0.7.1.3:

[sbcl.git] / src / compiler / macros.lisp

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index e51c8eb..1141310 100644 (file)
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -239,10 +239,10 @@
 ;;;   those in Attr2.
 (defmacro attributes-union (&rest attributes)
   `(the attributes
-       (logior ,@(mapcar #'(lambda (x) `(the attributes ,x)) attributes))))
+       (logior ,@(mapcar (lambda (x) `(the attributes ,x)) attributes))))
 (defmacro attributes-intersection (&rest attributes)
   `(the attributes
-       (logand ,@(mapcar #'(lambda (x) `(the attributes ,x)) attributes))))
+       (logand ,@(mapcar (lambda (x) `(the attributes ,x)) attributes))))
 (declaim (ftype (function (attributes attributes) boolean) attributes=))
 #!-sb-fluid (declaim (inline attributes=))
 (defun attributes= (attr1 attr2)
@@ -431,7 +431,7 @@
                ,(if eval-name
                     ``(function ,,arg-types ,,result-type)
                     `'(function ,arg-types ,result-type))
-               #'(lambda ,@stuff)
+               (lambda ,@stuff)
                ,doc
                ,(if important t nil)
                ,when)))))))
@@ -547,8 +547,8 @@
            ,(parse-deftransform lambda-list body n-args
                                 `(return-from ,name nil))))
        ,@(when (consp what)
-           `((setf (,(symbolicate "FUNCTION-INFO-" (second what))
-                    (function-info-or-lose ',(first what)))
+           `((setf (,(symbolicate "FUN-INFO-" (second what))
+                    (fun-info-or-lose ',(first what)))
                    #',name)))))))
 \f
 ;;;; IR groveling macros
@@ -657,7 +657,7 @@
                    `(eq ,node-var (block-last ,n-block))
                    `(eq ,cont-var ,n-last-cont))
           (return nil))))))
-;;; like Do-Nodes, only iterating in reverse order
+;;; like DO-NODES, only iterating in reverse order
 (defmacro do-nodes-backwards ((node-var cont-var block) &body body)
   (let ((n-block (gensym))
        (n-start (gensym))
@@ -674,23 +674,28 @@
         (when (eq ,n-next ,n-start)
           (return nil))))))
 
-;;; Bind the IR1 context variables so that IR1 conversion can be done
-;;; after the main conversion pass has finished.
-;;;
-;;; The lexical environment is presumably already null...
-(defmacro with-ir1-environment (node &rest forms)
-  (let ((n-node (gensym)))
-    `(let* ((,n-node ,node)
-           (*current-component* (block-component (node-block ,n-node)))
-           (*lexenv* (node-lexenv ,n-node))
-           (*current-path* (node-source-path ,n-node)))
-       ,@forms)))
+;;; Bind the IR1 context variables to the values associated with NODE,
+;;; so that new, extra IR1 conversion related to NODE can be done
+;;; after the original conversion pass has finished.
+(defmacro with-ir1-environment-from-node (node &rest forms)
+  `(flet ((closure-needing-ir1-environment-from-node ()
+           ,@forms))
+     (%with-ir1-environment-from-node
+      ,node
+      #'closure-needing-ir1-environment-from-node)))
+(defun %with-ir1-environment-from-node (node fun)
+  (declare (type node node) (type function fun))
+  (let ((*current-component* (node-component node))
+       (*lexenv* (node-lexenv node))
+       (*current-path* (node-source-path node)))
+    (aver-live-component *current-component*)
+    (funcall fun)))
 
 ;;; Bind the hashtables used for keeping track of global variables,
-;;; functions, &c. Also establish condition handlers.
+;;; functions, etc. Also establish condition handlers.
 (defmacro with-ir1-namespace (&body forms)
-  `(let ((*free-variables* (make-hash-table :test 'eq))
-        (*free-functions* (make-hash-table :test 'equal))
+  `(let ((*free-vars* (make-hash-table :test 'eq))
+        (*free-funs* (make-hash-table :test 'equal))
         (*constants* (make-hash-table :test 'equal))
         (*source-paths* (make-hash-table :test 'eq)))
      (handler-bind ((compiler-error #'compiler-error-handler)
@@ -810,10 +815,10 @@
 (declaim (ftype (function (&optional unsigned-byte stream) (values)) event-statistics))
 (defun event-statistics (&optional (min-count 1) (stream *standard-output*))
   (collect ((info))
-    (maphash #'(lambda (k v)
-                (declare (ignore k))
-                (when (>= (event-info-count v) min-count)
-                  (info v)))
+    (maphash (lambda (k v)
+              (declare (ignore k))
+              (when (>= (event-info-count v) min-count)
+                (info v)))
             *event-info*)
     (dolist (event (sort (info) #'> :key #'event-info-count))
       (format stream "~6D: ~A~%" (event-info-count event)
@@ -823,9 +828,9 @@
 
 (declaim (ftype (function nil (values)) clear-event-statistics))
 (defun clear-event-statistics ()
-  (maphash #'(lambda (k v)
-              (declare (ignore k))
-              (setf (event-info-count v) 0))
+  (maphash (lambda (k v)
+            (declare (ignore k))
+            (setf (event-info-count v) 0))
           *event-info*)
   (values))
 \f