0.8.21.29:

[sbcl.git] / src / code / late-format.lisp

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 2425388..88ff777 100644 (file)
--- 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 #\} ()