Changeset 15817 in project


Ignore:
Timestamp:
09/10/09 15:11:08 (10 years ago)
Author:
felix winkelmann
Message:

avoid inlining map/for-each for possibly side-effecting operator

Location:
chicken/trunk
Files:
2 edited

Legend:

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

    r15815 r15817  
    6565        (%and (r 'and))
    6666        (%pair? (r 'pair?))
     67        (%lambda (r 'lambda))
    6768        (lsts (cddr x)))
    6869    (if (and (memq 'for-each standard-bindings) ; we have to check this because the db (and thus
    69              (> (length+ x) 2))                  ; intrinsic marks) isn't set up yet
     70             (> (length+ x) 2)                   ; intrinsic marks) isn't set up yet
     71             (or (and (pair? (cadr x))
     72                      (c %lambda (caadr x)))
     73                 (symbol? (cadr x))))
    7074        (let ((vars (map (lambda _ (gensym)) lsts)))
    7175          `(,%let ,%loop ,(map list vars lsts)
     
    9094        (%node (r 'node))
    9195        (%quote (r 'quote))
     96        (%lambda (r 'lambda))
    9297        (%and (r 'and))
    9398        (%pair? (r 'pair?))
    9499        (lsts (cddr x)))
    95100    (if (and (memq 'map standard-bindings) ; s.a.
    96              (> (length+ x) 2))
     101             (> (length+ x) 2)
     102             (or (and (pair? (cadr x))
     103                      (c %lambda (caadr x)))
     104                 (symbol? (cadr x))))
    97105        (let ((vars (map (lambda _ (gensym)) lsts)))
    98106          `(,%let ((,%result (,%quote ()))
  • chicken/trunk/tests/compiler-tests-2.scm

    r15543 r15817  
    1 ;;; compiler-tests-2.scm - tests for compiler with -lambda-lift
     1;;; compiler-tests-2.scm - tests for particular compiler optimizations
    22
    33
     
    2525
    2626(assert (= 3 (len '(1 2 3))))
     27
     28
     29;;; compiler-syntax for map/for-each must be careful when the
     30;   operator may have side-effects (currently only lambda exprs and symbols
     31;   are allowed)
     32
     33(let ((x #f))
     34  (define (f1 x) (print* x " "))
     35  (map f1 '(1 2 3))
     36  (newline)
     37  (map (begin (assert (not x))
     38              (set! x #t)
     39              f1)
     40       '(1 2 3))
     41  (map (lambda (x) (print* ":" x)) '(1 2 3))
     42  (newline))
Note: See TracChangeset for help on using the changeset viewer.