diff options
| -rw-r--r-- | src/boot/ast.boot | 12 | ||||
| -rw-r--r-- | src/boot/strap/ast.clisp | 8 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 7 | ||||
| -rw-r--r-- | src/boot/utility.boot | 10 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 6 |
5 files changed, 25 insertions, 18 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 diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 27f870ce..486a7b34 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -38,7 +38,6 @@ import sys_-utility namespace BOOT module g_-util where - atomic?: %Thing -> %Boolean getTypeOfSyntax: %Form -> %Mode pairList: (%List %Form,%List %Form) -> %List %Pair(%Form,%Form) mkList: %List %Form -> %Form @@ -107,11 +106,6 @@ isSharpVarWithNum x == ok := digit? d => c := 10*c + DIG2FIX d if ok then c else nil -++ Returns true if `x' is either an atom or a quotation. -atomic? x == - cons? x => x.op is 'QUOTE - true - --% Sub-domains information handlers ++ If `dom' is a subdomain, return its immediate super-domain. |