Changeset 13147 for trunk/abcl/src/org/armedbear/lisp/compilerpass1.lisp
 Timestamp:
 01/14/11 15:57:37 (11 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass1.lisp
r13118 r13147 1290 1290 (let* ((op (car form)) 1291 1291 (localfunction (findlocalfunction op))) 1292 ( cond (localfunction1292 (when localfunction 1293 1293 ;; (format t "p1 local call to ~S~%" op) 1294 1294 ;; (format t "inlinep = ~S~%" (inlinep op)) 1295 (when (and *enableinlineexpansion* (inlinep op) 1296 (localfunctiondefinition localfunction)) 1297 (let* ((definition (localfunctiondefinition localfunction)) 1298 (lambdalist (car definition)) 1299 (body (cdr definition)) 1300 (expansion (generateinlineexpansion op lambdalist body 1301 (cdr form)))) 1302 (when expansion 1303 (let ((explain *explain*)) 1304 (when (and explain (memq :calls explain)) 1305 (format t "; inlining call to local function ~S~%" op))) 1306 (returnfrom p1functioncall 1307 (let ((*inlinedeclarations* 1308 (remove op *inlinedeclarations* :key #'car :test #'equal))) 1309 (p1 expansion)))))) 1310 1311 ;; FIXME 1312 (dformat t "local function assumed not singlevalued~%") 1313 (setf (compiland%singlevaluedp *currentcompiland*) nil) 1314 1315 (let ((variable (localfunctionvariable localfunction))) 1316 (when variable 1317 (dformat t "p1 ~S used nonlocally~%" (variablename variable)) 1318 (setf (variableusednonlocallyp variable) t)))) 1319 (t 1320 ;; Not a local function call. 1321 (dformat t "p1 nonlocal call to ~S~%" op) 1322 (unless (singlevaluedp form) 1323 ;; (format t "not singlevalued op = ~S~%" op) 1324 (setf (compiland%singlevaluedp *currentcompiland*) nil))))) 1295 1296 (when (and *enableinlineexpansion* (inlinep op) 1297 (localfunctiondefinition localfunction)) 1298 (let* ((definition (localfunctiondefinition localfunction)) 1299 (lambdalist (car definition)) 1300 (body (cdr definition)) 1301 (expansion (generateinlineexpansion op lambdalist body 1302 (cdr form)))) 1303 (when expansion 1304 (let ((explain *explain*)) 1305 (when (and explain (memq :calls explain)) 1306 (format t "; inlining call to local function ~S~%" op))) 1307 (returnfrom p1functioncall 1308 (let ((*inlinedeclarations* 1309 (remove op *inlinedeclarations* :key #'car :test #'equal))) 1310 (p1 expansion)))))) 1311 1312 (let ((variable (localfunctionvariable localfunction))) 1313 (when variable 1314 (dformat t "p1 ~S used nonlocally~%" (variablename variable)) 1315 (setf (variableusednonlocallyp variable) t))))) 1325 1316 (p1default form)) 1326 1317 … … 1458 1449 (closure (makeclosure `(lambda ,lambdalist nil) nil)) 1459 1450 (syms (sys::varlist closure)) 1460 (vars nil)) 1451 (vars nil) 1452 compilandresult) 1461 1453 (dolist (sym syms) 1462 1454 (let ((var (makevariable :name sym … … 1470 1462 (dolist (var freespecials) 1471 1463 (push var *visiblevariables*))) 1464 (setf compilandresult 1465 (list* 'LAMBDA lambdalist (p1body body))) 1466 (setf (compiland%singlevaluedp compiland) 1467 (singlevaluedp compilandresult)) 1472 1468 (setf (compilandp1result compiland) 1473 (list* 'LAMBDA lambdalist (p1body body))))))1469 compilandresult)))) 1474 1470 1475 1471 (provide "COMPILERPASS1")
Note: See TracChangeset
for help on using the changeset viewer.