More cleanup

3 files changed, 31 insertions, 45 deletions

diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 7d47a96c..fc1065fb 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -109,27 +109,20 @@
 
 (DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|)))
 
-(DEFUN |bMap1| (&REST |z|)
-  (PROG (|x| |f|)
-    (RETURN
-      (PROGN
-        (SETQ |f| (CAR |z|))
-        (SETQ |x| (CADR |z|))
-        (COND
-          ((|bStreamNull| |x|) |$bStreamNil|)
-          (T (CONS (APPLY |f| (LIST (CAR |x|))) (|bMap| |f| (CDR |x|)))))))))
+(DEFUN |bMap1| (|f| |x|)
+  (COND
+    ((|bStreamNull| |x|) |$bStreamNil|)
+    (T (CONS (APPLY |f| (LIST (CAR |x|))) (|bMap| |f| (CDR |x|))))))
 
 (DEFUN |bDelay| (|f| |x|) (CONS '|nonnullstream| (CONS |f| |x|)))
 
 (DEFUN |bAppend| (|x| |y|) (|bDelay| #'|bAppend1| (LIST |x| |y|)))
 
-(DEFUN |bAppend1| (&REST |z|)
+(DEFUN |bAppend1| (|x| |y|)
   (COND
-    ((|bStreamNull| (CAR |z|))
-     (COND
-       ((|bStreamNull| (CADR |z|)) (LIST '|nullstream|))
-       (T (CADR |z|))))
-    (T (CONS (CAAR |z|) (|bAppend| (CDAR |z|) (CADR |z|))))))
+    ((|bStreamNull| |x|)
+     (COND ((|bStreamNull| |y|) (LIST '|nullstream|)) (T |y|)))
+    (T (CONS (CAR |x|) (|bAppend| (CDR |x|) |y|)))))
 
 (DEFUN |bNext| (|f| |s|) (|bDelay| #'|bNext1| (LIST |f| |s|)))
 
@@ -143,34 +136,29 @@
 
 (DEFUN |bRgen| (|s|) (|bDelay| #'|bRgen1| (LIST |s|)))
 
-(DEFUN |bRgen1| (&REST |s|)
+(DEFUN |bRgen1| (|s|)
   (PROG (|a|)
     (RETURN
       (PROGN
-        (SETQ |a| (|shoeReadLine| (CAR |s|)))
+        (SETQ |a| (|shoeReadLine| |s|))
         (COND
           ((|shoePLACEP| |a|) (LIST '|nullstream|))
-          (T (CONS |a| (|bRgen| (CAR |s|)))))))))
+          (T (CONS |a| (|bRgen| |s|))))))))
 
 (DEFUN |bIgen| (|n|) (|bDelay| #'|bIgen1| (LIST |n|)))
 
-(DEFUN |bIgen1| (&REST |n|)
-  (PROGN (SETQ |n| (+ (CAR |n|) 1)) (CONS |n| (|bIgen| |n|))))
+(DEFUN |bIgen1| (|n|)
+  (PROGN (SETQ |n| (+ |n| 1)) (CONS |n| (|bIgen| |n|))))
 
 (DEFUN |bAddLineNumber| (|f1| |f2|)
   (|bDelay| #'|bAddLineNumber1| (LIST |f1| |f2|)))
 
-(DEFUN |bAddLineNumber1| (&REST |f|)
-  (PROG (|f2| |f1|)
-    (RETURN
-      (PROGN
-        (SETQ |f1| (CAR |f|))
-        (SETQ |f2| (CADR |f|))
-        (COND
-          ((|bStreamNull| |f1|) (LIST '|nullstream|))
-          ((|bStreamNull| |f2|) (LIST '|nullstream|))
-          (T (CONS (CONS (CAR |f1|) (CAR |f2|))
-                   (|bAddLineNumber| (CDR |f1|) (CDR |f2|)))))))))
+(DEFUN |bAddLineNumber1| (|f1| |f2|)
+  (COND
+    ((|bStreamNull| |f1|) (LIST '|nullstream|))
+    ((|bStreamNull| |f2|) (LIST '|nullstream|))
+    (T (CONS (CONS (CAR |f1|) (CAR |f2|))
+             (|bAddLineNumber| (CDR |f1|) (CDR |f2|))))))
 
 (DEFUN |shoePrefixLisp| (|x|) (CONCAT ")lisp" |x|))
 
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 36c8ef05..4f17e690 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -28,7 +28,7 @@
 
 (DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|))))
 
-(DEFUN |shoeConstructToken| (|ln| |lp| |b| |n|)
+(DEFUN |shoeConstructToken| (|lp| |b| |n|)
   (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|))))
 
 (DEFUN |shoeTokType| (|x|) (CAR |x|))
@@ -80,7 +80,7 @@
              ((SETQ |command| (|shoeLine?| |$ln|))
               (SETQ |dq|
                     (|dqUnit|
-                        (|shoeConstructToken| |$ln| |$linepos|
+                        (|shoeConstructToken| |$linepos|
                             (|shoeLeafLine| |command|) 0)))
               (CONS (LIST |dq|) |$r|))
              ((SETQ |command| (|shoeLisp?| |$ln|))
@@ -100,12 +100,10 @@
     (DECLARE (SPECIAL |$linepos| |$ln|))
     (RETURN
       (PROGN
-        (SETQ |string|
-              (COND
-                ((OR (EQL (LENGTH |string|) 0)
-                     (CHAR= (SCHAR |string| 0) (|char| '|;|)))
-                 "")
-                (T |string|)))
+        (COND
+          ((OR (EQL (LENGTH |string|) 0)
+               (CHAR= (SCHAR |string| 0) (|char| '|;|)))
+           (SETQ |string| "")))
         (SETQ |ln| |$ln|)
         (SETQ |linepos| |$linepos|)
         (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|))
@@ -113,8 +111,8 @@
         (SETQ |st| (CDR |LETTMP#1|))
         (SETQ |dq|
               (|dqUnit|
-                  (|shoeConstructToken| |ln| |linepos|
-                      (|shoeLeafLisp| |st|) 0)))
+                  (|shoeConstructToken| |linepos| (|shoeLeafLisp| |st|)
+                      0)))
         (CONS (LIST |dq|) |r|)))))
 
 (DEFUN |shoeAccumulateLines| (|s| |string|)
@@ -145,11 +143,10 @@
 (DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))
 
 (DEFUN |shoeToken| ()
-  (PROG (|b| |ch| |n| |linepos| |ln|)
-    (DECLARE (SPECIAL |$n| |$linepos| |$ln|))
+  (PROG (|b| |ch| |n| |linepos|)
+    (DECLARE (SPECIAL |$ln| |$n| |$linepos|))
     (RETURN
       (PROGN
-        (SETQ |ln| |$ln|)
         (SETQ |linepos| |$linepos|)
         (SETQ |n| |$n|)
         (SETQ |ch| (SCHAR |$ln| |$n|))
@@ -168,7 +165,7 @@
                 (T (|shoeError|))))
         (COND
           ((NULL |b|) NIL)
-          (T (|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|))))))))
+          (T (|dqUnit| (|shoeConstructToken| |linepos| |b| |n|))))))))
 
 (DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|)))
 
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 80875ca7..5eb38696 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -226,6 +226,7 @@
                   (LIST '|readByte| 'READ-BYTE)
                   (LIST '|readInteger| 'PARSE-INTEGER)
                   (LIST '|readLine| 'READ-LINE)
+                  (LIST '|readLispFromString| 'READ-FROM-STRING)
                   (LIST '|readOnly?| 'CONSTANTP)
                   (LIST '|removeDuplicates| 'REMDUP)
                   (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)