X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fprimordial-extensions.lisp;h=48be86dc0072c7ab1495a49ca0929fb71b953400;hb=a22dd643fb599880f4c0856e1a85bffe4358aea8;hp=4f259760e5190fe9a23a0e8c081e535c1038bf5e;hpb=22b819c0cd0ca0ea5be52ba280b9e9e0b8e86210;p=sbcl.git

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index 4f25976..48be86d 100644
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -98,18 +98,19 @@
 			 (t (illegal-varlist)))))
 		(t (illegal-varlist)))))
       ;; Construct the new form.
-      (multiple-value-bind (code decls) (parse-body decls-and-code nil)
+      (multiple-value-bind (code decls)
+	  (parse-body decls-and-code :doc-string-allowed nil)
 	`(block ,block
 	   (,bind ,(nreverse r-inits)
 		  ,@decls
 		  (tagbody
-		   (go ,label-2)
-		   ,label-1
-		   ,@code
-		   (,step ,@(nreverse r-steps))
-		   ,label-2
-		   (unless ,(first endlist) (go ,label-1))
-		   (return-from ,block (progn ,@(rest endlist))))))))))
+                     (go ,label-2)
+                     ,label-1
+                     (tagbody ,@code)
+                     (,step ,@(nreverse r-steps))
+                     ,label-2
+                     (unless ,(first endlist) (go ,label-1))
+                     (return-from ,block (progn ,@(rest endlist))))))))))
 
 ;;; This is like DO, except it has no implicit NIL block. Each VAR is
 ;;; initialized in parallel to the value of the specified INIT form.
@@ -173,14 +174,15 @@
 		  ;; check for bad lengths, the type system is needed
 		  ;; for calls to CONCATENATE. So we need to make sure
 		  ;; that the calls are transformed away:
-		  (1 (concatenate 'string (the simple-string (string (car things)))))
+		  (1 (concatenate 'string
+				  (the simple-base-string (string (car things)))))
 		  (2 (concatenate 'string 
-				  (the simple-string (string (car things)))
-				  (the simple-string (string (cadr things)))))
+				  (the simple-base-string (string (car things)))
+				  (the simple-base-string (string (cadr things)))))
 		  (3 (concatenate 'string
-				  (the simple-string (string (car things)))
-				  (the simple-string (string (cadr things)))
-				  (the simple-string (string (caddr things)))))
+				  (the simple-base-string (string (car things)))
+				  (the simple-base-string (string (cadr things)))
+				  (the simple-base-string (string (caddr things)))))
 		  (t (apply #'concatenate 'string (mapcar #'string things))))))
     (values (intern name)))))