0.pre7.117:

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

diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp
index 5844829..9d5328c 100644 (file)
--- a/src/compiler/macros.lisp
+++ b/src/compiler/macros.lisp
@@ -100,7 +100,7 @@
 ;;; If the desirability of the transformation depends on the current
 ;;; OPTIMIZE parameters, then the POLICY macro should be used to
 ;;; determine when to pass.
-(defmacro def-source-transform (name lambda-list &body body)
+(defmacro define-source-transform (name lambda-list &body body)
   (let ((fn-name
         (if (listp name)
             (collect ((pieces))
@@ -124,23 +124,6 @@
             ,@decls
             ,body))
         (setf (info :function :source-transform ',name) #',fn-name)))))
-
-;;; Define a function that converts a use of (%PRIMITIVE NAME ..)
-;;; into Lisp code. LAMBDA-LIST is a DEFMACRO-style lambda list.
-(defmacro def-primitive-translator (name lambda-list &body body)
-  (let ((fn-name (symbolicate "PRIMITIVE-TRANSLATE-" name))
-       (n-form (gensym))
-       (n-env (gensym)))
-    (multiple-value-bind (body decls)
-       (parse-defmacro lambda-list n-form body name "%primitive"
-                       :environment n-env
-                       :error-fun 'convert-condition-into-compiler-error)
-      `(progn
-        (defun ,fn-name (,n-form)
-          (let ((,n-env *lexenv*))
-            ,@decls
-            ,body))
-        (setf (gethash ',name *primitive-translators*) ',fn-name)))))
 \f
 ;;;; boolean attribute utilities
 ;;;;
@@ -532,9 +515,9 @@
 
 ;;; Create a function which parses combination args according to WHAT
 ;;; and LAMBDA-LIST, where WHAT is either a function name or a list
-;;; (FUNCTION-NAME KIND) and does some KIND of optimization.
+;;; (FUN-NAME KIND) and does some KIND of optimization.
 ;;;
-;;; The FUNCTION-NAME must name a known function. LAMBDA-LIST is used
+;;; The FUN-NAME must name a known function. LAMBDA-LIST is used
 ;;; to parse the arguments to the combination as in DEFTRANSFORM. If
 ;;; the argument syntax is invalid or there are non-constant keys,
 ;;; then we simply return NIL.
@@ -674,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))
@@ -691,20 +674,25 @@
         (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))
@@ -736,15 +724,15 @@
 
 (defstruct (event-info (:copier nil))
   ;; The name of this event.
-  (name (required-argument) :type symbol)
+  (name (missing-arg) :type symbol)
   ;; The string rescribing this event.
-  (description (required-argument) :type string)
+  (description (missing-arg) :type string)
   ;; The name of the variable we stash this in.
-  (var (required-argument) :type symbol)
+  (var (missing-arg) :type symbol)
   ;; The number of times this event has happened.
   (count 0 :type fixnum)
   ;; The level of significance of this event.
-  (level (required-argument) :type unsigned-byte)
+  (level (missing-arg) :type unsigned-byte)
   ;; If true, a function that gets called with the node that the event
   ;; happened to.
   (action nil :type (or function null)))