summaryrefslogtreecommitdiff
path: root/module/language/tree-il/optimize.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2011-09-27 09:48:18 +0200
committerAndy Wingo <wingo@pobox.com>2011-09-28 00:13:55 +0200
commitfbc9387f68be677663e6756c35afa973a9dc0a1a (patch)
treef51b2b232271fd1aeb7e672f66eb37555e070926 /module/language/tree-il/optimize.scm
parent58b5a2d4e10d2afb34dfcb086d2550e936800b3f (diff)
downloadguile-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.scm23
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)))