- (case (car form)
- ;; FIXME: It's not clear to me why we would want this
- ;; special case; it might have been needed for some
- ;; variation of the old GENESIS system, but it certainly
- ;; doesn't seem to be needed for ours. Sometime after the
- ;; system is running I'd like to remove it tentatively and
- ;; see whether anything breaks, and if nothing does break,
- ;; remove it permanently. (And if we *do* want special
- ;; treatment of all these, we probably want to treat WARN
- ;; the same way..)
- ((error cerror break signal)
- (process-cold-load-form form path nil))
- ;; FIXME: ANSI seems to encourage things like DEFSTRUCT to
- ;; be done with EVAL-WHEN, without this kind of one-off
- ;; compiler magic.
- (sb!kernel:%compiler-defstruct
- (convert-and-maybe-compile form path)
- (compile-top-level-lambdas () t))
- ((eval-when)
- (unless (>= (length form) 2)
- (compiler-error "EVAL-WHEN form is too short: ~S" form))
- (do-eval-when-stuff
- (cadr form) (cddr form)
- #'(lambda (forms)
- (process-top-level-progn forms path))))
- ((macrolet)
- (unless (>= (length form) 2)
- (compiler-error "MACROLET form is too short: ~S" form))
- (do-macrolet-stuff
- (cadr form)
- #'(lambda ()
- (process-top-level-progn (cddr form) path))))
- (locally (process-top-level-locally form path))
- (progn (process-top-level-progn (cdr form) path))
- (t
- (let* ((uform (uncross form))
- (exp (preprocessor-macroexpand uform)))
- (if (eq exp uform)
- (convert-and-maybe-compile uform path)
- (process-top-level-form exp path))))))))
+ (flet ((need-at-least-one-arg (form)
+ (unless (cdr form)
+ (compiler-error "~S form is too short: ~S"
+ (car form)
+ form))))
+ (case (car form)
+ ;; FIXME: It's not clear to me why we would want this
+ ;; special case; it might have been needed for some
+ ;; variation of the old GENESIS system, but it certainly
+ ;; doesn't seem to be needed for ours. Sometime after the
+ ;; system is running I'd like to remove it tentatively and
+ ;; see whether anything breaks, and if nothing does break,
+ ;; remove it permanently. (And if we *do* want special
+ ;; treatment of all these, we probably want to treat WARN
+ ;; the same way..)
+ ((error cerror break signal)
+ (process-cold-load-form form path nil))
+ ((eval-when macrolet symbol-macrolet);things w/ 1 arg before body
+ (need-at-least-one-arg form)
+ (destructuring-bind (special-operator magic &rest body) form
+ (ecase special-operator
+ ((eval-when)
+ ;; CT, LT, and E here are as in Figure 3-7 of ANSI
+ ;; "3.2.3.1 Processing of Top Level Forms".
+ (multiple-value-bind (ct lt e)
+ (parse-eval-when-situations magic)
+ (let ((new-compile-time-too (or ct
+ (and compile-time-too
+ e))))
+ (cond (lt (process-top-level-progn
+ body path new-compile-time-too))
+ (new-compile-time-too (eval
+ `(progn ,@body)))))))
+ ((macrolet)
+ (funcall-in-macrolet-lexenv
+ magic
+ (lambda ()
+ (process-top-level-locally body
+ path
+ compile-time-too))))
+ ((symbol-macrolet)
+ (funcall-in-symbol-macrolet-lexenv
+ magic
+ (lambda ()
+ (process-top-level-locally body
+ path
+ compile-time-too)))))))
+ ((locally)
+ (process-top-level-locally (rest form) path compile-time-too))
+ ((progn)
+ (process-top-level-progn (rest form) path compile-time-too))
+ #+sb-xc-host
+ ;; Consider: What should we do when we hit e.g.
+ ;; (EVAL-WHEN (:COMPILE-TOPLEVEL)
+ ;; (DEFUN FOO (X) (+ 7 X)))?
+ ;; DEFUN has a macro definition in the cross-compiler,
+ ;; and a different macro definition in the target
+ ;; compiler. The only sensible thing is to use the
+ ;; target compiler's macro definition, since the
+ ;; cross-compiler's macro is in general into target
+ ;; functions which can't meaningfully be executed at
+ ;; cross-compilation time. So make sure we do the EVAL
+ ;; here, before we macroexpand.
+ ;;
+ ;; (Isn't it fun to cross-compile Common Lisp?:-)
+ (t
+ (when compile-time-too
+ (eval form)) ; letting xc host EVAL do its own macroexpansion
+ (let* ((uncrossed (uncross form))
+ ;; letting our cross-compiler do its macroexpansion too
+ (expanded (preprocessor-macroexpand uncrossed)))
+ (if (eq expanded uncrossed)
+ (convert-and-maybe-compile expanded path)
+ ;; Note that we also have to demote
+ ;; COMPILE-TIME-TOO to NIL, no matter what it was
+ ;; before, since otherwise we'd tend to EVAL
+ ;; subforms more than once.
+ (process-top-level-form expanded path nil))))
+ ;; When we're not cross-compiling, we only need to
+ ;; macroexpand once, so we can follow the 1-thru-6
+ ;; sequence of steps in ANSI's "3.2.3.1 Processing of
+ ;; Top Level Forms".
+ #-sb-xc-host
+ (t
+ (let ((expanded (preprocessor-macroexpand form)))
+ (cond ((eq expanded form)
+ (when compile-time-too
+ (eval form))
+ (convert-and-maybe-compile form path))
+ (t
+ (process-top-level-form expanded
+ path
+ compile-time-too))))))))))
projects / sbcl.git / blobdiff