definition)))
;;; Handle the nontrivial case of CL:COMPILE.
-(defun actually-compile (name definition)
+(defun actually-compile (name definition *lexenv*)
(with-compilation-values
(sb!xc:with-compilation-unit ()
;; FIXME: These bindings were copied from SUB-COMPILE-FILE with
;; rebinding to itself is needed now that SBCL doesn't
;; need *BACKEND-INFO-ENVIRONMENT*.
(*info-environment* *info-environment*)
- (*lexenv* (make-null-lexenv))
(form (get-lambda-to-compile definition))
(*source-info* (make-lisp-source-info form))
(*toplevel-lambdas* ())
(*last-format-args* nil)
(*last-message-count* 0)
(*gensym-counter* 0)
+ ;; KLUDGE: This rebinding of policy is necessary so that
+ ;; forms such as LOCALLY at the REPL actually extend the
+ ;; compilation policy correctly. However, there is an
+ ;; invariant that is potentially violated: future
+ ;; refactoring must not allow this to be done in the file
+ ;; compiler. At the moment we're clearly alright, as we
+ ;; call %COMPILE with a core-object, not a fasl-stream,
+ ;; but caveat future maintainers. -- CSR, 2002-10-27
+ (*policy* (lexenv-policy *lexenv*))
;; FIXME: ANSI doesn't say anything about CL:COMPILE
;; interacting with these variables, so we shouldn't. As
;; of SBCL 0.6.7, COMPILE-FILE controls its verbosity by
:name name
:path '(original-source-start 0 0))))))
-(defun compile (name &optional (definition (fdefinition name)))
- #!+sb-doc
- "Coerce DEFINITION (by default, the function whose name is NAME)
- to a compiled function, returning (VALUES THING WARNINGS-P FAILURE-P),
- where if NAME is NIL, THING is the result of compilation, and
- otherwise THING is NAME. When NAME is not NIL, the compiled function
- is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
- (FDEFINITION NAME) otherwise."
+(defun compile-in-lexenv (name definition lexenv)
(multiple-value-bind (compiled-definition warnings-p failure-p)
(if (compiled-function-p definition)
(values definition nil nil)
- (actually-compile name definition))
+ (actually-compile name definition lexenv))
(cond (name
- (if (macro-function name)
+ (if (and (symbolp name)
+ (macro-function name))
(setf (macro-function name) compiled-definition)
(setf (fdefinition name) compiled-definition))
(values name warnings-p failure-p))
(t
(values compiled-definition warnings-p failure-p)))))
+
+(defun compile (name &optional (definition (or (macro-function name)
+ (fdefinition name))))
+ #!+sb-doc
+ "Coerce DEFINITION (by default, the function whose name is NAME)
+ to a compiled function, returning (VALUES THING WARNINGS-P FAILURE-P),
+ where if NAME is NIL, THING is the result of compilation, and
+ otherwise THING is NAME. When NAME is not NIL, the compiled function
+ is also set into (MACRO-FUNCTION NAME) if NAME names a macro, or into
+ (FDEFINITION NAME) otherwise."
+ (compile-in-lexenv name definition (make-null-lexenv)))