diff options
author | Andy Wingo <wingo@pobox.com> | 2025-01-27 09:38:43 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2025-01-27 10:24:01 +0100 |
commit | 624d78625b81d29fac389c1947b127f3ca4a3e65 (patch) | |
tree | 7e80c6579e94a23f4f58a8a1465d4b7b4d6ec520 | |
parent | f109baebc005952a58726ee80b56bc5ef291af92 (diff) | |
download | guile-624d78625b81d29fac389c1947b127f3ca4a3e65.tar.gz |
Avoid accidentally-quadratic use of intmap-keys
* module/language/cps/utils.scm (compute-reachable-functions): Rework to
not call intmap-keys on a data structure that we are building up in a
loop.
-rw-r--r-- | module/language/cps/utils.scm | 33 |
1 files changed, 19 insertions, 14 deletions
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm index 24ede7ff5..f9092d0b3 100644 --- a/module/language/cps/utils.scm +++ b/module/language/cps/utils.scm @@ -1,6 +1,6 @@ ;;; Continuation-passing style (CPS) intermediate language (IL) -;; Copyright (C) 2013, 2014, 2015, 2017, 2018, 2019, 2020, 2021, 2023 Free Software Foundation, Inc. +;; Copyright (C) 2013-2015,2017-2021,2023,2025 Free Software Foundation, Inc. ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -171,12 +171,15 @@ predecessor." "Compute a mapping LABEL->LABEL..., where each key is a reachable $kfun and each associated value is the body of the function, as an intset." - (define (intset-cons i set) (intset-add set i)) - (define (visit-fun kfun body to-visit) + (define (visit-fun kfun body to-visit visited) + (define (add-function i to-visit) + (if (intset-ref visited i) + to-visit + (intset-add to-visit i))) (intset-fold (lambda (label to-visit) - (define (return kfun*) (fold intset-cons to-visit kfun*)) - (define (return1 kfun) (intset-add to-visit kfun)) + (define (return kfun*) (fold add-function to-visit kfun*)) + (define (return1 kfun) (add-function kfun to-visit)) (define (return0) to-visit) (match (intmap-ref conts label) (($ $kargs _ _ ($ $continue _ _ exp)) @@ -190,20 +193,22 @@ intset." (_ (return0)))) body to-visit)) - (let lp ((to-visit (intset kfun)) (visited empty-intmap)) - (let ((to-visit (intset-subtract to-visit (intmap-keys visited)))) - (if (eq? to-visit empty-intset) - visited + (let lp ((to-visit (intset kfun)) (visited empty-intset) (out empty-intmap)) + (if (eq? to-visit empty-intset) + out + (let ((visited (intset-union to-visit visited))) (call-with-values (lambda () (intset-fold - (lambda (kfun to-visit visited) - (let ((body (compute-function-body conts kfun))) - (values (visit-fun kfun body to-visit) - (intmap-add visited kfun body)))) + (lambda (kfun to-visit visited out) + (let* ((body (compute-function-body conts kfun))) + (values (visit-fun kfun body to-visit visited) + visited + (intmap-add out kfun body)))) to-visit empty-intset - visited)) + visited + out)) lp))))) (define* (compute-successors conts #:optional (kfun (intmap-next conts))) |