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/compiler-pass1.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 (symbol-value form)) 1190 (or (numberp value) 1191 (stringp value) 1192 (pathnamep value)))) 1193 (setf form value)) 1194 (t 1195 (let ((variable (find-visible-variable form))) 1196 (when (null variable) 1197 (unless (or (special-variable-p form) 1198 (memq form *undefined-variables*)) 1199 (compiler-style-warn 1200 "Undefined variable ~S assumed special" form) 1201 (push form *undefined-variables*)) 1202 (setf variable (make-variable :name form :special-p t)) 1203 (push variable *visible-variables*)) 1204 (let ((ref (make-var-ref variable))) 1205 (unless (variable-special-p variable) 1206 (when (variable-ignore-p variable) 1207 (compiler-style-warn 1208 "Variable ~S is read even though it was declared to be ignored." 1209 (variable-name variable))) 1210 (push ref (variable-references variable)) 1211 (incf (variable-reads variable)) 1212 (cond 1213 ((eq (variable-compiland variable) *current-compiland*) 1214 (dformat t "p1: read ~S~%" form)) 1215 (t 1216 (dformat t "p1: non-local read ~S variable-compiland = ~S current compiland = ~S~%" 1217 form 1218 (compiland-name (variable-compiland variable)) 1219 (compiland-name *current-compiland*)) 1220 (setf (variable-used-non-locally-p 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 (compiler-macro-function op) 1231 (unless (notinline-p op) 1232 (multiple-value-bind (expansion expanded-p) 1233 (compiler-macroexpand form) 1234 ;; Fall through if no change... 1235 (when expanded-p 1236 (return-from p1 (p1 expansion)))))) 1237 (cond 1238 ((setf handler (get op 'p1-handler)) 1239 (funcall handler form)) 1240 ((macro-function op *compile-file-environment*) 1241 (p1 (macroexpand form *compile-file-environment*))) 1242 ((special-operator-p op) 1243 (compiler-unsupported "P1: unsupported special operator ~S" op)) 1244 (t 1245 (p1-function-call form)))) 1246 ((and (consp op) (eq (%car op) 'LAMBDA)) 1247 (let ((maybe-optimized-call (rewrite-function-call form))) 1248 (if (eq maybe-optimized-call form) 1249 (p1 `(%funcall (function ,op) ,@(cdr form))) 1250 (p1 maybe-optimized-call)))) 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 (symbol-value form)) 1191 (or (numberp value) 1192 (stringp value) 1193 (pathnamep value)))) 1194 (setf form value)) 1195 (t 1196 (let ((variable (find-visible-variable form))) 1197 (when (null variable) 1198 (unless (or (special-variable-p form) 1199 (memq form *undefined-variables*)) 1200 (compiler-style-warn 1201 "Undefined variable ~S assumed special" form) 1202 (push form *undefined-variables*)) 1203 (setf variable (make-variable :name form :special-p t)) 1204 (push variable *visible-variables*)) 1205 (let ((ref (make-var-ref variable))) 1206 (unless (variable-special-p variable) 1207 (when (variable-ignore-p variable) 1208 (compiler-style-warn 1209 "Variable ~S is read even though it was declared to be ignored." 1210 (variable-name variable))) 1211 (push ref (variable-references variable)) 1212 (incf (variable-reads variable)) 1213 (cond 1214 ((eq (variable-compiland variable) *current-compiland*) 1215 (dformat t "p1: read ~S~%" form)) 1216 (t 1217 (dformat t "p1: non-local read ~S variable-compiland = ~S current compiland = ~S~%" 1218 form 1219 (compiland-name (variable-compiland variable)) 1220 (compiland-name *current-compiland*)) 1221 (setf (variable-used-non-locally-p 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 (compiler-macro-function op) 1232 (unless (notinline-p op) 1233 (multiple-value-bind (expansion expanded-p) 1234 (compiler-macroexpand form) 1235 ;; Fall through if no change... 1236 (when expanded-p 1237 (return-from p1 (p1 expansion)))))) 1238 (cond 1239 ((setf handler (get op 'p1-handler)) 1240 (funcall handler form)) 1241 ((macro-function op *compile-file-environment*) 1242 (p1 (macroexpand form *compile-file-environment*))) 1243 ((special-operator-p op) 1244 (compiler-unsupported "P1: unsupported special operator ~S" op)) 1245 (t 1246 (p1-function-call form)))) 1247 ((and (consp op) (eq (%car op) 'LAMBDA)) 1248 (let ((maybe-optimized-call (rewrite-function-call form))) 1249 (if (eq maybe-optimized-call form) 1250 (p1 `(%funcall (function ,op) ,@(cdr form))) 1251 (p1 maybe-optimized-call)))) 1252 (t 1253 form)))))) 1253 1254 1254 1255 (defun install-p1-handler (symbol handler)
Note: See TracChangeset
for help on using the changeset viewer.