0.9.2.26: refactoring internals of foreign linkage

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

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 9f65732..0b23bac 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -128,13 +128,13 @@
       (let ((def `(lambda (,whole ,environment)
                    ,@local-decs
                    ,body))
-           (debug-name (sb!c::debug-namify "DEFINE-COMPILER-MACRO " name)))
+           (debug-name (sb!c::debug-name 'compiler-macro-function name)))
        `(eval-when (:compile-toplevel :load-toplevel :execute)
-         (sb!c::%define-compiler-macro ',name
-                                       #',def
-                                       ',lambda-list
-                                       ,doc
-                                       ,debug-name))))))
+           (sb!c::%define-compiler-macro ',name
+                                         #',def
+                                         ',lambda-list
+                                         ,doc
+                                         ',debug-name))))))
 
 ;;; FIXME: This will look remarkably similar to those who have already
 ;;; seen the code for %DEFMACRO in src/code/defmacro.lisp.  Various
@@ -369,9 +369,10 @@
                                                 ,(or start 0)
                                                 ,end)))))
         ,@decls
-        (unwind-protect
-            (progn ,@forms)
-          (close ,var)
+        (multiple-value-prog1
+            (unwind-protect
+                 (progn ,@forms)
+              (close ,var))
           ,@(when index
               `((setf ,index (string-input-stream-current ,var)))))))))
 
@@ -381,11 +382,17 @@
   (multiple-value-bind (forms decls)
       (parse-body forms-decls :doc-string-allowed nil)
     (if string
-      `(let ((,var (make-fill-pointer-output-stream ,string)))
-        ,@decls
-        (unwind-protect
-            (progn ,@forms)
-          (close ,var)))
+        (let ((element-type-var (gensym)))
+          `(let ((,var (make-fill-pointer-output-stream ,string))
+                 ;; ELEMENT-TYPE isn't currently used for anything
+                 ;; (see FILL-POINTER-OUTPUT-STREAM FIXME in stream.lisp),
+                 ;; but it still has to be evaluated for side-effects.
+                 (,element-type-var ,element-type))
+            (declare (ignore ,element-type-var))
+            ,@decls        
+            (unwind-protect
+                 (progn ,@forms)
+              (close ,var))))
       `(let ((,var (make-string-output-stream :element-type ,element-type)))
         ,@decls
         (unwind-protect