aboutsummaryrefslogtreecommitdiff
path: root/src/interp
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-05-08 14:20:57 +0000
committerdos-reis <gdr@axiomatics.org>2010-05-08 14:20:57 +0000
commit9306af57a53ceace77f8f0cfea65f6ceed76d5c1 (patch)
tree5ec4343bb04a9868541dea01c08a3244e15a831d /src/interp
parent9ede6cd0b5be47c119455a8df1bc41cb56e2f5ff (diff)
downloadopen-axiom-9306af57a53ceace77f8f0cfea65f6ceed76d5c1.tar.gz
* boot/parser.boot (bpArgumentList): New.
(bpParenthesizedApplication): Use it. New. (bpPrimary1): Use it to implement function call with explicit parenthesis as primary. (bpOperator): Remove. (bpAssignLHS): Rework. Allow field path after function call. * boot/translator.boot: Remove debugging statement. * interp/as.boot: Adjust to new syntax. * interp/br-con.boot: Likewise. * interp/br-data.boot: Likewise. * interp/c-doc.boot: Likewise. * interp/category.boot: Likewise. * interp/cattable.boot: Likewise. * interp/define.boot: Likewise. * interp/functor.boot: Likewise. * interp/g-util.boot: Likewise. * interp/interop.boot: Likewise. * interp/nrunopt.boot: Likewise. * interp/pspad1.boot: Likewise. * interp/setvars.boot: Likewise. * interp/trace.boot: Likewise.
Diffstat (limited to 'src/interp')
-rw-r--r--src/interp/as.boot2
-rw-r--r--src/interp/br-con.boot4
-rw-r--r--src/interp/br-data.boot2
-rw-r--r--src/interp/c-doc.boot2
-rw-r--r--src/interp/category.boot40
-rw-r--r--src/interp/cattable.boot2
-rw-r--r--src/interp/define.boot2
-rw-r--r--src/interp/functor.boot10
-rw-r--r--src/interp/g-util.boot2
-rw-r--r--src/interp/interop.boot6
-rw-r--r--src/interp/nrunopt.boot2
-rw-r--r--src/interp/pspad1.boot6
-rw-r--r--src/interp/setvars.boot4
-rw-r--r--src/interp/trace.boot14
14 files changed, 49 insertions, 49 deletions
diff --git a/src/interp/as.boot b/src/interp/as.boot
index 114696ba..bf51cee0 100644
--- a/src/interp/as.boot
+++ b/src/interp/as.boot
@@ -900,7 +900,7 @@ asyTypeJoinPartPred x ==
asyTypeJoinItem x ==
result := asyTypeUnit x
- isLowerCaseLetter (PNAME opOf result).0 =>
+ isLowerCaseLetter PNAME(opOf result).0 =>
$opStack := [[['ATTRIBUTE,result],:$predlist],:$opStack]
$conStack := [[result,:$predlist],:$conStack]
diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot
index 7560ac0c..90ab75ed 100644
--- a/src/interp/br-con.boot
+++ b/src/interp/br-con.boot
@@ -874,7 +874,7 @@ dbGetDocTable(op,$sig,docTable,$which,aux) == main where
-- each entry is [sig,doc] and code is NIL or else a topic code for op
main() ==
if null FIXP op and
- DIGITP (s := STRINGIMAGE op).0 then op := string2Integer s
+ DIGITP((s := STRINGIMAGE op).0) then op := string2Integer s
-- the above hack should be removed after 3/94 when 0 is not |0|
aux is [[packageName,:.],:pred] =>
doc := dbConstructorDoc(first aux,$op,$sig)
@@ -1077,7 +1077,7 @@ getConstructorDocumentation conname ==
is [[nil,line,:.],:.] and line or '""
dbSelectCon(htPage,which,index) ==
- conPage opOf first (htpProperty(htPage,'cAlist)).index
+ conPage opOf first htpProperty(htPage,'cAlist).index
dbShowConditions(htPage,cAlist,kind) ==
conform := htpProperty(htPage,'conform)
diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot
index a06c9d82..56f74854 100644
--- a/src/interp/br-data.boot
+++ b/src/interp/br-data.boot
@@ -113,7 +113,7 @@ buildLibdbConEntry conname ==
and t is ['CATEGORY,'package,:.] then kind := 'package
$kind :=
pname.(MAXINDEX pname) = char '_& => 'x
- DOWNCASE (PNAME kind).0
+ DOWNCASE PNAME(kind).0
argl := rest $conform
conComments :=
LASSOC('constructor,$doc) is [[=nil,:r]] => libdbTrim concatWithBlanks r
diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot
index a2423913..0aa8a5f9 100644
--- a/src/interp/c-doc.boot
+++ b/src/interp/c-doc.boot
@@ -93,7 +93,7 @@ recordSignatureDocumentation(opSig,lineno) ==
recordAttributeDocumentation(['Attribute,att],lineno) ==
name := opOf att
- UPPER_-CASE_-P (PNAME name).0 => nil
+ UPPER_-CASE_-P PNAME(name).0 => nil
recordDocumentation([name,['attribute,:IFCDR postTransform att]],lineno)
recordDocumentation(key,lineno) ==
diff --git a/src/interp/category.boot b/src/interp/category.boot
index 728faa85..85084b2b 100644
--- a/src/interp/category.boot
+++ b/src/interp/category.boot
@@ -63,9 +63,9 @@ isCategoryForm(x,e) ==
CategoryPrint(D,$e) ==
SAY "--------------------------------------"
SAY "Name (and arguments) of category:"
- PRETTYPRINT D.(0)
+ PRETTYPRINT D.0
SAY "operations:"
- PRETTYPRINT D.(1)
+ PRETTYPRINT D.1
SAY "attributes:"
PRETTYPRINT D.2
SAY "This is a sub-category of"
@@ -329,7 +329,7 @@ FindFundAncs l ==
--also as two-lists with the appropriate conditions
l=nil => nil
f1:= CatEval CAAR l
- f1.(0)=nil => FindFundAncs rest l
+ f1.0=nil => FindFundAncs rest l
ans:= FindFundAncs rest l
for u in FindFundAncs [[CatEval first x,mkAnd(CADAR l,second x)]
for x in second f1.4] repeat
@@ -361,14 +361,14 @@ CatEval x ==
-- l=nil => nil
-- leaves:= [first y for y in leaves]
-- --remove the slot pointers
--- [x for x in l | not AncestorP(x.(0),leaves)]
+-- [x for x in l | not AncestorP(x.0,leaves)]
AncestorP: (%Form, %List) -> %Form
AncestorP(xname,leaves) ==
-- checks for being a principal ancestor of one of the leaves
member(xname,leaves) => xname
for y in leaves repeat
- member(xname,first (CatEval y).4) => return y
+ member(xname,first CatEval(y).4) => return y
CondAncestorP(xname,leaves,condition) ==
-- checks for being a principal ancestor of one of the leaves
@@ -377,7 +377,7 @@ CondAncestorP(xname,leaves,condition) ==
ucond:=
null rest u => true
second u
- xname = u' or member(xname,first (CatEval u').4) =>
+ xname = u' or member(xname,first CatEval(u').4) =>
PredImplies(ucond,condition) => return u'
@@ -426,12 +426,12 @@ JoinInner(l,$e) ==
l':= [:CondList,:[[u,true] for u in l]]
-- This is a list of all the categories that this extends
-- conditionally or unconditionally
- sigl:= $NewCatVec.(1)
+ sigl:= $NewCatVec.1
attl:= $NewCatVec.2
globalDomains:= $NewCatVec.5
FundamentalAncestors:= second $NewCatVec.4
- if $NewCatVec.(0) then FundamentalAncestors:=
- [[$NewCatVec.(0)],:FundamentalAncestors]
+ if $NewCatVec.0 then FundamentalAncestors:=
+ [[$NewCatVec.0],:FundamentalAncestors]
--principal ancestor . all those already included
copied:= nil
originalVector:= true
@@ -442,14 +442,14 @@ JoinInner(l,$e) ==
for [b,condition] in FindFundAncs l' repeat
--This loop implements Category Subsumption
--as described in SYSTEM SCRIPT
- if not (b.(0)=nil) then
+ if not (b.0=nil) then
--It's a named category
- bname:= b.(0)
+ bname:= b.0
CondAncestorP(bname,FundamentalAncestors,condition) => nil
(f:=AncestorP(bname,[first u for u in FundamentalAncestors])) =>
[.,.,index]:=assoc(f,FundamentalAncestors)
FundamentalAncestors:=[[bname,condition,index],:FundamentalAncestors]
- PrinAncb:= first (CatEval bname).(4)
+ PrinAncb:= first CatEval(bname).4
--Principal Ancestors of b
reallynew:= true
for anc in FundamentalAncestors repeat
@@ -487,7 +487,7 @@ JoinInner(l,$e) ==
reallynew:= nil
MEMQ(b,l) =>
--MEMQ since category vectors are guaranteed unique
- (sigl:= $NewCatVec.(1); attl:= $NewCatVec.2; l:= delete(b,l))
+ (sigl:= $NewCatVec.1; attl:= $NewCatVec.2; l:= delete(b,l))
-- SAY("domain ",bname," subsumes")
-- SAY("adding a conditional domain ",
-- bname,
@@ -498,7 +498,7 @@ JoinInner(l,$e) ==
-- value of bCond not used and could be NIL
-- bCond:= second bCond
globalDomains:= $NewCatVec.5
- for u in $NewCatVec.(1) repeat
+ for u in $NewCatVec.1 repeat
if not member(u,sigl) then
[s,c,i]:= u
if c=true
@@ -512,7 +512,7 @@ JoinInner(l,$e) ==
else attl:= [[a,["and",condition,c]],:attl]
if reallynew then
n:= SIZE $NewCatVec
- FundamentalAncestors:= [[b.(0),condition,n],:FundamentalAncestors]
+ FundamentalAncestors:= [[b.0,condition,n],:FundamentalAncestors]
$NewCatVec:= LENGTHENVEC($NewCatVec,n+1)
-- We need to copy the vector otherwise the FundamentalAncestors
-- list will get stepped on while compiling "If R has ... " code
@@ -520,13 +520,13 @@ JoinInner(l,$e) ==
-- copied:= true
copied:= false
originalvector:= false
- $NewCatVec.n:= b.(0)
+ $NewCatVec.n:= b.0
if not copied then $NewCatVec:= COPY_-SEQ $NewCatVec
-- It is important to copy the vector now,
-- in case SigListUnion alters it while
-- performing Operator Subsumption
for b in l repeat
- sigl:= SigListUnion([DropImplementations u for u in b.(1)],sigl)
+ sigl:= SigListUnion([DropImplementations u for u in b.1],sigl)
attl:=
-- next two lines are merely performance improvements
MEMQ(attl,b.2) => b.2
@@ -548,7 +548,7 @@ JoinInner(l,$e) ==
[[first u,mkOr(second v,mkAnd(newpred,second u))],:attl]
sigl:=
SigListUnion(
- [AddPredicate(DropImplementations u,newpred) for u in (first b).(1)],sigl) where
+ [AddPredicate(DropImplementations u,newpred) for u in (first b).1],sigl) where
AddPredicate(op is [sig,oldpred,:implem],newpred) ==
newpred=true => op
oldpred=true => [sig,newpred,:implem]
@@ -556,7 +556,7 @@ JoinInner(l,$e) ==
FundamentalAncestors:= [x for x in FundamentalAncestors | rest x]
--strip out the pointer to Principal Ancestor
c:= first $NewCatVec.4
- pName:= $NewCatVec.(0)
+ pName:= $NewCatVec.0
if pName and not member(pName,c) then c:= [pName,:c]
$NewCatVec.4:= [c,FundamentalAncestors,third $NewCatVec.4]
mkCategory("domain",sigl,attl,globalDomains,$NewCatVec)
@@ -574,4 +574,4 @@ Join(:l) ==
-- --an incantation
-- [c,.,.]:= compMakeCategoryObject(sig,e)
-- -- We assume that the environment need not be kept
--- c.(1)
+-- c.1
diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot
index 39e6f699..f487146e 100644
--- a/src/interp/cattable.boot
+++ b/src/interp/cattable.boot
@@ -64,7 +64,7 @@ genCategoryTable() ==
in domainList | catl := getConstructorCategoryFromDB con]
-- $nonLisplibDomains, $noCategoryDomains are set in BUILDOM BOOT
specialDs := SETDIFFERENCE($nonLisplibDomains,$noCategoryDomains)
- domainTable:= [:[addDomainToTable(id, getConstrCat (eval [id]).3)
+ domainTable:= [:[addDomainToTable(id, getConstrCat eval([id]).3)
for id in specialDs], :domainTable]
for [id,:entry] in domainTable repeat
for [a,:b] in encodeCategoryAlist(id,entry) repeat
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 90a1b6d5..9ec731df 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -489,7 +489,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
-- following line causes cats with no with or Join to be fresh copies
if opOf(formalBody)~='Join and opOf(formalBody)~='mkCategory then
formalBody := ['Join, formalBody]
- body:= optFunctorBody (compOrCroak(formalBody,signature'.target,e)).expr
+ body:= optFunctorBody compOrCroak(formalBody,signature'.target,e).expr
if $extraParms then
formals:=actuals:=nil
for u in $extraParms repeat
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index bd435cab..54a79f75 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -431,7 +431,7 @@ setVector4Onecat(name,instantiator,info) ==
slist:=
[form(u,name) for u in slist] where
form([cat,:cond],name) ==
- u:= ['QUOTE,[cat,:first (eval cat).4]]
+ u:= ['QUOTE,[cat,:first eval(cat).4]]
['COND,[TryGDC cond,['SETQ,'TrueDomain,['CONS,['CONS,u,name],
'TrueDomain]]]]
LENGTH slist=1 => [CADAR slist]
@@ -751,8 +751,8 @@ InvestigateConditions catvecListMaker ==
[true,:[true for u in secondaries]]
$HackSlot4:=
MinimalPrimary=MaximalPrimary => nil
- MaximalPrimaries:=[MaximalPrimary,:first (CatEval MaximalPrimary).4]
- MinimalPrimaries:=[MinimalPrimary,:first (CatEval MinimalPrimary).4]
+ MaximalPrimaries:=[MaximalPrimary,:first CatEval(MaximalPrimary).4]
+ MinimalPrimaries:=[MinimalPrimary,:first CatEval(MinimalPrimary).4]
MaximalPrimaries:=S_-(MaximalPrimaries,MinimalPrimaries)
[[x] for x in MaximalPrimaries]
($Conditions:= Conds($principal,nil)) where
@@ -784,7 +784,7 @@ InvestigateConditions catvecListMaker ==
LENGTH u=1 => first u
['AND,:u]
for [v,:.] in newS repeat
- for v' in [v,:first (CatEval v).4] repeat
+ for v' in [v,:first CatEval(v).4] repeat
if (w:=assoc(v',$HackSlot4)) then
RPLAC(rest w,if rest w then mkOr(u,rest w) else u)
(list:= update(list,u,secondaries,newS)) where
@@ -1006,7 +1006,7 @@ alistSize c ==
count(CDAR x,level+1)+count(rest x,level)
addSuffix(n,u) ==
- ALPHA_-CHAR_-P (s:= STRINGIMAGE u).(MAXINDEX s) =>
+ ALPHA_-CHAR_-P((s:= STRINGIMAGE u).(MAXINDEX s)) =>
INTERN STRCONC(s,STRINGIMAGE n)
INTERNL STRCONC(s,STRINGIMAGE ";",STRINGIMAGE n)
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index cb4099c1..5e0bdd82 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -810,7 +810,7 @@ intern x ==
isDomain a ==
cons? a and VECP(first a) and
- member(first(a).0, $domainTypeTokens)
+ member(first a.0, $domainTypeTokens)
-- variables used by browser
diff --git a/src/interp/interop.boot b/src/interp/interop.boot
index 9e9b6581..48ed5ebd 100644
--- a/src/interp/interop.boot
+++ b/src/interp/interop.boot
@@ -139,13 +139,13 @@ closeOldAxiomFunctor(name) ==
lazyOldAxiomDomainLookupExport(domenv, self, op, sig, box, skipdefaults, env) ==
dom := instantiate domenv
- SPADCALL(rest dom, self, op, sig, box, skipdefaults, first(dom).3)
+ SPADCALL(rest dom, self, op, sig, box, skipdefaults, first dom.3)
lazyOldAxiomDomainHashCode(domenv, env) == first domenv
lazyOldAxiomDomainDevaluate(domenv, env) ==
dom := instantiate domenv
- SPADCALL(rest dom, first(dom).1)
+ SPADCALL(rest dom, first dom.1)
lazyOldAxiomAddChild(domenv, kid, env) ==
CONS($lazyOldAxiomDomainDispatch,domenv)
@@ -328,7 +328,7 @@ oldAxiomDomainHasCategory(domenv, cat, env) ==
HasCategory(domvec, devaluate cat)
oldAxiomDomainDevaluate(domenv, env) ==
- SExprToDName(rest(domenv).0, 'T)
+ SExprToDName(rest domenv.0, 'T)
oldAxiomAddChild(domenv, child, env) == CONS($oldAxiomDomainDispatch, domenv)
diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot
index b6c2a57e..4b5cdae4 100644
--- a/src/interp/nrunopt.boot
+++ b/src/interp/nrunopt.boot
@@ -733,7 +733,7 @@ numberOfNodes(x) ==
template con ==
con := abbreviation? con or con
- ppTemplate (getInfovec con).0
+ ppTemplate getInfovec(con).0
ppTemplate vec ==
for i in 0..MAXINDEX vec repeat
diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot
index 0af4b345..ddb0f5f8 100644
--- a/src/interp/pspad1.boot
+++ b/src/interp/pspad1.boot
@@ -264,9 +264,9 @@ format(x,:options) ==
if op = "return" then argl := rest argl
n := #argl
op is ['elt,y,"construct"] => formatDollar(y,'construct,argl)
- op is ['elt,name,p] and UPPER_-CASE_-P (STRINGIMAGE opOf name).0 =>
+ op is ['elt,name,p] and UPPER_-CASE_-P STRINGIMAGE(opOf name).0 =>
formatDollar(name,p,argl)
- op = 'elt and UPPER_-CASE_-P (STRINGIMAGE opOf first argl).0 =>
+ op = 'elt and UPPER_-CASE_-P STRINGIMAGE(opOf first argl).0 =>
formatDollar1(first argl,second argl)
fn:= GETL(op,"PSPAD") => formatFn(fn,x,$m,$c)
if op in '(AND OR NOT) then op:= DOWNCASE op
@@ -420,7 +420,7 @@ formatHasDollarOp x ==
x is ["elt",a,b] and isTypeProbably? a
isTypeProbably? x ==
- IDENTP x and UPPER_-CASE_-P (PNAME x).0
+ IDENTP x and UPPER_-CASE_-P PNAME(x).0
formatOpPren(op,x) == formatOp op and formatPren x
diff --git a/src/interp/setvars.boot b/src/interp/setvars.boot
index 8de73e17..ba9a85d2 100644
--- a/src/interp/setvars.boot
+++ b/src/interp/setvars.boot
@@ -287,8 +287,8 @@ displaySetOptionInformation(arg,setData) ==
st = 'INTEGER =>
sayMessage ['" The",:bright arg,'"option",
'" may be followed by an integer in the range",
- :bright (setData.setLeaf).0,'"to",'%l,
- :bright (setData.setLeaf).1,'"inclusive.",
+ :bright setData.setLeaf.0,'"to",'%l,
+ :bright setData.setLeaf.1,'"inclusive.",
'" The current setting is",:bright eval setData.setVar]
st = 'STRING =>
diff --git a/src/interp/trace.boot b/src/interp/trace.boot
index 93adc5e4..a6259f30 100644
--- a/src/interp/trace.boot
+++ b/src/interp/trace.boot
@@ -207,7 +207,7 @@ getTraceOption (x is [key,:l]) ==
key="of" =>
["of",:[hn y for y in l]] where
hn x ==
- atom x and not UPPER_-CASE_-P (STRINGIMAGE x).(0) =>
+ atom x and not UPPER_-CASE_-P STRINGIMAGE(x).0 =>
isDomainOrPackage EVAL x => x
stackTraceOptionError ["S2IT0013",[x]]
g:= domainToGenvar x => g
@@ -305,7 +305,7 @@ transTraceItem x ==
x := objVal value
(y:= domainToGenvar x) => y
x
- UPPER_-CASE_-P (STRINGIMAGE x).(0) =>
+ UPPER_-CASE_-P STRINGIMAGE(x).0 =>
y := opOf unabbrev x
constructor? y => y
(y:= domainToGenvar x) => y
@@ -418,7 +418,7 @@ funfind("functor","opname") ==
[u for u in ops | u is [[ =opname,:.],:.]]
isDomainOrPackage dom ==
- REFVECP dom and #dom>0 and isFunctor opOf dom.(0)
+ REFVECP dom and #dom>0 and isFunctor opOf dom.0
isTraceGensym x == GENSYMP x
@@ -438,7 +438,7 @@ spadTrace(domain,options) ==
if listOfBreakVars := getOption("VARBREAK",options) then
options := removeOption("VARBREAK",options)
anyifTrue:= null listOfOperations
- domainId:= opOf domain.(0)
+ domainId:= opOf domain.0
currentEntry:= assoc(domain,_/TRACENAMES)
currentAlist:= KDR currentEntry
opStructureList:= flattenOperationAlist getOperationAlistFromLisplib domainId
@@ -593,7 +593,7 @@ letPrint(x,val,currentFunction) ==
TERPRI()
if (y:= hasPair("BREAK",y)) and
(y="all" or MEMQ(x,y) and
- (not MEMQ((PNAME x).(0),'($ _#)) and not GENSYMP x)) then
+ (not MEMQ(PNAME(x).0,'($ _#)) and not GENSYMP x)) then
break [:bright currentFunction,'"breaks after",:bright x,'":= ",
shortenForPrinting val]
val
@@ -612,7 +612,7 @@ letPrint2(x,printform,currentFunction) ==
if flag='letPrint2 then print printform
if (y:= hasPair("BREAK",y)) and
(y="all" or MEMQ(x,y) and
- (not MEMQ((PNAME x).(0),'($ _#)) and not GENSYMP x)) then
+ (not MEMQ(PNAME(x).0,'($ _#)) and not GENSYMP x)) then
break [:bright currentFunction,'"breaks after",:bright x,":= ",
printform]
x
@@ -632,7 +632,7 @@ letPrint3(x,xval,printfn,currentFunction) ==
if flag='letPrint2 then print xval
if (y:= hasPair("BREAK",y)) and
(y="all" or MEMQ(x,y) and
- (not MEMQ((PNAME x).(0),'($ _#)) and not GENSYMP x)) then
+ (not MEMQ(PNAME(x).0,'($ _#)) and not GENSYMP x)) then
break [:bright currentFunction,'"breaks after",:bright x,'":= ",
xval]
x