X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1-translators.lisp;h=14823c990497cb39229548b0ab8e3030a850bccc;hb=25070981025894faaef260a38b83fd0bbcfdc80d;hp=76b2edcd39d88217ab18bbc2b33d76c4e115f334;hpb=b9b343d54da89ea7f3d2ac7823c34078775f7cad;p=sbcl.git

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 76b2edc..14823c9 100644
--- 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)))
-    (funcall fun)))
+    (funcall fun definitionize-keyword processed-definitions)))
 
 ;;; 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 .
-		   ,(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))
@@ -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."
-  (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
@@ -319,8 +323,8 @@
   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)
@@ -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)
-  (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))
 
 ;;;; 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.
-(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)
-    (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)