Changeset 15795 in project for chicken


Ignore:
Timestamp:
09/08/09 14:26:40 (10 years ago)
Author:
felix
Message:

added compiler-syntax for map (not enabled yet)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/compiler-syntax.scm

    r15580 r15795  
    7272                       (,(cadr x) (##sys#slot ,%lst 0))
    7373                       (##core#app ,%loop (##sys#slot ,%lst 1))) ) )
     74        x)))
     75
     76#+xxx
     77(define-internal-compiler-syntax ((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 standard-bindings) ; 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)))
    74106        x)))
    75107
Note: See TracChangeset for help on using the changeset viewer.