diff options
author | Andy Wingo <wingo@pobox.com> | 2011-09-27 09:48:18 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-09-28 00:13:55 +0200 |
commit | fbc9387f68be677663e6756c35afa973a9dc0a1a (patch) | |
tree | f51b2b232271fd1aeb7e672f66eb37555e070926 /module/language/tree-il/optimize.scm | |
parent | 58b5a2d4e10d2afb34dfcb086d2550e936800b3f (diff) | |
download | guile-fbc9387f68be677663e6756c35afa973a9dc0a1a.tar.gz |
peval: fix algorithmic behavior of `cons'
* module/language/tree-il/optimize.scm (peval): Fix treatment of `cons'
to not process the value twice, leading to n^2 work. This prevented
primitives.scm from compiling in a reasonable amount of time, because
it contained a `(foo ... ,@bar) form that resulted in a long sequence
of nested conses, and no effort counter was in place as it was not
within an inlining attempt.
Diffstat (limited to 'module/language/tree-il/optimize.scm')
-rw-r--r-- | module/language/tree-il/optimize.scm | 23 |
1 files changed, 12 insertions, 11 deletions
diff --git a/module/language/tree-il/optimize.scm b/module/language/tree-il/optimize.scm index d097331ed..bff6ed101 100644 --- a/module/language/tree-il/optimize.scm +++ b/module/language/tree-il/optimize.scm @@ -775,17 +775,18 @@ it does not handle <fix> and <let-values>, it should be called before (else (match (cons name (map for-value orig-args)) (('cons head tail) - (let ((tail (for-value tail))) - (match tail - (($ <const> src ()) - (make-application src (make-primitive-ref #f 'list) - (list head))) - (($ <application> src ($ <primitive-ref> _ 'list) elts) - (make-application src (make-primitive-ref #f 'list) - (cons head elts))) - (_ (make-application src proc - (list head tail)))))) - + (match tail + (($ <const> src ()) + (make-application src (make-primitive-ref #f 'list) + (list head))) + (($ <application> src ($ <primitive-ref> _ 'list) elts) + (make-application src (make-primitive-ref #f 'list) + (cons head elts))) + (_ (make-application src proc + (list head tail))))) + + ;; FIXME: these for-tail recursions could take + ;; place outside an effort counter. (('car ($ <application> src ($ <primitive-ref> _ 'cons) (head tail))) (for-tail (make-sequence src (list tail head)))) (('cdr ($ <application> src ($ <primitive-ref> _ 'cons) (head tail))) |