Changeset 12562
 Timestamp:
 03/19/10 21:19:34 (11 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass1.lisp
r12526 r12562 1244 1244 (defknown rewritefunctioncall (t) t) 1245 1245 (defun rewritefunctioncall (form) 1246 (let ((op (car form)) 1247 (args (cdr form))) 1248 (if (and (listp op) 1249 (eq (car op) 'lambda)) 1250 (expandfunctioncallinline form (cadr op) (copytree (cddr op)) args) 1251 (if (unsafep 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 (returnfrom rewritefunctioncall 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 (expandfunctioncallinline form (cadr op) (copytree (cddr op)) 1252 args))) 1253 ((and (listp op) (eq (car op) 'lambda)) 1254 ;;((lambda (...) ...) ...) 1255 (expandfunctioncallinline form (cadr op) (copytree (cddr op)) args)) 1256 (t (if (unsafep 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 (returnfrom rewritefunctioncall 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))))) 1272 1277 1273 1278 (defknown p1functioncall (t) t)
Note: See TracChangeset
for help on using the changeset viewer.