0.pre7.22:
authorWilliam Harold Newman <william.newman@airmail.net>
Tue, 28 Aug 2001 03:55:51 +0000 (03:55 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Tue, 28 Aug 2001 03:55:51 +0000 (03:55 +0000)
used %FUNCALL-IN-FOOMACROLET-LEXENV for SYMBOL-MACROLET too
(this time noticing that (MAKE-LEXENV :FUNCTIONS ..)
isn't the same as (MAKE-LEXENV :VARIABLES ..)!)

src/compiler/ir1tran.lisp
version.lisp-expr

index d061b64..02a58f8 100644 (file)
 
 ;;; common logic for MACROLET and SYMBOL-MACROLET
 ;;;
-;;; Call DEFINITIONIZE on each element of DEFINITIONS to find its
+;;; Call DEFINITIONIZE-FUN on each element of DEFINITIONS to find its
 ;;; in-lexenv representation, stuff the results into *LEXENV*, and
 ;;; call FUN (with no arguments).
-(defun %funcall-in-foomacrolet-lexenv (definitionize definitions fun)
-  (declare (type function process-definitions-fun fun) (type list definitions))
+(defun %funcall-in-foomacrolet-lexenv (definitionize-fun
+                                      definitionize-keyword
+                                      definitions
+                                      fun)
+  (declare (type function definitionize-fun fun))
+  (declare (type (member :variables :functions) definitionize-keyword))
+  (declare (type list definitions))
   (unless (= (length definitions)
              (length (remove-duplicates definitions :key #'first)))
     (compiler-style-warning "duplicate definitions in ~S" definitions))
-  (let* ((processed-definitions (mapcar definitionize definitions))
-         (*lexenv* (make-lexenv :functions processed-definitions)))
+  (let* ((processed-definitions (mapcar definitionize-fun definitions))
+         (*lexenv* (make-lexenv definitionize-keyword processed-definitions)))
     (funcall fun)))
 
 ;;; Tweak *LEXENV* to include the DEFINITIONS from a MACROLET, then
                             `(lambda (,whole ,environment)
                                ,@local-decls
                                (block ,name ,body))))))))
+   :functions
    definitions
    fun))
 
                              (lambda ()
                                (ir1-translate-locally body start cont))))
 
-;;; Tweak *LEXENV* to include the MACROBINDINGS from a SYMBOL-MACROLET,
-;;; then call FUN (with no arguments).
-;;;
-;;; This is split off from the IR1 convert method so that it can be
-;;; shared by the special-case top-level SYMBOL-MACROLET processing code.
-(defun funcall-in-symbol-macrolet-lexenv (macrobindings fun)
-  (declare (type list macrobindings) (type function fun))
-  (let ((processed-macrobindings
-        (mapcar (lambda (macrobinding)
-                  (unless (proper-list-of-length-p macrobinding 2)
-                    (compiler-error "malformed symbol/expansion pair: ~S"
-                                    macrobinding))
-                  (destructuring-bind (name expansion) macrobinding
-                    (unless (symbolp name)
-                      (compiler-error
-                       "The local symbol macro name ~S is not a symbol."
-                       name))
-                    `(,name . (MACRO . ,expansion))))
-                macrobindings)))
-    (unless (= (length macrobindings)
-              (length (remove-duplicates macrobindings :key #'first)))
-      (compiler-style-warning
-       "duplicate symbol macro names in SYMBOL-MACROLET ~S" macrobindings))
-    (let ((*lexenv* (make-lexenv :variables processed-macrobindings)))
-      (funcall fun)))
-  (values))
+(defun funcall-in-symbol-macrolet-lexenv (definitions fun)
+  (%funcall-in-foomacrolet-lexenv
+   (lambda (definition)
+     (unless (proper-list-of-length-p definition 2)
+       (compiler-error "malformed symbol/expansion pair: ~S" definition))
+     (destructuring-bind (name expansion) definition
+       (unless (symbolp name)
+         (compiler-error
+          "The local symbol macro name ~S is not a symbol."
+          name))
+       `(,name . (MACRO . ,expansion))))
+   :variables
+   definitions
+   fun))
   
 (def-ir1-translator symbol-macrolet ((macrobindings &body body) start cont)
   #!+sb-doc
index 06e78cc..0428aa6 100644 (file)
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.21"
+"0.pre7.22"