aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ast.boot12
-rw-r--r--src/boot/strap/ast.clisp8
-rw-r--r--src/boot/strap/utility.clisp7
-rw-r--r--src/boot/utility.boot10
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