* boot/ast.boot (bfSequence): Simplify COND branch bodies.

1 files changed, 63 insertions, 83 deletions

diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 5590d0ca..21722a2a 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -50,12 +50,11 @@
          (COND
            ((NULL |$n|) T)
            ((EQUAL (QENUM |$ln| |$n|) |shoeTAB|)
-            (PROGN
-              (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " "))
-              (SETF (ELT |$ln| |$n|) (ELT " " 0))
-              (SETQ |$ln| (CONCAT |a| |$ln|))
-              (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
-              (|shoeNextLine| |s1|)))
+            (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " "))
+            (SETF (ELT |$ln| |$n|) (ELT " " 0))
+            (SETQ |$ln| (CONCAT |a| |$ln|))
+            (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
+            (|shoeNextLine| |s1|))
            ('T T)))))))
 
 (DEFUN |shoeLineToks| (|s|)
@@ -74,41 +73,34 @@
         (COND
           ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
           ((NULL |$n|) (|shoeLineToks| |$r|))
-          (#0='T
-           (PROGN
-             (SETQ |fst| (QENUM |$ln| 0))
-             (COND
-               ((EQL |fst| |shoeCLOSEPAREN|)
+          (#0='T (SETQ |fst| (QENUM |$ln| 0))
+           (COND
+             ((EQL |fst| |shoeCLOSEPAREN|)
+              (COND
+                ((SETQ |command| (|shoeLine?| |$ln|))
+                 (SETQ |dq|
+                       (|dqUnit|
+                           (|shoeConstructToken| |$ln| |$linepos|
+                               (|shoeLeafLine| |command|) 0)))
+                 (CONS (LIST |dq|) |$r|))
+                ((SETQ |command| (|shoeLisp?| |$ln|))
+                 (|shoeLispToken| |$r| |command|))
+                ((SETQ |command| (|shoePackage?| |$ln|))
+                 (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")"))
+                 (SETQ |dq|
+                       (|dqUnit|
+                           (|shoeConstructToken| |$ln| |$linepos|
+                               (|shoeLeafLisp| |a|) 0)))
+                 (CONS (LIST |dq|) |$r|))
+                (#0# (|shoeLineToks| |$r|))))
+             (#0# (SETQ |toks| NIL)
+              (LOOP
                 (COND
-                  ((SETQ |command| (|shoeLine?| |$ln|))
-                   (PROGN
-                     (SETQ |dq|
-                           (|dqUnit|
-                               (|shoeConstructToken| |$ln| |$linepos|
-                                   (|shoeLeafLine| |command|) 0)))
-                     (CONS (LIST |dq|) |$r|)))
-                  ((SETQ |command| (|shoeLisp?| |$ln|))
-                   (|shoeLispToken| |$r| |command|))
-                  ((SETQ |command| (|shoePackage?| |$ln|))
-                   (PROGN
-                     (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")"))
-                     (SETQ |dq|
-                           (|dqUnit|
-                               (|shoeConstructToken| |$ln| |$linepos|
-                                   (|shoeLeafLisp| |a|) 0)))
-                     (CONS (LIST |dq|) |$r|)))
-                  (#0# (|shoeLineToks| |$r|))))
-               (#0#
-                (PROGN
-                  (SETQ |toks| NIL)
-                  (LOOP
-                    (COND
-                      ((NOT (< |$n| |$sz|)) (RETURN NIL))
-                      ('T
-                       (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
-                  (COND
-                    ((NULL |toks|) (|shoeLineToks| |$r|))
-                    (#0# (CONS (LIST |toks|) |$r|)))))))))))))
+                  ((NOT (< |$n| |$sz|)) (RETURN NIL))
+                  ('T (SETQ |toks| (|dqAppend| |toks| (|shoeToken|))))))
+              (COND
+                ((NULL |toks|) (|shoeLineToks| |$r|))
+                (#0# (CONS (LIST |toks|) |$r|)))))))))))
 
 (DEFUN |shoeLispToken| (|s| |string|)
   (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
@@ -140,30 +132,25 @@
         ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
         ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
         ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
-        (#0='T
-         (PROGN
-           (SETQ |fst| (QENUM |$ln| 0))
-           (COND
-             ((EQL |fst| |shoeCLOSEPAREN|)
-              (PROGN
-                (SETQ |command| (|shoeLisp?| |$ln|))
-                (COND
-                  ((AND |command| (< 0 (LENGTH |command|)))
-                   (COND
-                     ((EQL (QENUM |command| 0) (QENUM ";" 0))
-                      (|shoeAccumulateLines| |$r| |string|))
-                     (#0#
-                      (PROGN
-                        (SETQ |a| (STRPOS ";" |command| 0 NIL))
-                        (COND
-                          (|a| (|shoeAccumulateLines| |$r|
-                                   (CONCAT |string|
-                                    (SUBSTRING |command| 0 (- |a| 1)))))
-                          (#0#
-                           (|shoeAccumulateLines| |$r|
-                               (CONCAT |string| |command|))))))))
-                  (#0# (|shoeAccumulateLines| |$r| |string|)))))
-             (#0# (CONS |s| |string|)))))))))
+        (#0='T (SETQ |fst| (QENUM |$ln| 0))
+         (COND
+           ((EQL |fst| |shoeCLOSEPAREN|)
+            (SETQ |command| (|shoeLisp?| |$ln|))
+            (COND
+              ((AND |command| (< 0 (LENGTH |command|)))
+               (COND
+                 ((EQL (QENUM |command| 0) (QENUM ";" 0))
+                  (|shoeAccumulateLines| |$r| |string|))
+                 (#0# (SETQ |a| (STRPOS ";" |command| 0 NIL))
+                  (COND
+                    (|a| (|shoeAccumulateLines| |$r|
+                             (CONCAT |string|
+                                     (SUBSTRING |command| 0 (- |a| 1)))))
+                    (#0#
+                     (|shoeAccumulateLines| |$r|
+                         (CONCAT |string| |command|)))))))
+              (#0# (|shoeAccumulateLines| |$r| |string|))))
+           (#0# (CONS |s| |string|))))))))
 
 (DEFUN |shoeCloser| (|t|)
   (MEMBER (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
@@ -180,18 +167,16 @@
         (SETQ |ch| (ELT |$ln| |$n|))
         (SETQ |b|
               (COND
-                ((|shoeStartsComment|) (PROGN (|shoeComment|) NIL))
-                ((|shoeStartsNegComment|)
-                 (PROGN (|shoeNegComment|) NIL))
+                ((|shoeStartsComment|) (|shoeComment|) NIL)
+                ((|shoeStartsNegComment|) (|shoeNegComment|) NIL)
                 ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|))
                 ((|shoePunctuation| |c|) (|shoePunct|))
                 ((|shoeStartsId| |ch|) (|shoeWord| NIL))
-                ((EQUAL |c| |shoeSPACE|) (PROGN (|shoeSpace|) NIL))
+                ((EQUAL |c| |shoeSPACE|) (|shoeSpace|) NIL)
                 ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|))
                 ((|shoeDigit| |ch|) (|shoeNumber|))
                 ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|))
-                ((EQUAL |c| |shoeTAB|)
-                 (PROGN (SETQ |$n| (+ |$n| 1)) NIL))
+                ((EQUAL |c| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
                 (#0='T (|shoeError|))))
         (COND
           ((NULL |b|) NIL)
@@ -243,19 +228,14 @@
           ('T (SETQ |a| (|shoeReadLispString| |$ln| |$n|))
            (COND
              ((NULL |a|)
-              (PROGN
-                (|SoftShoeError| (CONS |$linepos| |$n|)
-                    "lisp escape error")
-                (|shoeLeafError| (ELT |$ln| |$n|))))
-             (#0='T
-              (PROGN
-                (SETQ |exp| (CAR |a|))
-                (SETQ |n| (CADR |a|))
-                (COND
-                  ((NULL |n|)
-                   (PROGN (SETQ |$n| |$sz|) (|shoeLeafLispExp| |exp|)))
-                  (#0#
-                   (PROGN (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))))))
+              (|SoftShoeError| (CONS |$linepos| |$n|)
+                  "lisp escape error")
+              (|shoeLeafError| (ELT |$ln| |$n|)))
+             (#0='T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|))
+              (COND
+                ((NULL |n|) (SETQ |$n| |$sz|)
+                 (|shoeLeafLispExp| |exp|))
+                (#0# (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))))
 
 (DEFUN |shoeEscape| ()
   (PROG (|a|)