X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-format.lisp;h=88ff77725758e1ab665781a2cf7d0f2dc346279f;hb=70c579379283da66f97906a0d62c8a5fc34e4dab;hp=24253880b6ff3217c115469ade0381aa6e961c91;hpb=cda1acc8c3082c239b02ea74fd9bc3d4ea0994af;p=sbcl.git

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 2425388..88ff777 100644
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -792,9 +792,10 @@
 		 (error 'format-error
 			:complaint
 			"must specify exactly two sections"))
-	     (expand-bind-defaults ((index (expand-next-arg))) params
+	     (expand-bind-defaults ((index nil)) params
 	       (setf *only-simple-args* nil)
-	       (let ((clauses nil))
+	       (let ((clauses nil)
+                     (case `(or ,index ,(expand-next-arg))))
 		 (when last-semi-with-colon-p
 		   (push `(t ,@(expand-directive-list (pop sublists)))
 			 clauses))
@@ -803,7 +804,7 @@
 		     (push `(,(decf count)
 			     ,@(expand-directive-list sublist))
 			   clauses)))
-		 `(case ,index ,@clauses)))))
+		 `(case ,case ,@clauses)))))
      remaining)))
 
 (defun parse-conditional-directive (directives)
@@ -836,7 +837,7 @@
 	    (let ((*simple-args* *simple-args*))
 	      (values (expand-directive-list sublist)
 		      *simple-args*))
-	  (cond ((eq *simple-args* (cdr new-args))
+	  (cond ((and new-args (eq *simple-args* (cdr new-args)))
 		 (setf *simple-args* new-args)
 		 `(when ,(caar new-args)
 		    ,@guts))
@@ -948,7 +949,7 @@
 		     (throw 'need-orig-args nil))
 		 (let ((*up-up-and-out-allowed* colonp))
 		   (expand-directive-list (subseq directives 0 posn)))))
-	   (compute-loop-aux (count)
+	   (compute-loop (count)
 	     (when atsignp
 	       (setf *only-simple-args* nil))
 	     `(loop
@@ -972,30 +973,31 @@
 		,@(when closed-with-colon
 		    '((when (null args)
 			(return))))))
-	   (compute-loop ()
-	     (if params
-		 (expand-bind-defaults ((count nil)) params
-		   (compute-loop-aux count))
-		 (compute-loop-aux nil)))
-	   (compute-block ()
+	   (compute-block (count)
 	     (if colonp
 		 `(block outside-loop
-		    ,(compute-loop))
-		 (compute-loop)))
-	   (compute-bindings ()
+		    ,(compute-loop count))
+		 (compute-loop count)))
+	   (compute-bindings (count)
 	     (if atsignp
-		 (compute-block)
-		 `(let* ((orig-args ,(expand-next-arg))
-			 (args orig-args))
-		    (declare (ignorable orig-args args))
-		    ,(let ((*expander-next-arg-macro* 'expander-next-arg)
-			   (*only-simple-args* nil)
-			   (*orig-args-available* t))
-		       (compute-block))))))
-	(values (if (zerop posn)
-		    `(let ((inside-string ,(expand-next-arg)))
-		       ,(compute-bindings))
-		    (compute-bindings))
+                 (compute-block count)
+                 `(let* ((orig-args ,(expand-next-arg))
+                         (args orig-args))
+                   (declare (ignorable orig-args args))
+                   ,(let ((*expander-next-arg-macro* 'expander-next-arg)
+                          (*only-simple-args* nil)
+                          (*orig-args-available* t))
+                      (compute-block count))))))
+	(values (if params
+                    (expand-bind-defaults ((count nil)) params
+                      (if (zerop posn)
+                          `(let ((inside-string ,(expand-next-arg)))
+                            ,(compute-bindings count))
+                          (compute-bindings count)))
+                    (if (zerop posn)
+                        `(let ((inside-string ,(expand-next-arg)))
+                          ,(compute-bindings nil))
+                        (compute-bindings nil)))
 		(nthcdr (1+ posn) directives))))))
 
 (def-complex-format-directive #\} ()