more cleanup

4 files changed, 25 insertions, 12 deletions

diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index 93951c19..76616c22 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -205,9 +205,8 @@ compFluid id ==
  
 compFluidize x==
   x = nil => nil
-  symbol? x and bfBeginsDollar x=>compFluid x
-  atom x => x
-  x is ["QUOTE",:.] => x
+  symbol? x and bfBeginsDollar x => compFluid x
+  atomic? x => x
   [compFluidize(first x),:compFluidize(rest x)]
  
 bfPlace x ==
@@ -497,8 +496,8 @@ bfLeave x ==
   ["%Leave",x]
  
 bfSUBLIS(p,e)==
-  atom e=>bfSUBLIS1(p,e)
-  e is ["QUOTE",:.] => e
+  atom e => bfSUBLIS1(p,e)
+  e.op is 'QUOTE => e
   [bfSUBLIS(p,first e),:bfSUBLIS(p,rest e)]
  
 +++ Returns e/p, where e is an atom.  We assume that the
@@ -961,7 +960,8 @@ shoeFluids x==
 
 shoeATOMs x ==
   x = nil => nil
-  atom x => [x]
+  symbol? x => [x]
+  atom x => nil
   [:shoeATOMs first x,:shoeATOMs rest x]
 
 ++ Return true if `x' is an identifier name that designates a
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 266b7e21..61a5f103 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -272,8 +272,7 @@
   (COND
     ((NULL |x|) NIL)
     ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
-    ((ATOM |x|) |x|)
-    ((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|)
+    ((|atomic?| |x|) |x|)
     (T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))
 
 (DEFUN |bfPlace| (|x|) (CONS '|%Place| |x|))
@@ -740,7 +739,7 @@
 (DEFUN |bfSUBLIS| (|p| |e|)
   (COND
     ((ATOM |e|) (|bfSUBLIS1| |p| |e|))
-    ((AND (CONSP |e|) (EQ (CAR |e|) 'QUOTE)) |e|)
+    ((EQ (CAR |e|) 'QUOTE) |e|)
     (T (CONS (|bfSUBLIS| |p| (CAR |e|)) (|bfSUBLIS| |p| (CDR |e|))))))
 
 (DEFUN |bfSUBLIS1| (|p| |e|)
@@ -1800,7 +1799,8 @@
 (DEFUN |shoeATOMs| (|x|)
   (COND
     ((NULL |x|) NIL)
-    ((ATOM |x|) (LIST |x|))
+    ((SYMBOLP |x|) (LIST |x|))
+    ((ATOM |x|) NIL)
     (T (|append| (|shoeATOMs| (CAR |x|)) (|shoeATOMs| (CDR |x|))))))
 
 (DEFUN |isDynamicVariable| (|x|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 7bfc9387..a832a3ce 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -10,7 +10,8 @@
                |charMember?| |scalarMember?| |listMember?| |reverse|
                |reverse!| |lastNode| |append| |append!| |copyList|
                |substitute| |substitute!| |setDifference| |applySubst|
-               |applySubst!| |applySubstNQ| |remove| |removeSymbol|)))
+               |applySubst!| |applySubstNQ| |remove| |removeSymbol|
+               |atomic?|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|)
                 |substitute|))
@@ -41,6 +42,10 @@
                     (|%List| |%Thing|))
                 |remove|))
 
+(DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Boolean|) |atomic?|))
+
+(DEFUN |atomic?| (|x|) (OR (NOT (CONSP |x|)) (EQ (CAR |x|) 'QUOTE)))
+
 (DEFUN |objectMember?| (|x| |l|)
   (LOOP
     (COND
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index c5a6591f..8410b790 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -32,11 +32,12 @@
 
 import initial_-env
 namespace BOOTTRAN
+
 module utility (objectMember?, symbolMember?, stringMember?,
   charMember?, scalarMember?, listMember?, reverse, reverse!,
   lastNode, append, append!, copyList, substitute, substitute!,
   setDifference, applySubst, applySubst!, applySubstNQ,
-  remove,removeSymbol) where
+  remove,removeSymbol,atomic?) where
     substitute: (%Thing,%Thing,%Thing) -> %Thing
     substitute!: (%Thing,%Thing,%Thing) -> %Thing
     append: (%List %Thing,%List %Thing) -> %List %Thing
@@ -45,6 +46,13 @@ module utility (objectMember?, symbolMember?, stringMember?,
     lastNode: %List %Thing -> %Maybe %Node %Thing
     removeSymbol: (%List %Thing, %Symbol) -> %List %Thing
     remove: (%List %Thing, %Thing) -> %List %Thing
+    atomic?: %Thing -> %Boolean
+
+--%
+
+++ Return true if `x' is an atom of a quotation.
+atomic? x ==
+  not cons? x or x.op is 'QUOTE
 
 --% membership operators