Changeset 12562


Ignore:
Timestamp:
03/19/10 21:19:34 (11 years ago)
Author:
astalla
Message:

Inlining of lambda calls: handled the case (funcall (lambda (...) ...) ...)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

    r12526 r12562  
    12441244(defknown rewrite-function-call (t) t)
    12451245(defun rewrite-function-call (form)
    1246   (let ((op (car form))
    1247   (args (cdr form)))
    1248     (if (and (listp op)
    1249        (eq (car op) 'lambda))
    1250   (expand-function-call-inline form (cadr op) (copy-tree (cddr op)) args)
    1251   (if (unsafe-p args)
    1252       (let ((arg1 (car args)))
    1253         (cond ((and (consp arg1) (eq (car arg1) 'GO))
    1254          arg1)
    1255         (t
    1256          (let ((syms ())
    1257          (lets ()))
    1258            ;; Preserve the order of evaluation of the arguments!
    1259            (dolist (arg args)
    1260        (cond ((constantp arg)
    1261         (push arg syms))
    1262              ((and (consp arg) (eq (car arg) 'GO))
    1263         (return-from rewrite-function-call
    1264           (list 'LET* (nreverse lets) arg)))
    1265              (t
    1266         (let ((sym (gensym)))
    1267           (push sym syms)
    1268           (push (list sym arg) lets)))))
    1269            (list 'LET* (nreverse lets)
    1270            (list* (car form) (nreverse syms)))))))
    1271       form))))
     1246  (let ((op (car form)) (args (cdr form)))
     1247    (cond
     1248      ((and (eq op 'funcall) (listp (car args)) (eq (caar args) 'lambda))
     1249       ;;(funcall (lambda (...) ...) ...)
     1250       (let ((op (car args)) (args (cdr args)))
     1251   (expand-function-call-inline form (cadr op) (copy-tree (cddr op))
     1252              args)))
     1253      ((and (listp op) (eq (car op) 'lambda))
     1254       ;;((lambda (...) ...) ...)
     1255       (expand-function-call-inline form (cadr op) (copy-tree (cddr op)) args))
     1256      (t (if (unsafe-p args)
     1257       (let ((arg1 (car args)))
     1258         (cond ((and (consp arg1) (eq (car arg1) 'GO))
     1259          arg1)
     1260         (t
     1261          (let ((syms ())
     1262          (lets ()))
     1263      ;; Preserve the order of evaluation of the arguments!
     1264      (dolist (arg args)
     1265        (cond ((constantp arg)
     1266         (push arg syms))
     1267        ((and (consp arg) (eq (car arg) 'GO))
     1268         (return-from rewrite-function-call
     1269           (list 'LET* (nreverse lets) arg)))
     1270        (t
     1271         (let ((sym (gensym)))
     1272           (push sym syms)
     1273           (push (list sym arg) lets)))))
     1274      (list 'LET* (nreverse lets)
     1275            (list* (car form) (nreverse syms)))))))
     1276       form)))))
    12721277
    12731278(defknown p1-function-call (t) t)
Note: See TracChangeset for help on using the changeset viewer.