Changeset 13522
- Timestamp:
- 08/21/11 09:10:43 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
r13488 r13522 1178 1178 (cond ((symbolp form) 1179 1179 (let (value) 1180 (cond ((null form) 1181 form) 1182 ((eq form t) 1183 form) 1184 ((keywordp form) 1185 form) 1186 ((and (constantp form) 1187 (progn 1188 (setf value (symbol-value form)) 1189 (or (numberp value) 1190 (stringp value) 1191 (pathnamep value)))) 1192 (setf form value)) 1193 (t 1194 (let ((variable (find-visible-variable form))) 1195 (when (null variable) 1196 (unless (or (special-variable-p form) 1197 (memq form *undefined-variables*)) 1198 (compiler-style-warn 1199 "Undefined variable ~S assumed special" form) 1200 (push form *undefined-variables*)) 1201 (setf variable (make-variable :name form :special-p t)) 1202 (push variable *visible-variables*)) 1203 (let ((ref (make-var-ref variable))) 1204 (unless (variable-special-p variable) 1205 (when (variable-ignore-p variable) 1206 (compiler-style-warn 1207 "Variable ~S is read even though it was declared to be ignored." 1208 (variable-name variable))) 1209 (push ref (variable-references variable)) 1210 (incf (variable-reads variable)) 1211 (cond ((eq (variable-compiland variable) *current-compiland*) 1212 (dformat t "p1: read ~S~%" form)) 1213 (t 1214 (dformat t "p1: non-local read ~S variable-compiland = ~S current compiland = ~S~%" 1215 form 1216 (compiland-name (variable-compiland variable)) 1217 (compiland-name *current-compiland*)) 1218 (setf (variable-used-non-locally-p variable) t)))) 1219 (setf form ref))) 1220 form)))) 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)))) 1221 1223 ((atom form) 1222 1224 form) … … 1224 1226 (let ((op (%car form)) 1225 1227 handler) 1226 (cond ((symbolp op) 1227 (when (compiler-macro-function op) 1228 (unless (notinline-p op) 1229 (multiple-value-bind (expansion expanded-p) 1230 (compiler-macroexpand form) 1231 ;; Fall through if no change... 1232 (when expanded-p 1233 (return-from p1 (p1 expansion)))))) 1234 (cond ((setf handler (get op 'p1-handler)) 1235 (funcall handler form)) 1236 ((macro-function op *compile-file-environment*) 1237 (p1 (macroexpand form *compile-file-environment*))) 1238 ((special-operator-p op) 1239 (compiler-unsupported "P1: unsupported special operator ~S" op)) 1240 (t 1241 (p1-function-call form)))) 1242 ((and (consp op) (eq (%car op) 'LAMBDA)) 1243 (let ((maybe-optimized-call (rewrite-function-call form))) 1244 (if (eq maybe-optimized-call form) 1245 (p1 `(%funcall (function ,op) ,@(cdr form))) 1246 (p1 maybe-optimized-call)))) 1247 (t 1248 form)))))) 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)))))) 1249 1253 1250 1254 (defun install-p1-handler (symbol handler)
Note: See TracChangeset
for help on using the changeset viewer.