Changeset 15234 in project for chicken/trunk/compiler.scm


Ignore:
Timestamp:
07/17/09 20:59:08 (12 years ago)
Author:
felix winkelmann
Message:

compiler-syntax based optimization of "o"; extended bindings weren't properly handled with regard to constant-folding; lambdas in operator position are now correctly handled and optimized (after expansion of procedure-call form)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • chicken/trunk/compiler.scm

    r15123 r15234  
    913913                                 se2 #f) ] )
    914914                          (set-real-names! aliases vars)
    915                           `(lambda ,aliases ,body) ) )
     915                          `(##core#lambda ,aliases ,body) ) )
    916916
    917917                        ((set! ##core#set!)
     
    12511251           (mapwalk x e se) )
    12521252
    1253           ((and (pair? (car x))
    1254                 (symbol? (caar x))
    1255                 (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda)))
    1256            (let ([lexp (car x)]
    1257                  [args (cdr x)] )
    1258              (emit-syntax-trace-info x #f)
    1259              (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se)
    1260              (let ([llist (cadr lexp)])
    1261                (if (and (proper-list? llist) (= (llist-length llist) (length args)))
    1262                    (walk `(##core#let
    1263                            ,(map list llist args) ,@(cddr lexp))
    1264                          e se dest)
    1265                    (let ((var (gensym 't)))
    1266                      (walk
    1267                       `(##core#let
    1268                         ((,var ,(car x)))
    1269                         (,var ,@(cdr x)) )
    1270                       e se dest) ) ) ) ) )
    1271          
    12721253          (else
    12731254           (emit-syntax-trace-info x #f)
    1274            (mapwalk x e se)) ) )
     1255           (let ((x (mapwalk x e se)))
     1256             (if (and (pair? (car x))
     1257                      (symbol? (caar x))
     1258                      (memq (or (lookup (caar x) se) (caar x)) '(lambda ##core#lambda)))
     1259                 (let ((lexp (car x))
     1260                       (args (cdr x)) )
     1261                   (##sys#check-syntax 'lambda lexp '(_ lambda-list . #(_ 1)) #f se)
     1262                   (let ((llist (cadr lexp)))
     1263                     (if (and (proper-list? llist) (= (llist-length llist) (length args)))
     1264                         `(let ,(map list llist args) ,@(cddr lexp))
     1265                         (let ((var (gensym 't)))
     1266                           `(let ((,var ,(car x)))
     1267                             (,var ,@(cdr x)) ) ) ) ) )
     1268                 x))) ) )
    12751269 
    12761270  (define (mapwalk xs e se)
Note: See TracChangeset for help on using the changeset viewer.