Changeset 13524
 Timestamp:
 08/21/11 12:58:49 (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass1.lisp
r13522 r13524 1176 1176 (defknown p1 (t) t) 1177 1177 (defun p1 (form) 1178 (cond ((symbolp form) 1179 (let (value) 1180 (cond 1181 ((null form) 1182 form) 1183 ((eq form t) 1184 form) 1185 ((keywordp form) 1186 form) 1187 ((and (constantp form) 1188 (progn 1189 (setf value (symbolvalue form)) 1190 (or (numberp value) 1191 (stringp value) 1192 (pathnamep value)))) 1193 (setf form value)) 1194 (t 1195 (let ((variable (findvisiblevariable form))) 1196 (when (null variable) 1197 (unless (or (specialvariablep form) 1198 (memq form *undefinedvariables*)) 1199 (compilerstylewarn 1200 "Undefined variable ~S assumed special" form) 1201 (push form *undefinedvariables*)) 1202 (setf variable (makevariable :name form :specialp t)) 1203 (push variable *visiblevariables*)) 1204 (let ((ref (makevarref variable))) 1205 (unless (variablespecialp variable) 1206 (when (variableignorep variable) 1207 (compilerstylewarn 1208 "Variable ~S is read even though it was declared to be ignored." 1209 (variablename variable))) 1210 (push ref (variablereferences variable)) 1211 (incf (variablereads variable)) 1212 (cond 1213 ((eq (variablecompiland variable) *currentcompiland*) 1214 (dformat t "p1: read ~S~%" form)) 1215 (t 1216 (dformat t "p1: nonlocal read ~S variablecompiland = ~S current compiland = ~S~%" 1217 form 1218 (compilandname (variablecompiland variable)) 1219 (compilandname *currentcompiland*)) 1220 (setf (variableusednonlocallyp variable) t)))) 1221 (setf form ref))) 1222 form)))) 1223 ((atom form) 1224 form) 1225 (t 1226 (let ((op (%car form)) 1227 handler) 1228 (cond 1229 ((symbolp op) 1230 (when (compilermacrofunction op) 1231 (unless (notinlinep op) 1232 (multiplevaluebind (expansion expandedp) 1233 (compilermacroexpand form) 1234 ;; Fall through if no change... 1235 (when expandedp 1236 (returnfrom p1 (p1 expansion)))))) 1237 (cond 1238 ((setf handler (get op 'p1handler)) 1239 (funcall handler form)) 1240 ((macrofunction op *compilefileenvironment*) 1241 (p1 (macroexpand form *compilefileenvironment*))) 1242 ((specialoperatorp op) 1243 (compilerunsupported "P1: unsupported special operator ~S" op)) 1244 (t 1245 (p1functioncall form)))) 1246 ((and (consp op) (eq (%car op) 'LAMBDA)) 1247 (let ((maybeoptimizedcall (rewritefunctioncall form))) 1248 (if (eq maybeoptimizedcall form) 1249 (p1 `(%funcall (function ,op) ,@(cdr form))) 1250 (p1 maybeoptimizedcall)))) 1251 (t 1252 form)))))) 1178 (cond 1179 ((symbolp form) 1180 (let (value) 1181 (cond 1182 ((null form) 1183 form) 1184 ((eq form t) 1185 form) 1186 ((keywordp form) 1187 form) 1188 ((and (constantp form) 1189 (progn 1190 (setf value (symbolvalue form)) 1191 (or (numberp value) 1192 (stringp value) 1193 (pathnamep value)))) 1194 (setf form value)) 1195 (t 1196 (let ((variable (findvisiblevariable form))) 1197 (when (null variable) 1198 (unless (or (specialvariablep form) 1199 (memq form *undefinedvariables*)) 1200 (compilerstylewarn 1201 "Undefined variable ~S assumed special" form) 1202 (push form *undefinedvariables*)) 1203 (setf variable (makevariable :name form :specialp t)) 1204 (push variable *visiblevariables*)) 1205 (let ((ref (makevarref variable))) 1206 (unless (variablespecialp variable) 1207 (when (variableignorep variable) 1208 (compilerstylewarn 1209 "Variable ~S is read even though it was declared to be ignored." 1210 (variablename variable))) 1211 (push ref (variablereferences variable)) 1212 (incf (variablereads variable)) 1213 (cond 1214 ((eq (variablecompiland variable) *currentcompiland*) 1215 (dformat t "p1: read ~S~%" form)) 1216 (t 1217 (dformat t "p1: nonlocal read ~S variablecompiland = ~S current compiland = ~S~%" 1218 form 1219 (compilandname (variablecompiland variable)) 1220 (compilandname *currentcompiland*)) 1221 (setf (variableusednonlocallyp variable) t)))) 1222 (setf form ref))) 1223 form)))) 1224 ((atom form) 1225 form) 1226 (t 1227 (let ((op (%car form)) 1228 handler) 1229 (cond 1230 ((symbolp op) 1231 (when (compilermacrofunction op) 1232 (unless (notinlinep op) 1233 (multiplevaluebind (expansion expandedp) 1234 (compilermacroexpand form) 1235 ;; Fall through if no change... 1236 (when expandedp 1237 (returnfrom p1 (p1 expansion)))))) 1238 (cond 1239 ((setf handler (get op 'p1handler)) 1240 (funcall handler form)) 1241 ((macrofunction op *compilefileenvironment*) 1242 (p1 (macroexpand form *compilefileenvironment*))) 1243 ((specialoperatorp op) 1244 (compilerunsupported "P1: unsupported special operator ~S" op)) 1245 (t 1246 (p1functioncall form)))) 1247 ((and (consp op) (eq (%car op) 'LAMBDA)) 1248 (let ((maybeoptimizedcall (rewritefunctioncall form))) 1249 (if (eq maybeoptimizedcall form) 1250 (p1 `(%funcall (function ,op) ,@(cdr form))) 1251 (p1 maybeoptimizedcall)))) 1252 (t 1253 form)))))) 1253 1254 1254 1255 (defun installp1handler (symbol handler)
Note: See TracChangeset
for help on using the changeset viewer.