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

1 files changed, 129 insertions, 164 deletions

diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 08964695..6146ddc7 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -93,24 +93,20 @@
     (RETURN
       (COND
         ((|bStreamNull| |stream|) (LIST NIL (LIST '|nullstream|)))
-        ('T
-         (PROGN
-           (SETQ |a| (CAAR |stream|))
-           (COND
-             ((AND (NOT (< (LENGTH |a|) 8))
-                   (EQUAL (SUBSTRING |a| 0 8) ")package"))
-              (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|)
-                  |sz| |name| (CDR |stream|)))
-             ((< (LENGTH |a|) |sz|)
-              (|shoePackageStartsAt| |lines| |sz| |name|
-                  (CDR |stream|)))
-             ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
-                   (< |sz| (LENGTH |a|))
-                   (NOT (|shoeIdChar| (ELT |a| |sz|))))
-              (LIST |lines| |stream|))
-             ('T
-              (|shoePackageStartsAt| |lines| |sz| |name|
-                  (CDR |stream|))))))))))
+        ('T (SETQ |a| (CAAR |stream|))
+         (COND
+           ((AND (NOT (< (LENGTH |a|) 8))
+                 (EQUAL (SUBSTRING |a| 0 8) ")package"))
+            (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|) |sz|
+                |name| (CDR |stream|)))
+           ((< (LENGTH |a|) |sz|)
+            (|shoePackageStartsAt| |lines| |sz| |name| (CDR |stream|)))
+           ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
+                 (< |sz| (LENGTH |a|))
+                 (NOT (|shoeIdChar| (ELT |a| |sz|))))
+            (LIST |lines| |stream|))
+           ('T
+            (|shoePackageStartsAt| |lines| |sz| |name| (CDR |stream|)))))))))
 
 (DEFUN |shoeFindLines| (|fn| |name| |a|)
   (PROG (|b| |lines| |LETTMP#1|)
@@ -140,16 +136,15 @@
       (COND
         ((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
         ('T
-         (PROGN
-           (LOOP
-             (COND
-               ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
-               ('T
-                (PROGN
-                  (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
-                  (RPLACA |x| (CAR |st|))
-                  (RPLACD |x| (CDR |st|))))))
-           (EQCAR |x| '|nullstream|)))))))
+         (LOOP
+           (COND
+             ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
+             ('T
+              (PROGN
+                (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
+                (RPLACA |x| (CAR |st|))
+                (RPLACD |x| (CDR |st|))))))
+         (EQCAR |x| '|nullstream|))))))
 
 (DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|)))
 
@@ -171,16 +166,12 @@
       (PROGN
         (SETQ |a| (|shoeInputFile| |fn|))
         (COND
-          ((NULL |a|)
-           (PROGN
-             (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
-             |$bStreamNil|))
-          ('T
-           (PROGN
-             (|shoeConsole| (CONCAT "READING " |fn|))
-             (|shoeInclude|
-                 (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
-                     (|bIgen| 0))))))))))
+          ((NULL |a|) (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
+           |$bStreamNil|)
+          ('T (|shoeConsole| (CONCAT "READING " |fn|))
+           (|shoeInclude|
+               (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
+                   (|bIgen| 0)))))))))
 
 (DEFUN |bDelay| (|f| |x|) (CONS '|nonnullstream| (CONS |f| |x|)))
 
@@ -201,10 +192,8 @@
     (RETURN
       (COND
         ((|bStreamNull| |s|) (LIST '|nullstream|))
-        ('T
-         (PROGN
-           (SETQ |h| (APPLY |f| (LIST |s|)))
-           (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|)))))))))
+        ('T (SETQ |h| (APPLY |f| (LIST |s|)))
+         (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|))))))))
 
 (DEFUN |bRgen| (|s|) (|bDelay| #'|bRgen1| (LIST |s|)))
 
@@ -255,21 +244,19 @@
     (RETURN
       (COND
         ((< (LENGTH |whole|) (LENGTH |prefix|)) NIL)
-        ('T
-         (PROGN
-           (SETQ |good| T)
-           (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
-             (LOOP
-               (COND
-                 ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
-                 ('T
-                  (SETQ |good|
-                        (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
-               (SETQ |i| (+ |i| 1))
-               (SETQ |j| (+ |j| 1))))
-           (COND
-             (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
-             ('T |good|))))))))
+        ('T (SETQ |good| T)
+         (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
+           (LOOP
+             (COND
+               ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
+               ('T
+                (SETQ |good|
+                      (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
+             (SETQ |i| (+ |i| 1))
+             (SETQ |j| (+ |j| 1))))
+         (COND
+           (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
+           ('T |good|)))))))
 
 (DEFUN |shoePlainLine?| (|s|)
   (COND
@@ -312,14 +299,12 @@
         (SETQ |n| (STRPOSL " " |x| 0 T))
         (COND
           ((NULL |n|) NIL)
-          (#0='T
-           (PROGN
-             (SETQ |n1| (STRPOSL " " |x| |n| NIL))
-             (COND
-               ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
-               (#0#
-                (LIST (SUBSTRING |x| |n| (- |n1| |n|))
-                      (SUBSTRING |x| |n1| NIL)))))))))))
+          (#0='T (SETQ |n1| (STRPOSL " " |x| |n| NIL))
+           (COND
+             ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
+             (#0#
+              (LIST (SUBSTRING |x| |n| (- |n1| |n|))
+                    (SUBSTRING |x| |n1| NIL))))))))))
 
 (DEFUN |shoeFileName| (|x|)
   (PROG (|c| |a|)
@@ -328,12 +313,10 @@
         (SETQ |a| (|shoeBiteOff| |x|))
         (COND
           ((NULL |a|) "")
-          (#0='T
-           (PROGN
-             (SETQ |c| (|shoeBiteOff| (CADR |a|)))
-             (COND
-               ((NULL |c|) (CAR |a|))
-               (#0# (CONCAT (CAR |a|) "." (CAR |c|)))))))))))
+          (#0='T (SETQ |c| (|shoeBiteOff| (CADR |a|)))
+           (COND
+             ((NULL |c|) (CAR |a|))
+             (#0# (CONCAT (CAR |a|) "." (CAR |c|))))))))))
 
 (DEFUN |shoeFnFileName| (|x|)
   (PROG (|c| |a|)
@@ -342,12 +325,10 @@
         (SETQ |a| (|shoeBiteOff| |x|))
         (COND
           ((NULL |a|) (LIST "" ""))
-          (#0='T
-           (PROGN
-             (SETQ |c| (|shoeFileName| (CADR |a|)))
-             (COND
-               ((NULL |c|) (LIST (CAR |a|) ""))
-               (#0# (LIST (CAR |a|) |c|))))))))))
+          (#0='T (SETQ |c| (|shoeFileName| (CADR |a|)))
+           (COND
+             ((NULL |c|) (LIST (CAR |a|) ""))
+             (#0# (LIST (CAR |a|) |c|)))))))))
 
 (DEFUN |shoeFunctionFileInput| (|bfVar#2|)
   (PROG (|fn| |fun|)
@@ -368,17 +349,13 @@
     (RETURN
       (COND
         ((|bStreamNull| |s|) |s|)
-        (#0='T
-         (PROGN
-           (SETQ |h| (CAR |s|))
-           (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
-           (COND
-             ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
-             ((SETQ |command| (|shoeIf?| |string|))
-              (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
-             (#0#
-              (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|))))))))))
+        (#0='T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
+         (SETQ |string| (CAR |h|))
+         (COND
+           ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
+           ((SETQ |command| (|shoeIf?| |string|))
+            (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
+           (#0# (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|)))))))))
 
 (DEFUN |shoeSimpleLine| (|h|)
   (PROG (|command| |string|)
@@ -399,10 +376,10 @@
            (|shoeFileInput| (|shoeFileName| |command|)))
           ((SETQ |command| (|shoePackage?| |string|)) (LIST |h|))
           ((SETQ |command| (|shoeSay?| |string|))
-           (PROGN (|shoeConsole| |command|) NIL))
-          ((SETQ |command| (|shoeEval?| |string|))
-           (PROGN (STTOMC |command|) NIL))
-          ('T (PROGN (|shoeLineSyntaxError| |h|) NIL)))))))
+           (|shoeConsole| |command|) NIL)
+          ((SETQ |command| (|shoeEval?| |string|)) (STTOMC |command|)
+           NIL)
+          ('T (|shoeLineSyntaxError| |h|) NIL))))))
 
 (DEFUN |shoeThen| (|keep| |b| |s|)
   (|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))
@@ -412,50 +389,44 @@
     (RETURN
       (COND
         ((|bPremStreamNull| |s|) |s|)
-        (#0='T
-         (PROGN
-           (SETQ |h| (CAR |s|))
-           (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
-           (COND
-             ((SETQ |command| (|shoeFin?| |string|))
-              (|bPremStreamNil| |h|))
-             (#0#
-              (PROGN
-                (SETQ |keep1| (CAR |keep|))
-                (SETQ |b1| (CAR |b|))
-                (COND
-                  ((SETQ |command| (|shoeIf?| |string|))
-                   (COND
-                     ((AND |keep1| |b1|)
-                      (|shoeThen| (CONS T |keep|)
-                          (CONS (STTOMC |command|) |b|) |t|))
-                     (#0#
-                      (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
-                  ((SETQ |command| (|shoeElseIf?| |string|))
-                   (COND
-                     ((AND |keep1| (NOT |b1|))
-                      (|shoeThen| (CONS T (CDR |keep|))
-                          (CONS (STTOMC |command|) (CDR |b|)) |t|))
-                     (#0#
-                      (|shoeThen| (CONS NIL (CDR |keep|))
-                          (CONS NIL (CDR |b|)) |t|))))
-                  ((SETQ |command| (|shoeElse?| |string|))
-                   (COND
-                     ((AND |keep1| (NOT |b1|))
-                      (|shoeElse| (CONS T (CDR |keep|))
-                          (CONS T (CDR |b|)) |t|))
-                     (#0#
-                      (|shoeElse| (CONS NIL (CDR |keep|))
-                          (CONS NIL (CDR |b|)) |t|))))
-                  ((SETQ |command| (|shoeEndIf?| |string|))
-                   (COND
-                     ((NULL (CDR |b|)) (|shoeInclude| |t|))
-                     (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
-                  ((AND |keep1| |b1|)
-                   (|bAppend| (|shoeSimpleLine| |h|)
-                       (|shoeThen| |keep| |b| |t|)))
-                  (#0# (|shoeThen| |keep| |b| |t|))))))))))))
+        (#0='T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
+         (SETQ |string| (CAR |h|))
+         (COND
+           ((SETQ |command| (|shoeFin?| |string|))
+            (|bPremStreamNil| |h|))
+           (#0# (SETQ |keep1| (CAR |keep|)) (SETQ |b1| (CAR |b|))
+            (COND
+              ((SETQ |command| (|shoeIf?| |string|))
+               (COND
+                 ((AND |keep1| |b1|)
+                  (|shoeThen| (CONS T |keep|)
+                      (CONS (STTOMC |command|) |b|) |t|))
+                 (#0#
+                  (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+              ((SETQ |command| (|shoeElseIf?| |string|))
+               (COND
+                 ((AND |keep1| (NOT |b1|))
+                  (|shoeThen| (CONS T (CDR |keep|))
+                      (CONS (STTOMC |command|) (CDR |b|)) |t|))
+                 (#0#
+                  (|shoeThen| (CONS NIL (CDR |keep|))
+                      (CONS NIL (CDR |b|)) |t|))))
+              ((SETQ |command| (|shoeElse?| |string|))
+               (COND
+                 ((AND |keep1| (NOT |b1|))
+                  (|shoeElse| (CONS T (CDR |keep|)) (CONS T (CDR |b|))
+                      |t|))
+                 (#0#
+                  (|shoeElse| (CONS NIL (CDR |keep|))
+                      (CONS NIL (CDR |b|)) |t|))))
+              ((SETQ |command| (|shoeEndIf?| |string|))
+               (COND
+                 ((NULL (CDR |b|)) (|shoeInclude| |t|))
+                 (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+              ((AND |keep1| |b1|)
+               (|bAppend| (|shoeSimpleLine| |h|)
+                   (|shoeThen| |keep| |b| |t|)))
+              (#0# (|shoeThen| |keep| |b| |t|))))))))))
 
 (DEFUN |shoeElse| (|keep| |b| |s|)
   (|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))
@@ -465,34 +436,28 @@
     (RETURN
       (COND
         ((|bPremStreamNull| |s|) |s|)
-        (#0='T
-         (PROGN
-           (SETQ |h| (CAR |s|))
-           (SETQ |t| (CDR |s|))
-           (SETQ |string| (CAR |h|))
-           (COND
-             ((SETQ |command| (|shoeFin?| |string|))
-              (|bPremStreamNil| |h|))
-             (#0#
-              (PROGN
-                (SETQ |b1| (CAR |b|))
-                (SETQ |keep1| (CAR |keep|))
-                (COND
-                  ((SETQ |command| (|shoeIf?| |string|))
-                   (COND
-                     ((AND |keep1| |b1|)
-                      (|shoeThen| (CONS T |keep|)
-                          (CONS (STTOMC |command|) |b|) |t|))
-                     (#0#
-                      (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
-                  ((SETQ |command| (|shoeEndIf?| |string|))
-                   (COND
-                     ((NULL (CDR |b|)) (|shoeInclude| |t|))
-                     (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
-                  ((AND |keep1| |b1|)
-                   (|bAppend| (|shoeSimpleLine| |h|)
-                       (|shoeElse| |keep| |b| |t|)))
-                  (#0# (|shoeElse| |keep| |b| |t|))))))))))))
+        (#0='T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
+         (SETQ |string| (CAR |h|))
+         (COND
+           ((SETQ |command| (|shoeFin?| |string|))
+            (|bPremStreamNil| |h|))
+           (#0# (SETQ |b1| (CAR |b|)) (SETQ |keep1| (CAR |keep|))
+            (COND
+              ((SETQ |command| (|shoeIf?| |string|))
+               (COND
+                 ((AND |keep1| |b1|)
+                  (|shoeThen| (CONS T |keep|)
+                      (CONS (STTOMC |command|) |b|) |t|))
+                 (#0#
+                  (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+              ((SETQ |command| (|shoeEndIf?| |string|))
+               (COND
+                 ((NULL (CDR |b|)) (|shoeInclude| |t|))
+                 (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+              ((AND |keep1| |b1|)
+               (|bAppend| (|shoeSimpleLine| |h|)
+                   (|shoeElse| |keep| |b| |t|)))
+              (#0# (|shoeElse| |keep| |b| |t|))))))))))
 
 (DEFUN |shoeLineSyntaxError| (|h|)
   (PROGN