More cleanup

6 files changed, 107 insertions, 123 deletions

diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index e74542eb..4ea4ef4b 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -77,9 +77,9 @@ shoeNotFound fn ==
 
  
 shoeReadLispString(s,n) ==
-    l:=# s
-    n >= l => nil
-    READ_-FROM_-STRING strconc ( "(", subString(s,n,l-n) ,")")
+  l := #s
+  n >= l => nil
+  READ_-FROM_-STRING strconc ( "(", subString(s,n,l-n) ,")")
 
 -- read a line from stream
 shoeReadLine stream ==
@@ -101,26 +101,28 @@ diagnosticLocation tok ==
     toString lineCharacter pos)
 
 SoftShoeError(posn,key)==
-    coreError ['"in line ", toString lineNo posn]
-    shoeConsole lineString posn
-    shoeConsole strconc(shoeSpaces lineCharacter posn,'"|")
-    shoeConsole key
+  coreError ['"in line ", toString lineNo posn]
+  shoeConsole lineString posn
+  shoeConsole strconc(shoeSpaces lineCharacter posn,'"|")
+  shoeConsole key
  
 bpSpecificErrorAtToken(tok, key) ==
-     a:=shoeTokPosn tok
-     SoftShoeError(a,key)
+  a := shoeTokPosn tok
+  SoftShoeError(a,key)
  
-bpSpecificErrorHere(key) ==  bpSpecificErrorAtToken($stok, key)
+bpSpecificErrorHere(key) ==
+  bpSpecificErrorAtToken($stok, key)
 
-bpGeneralErrorHere() ==  bpSpecificErrorHere('"syntax error")
+bpGeneralErrorHere() ==
+  bpSpecificErrorHere('"syntax error")
  
 bpIgnoredFromTo(pos1, pos2) ==
-    shoeConsole strconc('"ignored from line ", toString lineNo pos1)
-    shoeConsole lineString pos1
-    shoeConsole strconc(shoeSpaces lineCharacter pos1,'"|")
-    shoeConsole strconc('"ignored through line ", toString lineNo pos2)
-    shoeConsole lineString pos2
-    shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|")
+  shoeConsole strconc('"ignored from line ", toString lineNo pos1)
+  shoeConsole lineString pos1
+  shoeConsole strconc(shoeSpaces lineCharacter pos1,'"|")
+  shoeConsole strconc('"ignored through line ", toString lineNo pos2)
+  shoeConsole lineString pos2
+  shoeConsole strconc(shoeSpaces lineCharacter pos2,'"|")
 
 -- Line inclusion support.
  
@@ -148,8 +150,7 @@ bStreamNull x ==
 bMap(f,x) == 
   bDelay(function bMap1, [f,x])
  
-bMap1(:z)==
-  [f,x] := z
+bMap1(f,x)==
   bStreamNull x => $bStreamNil
   [apply(f,[first x]),:bMap(f,rest x)]
 
@@ -159,40 +160,39 @@ bDelay(f,x) ==
 bAppend(x,y) ==
   bDelay(function bAppend1,[x,y])
  
-bAppend1(:z)==
-  bStreamNull first z =>
-    bStreamNull second z => ["nullstream"]
-    second z
-  [CAAR z,:bAppend(CDAR z,second z)]
+bAppend1(x,y)==
+  bStreamNull x =>
+    bStreamNull y => ["nullstream"]
+    y
+  [first x,:bAppend(rest x,y)]
  
 bNext(f,s) ==
   bDelay(function bNext1,[f,s])
  
 bNext1(f,s)==
-  bStreamNull s=> ["nullstream"]
-  h:= apply(f, [s])
+  bStreamNull s => ["nullstream"]
+  h := apply(f,[s])
   bAppend(first h,bNext(f,rest h))
  
 bRgen s ==
   bDelay(function bRgen1,[s])
  
-bRgen1(:s) ==
-  a := shoeReadLine first s
+bRgen1 s ==
+  a := shoeReadLine s
   shoePLACEP a => ["nullstream"]
-  [a,:bRgen first s]
+  [a,:bRgen s]
  
 bIgen n ==
   bDelay(function bIgen1,[n])
  
-bIgen1(:n)==
-  n:=first n+1
+bIgen1 n ==
+  n := n + 1
   [n,:bIgen n]
  
 bAddLineNumber(f1,f2) ==
   bDelay(function bAddLineNumber1,[f1,f2])
  
-bAddLineNumber1(:f)==
-  [f1,f2] := f
+bAddLineNumber1(f1,f2)==
   bStreamNull f1 =>  ["nullstream"]
   bStreamNull f2 =>  ["nullstream"]
   [[first f1,:first f2],:bAddLineNumber(rest f1,rest f2)]
@@ -226,44 +226,44 @@ shoeElseIf?       s  == shoePrefix?('")elseif",      s)
 shoeLisp?         s  == shoePrefix?('")lisp",        s)
 shoeLine?         s  == shoePrefix?('")line",        s)
  
-shoeBiteOff x==
-  n:=STRPOSL('" ",x,0,true)
+shoeBiteOff x ==
+  n :=STRPOSL('" ",x,0,true)
   n = nil =>  false
-  n1:=STRPOSL ('" ",x,n,nil)
+  n1 := STRPOSL ('" ",x,n,nil)
   n1 = nil =>  [subString(x,n),'""]
   [subString(x,n,n1-n),subString(x,n1)]
  
 shoeFileName x==
-  a:=shoeBiteOff x
+  a := shoeBiteOff x
   a = nil =>  '""
-  c:=shoeBiteOff second a
+  c := shoeBiteOff second a
   c = nil =>  first a
   strconc(first a,'".",first c)
  
 shoeFnFileName x==
-  a:=shoeBiteOff x
+  a := shoeBiteOff x
   a = nil =>  ['"",'""]
-  c:=shoeFileName second a
+  c := shoeFileName second a
   c = nil =>  [first a,'""]
   [first a, c]
  
 shoeInclude s == 
   bDelay(function shoeInclude1,[s])
 
-shoeInclude1 s==
-  bStreamNull s=> s
-  [h,:t]  :=s
-  string  :=first h
-  command :=shoeFin? string  => $bStreamNil
-  command :=shoeIf? string   => shoeThen([true],[STTOMC command],t)
+shoeInclude1 s ==
+  bStreamNull s => s
+  [h,:t]  := s
+  string  := first h
+  command := shoeFin? string  => $bStreamNil
+  command := shoeIf? string   => shoeThen([true],[STTOMC command],t)
   bAppend(shoeSimpleLine h,shoeInclude t)
  
 shoeSimpleLine(h) ==
-  string  :=first h
+  string := first h
   shoePlainLine? string=> [h]
-  command:=shoeLisp? string => [h]
-  command:=shoeLine? string => [h]
-  command:=shoeSay? string =>
+  command := shoeLisp? string => [h]
+  command := shoeLine? string => [h]
+  command := shoeSay? string =>
     shoeConsole command
     nil
   command:=shoeEval? string =>
@@ -277,17 +277,17 @@ shoeThen(keep,b,s) ==
 
 shoeThen1(keep,b,s)==
   bPremStreamNull s=> s
-  [h,:t]  :=s
-  string  :=first h
-  command :=shoeFin? string  => bPremStreamNil(h)
-  keep1:= first keep
-  b1   := first b
-  command :=shoeIf? string  =>
-    keep1 and b1=>  shoeThen([true,:keep],[STTOMC command,:b],t)
+  [h,:t] := s
+  string := first h
+  command := shoeFin? string  => bPremStreamNil(h)
+  keep1 := first keep
+  b1 := first b
+  command := shoeIf? string  =>
+    keep1 and b1 =>  shoeThen([true,:keep],[STTOMC command,:b],t)
     shoeThen([false,:keep],[false,:b],t)
-  command :=shoeElseIf? string=>
-    keep1 and not b1=>
-	shoeThen([true,:rest keep],[STTOMC command,:rest b],t)
+  command := shoeElseIf? string =>
+    keep1 and not b1 =>
+      shoeThen([true,:rest keep],[STTOMC command,:rest b],t)
     shoeThen([false,:rest keep],[false,:rest b],t)
   command :=shoeElse? string =>
    keep1 and not b1=>shoeElse([true,:rest keep],[true,:rest b],t)
@@ -303,15 +303,15 @@ shoeElse(keep,b,s) ==
 
 shoeElse1(keep,b,s)==
   bPremStreamNull s=> s
-  [h,:t]  :=s
-  string  :=first h
-  command :=shoeFin? string => bPremStreamNil(h)
-  b1:=first b
-  keep1:=first keep
-  command :=shoeIf? string=>
-    keep1 and b1=> shoeThen([true,:keep],[STTOMC command,:b],t)
+  [h,:t] := s
+  string := first h
+  command := shoeFin? string => bPremStreamNil(h)
+  b1 := first b
+  keep1 := first keep
+  command := shoeIf? string =>
+    keep1 and b1 => shoeThen([true,:keep],[STTOMC command,:b],t)
     shoeThen([false,:keep],[false,:b],t)
-  command :=shoeEndIf? string =>
+  command := shoeEndIf? string =>
     rest b = nil =>  shoeInclude t
     shoeThen(rest keep,rest b,t)
   keep1 and b1 => bAppend(shoeSimpleLine h,shoeElse(keep,b,t))
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 4522e2b1..b90bd0d5 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -64,7 +64,7 @@ dqToList s ==
   s = nil => nil
   first s
  
-shoeConstructToken(ln,lp,b,n) == 
+shoeConstructToken(lp,b,n) == 
   [b.0,b.1,:[lp,:n]]
 
 shoeTokType x == 
@@ -108,8 +108,7 @@ shoeLineToks(s)==
   $n = nil => shoeLineToks $r
   stringChar($ln,0) = char ")" =>
     command:=shoeLine? $ln=>
-      dq:=dqUnit shoeConstructToken
-	       ($ln,$linepos,shoeLeafLine command,0)
+      dq := dqUnit shoeConstructToken($linepos,shoeLeafLine command,0)
       [[dq],:$r]
     command:=shoeLisp? $ln=> shoeLispToken($r,command)
     shoeLineToks $r
@@ -119,13 +118,12 @@ shoeLineToks(s)==
   [[toks],:$r]
  
 shoeLispToken(s,string)==
-  string:=
-    #string = 0 or stringChar(string,0) = char ";" => '""
-    string
-  ln:=$ln
+  if #string = 0 or stringChar(string,0) = char ";" then
+    string := '""
+  ln := $ln
   linepos:=$linepos
   [r,:st]:=shoeAccumulateLines(s,string)
-  dq:=dqUnit shoeConstructToken(ln,linepos,shoeLeafLisp st,0)
+  dq := dqUnit shoeConstructToken(linepos,shoeLeafLisp st,0)
   [[dq],:r]
  
 shoeAccumulateLines(s,string)==
@@ -150,7 +148,6 @@ shoeCloser t ==
   shoeKeyWord t in '(CPAREN CBRACK)
  
 shoeToken () ==
-  ln := $ln
   linepos := $linepos
   n := $n
   ch := stringChar($ln,$n)
@@ -175,7 +172,7 @@ shoeToken () ==
       []
     shoeError()
   b = nil => nil
-  dqUnit shoeConstructToken(ln,linepos,b,n)
+  dqUnit shoeConstructToken(linepos,b,n)
  
 -- to pair badge and badgee
 shoeLeafId x ==  
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)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 671439c5..ad662ce7 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -285,6 +285,7 @@ for i in [ _
   ["readByte", "READ-BYTE"], _
   ["readInteger", "PARSE-INTEGER"], _
   ["readLine", "READ-LINE"], _
+  ["readLispFromString", "READ-FROM-STRING"] , _
   ["readOnly?","CONSTANTP"], _
   ["removeDuplicates", "REMDUP"]  , _
   ["rest",         "CDR"]  , _