Cleanup.

9 files changed, 29 insertions, 68 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 082ca6e2..aa1f06b9 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -40,7 +40,7 @@
 
 import includer
 namespace BOOTTRAN
-module ast
+module ast (quote)
 
 ++ True means that Boot functions should be translated to use
 ++ hash tables to remember values.  By default, functions are
@@ -116,7 +116,7 @@ $inDefIS := false
 
 ++ returns a `quote' ast for x.
 quote x ==
-  ["QUOTE",x]
+  ['QUOTE,x]
 
 --%
 
@@ -191,7 +191,7 @@ bfAppend ls ==
 bfColonAppend: (%List %Form,%Form) -> %Form
 bfColonAppend(x,y) ==
   x = nil => 
-    y is ["BVQUOTE",:a] => ["&REST",["QUOTE",:a]]
+    y is ["BVQUOTE",:a] => ["&REST",['QUOTE,:a]]
     ["&REST",y]
   [first x,:bfColonAppend(rest x,y)]
 
@@ -358,7 +358,7 @@ bfSep(iters)==
  
 bfReduce(op,y)==
   a :=
-    op is ["QUOTE",:.] => second op
+    op is ['QUOTE,:.] => second op
     op
   op := bfReName a
   init := a has SHOETHETA or op has SHOETHETA
@@ -380,7 +380,7 @@ bfReduceCollect(op,y)==
     body := second y
     itl := third y
     a :=
-      op is ["QUOTE",:.] => second op
+      op is ['QUOTE,:.] => second op
       op
     a is "append!" => bfDoCollect(body,itl,'lastNode,'skipNil)
     a is "append" => bfDoCollect(['copyList,body],itl,'lastNode,'skipNil)
@@ -634,7 +634,7 @@ bfLET2(lhs,rhs) ==
     cons? first b => [a,:b]
     [a,b]
   lhs is ['CONS,var1,var2] =>
-    var1 is "DOT" or var1 is ["QUOTE",:.] =>
+    var1 is "DOT" or var1 is ['QUOTE,:.] =>
       bfLET2(var2,addCARorCDR('CDR,rhs))
     l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
     var2 = nil or var2 is "DOT" =>l1
@@ -779,7 +779,7 @@ bfReName x==
   x
 
 sequence?(x,pred) ==
-  x is ["QUOTE",seq] and cons? seq and
+  x is ['QUOTE,seq] and cons? seq and
     "and"/[apply(pred,y,nil) for y in seq]
 
 idList? x ==
@@ -795,10 +795,10 @@ stringList? x ==
 ++ is a sequence (e.g. a list)
 bfMember(var,seq) ==
   integer? var or sequence?(seq,function integer?) =>
-    seq is ["QUOTE",[x]] => ["EQL",var,x]
+    seq is ['QUOTE,[x]] => ["EQL",var,x]
     ["scalarMember?",var,seq]
   defQuoteId var or sequence?(seq,function symbol?) =>
-    seq is ["QUOTE",[x]] => ["EQ",var, quote x]
+    seq is ['QUOTE,[x]] => ["EQ",var, quote x]
     ["symbolMember?",var,seq]
   idList? seq =>
     seq.args is [.] => ["EQ",var,:seq.args]
@@ -806,7 +806,7 @@ bfMember(var,seq) ==
       bfOR [["EQ",var,x],["EQ",var,y]]
     ["symbolMember?",var,seq]
   bfChar? var or sequence?(seq,function char?) =>
-    seq is ["QUOTE",[x]] => ["CHAR=",var,x]
+    seq is ['QUOTE,[x]] => ["CHAR=",var,x]
     ["charMember?",var,seq]
   charList? seq =>
     seq.args is [.] => ["CHAR=",var,:seq.args]
@@ -814,7 +814,7 @@ bfMember(var,seq) ==
       bfOR [["CHAR=",var,x],["CHAR=",var,y]]
     ["charMember?",var,seq]
   bfString? var or sequence?(seq,function string?) =>
-    seq is ["QUOTE",[x]] => ["STRING=",var,x]
+    seq is ['QUOTE,[x]] => ["STRING=",var,x]
     ["stringMember?",var,seq]
   stringList? seq =>
     seq.args is [.] => ["STRING=",var,:seq.args]
@@ -856,7 +856,7 @@ bfAND l ==
  
  
 defQuoteId x==  
-  x is ["QUOTE",:.] and symbol? second x
+  x is ['QUOTE,:.] and symbol? second x
  
 bfChar? x ==
   char? x or cons? x and x.op in '(char CODE_-CHAR SCHAR)
@@ -964,7 +964,7 @@ bfParameterList(p1,p2) ==
 bfInsertLet(x,body)==
   x = nil => [false,nil,x,body]
   x is ["&REST",a] =>
-    a is ["QUOTE",b] => [true,"QUOTE",["&REST",b],body]
+    a is ['QUOTE,b] => [true,'QUOTE,["&REST",b],body]
     [false,nil,x,body]
   [b,norq,name1,body1] :=  bfInsertLet1 (first x,body)
   [b1,norq1,name2,body2] :=  bfInsertLet (rest x,body1)
@@ -973,7 +973,7 @@ bfInsertLet(x,body)==
 bfInsertLet1(y,body)==
   y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]]
   symbol? y => [false,nil,y,body]
-  y is ["BVQUOTE",b] => [true,"QUOTE",b,body]
+  y is ["BVQUOTE",b] => [true,'QUOTE,b,body]
   g:=bfGenSymbol()
   y isnt [.,:.] => [false,nil,g,body]
   case y of
@@ -1045,7 +1045,7 @@ shoeCompTran1 x ==
       $dollarVars := [x,:$dollarVars]
     x
   U := first x
-  U is "QUOTE" => x
+  U is 'QUOTE => x
   x is ["CASE",y,:zs] =>
     second(x) := shoeCompTran1 y
     while zs ~= nil repeat
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index cdeedf96..05a253a1 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -40,10 +40,6 @@ module scanner
 
 shoeTAB == abstractChar 9
  
--- converts X to double-float.
-double x ==
-  FLOAT(x, 1.0)
- 
 dqUnit s==
   a := [s]
   [a,:a]
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 6a92bd8d..2842cf8a 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -5,6 +5,8 @@
 
 (PROVIDE "ast")
 
+(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE) (EXPORT '|quote|))
+
 (DEFPARAMETER |$bfClamming| NIL)
 
 (DEFPARAMETER |$constantIdentifiers| NIL)
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 28ade94d..a5beae8e 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -182,38 +182,6 @@
 
 (DEFUN |shoeLine?| (|s|) (|shoePrefix?| ")line" |s|))
 
-(DEFUN |shoeBiteOff| (|x|)
-  (PROG (|n1| |n|)
-    (RETURN
-     (PROGN
-      (SETQ |n| (|firstNonblankPosition| |x| 0))
-      (COND ((NULL |n|) NIL)
-            (T (SETQ |n1| (|firstBlankPosittion| |x| |n|))
-             (COND ((NULL |n1|) (LIST (|subString| |x| |n|) ""))
-                   (T
-                    (LIST (|subString| |x| |n| (- |n1| |n|))
-                          (|subString| |x| |n1|))))))))))
-
-(DEFUN |shoeFileName| (|x|)
-  (PROG (|c| |a|)
-    (RETURN
-     (PROGN
-      (SETQ |a| (|shoeBiteOff| |x|))
-      (COND ((NULL |a|) "")
-            (T (SETQ |c| (|shoeBiteOff| (CADR |a|)))
-             (COND ((NULL |c|) (CAR |a|))
-                   (T (CONCAT (CAR |a|) "." (CAR |c|))))))))))
-
-(DEFUN |shoeFnFileName| (|x|)
-  (PROG (|c| |a|)
-    (RETURN
-     (PROGN
-      (SETQ |a| (|shoeBiteOff| |x|))
-      (COND ((NULL |a|) (LIST "" ""))
-            (T (SETQ |c| (|shoeFileName| (CADR |a|)))
-             (COND ((NULL |c|) (LIST (CAR |a|) ""))
-                   (T (LIST (CAR |a|) |c|)))))))))
-
 (DEFUN |shoeInclude| (|s|) (|bDelay| #'|shoeInclude1| (LIST |s|)))
 
 (DEFUN |shoeInclude1| (|s|)
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 166a9dce..1df760be 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -9,8 +9,6 @@
 
 (DEFCONSTANT |shoeTAB| (CODE-CHAR 9))
 
-(DEFUN |double| (|x|) (FLOAT |x| 1.0))
-
 (DEFUN |dqUnit| (|s|)
   (PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|)))))
 
@@ -24,16 +22,17 @@
 
 (DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|))))
 
+(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|)))
+
 (DEFUN |shoeConstructToken| (|lp| |b| |n|)
-  (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|))))
+  (|shoeTokConstruct| (ELT |b| 0) (ELT |b| 1) (CONS |lp| |n|)))
 
 (DEFUN |shoeTokType| (|x|) (CAR |x|))
 
 (DEFUN |shoeTokPart| (|x|) (CADR |x|))
 
-(DEFUN |shoeTokPosn| (|x|) (CDDR |x|))
-
-(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|)))
+(DEFUN |shoeTokPosn| (|x|)
+  (PROG (|p|) (RETURN (PROGN (SETQ |p| (CDDR |x|)) |p|))))
 
 (DEFUN |shoeNextLine| (|s|)
   (PROG (|s1| |a|)
@@ -406,7 +405,7 @@
       (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
         (LOOP
          (COND ((> |i| |bfVar#1|) (RETURN NIL))
-               (T (SETQ |d| (|shoeOrdToNum| (SCHAR |s| |i|)))
+               (T (SETQ |d| (DIGIT-CHAR-P (SCHAR |s| |i|)))
                 (SETQ |ival| (+ (* 10 |ival|) |d|))))
          (SETQ |i| (+ |i| 1))))
       |ival|))))
@@ -468,8 +467,6 @@
                                " is not a Boot character"))
       (|shoeLeafError| (SCHAR |$ln| |n|))))))
 
-(DEFUN |shoeOrdToNum| (|x|) (DIGIT-CHAR-P |x|))
-
 (DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|))
 
 (DEFUN |shoeKeyWordP| (|st|) (|tableValue| |shoeKeyTable| |st|))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index c39dcf5b..2f87cc64 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -599,8 +599,6 @@
                                (AND (CONSP |ISTMP#2|) (NULL (CDR |ISTMP#2|))
                                     (EQ (CAR |ISTMP#2|) '|Foreign|))))))
                    (COND ((|%hasFeature| :SBCL) 'SB-ALIEN)
-                         ((|%hasFeature| :CLISP) 'FFI)
-                         ((|%hasFeature| :CLOZURE) 'CCL)
                          ((|%hasFeature| :ECL) 'FFI) (T (RETURN NIL))))
                   ((|ident?| |ns|) |ns|) (T (|bpTrap|))))
          (CONS 'USE-PACKAGE (CONS (SYMBOL-NAME |z|) |user|)))))
@@ -877,7 +875,7 @@
          (COND
           ((OR (NOT (CONSP |bfVar#5|)) (PROGN (SETQ |i| (CAR |bfVar#5|)) NIL))
            (RETURN NIL))
-          (T (SETQ |b| (CONCAT (PNAME |i|) " is used in "))
+          (T (SETQ |b| (CONCAT (SYMBOL-NAME |i|) " is used in "))
            (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream|
                            |b|)))
          (SETQ |bfVar#5| (CDR |bfVar#5|))))))))
@@ -1131,7 +1129,7 @@
          (COND
           ((OR (NOT (CONSP |bfVar#3|)) (PROGN (SETQ |i| (CAR |bfVar#3|)) NIL))
            (RETURN NIL))
-          (T (SETQ |a| (CONCAT (PNAME |i|) " is used in "))
+          (T (SETQ |a| (CONCAT (SYMBOL-NAME |i|) " is used in "))
            (|bootOutLines| (SSORT (|tableValue| |$bootUsed| |i|)) |stream|
                            |a|)))
          (SETQ |bfVar#3| (CDR |bfVar#3|))))))))
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 7125bd09..c42cc8f2 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -19,8 +19,8 @@
                      |scalarMember?| |listMember?| |reverse| |reverse!|
                      |lastNode| |append| |append!| |copyList| |substitute|
                      |substitute!| |setDifference| |setUnion| |setIntersection|
-                     |applySubst| |applySubst!| |applySubstNQ| |remove|
-                     |removeSymbol| |atomic?| |finishLine|)))
+                     |applySubst| |applySubst!| |applySubstNQ| |objectAssoc|
+                     |remove| |removeSymbol| |atomic?| |finishLine|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
 
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 8b58821c..7179d8fa 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -591,7 +591,7 @@ defuse1(e,y)==
 	 for i in dol repeat
 	       tableValue($bootDefined,i) := true
 	 defuse1 (append(ndol,e),b)
-  y is ["QUOTE",:a] => []
+  y is ['QUOTE,:a] => []
   y is ["+LINE",:a] => []
   for i in y repeat defuse1(e,i)
  
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 44c20d2c..d60c7d5c 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -225,7 +225,7 @@ applySubst!(sl,t) ==
 ++ Like applySubst, but skip quoted materials.
 applySubstNQ(sl,t) ==
   t is [hd,:tl] =>
-    hd is "QUOTE" => t
+    hd is 'QUOTE => t
     hd := applySubstNQ(sl,hd)
     tl := applySubstNQ(sl,tl)
     sameObject?(hd,first t) and sameObject?(tl,rest t) => t