From 9306af57a53ceace77f8f0cfea65f6ceed76d5c1 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sat, 8 May 2010 14:20:57 +0000 Subject: * 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. --- src/interp/as.boot | 2 +- src/interp/br-con.boot | 4 ++-- src/interp/br-data.boot | 2 +- src/interp/c-doc.boot | 2 +- src/interp/category.boot | 40 ++++++++++++++++++++-------------------- src/interp/cattable.boot | 2 +- src/interp/define.boot | 2 +- src/interp/functor.boot | 10 +++++----- src/interp/g-util.boot | 2 +- src/interp/interop.boot | 6 +++--- src/interp/nrunopt.boot | 2 +- src/interp/pspad1.boot | 6 +++--- src/interp/setvars.boot | 4 ++-- src/interp/trace.boot | 14 +++++++------- 14 files changed, 49 insertions(+), 49 deletions(-) (limited to 'src/interp') 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 -- cgit v1.2.3