aboutsummaryrefslogtreecommitdiff
path: root/src/boot
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot')
-rw-r--r--src/boot/ast.boot33
-rw-r--r--src/boot/initial-env.lisp3
-rw-r--r--src/boot/parser.boot2
-rw-r--r--src/boot/strap/ast.clisp35
-rw-r--r--src/boot/strap/parser.clisp2
-rw-r--r--src/boot/strap/translator.clisp4
-rw-r--r--src/boot/translator.boot4
7 files changed, 42 insertions, 41 deletions
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index fde74059..bd4402e0 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -206,7 +206,8 @@ compFluid id ==
["FLUID",id]
compFluidize x==
- IDENTP x and bfBeginsDollar x=>compFluid x
+ x = nil => nil
+ symbol? x and bfBeginsDollar x=>compFluid x
atom x => x
x is ["QUOTE",:.] => x
[compFluidize(first x),:compFluidize(rest x)]
@@ -515,27 +516,27 @@ bfLetForm(lhs,rhs) ==
['L%T,lhs,rhs]
bfLET1(lhs,rhs) ==
- IDENTP lhs => bfLetForm(lhs,rhs)
+ symbol? lhs => bfLetForm(lhs,rhs)
lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
- IDENTP rhs and not bfCONTAINED(rhs,lhs) =>
+ symbol? rhs and not bfCONTAINED(rhs,lhs) =>
rhs1 := bfLET2(lhs,rhs)
rhs1 is ["L%T",:.] => bfMKPROGN [rhs1,rhs]
rhs1 is ["PROGN",:.] => [:rhs1,:[rhs]]
- if IDENTP first rhs1 then rhs1 := [rhs1,:nil]
+ if symbol? first rhs1 then rhs1 := [rhs1,:nil]
bfMKPROGN [:rhs1,rhs]
- rhs is ["L%T",:.] and IDENTP(name := second rhs) =>
+ rhs is ["L%T",:.] and symbol?(name := second rhs) =>
-- handle things like [a] := x := foo
l1 := bfLET1(name,third rhs)
l2 := bfLET1(lhs,name)
l2 is ["PROGN",:.] => bfMKPROGN [l1,:rest l2]
- if IDENTP first l2 then l2 := [l2,:nil]
+ if symbol? first l2 then l2 := [l2,:nil]
bfMKPROGN [l1,:l2,name]
g := INTERN strconc('"LETTMP#",toString $letGenVarCounter)
$letGenVarCounter := $letGenVarCounter + 1
rhs1 := ['L%T,g,rhs]
let1 := bfLET1(lhs,g)
let1 is ["PROGN",:.] => bfMKPROGN [rhs1,:rest let1]
- if IDENTP first let1 then let1 := [let1,:nil]
+ if symbol? first let1 then let1 := [let1,:nil]
bfMKPROGN [rhs1,:let1,g]
bfCONTAINED(x,y)==
@@ -544,8 +545,8 @@ bfCONTAINED(x,y)==
bfCONTAINED(x,first y) or bfCONTAINED(x,rest y)
bfLET2(lhs,rhs) ==
- IDENTP lhs => bfLetForm(lhs,rhs)
lhs = nil => nil
+ symbol? lhs => bfLetForm(lhs,rhs)
lhs is ['FLUID,.] => bfLetForm(lhs,rhs)
lhs is ['L%T,a,b] =>
a := bfLET2(a,rhs)
@@ -559,7 +560,7 @@ bfLET2(lhs,rhs) ==
l1 := bfLET2(var1,addCARorCDR('CAR,rhs))
var2 = nil or var2 = "DOT" =>l1
if cons? l1 and atom first l1 then l1 := [l1,:nil]
- IDENTP var2 =>
+ symbol? var2 =>
[:l1,bfLetForm(var2,addCARorCDR('CDR,rhs))]
l2 := bfLET2(var2,addCARorCDR('CDR,rhs))
if cons? l2 and atom first l2 then l2 := [l2,:nil]
@@ -680,7 +681,7 @@ bfIS1(lhs,rhs) ==
bfHas(expr,prop) ==
- IDENTP prop => ["GET",expr,["QUOTE",prop]]
+ symbol? prop => ["GET",expr,["QUOTE",prop]]
bpSpecificErrorHere('"expected identifier as property name")
bfApplication(bfop, bfarg) ==
@@ -740,7 +741,7 @@ bfAND l ==
defQuoteId x==
- x is ["QUOTE",:.] and IDENTP second x
+ x is ["QUOTE",:.] and symbol? second x
bfSmintable x==
integer? x or cons? x and first x in '(SIZE LENGTH char QENUM)
@@ -844,7 +845,7 @@ bfInsertLet(x,body)==
bfInsertLet1(y,body)==
y is ["L%T",l,r] => [false,nil,l,bfMKPROGN [bfLET(r,l),body]]
- IDENTP y => [false,nil,y,body]
+ symbol? y => [false,nil,y,body]
y is ["BVQUOTE",b] => [true,"QUOTE",b,body]
g:=bfGenSymbol()
atom y => [false,nil,g,body]
@@ -895,7 +896,7 @@ shoePROG(v,b)==
shoeFluids x==
x = nil => nil
- IDENTP x and bfBeginsDollar x => [x]
+ symbol? x and bfBeginsDollar x => [x]
atom x => nil
x is ["QUOTE",:.] => nil
[:shoeFluids first x,:shoeFluids rest x]
@@ -908,7 +909,7 @@ shoeATOMs x ==
++ Return true if `x' is an identifier name that designates a
++ dynamic (e.g. Lisp special) variable.
isDynamicVariable x ==
- IDENTP x and bfBeginsDollar x =>
+ symbol? x and bfBeginsDollar x =>
MEMQ(x,$constantIdentifiers) => false
CONSTANTP x => false
BOUNDP x or $activeNamespace = nil => true
@@ -928,7 +929,7 @@ shoeCompTran1 x==
x is ["L%T",l,r] =>
x.first := "SETQ"
shoeCompTran1 r
- IDENTP l =>
+ symbol? l =>
not bfBeginsDollar l=>
$locVars:=
MEMQ(l,$locVars)=>$locVars
@@ -955,7 +956,7 @@ shoeCompTran1 x==
bfTagged(a,b)==
$op = nil => %Signature(a,b) -- surely a toplevel decl
- IDENTP a =>
+ symbol? a =>
b = "FLUID" => bfLET(compFluid a,nil)
b = "fluid" => bfLET(compFluid a,nil)
b = "local" => bfLET(compFluid a,nil)
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index a4b45b76..b5e9d869 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -178,9 +178,6 @@
(defun bvec-setelt (bv i x)
(setf (sbit bv i) x))
-(defun identp (a)
- (and (symbolp a) a))
-
(defun |shoeReadLisp| (s n)
(multiple-value-list (read-from-string s nil nil :start n)))
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index 4d475238..14cbd4a0 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -1159,7 +1159,7 @@ bpOutItem()==
b:=bpPop1()
bpPush
b is ["+LINE",:.] => [ b ]
- b is ["L%T",l,r] and IDENTP l =>
+ b is ["L%T",l,r] and symbol? l =>
$InteractiveMode => [["SETQ",l,r]]
[["DEFPARAMETER",l,r]]
translateToplevel(b,false)
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index ba658ba5..e491f548 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -234,7 +234,8 @@
(DEFUN |compFluidize| (|x|)
(COND
- ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
+ ((NULL |x|) NIL)
+ ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (|compFluid| |x|))
((ATOM |x|) |x|)
((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) |x|)
(T (CONS (|compFluidize| (CAR |x|)) (|compFluidize| (CDR |x|))))))
@@ -721,13 +722,13 @@
(DECLARE (SPECIAL |$letGenVarCounter|))
(RETURN
(COND
- ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|))
+ ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID)
(PROGN
(SETQ |ISTMP#1| (CDR |lhs|))
(AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)))))
(|bfLetForm| |lhs| |rhs|))
- ((AND (IDENTP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
+ ((AND (SYMBOLP |rhs|) (NOT (|bfCONTAINED| |rhs| |lhs|)))
(SETQ |rhs1| (|bfLET2| |lhs| |rhs|))
(COND
((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'L%T))
@@ -735,16 +736,18 @@
((AND (CONSP |rhs1|) (EQ (CAR |rhs1|) 'PROGN))
(APPEND |rhs1| (LIST |rhs|)))
(T (COND
- ((IDENTP (CAR |rhs1|)) (SETQ |rhs1| (CONS |rhs1| NIL))))
+ ((SYMBOLP (CAR |rhs1|))
+ (SETQ |rhs1| (CONS |rhs1| NIL))))
(|bfMKPROGN| (APPEND |rhs1| (CONS |rhs| NIL))))))
((AND (CONSP |rhs|) (EQ (CAR |rhs|) 'L%T)
- (IDENTP (SETQ |name| (CADR |rhs|))))
+ (SYMBOLP (SETQ |name| (CADR |rhs|))))
(SETQ |l1| (|bfLET1| |name| (CADDR |rhs|)))
(SETQ |l2| (|bfLET1| |lhs| |name|))
(COND
((AND (CONSP |l2|) (EQ (CAR |l2|) 'PROGN))
(|bfMKPROGN| (CONS |l1| (CDR |l2|))))
- (T (COND ((IDENTP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
+ (T (COND
+ ((SYMBOLP (CAR |l2|)) (SETQ |l2| (CONS |l2| NIL))))
(|bfMKPROGN| (CONS |l1| (APPEND |l2| (CONS |name| NIL)))))))
(T (SETQ |g|
(INTERN (CONCAT "LETTMP#"
@@ -756,7 +759,7 @@
((AND (CONSP |let1|) (EQ (CAR |let1|) 'PROGN))
(|bfMKPROGN| (CONS |rhs1| (CDR |let1|))))
(T (COND
- ((IDENTP (CAR |let1|))
+ ((SYMBOLP (CAR |let1|))
(SETQ |let1| (CONS |let1| NIL))))
(|bfMKPROGN|
(CONS |rhs1| (APPEND |let1| (CONS |g| NIL)))))))))))
@@ -773,8 +776,8 @@
(DECLARE (SPECIAL |$inDefIS| |$letGenVarCounter|))
(RETURN
(COND
- ((IDENTP |lhs|) (|bfLetForm| |lhs| |rhs|))
((NULL |lhs|) NIL)
+ ((SYMBOLP |lhs|) (|bfLetForm| |lhs| |rhs|))
((AND (CONSP |lhs|) (EQ (CAR |lhs|) 'FLUID)
(PROGN
(SETQ |ISTMP#1| (CDR |lhs|))
@@ -815,7 +818,7 @@
((AND (CONSP |l1|) (ATOM (CAR |l1|)))
(SETQ |l1| (CONS |l1| NIL))))
(COND
- ((IDENTP |var2|)
+ ((SYMBOLP |var2|)
(APPEND |l1|
(CONS (|bfLetForm| |var2|
(|addCARorCDR| 'CDR |rhs|))
@@ -1077,7 +1080,7 @@
(DEFUN |bfHas| (|expr| |prop|)
(COND
- ((IDENTP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|)))
+ ((SYMBOLP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|)))
(T (|bpSpecificErrorHere| "expected identifier as property name"))))
(DEFUN |bfApplication| (|bfop| |bfarg|)
@@ -1196,7 +1199,7 @@
(SETQ |bfVar#98| (CDR |bfVar#98|))))))))
(DEFUN |defQuoteId| (|x|)
- (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (IDENTP (CADR |x|))))
+ (AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE) (SYMBOLP (CADR |x|))))
(DEFUN |bfSmintable| (|x|)
(OR (INTEGERP |x|)
@@ -1445,7 +1448,7 @@
(PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
(LIST NIL NIL |l|
(|bfMKPROGN| (LIST (|bfLET| |r| |l|) |body|))))
- ((IDENTP |y|) (LIST NIL NIL |y| |body|))
+ ((SYMBOLP |y|) (LIST NIL NIL |y| |body|))
((AND (CONSP |y|) (EQ (CAR |y|) 'BVQUOTE)
(PROGN
(SETQ |ISTMP#1| (CDR |y|))
@@ -1546,7 +1549,7 @@
(DEFUN |shoeFluids| (|x|)
(COND
((NULL |x|) NIL)
- ((AND (IDENTP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
+ ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|)) (LIST |x|))
((ATOM |x|) NIL)
((AND (CONSP |x|) (EQ (CAR |x|) 'QUOTE)) NIL)
(T (APPEND (|shoeFluids| (CAR |x|)) (|shoeFluids| (CDR |x|))))))
@@ -1562,7 +1565,7 @@
(DECLARE (SPECIAL |$activeNamespace| |$constantIdentifiers|))
(RETURN
(COND
- ((AND (IDENTP |x|) (|bfBeginsDollar| |x|))
+ ((AND (SYMBOLP |x|) (|bfBeginsDollar| |x|))
(COND
((MEMQ |x| |$constantIdentifiers|) NIL)
((CONSTANTP |x|) NIL)
@@ -1600,7 +1603,7 @@
(PROGN (SETQ |r| (CAR |ISTMP#2|)) T))))))
(RPLACA |x| 'SETQ) (|shoeCompTran1| |r|)
(COND
- ((IDENTP |l|)
+ ((SYMBOLP |l|)
(COND
((NOT (|bfBeginsDollar| |l|))
(SETQ |$locVars|
@@ -1655,7 +1658,7 @@
(DECLARE (SPECIAL |$typings| |$op|))
(COND
((NULL |$op|) (|%Signature| |a| |b|))
- ((IDENTP |a|)
+ ((SYMBOLP |a|)
(COND
((EQ |b| 'FLUID) (|bfLET| (|compFluid| |a|) NIL))
((EQ |b| '|fluid|) (|bfLET| (|compFluid| |a|) NIL))
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 77744484..7b978080 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -1221,7 +1221,7 @@
(AND (CONSP |ISTMP#2|)
(NULL (CDR |ISTMP#2|))
(PROGN (SETQ |r| (CAR |ISTMP#2|)) T)))))
- (IDENTP |l|))
+ (SYMBOLP |l|))
(COND
(|$InteractiveMode| (LIST (LIST 'SETQ |l| |r|)))
(T (LIST (LIST 'DEFPARAMETER |l| |r|)))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index e96bf98a..c941265d 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -920,7 +920,7 @@
(COND
((ATOM |y|)
(COND
- ((IDENTP |y|)
+ ((SYMBOLP |y|)
(SETQ |$used|
(COND
((MEMQ |y| |e|) |$used|)
@@ -1148,7 +1148,7 @@
(COND
((ATOM |x|)
(COND
- ((IDENTP |x|)
+ ((SYMBOLP |x|)
(COND
((EQUAL (SYMBOL-PACKAGE |x|) |bt|) (INTERN (PNAME |x|) |pk|))
(T |x|)))
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 84f3c9ec..5d2e0a71 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -543,7 +543,7 @@ defuse(e,x)==
defuse1(e,y)==
atom y =>
- IDENTP y =>
+ symbol? y =>
$used:=
MEMQ(y,e)=>$used
MEMQ(y,$used)=>$used
@@ -659,7 +659,7 @@ shoeItem (str)==
stripm (x,pk,bt)==
atom x =>
- IDENTP x =>
+ symbol? x =>
SYMBOL_-PACKAGE x = bt => INTERN(PNAME x,pk)
x
x
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 04:53:55 +0000