aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2009-09-20 04:30:17 +0000
committerdos-reis <gdr@axiomatics.org>2009-09-20 04:30:17 +0000
commita50eb601b4dc0699cde4084584763798ee8dab02 (patch)
tree540011a51f4396a3362cb066445c2fd250659b54 /src
parent0c55ed614187758d4e0a670fc4f031d5f4ad7e4e (diff)
downloadopen-axiom-a50eb601b4dc0699cde4084584763798ee8dab02.tar.gz
* boot/tokens.boot: "has" is not a keyword.
* boot/ast.boot (bfHas): New. (bfReduce): Use "has" instead "has". (bfReduceCollect): Likewise. (bfReName): Likewise. (bfElt): Likewise. (bfSetelt): Likewise. * boot/parser.boot (bpSexpKey): Likewise. (bpPrefixOperator): Likewise. (bpInfixOperator): Likewise. (bpThetaName): Likewise. (bpIs): Parse "has" expressions. * boot/pile.boot (shoePileCoagulate): Likewise. * interp/: Fix unquoted use of "has". * interp/interop.boot (has): Remove.
Diffstat (limited to 'src')
-rw-r--r--src/ChangeLog18
-rw-r--r--src/boot/ast.boot17
-rw-r--r--src/boot/parser.boot17
-rw-r--r--src/boot/pile.boot2
-rw-r--r--src/boot/strap/ast.clisp32
-rw-r--r--src/boot/strap/parser.clisp12
-rw-r--r--src/boot/strap/tokens.clisp6
-rw-r--r--src/boot/tokens.boot1
-rw-r--r--src/interp/as.boot2
-rw-r--r--src/interp/ax.boot2
-rw-r--r--src/interp/br-con.boot2
-rw-r--r--src/interp/br-op1.boot2
-rw-r--r--src/interp/br-op2.boot2
-rw-r--r--src/interp/cattable.boot20
-rw-r--r--src/interp/database.boot2
-rw-r--r--src/interp/define.boot4
-rw-r--r--src/interp/functor.boot6
-rw-r--r--src/interp/i-funsel.boot26
-rw-r--r--src/interp/interop.boot2
-rw-r--r--src/interp/nruncomp.boot2
-rw-r--r--src/interp/nrunfast.boot2
-rw-r--r--src/interp/nrungo.boot2
-rw-r--r--src/interp/nrunopt.boot6
-rw-r--r--src/interp/wi2.boot2
24 files changed, 112 insertions, 77 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 6df870d1..06a75817 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,21 @@
+2009-09-19 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ * boot/tokens.boot: "has" is not a keyword.
+ * boot/ast.boot (bfHas): New.
+ (bfReduce): Use "has" instead "has".
+ (bfReduceCollect): Likewise.
+ (bfReName): Likewise.
+ (bfElt): Likewise.
+ (bfSetelt): Likewise.
+ * boot/parser.boot (bpSexpKey): Likewise.
+ (bpPrefixOperator): Likewise.
+ (bpInfixOperator): Likewise.
+ (bpThetaName): Likewise.
+ (bpIs): Parse "has" expressions.
+ * boot/pile.boot (shoePileCoagulate): Likewise.
+ * interp/: Fix unquoted use of "has".
+ * interp/interop.boot (has): Remove.
+
2009-09-16 Kosta Oikonomou <ko@research.att.com>
Gabriel Dos Reis <gdr@cs.tamu.edu>
diff --git a/src/boot/ast.boot b/src/boot/ast.boot
index c83e95c6..0e7b50a8 100644
--- a/src/boot/ast.boot
+++ b/src/boot/ast.boot
@@ -335,7 +335,7 @@ bfReduce(op,y)==
op is ["QUOTE",:.] => second op
op
op := bfReName a
- init := GET(a,"SHOETHETA") or GET(op,"SHOETHETA")
+ init := a has SHOETHETA or op has SHOETHETA
g := bfGenSymbol()
g1 := bfGenSymbol()
body := ['SETQ,g,[op,g,g1]]
@@ -357,7 +357,7 @@ bfReduceCollect(op,y)==
op is ["QUOTE",:.] => second op
op
op := bfReName a
- init := GET(a, "SHOETHETA") or GET(op,"SHOETHETA")
+ init := a has SHOETHETA or op has SHOETHETA
bfOpReduce(op,init,body,itl)
bfReduce(op,bfTupleConstruct (y.1))
@@ -666,14 +666,19 @@ bfIS1(lhs,rhs) ==
bfAND [rev,:l2,['PROGN,bfLetForm(a,['NREVERSE,a]),'T]]
bpSpecificErrorHere '"bad IS code is generated"
bpTrap()
-
+
+
+bfHas(expr,prop) ==
+ IDENTP prop => ["GET",expr,["QUOTE",prop]]
+ bpSpecificErrorAtToken('"expected identifier as property name")
+
bfApplication(bfop, bfarg) ==
bfTupleP bfarg => [bfop,:rest bfarg]
[bfop,bfarg]
-- returns the meaning of x in the appropriate Boot dialect.
bfReName x==
- a := GET(x,"SHOERENAME") => first a
+ a := x has SHOERENAME => first a
x
bfInfApplication(op,left,right)==
@@ -932,14 +937,14 @@ bfSetelt(e,l,r)==
bfSetelt(bfElt(e,first l),rest l,r)
bfElt(expr,sel)==
- y:=SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
+ y:=SYMBOLP sel and sel has SHOESELFUNCTION
y =>
INTEGERP y => ["ELT",expr,y]
[y,expr]
["ELT",expr,sel]
defSETELT(var,sel,expr)==
- y := SYMBOLP sel and GET(sel,"SHOESELFUNCTION")
+ y := SYMBOLP sel and sel has SHOESELFUNCTION
y =>
INTEGERP y => ["SETF",["ELT",var,y],expr]
["SETF",[y,var],expr]
diff --git a/src/boot/parser.boot b/src/boot/parser.boot
index fa74a739..036f6375 100644
--- a/src/boot/parser.boot
+++ b/src/boot/parser.boot
@@ -521,7 +521,7 @@ bpExceptions()==
bpSexpKey()==
$stok is ["KEY",:.] and not bpExceptions()=>
- a:=GET($ttok,"SHOEINF")
+ a := $ttok has SHOEINF
null a=> bpPush $ttok and bpNext()
bpPush a and bpNext()
false
@@ -561,11 +561,11 @@ bpDot()== bpEqKey "DOT" and bpPush bfDot ()
bpPrefixOperator()==
$stok is ["KEY",:.] and
- GET($ttok,"SHOEPRE") and bpPushId() and bpNext()
+ $ttok has SHOEPRE and bpPushId() and bpNext()
bpInfixOperator()==
$stok is ["KEY",:.] and
- GET($ttok,"SHOEINF") and bpPushId() and bpNext()
+ $ttok has SHOEINF and bpPushId() and bpNext()
bpSelector()==
bpEqKey "DOT" and (bpPrimary()
@@ -626,7 +626,7 @@ bpString()==
bpPush(["QUOTE",INTERN $ttok]) and bpNext()
bpThetaName() ==
- $stok is ["ID",:.] and GET($ttok,"SHOETHETA") =>
+ $stok is ["ID",:.] and $ttok has SHOETHETA =>
bpPushId()
bpNext()
false
@@ -656,9 +656,12 @@ bpMinus()==
bpArith()==bpLeftAssoc('(PLUS MINUS),function bpMinus)
bpIs()==
- bpArith() and (bpInfKey '(IS ISNT) and (bpPattern() or bpTrap())
- and bpPush bfISApplication(bpPop2(),bpPop2(),bpPop1())
- or true)
+ bpArith() and
+ bpInfKey '(IS ISNT) and (bpPattern() or bpTrap()) =>
+ bpPush bfISApplication(bpPop2(),bpPop2(),bpPop1())
+ bpEqKey "HAS" and (bpApplication() or bpTrap()) =>
+ bpPush bfHas(bpPop2(), bpPop1())
+ true
bpBracketConstruct(f)==
bpBracket f and bpPush bfConstruct bpPop1()
diff --git a/src/boot/pile.boot b/src/boot/pile.boot
index 52bebdea..9f9fcd96 100644
--- a/src/boot/pile.boot
+++ b/src/boot/pile.boot
@@ -109,7 +109,7 @@ shoePileCoagulate(a,b)==
d := second a
e := shoeTokPart d
d is ["KEY",:.] and
- (GET(e,"SHOEINF") or e = "COMMA" or e = "SEMICOLON") =>
+ (e has SHOEINF or e = "COMMA" or e = "SEMICOLON") =>
shoePileCoagulate(dqAppend(a,c),rest b)
cons(a,shoePileCoagulate(c,rest b))
diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp
index 0c52e92b..615c3f0d 100644
--- a/src/boot/strap/ast.clisp
+++ b/src/boot/strap/ast.clisp
@@ -1055,6 +1055,12 @@
(T (|bpSpecificErrorHere| "bad IS code is generated")
(|bpTrap|))))))
+(DEFUN |bfHas| (|expr| |prop|)
+ (COND
+ ((IDENTP |prop|) (LIST 'GET |expr| (LIST 'QUOTE |prop|)))
+ (T (|bpSpecificErrorAtToken|
+ "expected identifier as property name"))))
+
(DEFUN |bfApplication| (|bfop| |bfarg|)
(COND
((|bfTupleP| |bfarg|) (CONS |bfop| (CDR |bfarg|)))
@@ -2050,9 +2056,9 @@
(LIST 'DEFTYPE |op| |args| (|backquote| |body| |args|))))))
(DEFCONSTANT |$NativeSimpleDataTypes|
- '(|char| |byte| |int| |int8| |uint8| |int16| |uint16| |int32|
- |uint32| |int64| |uint64| |float| |float32| |double|
- |float64|))
+ '(|char| |byte| |int| |pointer| |int8| |uint8| |int16| |uint16|
+ |int32| |uint32| |int64| |uint64| |float| |float32|
+ |double| |float64|))
(DEFCONSTANT |$NativeSimpleReturnTypes|
(APPEND |$NativeSimpleDataTypes| '(|void| |string|)))
@@ -2148,6 +2154,14 @@
(T (|unknownNativeTypeError| |t|))))
((EQ |t| '|float32|) (|nativeType| '|float|))
((EQ |t| '|float64|) (|nativeType| '|double|))
+ ((EQ |t| '|pointer|)
+ (COND
+ ((|%hasFeature| :GCL) '|fixnum|)
+ ((|%hasFeature| :ECL) :POINTER-VOID)
+ ((|%hasFeature| :SBCL)
+ (LIST '* (|bfColonColon| 'SB-ALIEN 'VOID)))
+ ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
+ (T (|unknownNativeTypeError| |t|))))
(T (|unknownNativeTypeError| |t|))))
((EQ (CAR |t|) '|buffer|)
(COND
@@ -2156,13 +2170,7 @@
((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|))))
((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
(T (|unknownNativeTypeError| |t|))))
- ((EQ (CAR |t|) '|buffer|)
- (COND
- ((|%hasFeature| :GCL) '|fixnum|)
- ((|%hasFeature| :ECL) :OBJECT)
- ((|%hasFeature| :SBCL) (LIST '* (|nativeType| (CADR |t|))))
- ((|%hasFeature| :CLISP) (|bfColonColon| 'FFI 'C-POINTER))
- (T (|unknownNativeTypeError| |t|))))
+ ((EQ (CAR |t|) '|pointer|) (|nativeType| '|pointer|))
(T (|unknownNativeTypeError| |t|))))))
(DEFUN |nativeReturnType| (|t|)
@@ -2188,7 +2196,7 @@
"missing modifier for argument type for a native function"))
((NOT (MEMBER |c| '(|buffer| |pointer|)))
(|coreError|
- "expect 'buffer' or 'pointer' type instance"))
+ "expected 'buffer' or 'pointer' type instance"))
((NOT (MEMBER |t'| |$NativeSimpleDataTypes|))
(|coreError| "expected simple native data type"))
(T (|nativeType| (CADR |t|)))))))))
@@ -2470,7 +2478,7 @@
((EQ |y| '|double|) "->vector.self.df")
(T (|coreError|
"unknown argument to buffer type constructor"))))
- ((EQ |c| '|pointer|) '||)
+ ((EQ |c| '|pointer|) "")
(T (|coreError| "unknown type constructor"))))))))
(DEFUN |genCLISPnativeTranslation| (|op| |s| |t| |op'|)
diff --git a/src/boot/strap/parser.clisp b/src/boot/strap/parser.clisp
index 716b86d1..5683aef5 100644
--- a/src/boot/strap/parser.clisp
+++ b/src/boot/strap/parser.clisp
@@ -700,11 +700,13 @@
(DEFUN |bpIs| ()
(AND (|bpArith|)
- (OR (AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|))
- (|bpPush|
- (|bfISApplication| (|bpPop2|) (|bpPop2|)
- (|bpPop1|))))
- T)))
+ (COND
+ ((AND (|bpInfKey| '(IS ISNT)) (OR (|bpPattern|) (|bpTrap|)))
+ (|bpPush|
+ (|bfISApplication| (|bpPop2|) (|bpPop2|) (|bpPop1|))))
+ ((AND (|bpEqKey| 'HAS) (OR (|bpApplication|) (|bpTrap|)))
+ (|bpPush| (|bfHas| (|bpPop2|) (|bpPop1|))))
+ (T T))))
(DEFUN |bpBracketConstruct| (|f|)
(AND (|bpBracket| |f|) (|bpPush| (|bfConstruct| (|bpPop1|)))))
diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp
index 9deef054..ce8f5cac 100644
--- a/src/boot/strap/tokens.clisp
+++ b/src/boot/strap/tokens.clisp
@@ -8,9 +8,9 @@
(DEFCONSTANT |shoeKeyWords|
(LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
(LIST "catch" 'CATCH) (LIST "cross" 'CROSS)
- (LIST "else" 'ELSE) (LIST "for" 'FOR) (LIST "if" 'IF)
- (LIST "import" 'IMPORT) (LIST "in" 'IN) (LIST "is" 'IS)
- (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
+ (LIST "else" 'ELSE) (LIST "for" 'FOR) (LIST "has" 'HAS)
+ (LIST "if" 'IF) (LIST "import" 'IMPORT) (LIST "in" 'IN)
+ (LIST "is" 'IS) (LIST "isnt" 'ISNT) (LIST "module" 'MODULE)
(LIST "namespace" 'NAMESPACE) (LIST "of" 'OF) (LIST "or" 'OR)
(LIST "repeat" 'REPEAT) (LIST "return" 'RETURN)
(LIST "structure" 'STRUCTURE) (LIST "then" 'THEN)
diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot
index 1116654d..39a40df2 100644
--- a/src/boot/tokens.boot
+++ b/src/boot/tokens.boot
@@ -45,6 +45,7 @@ shoeKeyWords == [ _
['"cross","CROSS"] , _
['"else", "ELSE"] , _
['"for", "FOR"] , _
+ ['"has", "HAS"] , _
['"if", "IF"], _
['"import", "IMPORT"], _
['"in", "IN" ], _
diff --git a/src/interp/as.boot b/src/interp/as.boot
index 15242412..68e0b01f 100644
--- a/src/interp/as.boot
+++ b/src/interp/as.boot
@@ -1012,7 +1012,7 @@ asyCattranOp1(op, item, predlist) ==
asyPredTran p == asyPredTran1 asyJoinPart p
asyPredTran1 p ==
- p is ['Has,x,y] => ['has,x, simpCattran y]
+ p is ['Has,x,y] => ["has",x, simpCattran y]
p is ['Test, q] => asyPredTran1 q
p is [op,:r] and MEMQ(op,'(AND OR NOT)) =>
[op,:[asyPredTran1 q for q in r]]
diff --git a/src/interp/ax.boot b/src/interp/ax.boot
index 7ddee7e8..f70ad4bc 100644
--- a/src/interp/ax.boot
+++ b/src/interp/ax.boot
@@ -265,7 +265,7 @@ axFormatPred pred ==
atom pred => pred
[op,:args] := pred
op = 'IF => axFormatOp pred
- op = 'has =>
+ op = "has" =>
[name,type] := args
if name = '$ then name := '%
else name := axFormatOp name
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index d1c1911c..d8499ed6 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -273,7 +273,7 @@ domainDescendantsOf(conform,domform) == main where --called by kargPage
for x in r repeat
x isnt [op1,:.] and MEMQ(op1,'(ATTRIBUTE SIGNATURE)) => systemError x
alist := [[item,:npred] for [item,:pred] in alist |
- (pred1 := simpHasPred ['has,item,x]) and (npred := quickAnd(pred1,pred))]
+ (pred1 := simpHasPred ["has",item,x]) and (npred := quickAnd(pred1,pred))]
alist
--=======================================================================
diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot
index c5d51419..9348194d 100644
--- a/src/interp/br-op1.boot
+++ b/src/interp/br-op1.boot
@@ -970,7 +970,7 @@ evalDomainOpPred(dom,pred) == process(dom,pred) where
MEMQ(op,'(AND and)) => ['AND,:[convert(dom,x) for x in argl]]
MEMQ(op,'(OR or)) => ['OR,:[convert(dom,x) for x in argl]]
MEMQ(op,'(NOT not)) => ['NOT,convert(dom,first argl)]
- op = 'has =>
+ op = "has" =>
[arg,p] := argl
p is ['ATTRIBUTE,a] => ['HasAttribute,arg,MKQ a]
['HasCategory,arg,convertCatArg p]
diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot
index 2171a7ae..c89e727d 100644
--- a/src/interp/br-op2.boot
+++ b/src/interp/br-op2.boot
@@ -609,7 +609,7 @@ getSigSubst(u, pl, vl, fl) ==
key = 'isDomain => getSigSubst(r, pl, [v, :vl], [f, :fl])
key = 'ofCategory => getSigSubst(r, pl, ['D, :vl], [f, :fl])
key = 'ofType => getSigSubst(r, pl, vl, fl)
- key = 'has => getSigSubst(r, [item, :pl], vl, fl)
+ key = "has" => getSigSubst(r, [item, :pl], vl, fl)
key = 'not => getSigSubst(r, [item, :pl], vl, fl)
systemError()
[pl, vl, fl]
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 25c909b7..2c8129b8 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -96,19 +96,19 @@ simpHasPred(pred,:options) == main where
simp pred ==
pred is [op,:r] =>
op = "has" => simpHas(pred,first r,first rest r)
- op = 'HasCategory => simp ['has,CAR r,simpDevaluate CADR r]
+ op = 'HasCategory => simp ["has",CAR r,simpDevaluate CADR r]
op = 'HasSignature =>
[op,sig] := simpDevaluate CADR r
["has",CAR r,['SIGNATURE,op,sig]]
op = 'HasAttribute =>
- form := ['has,a := CAR r,['ATTRIBUTE,b := simpDevaluate CADR r]]
+ form := ["has",a := CAR r,['ATTRIBUTE,b := simpDevaluate CADR r]]
simpHasAttribute(form,a,b)
MEMQ(op,'(AND OR NOT)) =>
null (u := MKPF([simp p for p in r],op)) => nil
u is '(QUOTE T) => true
simpBool u
op = 'hasArgs => ($hasArgs => $hasArgs = r; pred)
- null r and opOf op = 'has => simp first pred
+ null r and opOf op = "has" => simp first pred
pred is '(QUOTE T) => true
op1 := LASSOC(op,'((and . AND)(or . OR)(not . NOT))) => simp [op1,:r]
simp first pred --REMOVE THIS HACK !!!!
@@ -123,7 +123,7 @@ simpHasPred(pred,:options) == main where
npred := eval pred
IDENTP npred or null hasIdent npred => npred
pred
- eval (pred := ['has,d,cat]) ==
+ eval (pred := ["has",d,cat]) ==
x := hasCat(CAR d,CAR cat)
y := CDR cat =>
npred := or/[p for [args,:p] in x | y = args] => simp npred
@@ -233,7 +233,7 @@ encodeUnion(id,new:=[a,:b],alist) ==
moreGeneralCategoryPredicate(id,new,old) ==
old = 'T or new = 'T => 'T
- old is ['has,a,b] and new is ['has,=a,c] =>
+ old is ["has",a,b] and new is ["has",=a,c] =>
tempExtendsCat(b,c) => new
tempExtendsCat(c,b) => old
['OR,old,new]
@@ -246,10 +246,10 @@ mkCategoryOr(new,old) ==
simpCategoryOr(new,l) ==
newExtendsAnOld:= false
anOldExtendsNew:= false
- ['has,a,b] := new
+ ["has",a,b] := new
newList:= nil
for pred in l repeat
- pred is ['has,=a,c] =>
+ pred is ["has",=a,c] =>
tempExtendsCat(c,b) => anOldExtendsNew:= true
if tempExtendsCat(b,c) then newExtendsAnOld:= true
newList:= [pred,:newList]
@@ -331,7 +331,7 @@ simpOrUnion1(x,l) ==
[first l,:simpOrUnion1(x,rest l)]
mergeOr(x,y) ==
- x is ["has",a,b] and y is ['has,=a,c] =>
+ x is ["has",a,b] and y is ["has",=a,c] =>
testExtend(b,c) => y
testExtend(c,b) => x
nil
@@ -356,12 +356,12 @@ getConstrCat(x) ==
makeCatPred(zz, cats, thePred) ==
- if zz is ['IF,curPred := ['has,z1,z2],ats,.] then
+ if zz is ['IF,curPred := ["has",z1,z2],ats,.] then
ats := if ats is ['PROGN,:atl] then atl else [ats]
for at in ats repeat
if at is ['ATTRIBUTE,z3] and not atom z3 and
constructor? CAR z3 then
- cats:= CONS(['IF,quickAnd(['has,z1,z2], thePred),z3,'%noBranch],cats)
+ cats:= CONS(['IF,quickAnd(["has",z1,z2], thePred),z3,'%noBranch],cats)
at is ['IF, pred, :.] =>
cats := makeCatPred(at, cats, curPred)
cats
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 1f4b8c0f..622f1051 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -395,7 +395,7 @@ isDomainSubst u == main where
signatureTran pred ==
atom pred => pred
- pred is ['has,D,catForm] and isCategoryForm(catForm,$e) =>
+ pred is ["has",D,catForm] and isCategoryForm(catForm,$e) =>
['ofCategory,D,catForm]
[signatureTran p for p in pred]
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 0780dc52..b74fc64a 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -417,7 +417,7 @@ makeCategoryPredicates(form,u) ==
fn(u,pl) ==
u is ['Join,:.,a] => fn(a,pl)
u is ["IF",p,:x] => fnl(x,insert(EQSUBSTLIST($mvl,$tvl,p),pl))
- u is ['has,:.] => insert(EQSUBSTLIST($mvl,$tvl,u),pl)
+ u is ["has",:.] => insert(EQSUBSTLIST($mvl,$tvl,u),pl)
u is [op,:.] and MEMQ(op,'(SIGNATURE ATTRIBUTE)) => pl
atom u => pl
fnl(u,pl)
@@ -810,7 +810,7 @@ makeFunctorArgumentParameters(argl,sigl,target) ==
findExtrasP(a,x) ==
x is ['AND,:l] => "union"/[findExtrasP(a,y) for y in l]
x is ['OR,:l] => "union"/[findExtrasP(a,y) for y in l]
- x is ['has,=a,y] and y is ['SIGNATURE,:.] => [y]
+ x is ["has",=a,y] and y is ['SIGNATURE,:.] => [y]
nil
nil
augmentSig(s,ss) ==
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 18d412ec..3c97b449 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -368,7 +368,7 @@ sublisProp(subst,props) ==
--keep original CONS
cond is ['or,:x] =>
(or/[inspect(u,subst) for u in x] => [a,true,:l]; nil)
- cond is ['has,nam,b] and (val:= ASSQ(nam,subst)) =>
+ cond is ["has",nam,b] and (val:= ASSQ(nam,subst)) =>
ev:=
b is ['ATTRIBUTE,c] => HasAttribute(rest val,c)
b is ['SIGNATURE,c] => HasSignature(rest val,c)
@@ -764,7 +764,7 @@ CheckVector(vec,name,catvecListMaker) ==
makeMissingFunctionEntry(alist,i) ==
tran SUBLIS(alist,$MissingFunctionInfo.i) where
tran x ==
- x is ["HasCategory",a,["QUOTE",b]] => ['has,a,b]
+ x is ["HasCategory",a,["QUOTE",b]] => ["has",a,b]
x is [op,:l] and op in '(AND OR NOT) => [op,:[tran y for y in l]]
x
@@ -878,7 +878,7 @@ InvestigateConditions catvecListMaker ==
ICformat u ==
atom u => u
- u is ['has,:.] => compHasFormat u
+ u is ["has",:.] => compHasFormat u
u is ['AND,:l] or u is ['and,:l] =>
l:= REMDUP [ICformat v for [v,:l'] in tails l | not member(v,l')]
-- we could have duplicates after, even if not before
diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot
index 9fcff10e..da2d49db 100644
--- a/src/interp/i-funsel.boot
+++ b/src/interp/i-funsel.boot
@@ -915,7 +915,7 @@ matchMmCond(cond) ==
and/[matchMmCond c for c in conds]
cond is ['OR,:conds] or cond is ['or,:conds] =>
or/[matchMmCond c for c in conds]
- cond is ['has,dom,x] =>
+ cond is ["has",dom,x] =>
hasCaty(dom,x,NIL) ~= 'failed
cond is ['not,cond1] => not matchMmCond cond1
keyedSystemError("S2GE0016",
@@ -1174,7 +1174,7 @@ evalMmStack(mmC) ==
mmC is ['ofCategory,pvar,cat] and cat is ['Join,:args] =>
evalMmStack CONS('AND,[['ofCategory,pvar,c] for c in args])
mmC is ['ofType,:.] => [NIL]
- mmC is ['has,pat,x] =>
+ mmC is ["has",pat,x] =>
MEMQ(x,'(ATTRIBUTE SIGNATURE)) =>
[[['ofCategory,pat,['CATEGORY,'unknown,x]]]]
[['ofCategory,pat,x]]
@@ -1189,7 +1189,7 @@ evalMmStackInner(mmC) ==
[['ofCategory, pvar, c] for c in args]
mmC is ['ofType,:.] => NIL
mmC is ['isAsConstant] => NIL
- mmC is ['has,pat,x] =>
+ mmC is ["has",pat,x] =>
MEMQ(x,'(ATTRIBUTE SIGNATURE)) =>
[['ofCategory,pat,['CATEGORY,'unknown,x]]]
[['ofCategory,pat,x]]
@@ -1495,12 +1495,12 @@ hasCaty(d,cat,SL) ==
if not (S1='failed) then S1:=
atom cond => S1
ncond := subCopy(cond, S)
- ncond is ['has, =d, =cat] => 'failed
+ ncond is ["has", =d, =cat] => 'failed
hasCaty1(ncond,S1)
S1
atom x => SL
ncond := subCopy(x, constructSubst d)
- ncond is ['has, =d, =cat] => 'failed
+ ncond is ["has", =d, =cat] => 'failed
hasCaty1(ncond, SL)
'failed
@@ -1523,20 +1523,20 @@ hasCaty1(cond,SL) ==
-- cond is either a (has a b) or an OR clause of such conditions
-- SL is augmented, if cond is true, otherwise the result is 'failed
$domPvar: local := NIL
- cond is ['has,a,b] => hasCate(a,b,SL)
+ cond is ["has",a,b] => hasCate(a,b,SL)
cond is ['AND,:args] =>
for x in args while not (S='failed) repeat S:=
- x is ['has,a,b] => hasCate(a,b, SL)
+ x is ["has",a,b] => hasCate(a,b, SL)
-- next line is for an obscure bug in the table
- x is [['has,a,b]] => hasCate(a,b, SL)
+ x is [["has",a,b]] => hasCate(a,b, SL)
--'failed
hasCaty1(x, SL)
S
cond is ['OR,:args] =>
for x in args until not (S='failed) repeat S:=
- x is ['has,a,b] => hasCate(a,b,copy SL)
+ x is ["has",a,b] => hasCate(a,b,copy SL)
-- next line is for an obscure bug in the table
- x is [['has,a,b]] => hasCate(a,b,copy SL)
+ x is [["has",a,b]] => hasCate(a,b,copy SL)
--'failed
hasCaty1(x, copy SL)
S
@@ -1559,7 +1559,7 @@ hasSigAnd(andCls, S0, SL) ==
for cls in andCls while not dead repeat
SA :=
atom cls => copy SL
- cls is ['has,a,b] =>
+ cls is ["has",a,b] =>
hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
keyedSystemError("S2GE0016",
['"hasSigAnd",'"unexpected condition for signature"])
@@ -1572,7 +1572,7 @@ hasSigOr(orCls, S0, SL) ==
for cls in orCls until found repeat
SA :=
atom cls => copy SL
- cls is ['has,a,b] =>
+ cls is ["has",a,b] =>
hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
cls is ['AND,:andCls] or cls is ['and,:andCls] =>
hasSigAnd(andCls, S0, SL)
@@ -1591,7 +1591,7 @@ hasSig(dom,foo,sig,SL) ==
for [x,.,cond,.] in CDR p until not (S='failed) repeat
S:=
atom cond => copy SL
- cond is ['has,a,b] =>
+ cond is ["has",a,b] =>
hasCate(subCopy(a,S0),subCopy(b,S0),copy SL)
cond is ['AND,:andCls] or cond is ['and,:andCls] =>
hasSigAnd(andCls, S0, SL)
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 249f7b1b..e56e396a 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -589,8 +589,6 @@ getCatForm(catvec, index, domain) ==
HasSignature(domain,[op,sig]) ==
compiledLookup(op,sig,domain)
-has(domain,catform') == HasCategory(domain,catform')
-
HasCategory(domain,catform') ==
catform' is ['SIGNATURE,:f] => HasSignature(domain,f)
catform' is ['ATTRIBUTE,f] => HasAttribute(domain,f)
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 751bf073..7fd6aa3c 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -650,7 +650,7 @@ NRToptimizeHas u ==
a='HasCategory => LASSOC(u,$hasCategoryAlist) or
$hasCategoryAlist := [[u,:(y:=GENSYM())],:$hasCategoryAlist]
y
- a='has => NRToptimizeHas ['HasCategory,first b,MKQ first rest b]
+ a="has" => NRToptimizeHas ['HasCategory,first b,MKQ first rest b]
a = 'QUOTE => u
[NRToptimizeHas a,:NRToptimizeHas b]
u
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 03429303..0a33b680 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -646,7 +646,7 @@ newHasTest(domform,catOrAtt) ==
evalCond x ==
ATOM x => x
[pred,:l] := x
- pred = 'has =>
+ pred = "has" =>
l is [ w1,['ATTRIBUTE,w2]] => newHasTest(w1,w2)
l is [ w1,['SIGNATURE,:w2]] => compiledLookup(CAR w2,CADR w2, eval mkEvalable w1)
newHasTest(first l ,first rest l)
diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot
index 171dcdcf..d49177a8 100644
--- a/src/interp/nrungo.boot
+++ b/src/interp/nrungo.boot
@@ -252,7 +252,7 @@ lookupPred(pred,dollar,domain) ==
or/[lookupPred(p,dollar,domain) for p in pl]
pred is ['NOT,p] or pred is ['not,p] => not lookupPred(p,dollar,domain)
pred is ['is,dom1,dom2] => domainEqual(dom1,dom2)
- pred is ['has,a,b] =>
+ pred is ["has",a,b] =>
VECP a =>
keyedSystemError("S2GE0016",['"lookupPred",
'"vector as first argument to has"])
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index 62fb4935..401cf9a4 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -231,7 +231,7 @@ predicateBitIndexRemop p==
--transform attribute predicates taken out by removeAttributePredicates
p is [op,:argl] and op in '(AND and OR or NOT not) =>
simpBool makePrefixForm([predicateBitIndexRemop x for x in argl],op)
- p is ['has,'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
+ p is ["has",'$,['ATTRIBUTE,a]] => LASSOC(a,$NRTattributeAlist)
p
predicateBitRef x ==
@@ -291,7 +291,7 @@ removeAttributePredicates pl ==
fn p ==
p is [op,:argl] and op in '(AND and OR or NOT not) =>
makePrefixForm(fnl argl,op)
- p is ['has,'$,['ATTRIBUTE,a]] =>
+ p is ["has",'$,['ATTRIBUTE,a]] =>
sayBrightlyNT '"Predicate: "
PRINT p
sayBrightlyNT '" replaced by: "
@@ -303,7 +303,7 @@ transHasCode x ==
atom x => x
op := QCAR x
MEMQ(op,'(HasCategory HasAttribute)) => x
- op='has => compHasFormat x
+ op="has" => compHasFormat x
[transHasCode y for y in x]
mungeAddGensyms(u,gal) ==
diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot
index ca28c739..fa3f48bc 100644
--- a/src/interp/wi2.boot
+++ b/src/interp/wi2.boot
@@ -236,7 +236,7 @@ makeFunctorArgumentParameters(argl,sigl,target) ==
findExtrasP(a,x) ==
x is ['AND,:l] => "union"/[findExtrasP(a,y) for y in l]
x is ['OR,:l] => "union"/[findExtrasP(a,y) for y in l]
- x is ['has,=a,y] and y is ['SIGNATURE,:.] => [y]
+ x is ["has",=a,y] and y is ['SIGNATURE,:.] => [y]
nil
nil
augmentSig(s,ss) ==