0.7.8.41:

[sbcl.git] / src / compiler / ir1-translators.lisp

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 76b2edc..14823c9 100644 (file)
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -250,7 +250,7 @@
     (compiler-style-warn "duplicate definitions in ~S" definitions))
   (let* ((processed-definitions (mapcar definitionize-fun definitions))
          (*lexenv* (make-lexenv definitionize-keyword processed-definitions)))
     (compiler-style-warn "duplicate definitions in ~S" definitions))
   (let* ((processed-definitions (mapcar definitionize-fun definitions))
          (*lexenv* (make-lexenv definitionize-keyword processed-definitions)))

-    (funcall fun)))
+    (funcall fun definitionize-keyword processed-definitions)))

 
 ;;; Tweak *LEXENV* to include the DEFINITIONS from a MACROLET, then
 ;;; call FUN (with no arguments).
 
 ;;; Tweak *LEXENV* to include the DEFINITIONS from a MACROLET, then
 ;;; call FUN (with no arguments).

@@ -275,10 +275,12 @@
             (parse-defmacro arglist whole body name 'macrolet
                             :environment environment)
           `(,name macro .
             (parse-defmacro arglist whole body name 'macrolet
                             :environment environment)
           `(,name macro .

-                  ,(compile nil
-                            `(lambda (,whole ,environment)
-                               ,@local-decls
-                               (block ,name ,body))))))))
+                  ,(compile-in-lexenv
+                     nil
+                     `(lambda (,whole ,environment)
+                        ,@local-decls
+                        (block ,name ,body))
+                     (make-restricted-lexenv *lexenv*)))))))

    :funs
    definitions
    fun))
    :funs
    definitions
    fun))

@@ -290,9 +292,11 @@
   defined. Name is the local macro name, Lambda-List is the DEFMACRO style
   destructuring lambda list, and the Forms evaluate to the expansion. The
   Forms are evaluated in the null environment."
   defined. Name is the local macro name, Lambda-List is the DEFMACRO style
   destructuring lambda list, and the Forms evaluate to the expansion. The
   Forms are evaluated in the null environment."

-  (funcall-in-macrolet-lexenv definitions
-                             (lambda ()
-                               (ir1-translate-locally body start cont))))
+  (funcall-in-macrolet-lexenv
+   definitions
+   (lambda (&key funs)
+     (declare (ignore funs))
+     (ir1-translate-locally body start cont))))

 
 (defun funcall-in-symbol-macrolet-lexenv (definitions fun)
   (%funcall-in-foomacrolet-lexenv
 
 (defun funcall-in-symbol-macrolet-lexenv (definitions fun)
   (%funcall-in-foomacrolet-lexenv

@@ -319,8 +323,8 @@
   body, references to a Name will effectively be replaced with the Expansion."
   (funcall-in-symbol-macrolet-lexenv
    macrobindings
   body, references to a Name will effectively be replaced with the Expansion."
   (funcall-in-symbol-macrolet-lexenv
    macrobindings

-   (lambda ()
-     (ir1-translate-locally body start cont))))
+   (lambda (&key vars)
+     (ir1-translate-locally body start cont :vars vars))))

 
 ;;; not really a special form, but..
 (def-ir1-translator declare ((&rest stuff) start cont)
 
 ;;; not really a special form, but..
 (def-ir1-translator declare ((&rest stuff) start cont)

@@ -457,13 +461,15 @@
 ;;; for the function used to implement
 ;;;   (DEFMETHOD PRINT-OBJECT :AROUND ((SS STARSHIP) STREAM) ...).
 (def-ir1-translator named-lambda ((name &rest rest) start cont)
 ;;; for the function used to implement
 ;;;   (DEFMETHOD PRINT-OBJECT :AROUND ((SS STARSHIP) STREAM) ...).
 (def-ir1-translator named-lambda ((name &rest rest) start cont)

-  (reference-leaf start
-                 cont
-                 (if (legal-fun-name-p name)
-                     (ir1-convert-lambda `(lambda ,@rest)
-                                         :source-name name)
-                     (ir1-convert-lambda `(lambda ,@rest)
-                                         :debug-name name))))
+  (let* ((fun (if (legal-fun-name-p name)
+                  (ir1-convert-lambda `(lambda ,@rest)
+                                      :source-name name)
+                  (ir1-convert-lambda `(lambda ,@rest)
+                                      :debug-name name)))
+         (leaf (reference-leaf start cont fun)))
+    (when (legal-fun-name-p name)
+      (assert-global-function-definition-type name fun))
+    leaf))

 \f
 ;;;; FUNCALL
 
 \f
 ;;;; FUNCALL
 

@@ -577,10 +583,10 @@
 ;;; but we don't need to worry about that within an IR1 translator,
 ;;; since toplevel-formness is picked off by PROCESS-TOPLEVEL-FOO
 ;;; forms before we hit the IR1 transform level.
 ;;; but we don't need to worry about that within an IR1 translator,
 ;;; since toplevel-formness is picked off by PROCESS-TOPLEVEL-FOO
 ;;; forms before we hit the IR1 transform level.

-(defun ir1-translate-locally (body start cont)
+(defun ir1-translate-locally (body start cont &key vars funs)

   (declare (type list body) (type continuation start cont))
   (multiple-value-bind (forms decls) (parse-body body nil)
   (declare (type list body) (type continuation start cont))
   (multiple-value-bind (forms decls) (parse-body body nil)

-    (let ((*lexenv* (process-decls decls nil nil cont)))
+    (let ((*lexenv* (process-decls decls vars funs cont)))

       (ir1-convert-aux-bindings start cont forms nil nil))))
 
 (def-ir1-translator locally ((&body body) start cont)
       (ir1-convert-aux-bindings start cont forms nil nil))))
 
 (def-ir1-translator locally ((&body body) start cont)