0.7.9.7:

[sbcl.git] / src / compiler / target-main.lisp

diff --git a/src/compiler/target-main.lisp b/src/compiler/target-main.lisp
index 23bfb23..6838041 100644 (file)
--- a/src/compiler/target-main.lisp
+++ b/src/compiler/target-main.lisp
@@ -28,7 +28,7 @@
        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
@@ -44,7 +44,6 @@
             ;; 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* ())
@@ -62,6 +61,15 @@
             (*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
@@ -76,19 +84,11 @@
                  :name name
                  :path '(original-source-start 0 0))))))
 
-(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."
+(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 (and (symbolp name)
                     (macro-function name))
@@ -97,3 +97,14 @@
           (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)))