X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fir1-translators.lisp;h=88f8ff3f5f80f6feea06f3f27406e6e42c8a08ec;hb=d492ebb264e900df38f21c904f5d2f5c46c8b8da;hp=274ce421a8f7312a045d7d7e0eb7c3e838cb3df9;hpb=fae139755a81c0431e7f12f2af9b5f3abc1326dc;p=sbcl.git

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index 274ce42..88f8ff3 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -342,7 +342,7 @@
             (fail "Attempt to bind a ~(~A~) variable with SYMBOL-MACROLET: ~S"
                   kind name)))
 	;; A magical cons that MACROEXPAND-1 understands.
-        `(,name . (MACRO . ,expansion))))))
+        `(,name . (macro . ,expansion))))))
 
 (defun funcall-in-symbol-macrolet-lexenv (definitions fun context)
   (%funcall-in-foomacrolet-lexenv
@@ -435,6 +435,15 @@
   (reference-constant start next result thing))
 
 ;;;; FUNCTION and NAMED-LAMBDA
+(defun name-lambdalike (thing)
+  (ecase (car thing)
+    ((named-lambda)
+     (second thing))
+    ((lambda instance-lambda)
+     `(lambda ,(second thing)))
+    ((lambda-with-lexenv)'
+     `(lambda ,(fifth thing)))))
+
 (defun fun-name-leaf (thing)
   (if (consp thing)
       (cond
@@ -442,7 +451,7 @@
 		 '(lambda named-lambda instance-lambda lambda-with-lexenv))
 	 (values (ir1-convert-lambdalike
                   thing
-                  :debug-name (debug-namify "#'" thing))
+                  :debug-name (name-lambdalike thing))
                  t))
 	((legal-fun-name-p thing)
 	 (values (find-lexically-apparent-fun
@@ -577,12 +586,13 @@
              (binding* ((ctran (make-ctran))
                         (fun-lvar (make-lvar))
                         ((next result)
-                         (processing-decls (decls vars nil next result)
+                         (processing-decls (decls vars nil next result
+						  post-binding-lexenv)
                            (let ((fun (ir1-convert-lambda-body
                                        forms
                                        vars
-                                       :debug-name (debug-namify "LET S"
-                                                                 bindings))))
+				       :post-binding-lexenv post-binding-lexenv
+                                       :debug-name (debug-name 'let bindings))))
                              (reference-leaf start ctran fun-lvar fun))
                            (values next result))))
                (ir1-convert-combination-args fun-lvar ctran next result values)))))
@@ -599,13 +609,14 @@
       (multiple-value-bind (forms decls)
           (parse-body body :doc-string-allowed nil)
         (multiple-value-bind (vars values) (extract-let-vars bindings 'let*)
-          (processing-decls (decls vars nil start next)
+          (processing-decls (decls vars nil start next post-binding-lexenv)
             (ir1-convert-aux-bindings start
                                       next
                                       result
                                       forms
                                       vars
-                                      values))))
+                                      values
+				      post-binding-lexenv))))
       (compiler-error "Malformed LET* bindings: ~S." bindings)))
 
 ;;; logic shared between IR1 translators for LOCALLY, MACROLET,
@@ -696,8 +707,7 @@
       (let ((fvars (mapcar (lambda (n d)
                              (ir1-convert-lambda d
                                                  :source-name n
-                                                 :debug-name (debug-namify
-                                                              "FLET " n)))
+                                                 :debug-name (debug-name 'flet n)))
                            names defs)))
         (processing-decls (decls nil fvars next result)
           (let ((*lexenv* (make-lexenv :funs (pairlis names fvars))))
@@ -717,8 +727,8 @@
              (placeholder-funs (mapcar (lambda (name)
                                          (make-functional
                                           :%source-name name
-                                          :%debug-name (debug-namify
-                                                        "LABELS placeholder "
+                                          :%debug-name (debug-name 
+                                                        'labels-placeholder 
                                                         name)))
                                        names))
              ;; (like PAIRLIS but guaranteed to preserve ordering:)
@@ -730,8 +740,7 @@
                 (mapcar (lambda (name def)
                           (ir1-convert-lambda def
                                               :source-name name
-                                              :debug-name (debug-namify
-                                                           "LABELS " name)))
+                                              :debug-name (debug-name 'labels name)))
                         names defs))))
 
         ;; Modify all the references to the dummy function leaves so
@@ -827,7 +836,7 @@
 		  name)))
 	     (setq-var start next result leaf (second things)))
 	    (cons
-	     (aver (eq (car leaf) 'MACRO))
+	     (aver (eq (car leaf) 'macro))
              ;; FIXME: [Free] type declaration. -- APD, 2002-01-26
 	     (ir1-convert start next result
                           `(setf ,(cdr leaf) ,(second things))))
@@ -905,7 +914,7 @@
                (ir1-convert-lambda
                 `(lambda ()
                    (return-from ,tag (%unknown-values)))
-                :debug-name (debug-namify "escape function for " tag))))
+                :debug-name (debug-name 'escape-fun tag))))
         (ctran (make-ctran)))
     (setf (functional-kind fun) :escape)
     (ir1-convert start ctran nil `(%%allocate-closures ,fun))