Changeset 15795 in project
 Timestamp:
 09/08/09 14:26:40 (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

chicken/trunk/compilersyntax.scm
r15580 r15795 72 72 (,(cadr x) (##sys#slot ,%lst 0)) 73 73 (##core#app ,%loop (##sys#slot ,%lst 1))) ) ) 74 x))) 75 76 #+xxx 77 (defineinternalcompilersyntax ((map ##sys#map #%map) x r c) 78 (pair?) 79 (let ((%let (r 'let)) 80 (%let* (r 'let*)) 81 (%if (r 'if)) 82 (%loop (r 'loop)) 83 (%lst (r 'lst)) 84 (%res (r 'res)) 85 (%cons (r 'cons)) 86 (%set! (r 'set!)) 87 (%result (r 'result)) 88 (%x (r 'x)) 89 (%node (r 'node)) 90 (%quote (r 'quote)) 91 (%pair? (r 'pair?))) 92 (if (and (memq 'map standardbindings) ; s.a. 93 (= 3 (length x))) 94 `(,%let ((,%result (,%quote ())) 95 (,%node #f)) 96 (,%let ,%loop ((,%lst ,(caddr x))) 97 (,%if (,%pair? ,%lst) 98 (,%let* ((,%x (##sys#slot ,%lst 0)) 99 (,%res (,%cons (,(cadr x) ,%x) (,%quote ())))) 100 (,%if ,%node 101 (##sys#setslot ,%node 1 ,%res) 102 (,%set! ,%result ,%res)) 103 (,%set! ,%node ,%res) 104 (,%loop (##sys#slot ,%lst 1))) 105 ,%result))) 74 106 x))) 75 107
Note: See TracChangeset
for help on using the changeset viewer.