[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Not fixing ‘letrec*’
From: |
Ludovic Courtès |
Subject: |
Not fixing ‘letrec*’ |
Date: |
Sun, 27 Feb 2011 13:19:20 +0100 |
User-agent: |
Gnus/5.110011 (No Gnus v0.11) Emacs/23.2 (gnu/linux) |
Hello!
We don't do “Fix letrec (reloaded)”, so ‘letrec*’ (and thus internal
defines) are compiled sub-optimally:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,c (letrec* ((x 2)(y 3)) y)
Disassembly of #<objcode 1ea7a28>:
0 (assert-nargs-ee/locals 16)
2 (make-int8 3) ;; 3
4 (void)
5 (box 1)
7 (local-set 0)
9 (make-int8 2) ;; 2
11 (local-boxed-set 1)
13 (local-ref 0)
15 (return)
--8<---------------cut here---------------end--------------->8---
The patch below hacks around it by converting ‘letrec*’ to ‘letrec’ when
all the inits are simple expressions or lambdas:
--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> ,c (letrec* ((x 2)(y 3)) y)
Disassembly of #<objcode 5c1f9a8>:
0 (assert-nargs-ee/locals 8)
2 (make-int8 3) ;; 3
4 (local-set 0)
6 (local-ref 0)
8 (return)
--8<---------------cut here---------------end--------------->8---
diff --git a/module/language/tree-il/fix-letrec.scm
b/module/language/tree-il/fix-letrec.scm
index 8d4b239..2e696e4 100644
--- a/module/language/tree-il/fix-letrec.scm
+++ b/module/language/tree-il/fix-letrec.scm
@@ -176,8 +176,34 @@
'())))
(values unref simple lambda* complex)))
+(define (maybe-simplify-letrec* x)
+ ;; If X is a `letrec*', return an equivalent `letrec' when it's
+ ;; possible. This function is a hack until we implement the algorithm
+ ;; described in "Fixing Letrec (Reloaded)" (Ghuloum and Dybvig) to
+ ;; allow cases such as
+ ;; (letrec* ((f (lambda () ...))(g (lambda () ...))) ...)
+ ;; or
+ ;; (letrec* ((x 2)(y 3)) y)
+ ;; to be optimized. These can be common when using internal defines.
+ (post-order!
+ (lambda (x)
+ (record-case x
+ ((<letrec> src in-order? names gensyms vals body)
+ (if (and in-order?
+ (every (lambda (x)
+ (or (lambda? x)
+ (simple-expression?
+ x gensyms
+ effect+exception-free-primitive?)))
+ vals))
+ (make-letrec src #f names gensyms vals body)
+ x))
+ (else x)))
+ x))
+
(define (fix-letrec! x)
- (let-values (((unref simple lambda* complex) (partition-vars x)))
+ (let-values (((unref simple lambda* complex)
+ (partition-vars (maybe-simplify-letrec* x))))
(post-order!
(lambda (x)
(record-case x
@@ -271,3 +297,7 @@
(else x)))
x)))
+
+;;; Local Variables:
+;;; eval: (put 'record-case 'scheme-indent-function 1)
+;;; End:
Modified test-suite/tests/tree-il.test
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 76c825d..8ea2443 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -363,7 +363,18 @@
(lexical #t #t set 1)
(lexical #t #t ref 0)
(lexical #t #t ref 1)
- (call add 2) (call return 1) (unbind))))
+ (call add 2) (call return 1) (unbind)))
+
+ ;; simple bindings in letrec* -> equivalent to letrec
+ (assert-tree-il->glil
+ (letrec* (x y) (xx yy) ((const 1) (const 2))
+ (lexical y yy))
+ (program () (std-prelude 0 1 #f) (label _)
+ (const 2)
+ (bind (y #f 0)) ;; X is removed, and Y is unboxed
+ (lexical #t #f set 0)
+ (lexical #t #f ref 0)
+ (call return 1) (unbind))))
(with-test-prefix "lambda"
(assert-tree-il->glil
OK to commit?
I *think* ‘effect-free-primitive?’ would be enough above. WDYT?
Thanks,
Ludo’.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- Not fixing ‘letrec*’,
Ludovic Courtès <=