~ chicken-core (chicken-5) 0f1330246075166051ab396b1c31c06a167b97b3
commit 0f1330246075166051ab396b1c31c06a167b97b3
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Mon Dec 21 12:18:48 2015 +1300
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Mon Dec 21 21:52:40 2015 +0100
Use pair as loop result handle in compiler-syntax for `map`
This allows the expansion to blindly dereference the second slot of the
value accumulated by the loop, avoiding the need for a conditional that
detects the first iteration and updates the loop's result box and
removing the continuation resulting from that conditional. Because the
map-loop is then free of any CPS calls, it compiles to a label and goto.
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 520c7752..6c7e81ef 100644
--- a/compiler-syntax.scm
+++ b/compiler-syntax.scm
@@ -118,28 +118,26 @@
(if (and (memq 'map standard-bindings) ; s.a.
(> (length+ x) 2))
(let ((vars (map (lambda _ (gensym)) lsts)))
- `(,%let ((,%result (,%quote ()))
- (,%node #f)
- (,%proc ,(cadr x))
- ,@(map list vars lsts))
- ,@(map (lambda (var)
- `(##core#check (##sys#check-list ,var (,%quote map))))
- vars)
- (,%let ,%loop ,(map list vars vars)
- (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
- (,%let ((,%res
- (,%cons
- (,%proc
- ,@(map (lambda (v) `(##sys#slot ,v 0)) vars))
- (,%quote ()))))
- (,%if ,%node
- (##sys#setslot ,%node 1 ,%res)
- (,%set! ,%result ,%res))
- (,%set! ,%node ,%res)
- (##core#app
- ,%loop
- ,@(map (lambda (v) `(##sys#slot ,v 1)) vars)))
- ,%result))))
+ `(,%let ((,%node (,%cons (##core#undefined) (,%quote ()))))
+ (,%let ((,%result ,%node)
+ (,%proc ,(cadr x))
+ ,@(map list vars lsts))
+ ,@(map (lambda (var)
+ `(##core#check (##sys#check-list ,var (,%quote map))))
+ vars)
+ (,%let ,%loop ,(map list vars vars)
+ (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
+ (,%let ((,%res
+ (,%cons
+ (,%proc
+ ,@(map (lambda (v) `(##sys#slot ,v 0)) vars))
+ (,%quote ()))))
+ (##sys#setslot ,%node 1 ,%res)
+ (,%set! ,%node ,%res)
+ (##core#app
+ ,%loop
+ ,@(map (lambda (v) `(##sys#slot ,v 1)) vars)))
+ (##sys#slot ,%result 1))))))
x)))
(define-internal-compiler-syntax ((chicken.data-structures#o) x r c) ()
Trap