0.8.3.72:
[sbcl.git] / src / code / defboot.lisp
index 45d064c..978a3c8 100644 (file)
 \f
 ;;;; various sequencing constructs
 
-(defmacro-mundanely prog (varlist &body body-decls)
-  (multiple-value-bind (body decls) (parse-body body-decls nil)
-    `(block nil
-       (let ,varlist
-        ,@decls
-        (tagbody ,@body)))))
-
-(defmacro-mundanely prog* (varlist &body body-decls)
-  (multiple-value-bind (body decls) (parse-body body-decls nil)
-    `(block nil
-       (let* ,varlist
-        ,@decls
-        (tagbody ,@body)))))
+(flet ((prog-expansion-from-let (varlist body-decls let)
+         (multiple-value-bind (body decls)
+            (parse-body body-decls :doc-string-allowed nil)
+          `(block nil
+             (,let ,varlist
+               ,@decls
+               (tagbody ,@body))))))
+  (defmacro-mundanely prog (varlist &body body-decls)
+    (prog-expansion-from-let varlist body-decls 'let))
+  (defmacro-mundanely prog* (varlist &body body-decls)
+    (prog-expansion-from-let varlist body-decls 'let*)))
 
 (defmacro-mundanely prog1 (result &body body)
   (let ((n-result (gensym)))
              (or (sb!c:maybe-inline-syntactic-closure lambda env)
                  (progn
                    (#+sb-xc-host warn
-                    #-sb-xc-host sb!c:maybe-compiler-note
+                    #-sb-xc-host sb!c:maybe-compiler-notify
                     "lexical environment too hairy, can't inline DEFUN ~S"
                     name)
                    nil)))))
   ;; environment. We spuriously reference the gratuitous variable,
   ;; since we don't want to use IGNORABLE on what might be a special
   ;; var.
-  (multiple-value-bind (forms decls) (parse-body body nil)
+  (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil)
     (let ((n-list (gensym)))
       `(do* ((,n-list ,list (cdr ,n-list)))
        ((endp ,n-list)
                     ,n-cond
                     (car *restart-clusters*)
                   ,(if (eq name 'cerror)
-                       `(cerror ,(second expression) ,n-cond)
+                       `(cerror ,(second exp) ,n-cond)
                        `(,name ,n-cond))))
              expression))
        expression)))