Changeset 15815 in project for chicken


Ignore:
Timestamp:
09/09/09 10:08:28 (10 years ago)
Author:
felix
Message:

inlining of multi-arg for-each/map

Location:
chicken/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/NEWS

    r15794 r15815  
    88
    99- added compiler and interpreter option `-setup-mode'
     10
     11- various minor performance improvements
    1012
    1113
  • chicken/trunk/compiler-syntax.scm

    r15799 r15815  
    5959(define-internal-compiler-syntax ((for-each ##sys#for-each #%for-each) x r c)
    6060  (pair?)
    61   ;; XXX add support for multiple lists
    6261  (let ((%let (r 'let))
    6362        (%if (r 'if))
    6463        (%loop (r 'loop))
    65         (%lst (r 'lst))
    6664        (%begin (r 'begin))
    67         (%pair? (r 'pair?)))
     65        (%and (r 'and))
     66        (%pair? (r 'pair?))
     67        (lsts (cddr x)))
    6868    (if (and (memq 'for-each standard-bindings) ; we have to check this because the db (and thus
    69              (= (length+ x) 3))                  ; intrinsic marks) isn't set up yet
    70         `(,%let ,%loop ((,%lst ,(caddr x)))
    71                 (,%if (,%pair? ,%lst)
    72                       (,%begin
    73                        (,(cadr x) (##sys#slot ,%lst 0))
    74                        (##core#app ,%loop (##sys#slot ,%lst 1))) ) )
     69             (> (length+ x) 2))                  ; intrinsic marks) isn't set up yet
     70        (let ((vars (map (lambda _ (gensym)) lsts)))
     71          `(,%let ,%loop ,(map list vars lsts)
     72                  (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
     73                        (,%begin
     74                         (,(cadr x)
     75                          ,@(map (lambda (v) `(##sys#slot ,v 0)) vars))
     76                         (##core#app
     77                          ,%loop
     78                          ,@(map (lambda (v) `(##sys#slot ,v 1)) vars) ) ))))
    7579        x)))
    7680
    7781(define-internal-compiler-syntax ((map ##sys#map #%map) x r c)
    7882  (pair?)
    79   ;; XXX add support for multiple lists
    8083  (let ((%let (r 'let))
    81         (%let* (r 'let*))
    8284        (%if (r 'if))
    8385        (%loop (r 'loop))
    84         (%lst (r 'lst))
    8586        (%res (r 'res))
    8687        (%cons (r 'cons))
    8788        (%set! (r 'set!))
    8889        (%result (r 'result))
    89         (%x (r 'x))
    9090        (%node (r 'node))
    9191        (%quote (r 'quote))
    92         (%pair? (r 'pair?)))
     92        (%and (r 'and))
     93        (%pair? (r 'pair?))
     94        (lsts (cddr x)))
    9395    (if (and (memq 'map standard-bindings) ; s.a.
    94              (= 3 (length x)))
    95         `(,%let ((,%result (,%quote ()))
    96                  (,%node #f))
    97                 (,%let ,%loop ((,%lst ,(caddr x)))
    98                        (,%if (,%pair? ,%lst)
    99                              (,%let* ((,%x (##sys#slot ,%lst 0))
    100                                       (,%res (,%cons (,(cadr x) ,%x) (,%quote ()))))
    101                                      (,%if ,%node
    102                                            (##sys#setslot ,%node 1 ,%res)
    103                                            (,%set! ,%result ,%res))
    104                                      (,%set! ,%node ,%res)
    105                                      (,%loop (##sys#slot ,%lst 1)))
    106                              ,%result)))
     96             (> (length+ x) 2))
     97        (let ((vars (map (lambda _ (gensym)) lsts)))
     98          `(,%let ((,%result (,%quote ()))
     99                   (,%node #f))
     100                  (,%let ,%loop ,(map list vars lsts)
     101                       (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
     102                             (,%let ((,%res
     103                                      (,%cons
     104                                       (,(cadr x)
     105                                        ,@(map (lambda (v) `(##sys#slot ,v 0)) vars))
     106                                       (,%quote ()))))
     107                                    (,%if ,%node
     108                                          (##sys#setslot ,%node 1 ,%res)
     109                                          (,%set! ,%result ,%res))
     110                                    (,%set! ,%node ,%res)
     111                                    (,%loop
     112                                     ,@(map (lambda (v) `(##sys#slot ,v 1)) vars)))
     113                             ,%result))))
    107114        x)))
    108115
Note: See TracChangeset for help on using the changeset viewer.