~ 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