diff options
Diffstat (limited to 'src')
60 files changed, 389 insertions, 327 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 39399078..e1bed717 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,65 @@ 2009-09-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/as.boot: Clean up. + * interp/ax.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/br-data.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-saturn.boot: Likewise. + * interp/br-search.boot: Likewise. + * interp/c-util.boot: Likewise. + * interp/category.boot: Likewise. + * interp/cattable.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/cstream.boot: Likewise. + * interp/define.boot: Likewise. + * interp/format.boot: Likewise. + * interp/fortcall.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/g-boot.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/g-timer.boot: Likewise. + * interp/guess.boot: Likewise. + * interp/i-analy.boot: Likewise. + * interp/i-coerce.boot: Likewise. + * interp/i-coerfn.boot: Likewise. + * interp/i-eval.boot: Likewise. + * interp/i-funsel.boot: Likewise. + * interp/i-intern.boot: Likewise. + * interp/i-map.boot: Likewise. + * interp/i-object.boot: Likewise. + * interp/i-output.boot: Likewise. + * interp/i-resolv.boot: Likewise. + * interp/i-spec1.boot: Likewise. + * interp/i-spec2.boot: Likewise. + * interp/i-syscmd.boot: Likewise. + * interp/int-top.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/lisplib.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/msg.boot: Likewise. + * interp/msgdb.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/nrunfast.boot: Likewise. + * interp/nrungo.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/pf2atree.boot: Likewise. + * interp/pile.boot: Likewise. + * interp/pspad1.boot: Likewise. + * interp/ptrees.boot: Likewise. + * interp/scan.boot: Likewise. + * interp/sfsfun.boot: Likewise. + * interp/showimp.boot: Likewise. + * interp/slam.boot: Likewise. + * interp/trace.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/word.boot: Likewise. + +2009-09-25 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/ast.boot (bfMember): Improve a bit. * boot/tokens.boot: Don't rename 'is' and 'inst'. * boot/parser.boot: Use 'in' instead of 'MEMQ' where approrpriate. diff --git a/src/interp/as.boot b/src/interp/as.boot index 3452a559..b6c7a2d2 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -151,7 +151,7 @@ asMakeAlist con == opAlist := SUBLISLIS($FormalMapVariableList,KDR form,CDDR alists) ancestorAlist:= SUBLISLIS($FormalMapVariableList,KDR form,CAR alists) catAttrs := [[x,:true] for x in getAttributesFromCATEGORY $constructorCategory] - attributeAlist := REMDUP [:CADR alists,:catAttrs] + attributeAlist := REMDUP [:second alists,:catAttrs] documentation := SUBLISLIS($FormalMapVariableList,KDR form,LASSOC(con,$docAlist)) filestring := STRCONC(PATHNAME_-NAME STRINGIMAGE filename,'".as") diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 0a15dd87..80af0206 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -220,10 +220,10 @@ axFormatType(typeform) == for type in args]] typeform is ['Dictionary,['Record,:args]] => ['Apply, 'Dictionary, - ['PretendTo, axFormatType CADR typeform, 'SetCategory]] + ['PretendTo, axFormatType second typeform, 'SetCategory]] typeform is ['FileCategory,xx,['Record,:args]] => ['Apply, 'FileCategory, axFormatType xx, - ['PretendTo, axFormatType CADDR typeform, 'SetCategory]] + ['PretendTo, axFormatType third typeform, 'SetCategory]] typeform is [op,:args] => $pretendFlag and constructor? op and getConstructorModemapFromDB op is [[.,target,:argtypes],.] => diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 4454b5ec..39813330 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -389,9 +389,9 @@ dbSearchOrder(conform,domname,$domain) == --domain = nil or set to live domain $predvec:= $domain => $domain . 3 getConstructorPredicatesFromDB name - catpredvec := CAR u - catinfo := CADR u - catvec := CADDR u + catpredvec := first u + catinfo := second u + catvec := third u catforms := [[pakform,:pred] for i in 0..MAXINDEX catvec | test ] where test() == pred := simpCatPredicate diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index f137ecaa..8f513175 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -479,13 +479,13 @@ getImports conname == --called by mkUsersHashTable op = 'QUOTE or op = 'NRTEVAL => CAR args op = 'local => first args op = 'Record => - ['Record,:[[":",CADR y,doImport(CADDR y,template)] for y in args]] + ['Record,:[[":",second y,doImport(third y,template)] for y in args]] --TTT next three lines: handles some tagged/untagged Union case. op = 'Union=> args is [['_:,:x1],:x2] => -- CAAR args = '_: => -- tagged! - ['Union,:[[":",CADR y,doImport(CADDR y,template)] for y in args]] + ['Union,:[[":",second y,doImport(third y,template)] for y in args]] [op,:[doImport(y,template) for y in args]] [op,:[doImport(y,template) for y in args]] diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 61ccfd58..e3f17e52 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -366,7 +366,7 @@ dbGatherData(htPage,opAlist,which,key) == nil newEntry := u := assoc(entry,data) => --key seen before? look on DATA - RPLACA(CDR u,CADR u or exposeFlag)--yes, expose if any 1 is exposed + RPLACA(CDR u,second u or exposeFlag)--yes, expose if any 1 is exposed u data := [y := [entry,exposeFlag,:tail],:data] y --no, create new entry in DATA @@ -435,8 +435,8 @@ dbSelectData(htPage,opAlist,key) == dbReduceOpAlist(opAlist,data,branch) == branch = 'signatures => dbReduceBySignature(opAlist,CAAR data,CADAR data) - branch = 'origins => dbReduceBySelection(opAlist,CAR data,function CADDR) - branch = 'conditions => dbReduceBySelection(opAlist,CAR data,function CADR) + branch = 'origins => dbReduceBySelection(opAlist,CAR data,function third) + branch = 'conditions => dbReduceBySelection(opAlist,CAR data,function second) branch = 'implementation => dbReduceByOpSignature(opAlist,CDDR data) branch = 'parameters => dbReduceByForm(opAlist,CAR data) systemError ['"Unexpected branch: ",branch] @@ -817,7 +817,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == --Case 1: Already expanded; just cons it onto ACC null STRINGP line => --already expanded if condition? then --this could have been expanded at a lower level - if null atom (pred := CADR line) then value := pred + if null atom (pred := second line) then value := pred acc := [line,:acc] --this one is already expanded; record it anyway --Case 2: unexpanded; expand it then cons it onto ACC [name,nargs,xflag,sigs,conname,pred,comments] := dbParts(line,7,1) @@ -875,7 +875,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == getRegistry(op,sig) == u := getConstructorDocumentationFromDB "AttributeRegistry" v := LASSOC(op,u) - match := or/[y for y in v | y is [['attribute,: =sig],:.]] => CADR match + match := or/[y for y in v | y is [['attribute,: =sig],:.]] => second match '"" evalableConstructor2HtString domform == diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index f82cea01..d1f7e888 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -422,11 +422,11 @@ zeroOneConvert x == kFormatSlotDomain x == fn formatSlotDomain x where fn x == atom x => x (op := CAR x) = '_$ => '_$ - op = 'local => CADR x - op = ":" => [":",CADR x,fn CADDR x] + op = 'local => second x + op = ":" => [":",second x,fn third x] isConstructorName op => [fn y for y in x] INTEGERP op => op - op = 'QUOTE and atom CADR x => CADR x + op = 'QUOTE and atom second x => second x x koCatOps(conform,domname) == diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index a67261bd..c482c72d 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -1648,15 +1648,15 @@ bcConform1 form == main where satTypeDownLink(s, ["(|conPage| '|",s,'"|)"]) (head := QCAR form) = 'QUOTE => htSay('"'") - hd CADR form + hd second form head = 'SIGNATURE => - htSay(CADR form,'": ") - mapping CADDR form + htSay(second form,'": ") + mapping third form head = 'Mapping and rest form => rest form => mapping rest form head = ":" => - hd CADR form + hd second form htSay '": " - hd CADDR form + hd third form QCDR form and dbEvalableConstructor? form => bcConstructor(form,head) hd head diff --git a/src/interp/br-search.boot b/src/interp/br-search.boot index 4bb062b4..a7f8cd2a 100644 --- a/src/interp/br-search.boot +++ b/src/interp/br-search.boot @@ -408,10 +408,10 @@ genSearch1(filter,reg,doc) == count = 0 => emptySearchPage('"entry",filter,true) count = 1 => alist := (regCount = 1 => regSearchAlist; docSearchAlist) - showNamedConstruct(or/[x for x in alist | CADR x]) + showNamedConstruct(or/[x for x in alist | second x]) summarize? := docSearchAlist => true - nonEmpties := [pair for pair in regSearchAlist | #(CADR pair) > 0] + nonEmpties := [pair for pair in regSearchAlist | #(second pair) > 0] not(nonEmpties is [pair]) not summarize? => showNamedConstruct pair -----------generate a summary page--------------------------- @@ -553,7 +553,7 @@ docSearch1(filter,doc) == docSearchAlist := searchDropUnexposedLines doc count := searchCount docSearchAlist count = 0 => emptySearchPage('"entry",filter,true) - count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | CADR x]) + count = 1 => showNamedConstruct(or/[x for x in docSearchAlist | second x]) prefix := pluralSay(count,'"entry matches",'"entries match") emfilter := ['"{\em ",escapeSpecialChars STRINGIMAGE filter,'"}"] header := [:prefix,'" ",:emfilter] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index dbc3789a..5afcd2be 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -621,7 +621,7 @@ adjExitLevel(x,seqnum,inc) == x is [op,:l] and op in '(SEQ REPEAT COLLECT) => for u in l repeat adjExitLevel(u,seqnum+1,inc) x is ["exit",n,u] => - (adjExitLevel(u,seqnum,inc); seqnum>n => x; rplac(CADR x,n+inc)) + (adjExitLevel(u,seqnum,inc); seqnum>n => x; rplac(second x,n+inc)) x is [op,:l] => for u in l repeat adjExitLevel(u,seqnum,inc) wrapSEQExit l == @@ -797,7 +797,7 @@ extendsCategoryForm(domain,form,form') == member(form',SUBSTQ(domain,"$",first catvlist)) or (or/ [extendsCategoryForm(domain,SUBSTQ(domain,"$",cat),form') - for [cat,:.] in CADR catvlist]) + for [cat,:.] in second catvlist]) nil getmode(x,e) == diff --git a/src/interp/category.boot b/src/interp/category.boot index 190aa792..a078366b 100644 --- a/src/interp/category.boot +++ b/src/interp/category.boot @@ -70,9 +70,9 @@ CategoryPrint(D,$e) == PRETTYPRINT D.2 SAY "This is a sub-category of" PRETTYPRINT first D.4 - for u in CADR D.4 repeat + for u in second D.4 repeat SAY("This has an alternate view: slot ",rest u," corresponds to ",first u) - for u in CADDR D.4 repeat + for u in third D.4 repeat SAY("This has a local domain: slot ",rest u," corresponds to ",first u) for j in 6..MAXINDEX D repeat u:= D.j @@ -186,7 +186,7 @@ SigListUnion(extra,original) == original:= delete(x,original) [xsig,xpred,:ximplem]:= x -- if xsig ~= esig then -- not quite strong enough - if CAR xsig ~= CAR esig or CADR xsig ~= CADR esig then + if CAR xsig ~= CAR esig or second xsig ~= second esig then -- the new version won't get confused by "constant"markers if ximplem is [["Subsumed",:.],:.] then original := [x,:original] @@ -195,7 +195,7 @@ SigListUnion(extra,original) == else epred:=mkOr(epred,xpred) -- this used always to be done, as noted below, but that's not safe if not(ximplem is [["Subsumed",:.],:.]) then eimplem:= ximplem - if eimplem then esig:=[CAR esig,CADR esig] + if eimplem then esig:=[CAR esig,second esig] -- in case there's a constant marker e:= [esig,epred,:eimplem] -- e:= [esig,mkOr(xpred,epred),:ximplem] @@ -331,19 +331,19 @@ FindFundAncs l == f1:= CatEval CAAR l f1.(0)=nil => FindFundAncs rest l ans:= FindFundAncs rest l - for u in FindFundAncs [[CatEval first x,mkAnd(CADAR l,CADR x)] - for x in CADR f1.4] repeat + for u in FindFundAncs [[CatEval first x,mkAnd(CADAR l,second x)] + for x in second f1.4] repeat x:= ASSQ(first u,ans) => - ans:= [[first u,mkOr(CADR x,CADR u)],:delete(x,ans)] + ans:= [[first u,mkOr(second x,second u)],:delete(x,ans)] ans:= [u,:ans] --testing to see if CAR l is already there - x:= ASSQ(CAAR l,ans) => [[CAAR l,mkOr(CADAR l,CADR x)],:delete(x,ans)] + x:= ASSQ(CAAR l,ans) => [[CAAR l,mkOr(CADAR l,second x)],:delete(x,ans)] CADAR l=true => for x in first f1.4 repeat if y:= ASSQ(CatEval x,ans) then ans:= delete(y,ans) [first l,:ans] for x in first f1.4 repeat if y:= ASSQ(CatEval x,ans) then ans:= - [[first y,mkOr(CADAR l,CADR y)],:delete(y,ans)] + [[first y,mkOr(CADAR l,second y)],:delete(y,ans)] [first l,:ans] -- Our new thing may have, as an alternate view, a principal -- descendant of something previously added which is therefore @@ -429,7 +429,7 @@ JoinInner(l,$e) == sigl:= $NewCatVec.(1) attl:= $NewCatVec.2 globalDomains:= $NewCatVec.5 - FundamentalAncestors:= CADR $NewCatVec.4 + FundamentalAncestors:= second $NewCatVec.4 if $NewCatVec.(0) then FundamentalAncestors:= [[$NewCatVec.(0)],:FundamentalAncestors] --principal ancestor . all those already included @@ -456,7 +456,7 @@ JoinInner(l,$e) == if member(first anc,PrinAncb) then --This is the check for "Category Subsumption" if rest anc - then (anccond:= CADR anc; ancindex:= CADDR anc) + then (anccond:= second anc; ancindex:= third anc) else (anccond:= true; ancindex:= nil) if PredImplies(condition,anccond) then FundamentalAncestors:= @@ -482,7 +482,7 @@ JoinInner(l,$e) == if originalVector and (condition=true) then $NewCatVec:= CatEval bname copied:= nil - FundamentalAncestors:= [[bname],:CADR $NewCatVec.4] + FundamentalAncestors:= [[bname],:second $NewCatVec.4] --bname is Principal, so comes first reallynew:= nil MEMQ(b,l) => @@ -496,7 +496,7 @@ JoinInner(l,$e) == bCond:= ASSQ(b,CondList) CondList:= delete(bCond,CondList) -- value of bCond not used and could be NIL - -- bCond:= CADR bCond + -- bCond:= second bCond globalDomains:= $NewCatVec.5 for u in $NewCatVec.(1) repeat if not member(u,sigl) then @@ -539,13 +539,13 @@ JoinInner(l,$e) == v:= assoc(first u,attl) null v => attl:= - CADR u=true => [[first u,newpred],:attl] - [[first u,["and",newpred,CADR u]],:attl] - CADR v=true => nil + second u=true => [[first u,newpred],:attl] + [[first u,["and",newpred,second u]],:attl] + second v=true => nil attl:= delete(v,attl) attl:= - CADR u=true => [[first u,mkOr(CADR v,newpred)],:attl] - [[first u,mkOr(CADR v,mkAnd(newpred,CADR u))],:attl] + second u=true => [[first u,mkOr(second v,newpred)],:attl] + [[first u,mkOr(second v,mkAnd(newpred,second u))],:attl] sigl:= SigListUnion( [AddPredicate(DropImplementations u,newpred) for u in (first b).(1)],sigl) where @@ -558,7 +558,7 @@ JoinInner(l,$e) == c:= first $NewCatVec.4 pName:= $NewCatVec.(0) if pName and not member(pName,c) then c:= [pName,:c] - $NewCatVec.4:= [c,FundamentalAncestors,CADDR $NewCatVec.4] + $NewCatVec.4:= [c,FundamentalAncestors,third $NewCatVec.4] mkCategory("domain",sigl,attl,globalDomains,$NewCatVec) Join(:l) == diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 10afbecd..78831c76 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -96,12 +96,12 @@ 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 second r] op = 'HasSignature => - [op,sig] := simpDevaluate CADR r + [op,sig] := simpDevaluate second 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 second r]] simpHasAttribute(form,a,b) op in '(AND OR NOT) => null (u := MKPF([simp p for p in r],op)) => nil diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 2246f87d..75220181 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -474,9 +474,9 @@ assocCacheShiftCount(x,al,fn) == until EQ(forwardPointer,al) repeat FUNCALL(fn, CAR (y:=CAR forwardPointer),x) => newFrontPointer := forwardPointer - RPLAC(CADR y,QSADD1 CADR y) --increment use count + RPLAC(second y,QSADD1 second y) --increment use count return (val:= y) - if QSLESSP(c := CADR y,minCount) then --initial c is 1 so is true 1st time + if QSLESSP(c := second y,minCount) then --initial c is 1 so is true 1st time minCount := c newFrontPointer := forwardPointer --CAR is slot replaced on failure forwardPointer:= CDR forwardPointer diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 6f85c84c..21e76792 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -647,7 +647,7 @@ getFormModemaps(form is [op,:argl],e) == then modemapList:= eltModemapFilter(LAST argl,modemapList,e) or return nil else if op="setelt" then modemapList:= - seteltModemapFilter(CADR argl,modemapList,e) or return nil + seteltModemapFilter(second argl,modemapList,e) or return nil nargs:= #argl finalModemapList:= [mm for (mm:= [[.,.,:sig],:.]) in modemapList | enoughArguments(argl,sig)] @@ -1039,9 +1039,9 @@ replaceExitEtc(x,tag,opFlag,opMode) == $finalEnv => intersectionEnvironment($finalEnv,t.env) t.env rplac(first x,"THROW") - rplac(CADR x,tag) - rplac(CADDR x,(convertOrCroak(t,opMode)).expr) - true => rplac(CADR x,CADR x-1) + rplac(second x,tag) + rplac(third x,(convertOrCroak(t,opMode)).expr) + true => rplac(second x,second x-1) x is [key,n,t] and key in '(TAGGEDreturn TAGGEDexit) => rplac(first t,replaceExitEtc(first t,tag,opFlag,opMode)) replaceExitEtc(first x,tag,opFlag,opMode) @@ -1306,7 +1306,7 @@ getUnionMode(x,e) == isUnionMode(m,e) == m is ["Union",:.] => m - (m':= getmode(m,e)) is ["Mapping",["UnionCategory",:.]] => CADR m' + (m':= getmode(m,e)) is ["Mapping",["UnionCategory",:.]] => second m' v:= get(RepIfRepHack m,"value",e) => (v.expr is ["Union",:.] => v.expr; nil) nil @@ -1624,7 +1624,7 @@ tryCourtesyCoercion(T,m) == keyedSystemError("S2GE0016",['"coerce", '"function coerce called from the interpreter."]) if $useRepresentationHack then - rplac(CADR T,MSUBST("$",$Rep,CADR T)) + rplac(second T,MSUBST("$",$Rep,second T)) T':= coerceEasy(T,m) => T' T':= coerceSubset(T,m) => T' T':= coerceHard(T,m) => T' @@ -2427,7 +2427,7 @@ compIterator(it,e) == stackMessage('"final value of index: %1b must be an integer",[final]) optFinal:= [final] indexmode:= - comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger + comp(third it,$NonNegativeInteger,e) => $NonNegativeInteger $Integer if null get(index,"mode",e) then [.,.,e]:= compMakeDeclaration(index,indexmode,e) or return nil diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot index d6cdfeda..04aee282 100644 --- a/src/interp/cparse.boot +++ b/src/interp/cparse.boot @@ -110,12 +110,12 @@ npPop1()== a npPop2()== - a:=CADR $stack + a:= second $stack RPLACD($stack,CDDR $stack) a npPop3()== - a:=CADDR $stack + a:= third $stack RPLACD(CDR $stack,CDDDR $stack) a diff --git a/src/interp/cstream.boot b/src/interp/cstream.boot index 5695f37a..85b2b874 100644 --- a/src/interp/cstream.boot +++ b/src/interp/cstream.boot @@ -42,7 +42,7 @@ npNull x== StreamNull x StreamNull x== null x or x is ["nullstream",:.] => true while x is ["nonnullstream",:.] repeat - st:=APPLY(CADR x,CDDR x) + st:=APPLY(second x,CDDR x) RPLACA(x,CAR st) RPLACD(x,CDR st) x is ["nullstream",:.] diff --git a/src/interp/define.boot b/src/interp/define.boot index a9900f74..e79d7281 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -374,7 +374,7 @@ mkEvalableCategoryForm c == --$extraParms :local --catobj := EVAL c -- DomainSubstitutionFunction makes $extraParms --mkEvalableCategoryForm sublisV($extraParms, catobj) - mkEvalableCategoryForm CADR argl + mkEvalableCategoryForm second argl op is "mkCategory" => c MEMQ(op,$CategoryNames) => ([x,m,$e]:= compOrCroak(c,$EmptyMode,$e); m=$Category => x) @@ -1147,7 +1147,7 @@ stripOffSubdomainConditions(margl,argl) == f() == x is ['SubDomain,marg,condition] => pair:= assoc(i,$argumentConditionList) => - (RPLAC(CADR pair,MKPF([condition,CADR pair],'AND)); marg) + (RPLAC(second pair,MKPF([condition,second pair],'AND)); marg) $argumentConditionList:= [[i,arg,condition],:$argumentConditionList] marg x diff --git a/src/interp/format.boot b/src/interp/format.boot index 8cc64896..548629a5 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -245,8 +245,8 @@ formatOpSymbol(op,sig) == quad := specialChar 'quad n := #sig (op = 'elt) and (n = 3) => - (CADR(sig) = '_$) => - STRINGP (sel := CADDR(sig)) => + (second(sig) = '_$) => + STRINGP (sel := third(sig)) => [quad,".",sel] [quad,".",quad] op @@ -754,7 +754,7 @@ pkey keyStuff == keyStuff := IFCDR keyStuff next := IFCAR keyStuff while CONSP next repeat - if CAR next = 'dbN then dbN := CADR next + if CAR next = 'dbN then dbN := second next else argL := next keyStuff := IFCDR keyStuff next := IFCAR keyStuff diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index 054e8e84..edd5972b 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -331,7 +331,7 @@ makeSpadFun(name,userArgs,args,dummies,decls,results,returnType,asps,aspInfo, [["$elt","Result","construct"],body]] stripNil u == - [CAR(u), ["construct",:CADR(u)], if CADDR(u) then "true" else "false"] + [CAR(u), ["construct",:second(u)], if third(u) then "true" else "false"] makeUnion aspType == -- The argument is the type of the asp to be generated. We would like to @@ -348,11 +348,11 @@ axiomType(a,decls,asps,aspInfo) == "construct"] makeUnion ["FortranProgram",_ a,_ - CADR(entry),_ - ["construct",:mkQuote CADDR entry], _ + second(entry),_ + ["construct",:mkQuote third entry], _ [ ["$elt", "SymbolTable","symbolTable"],_ ["construct",_ - :[[rc,first(v),[ftc,:stripNil rest(v)]] for v in CADDDR entry]]_ + :[[rc,first(v),[ftc,:stripNil rest(v)]] for v in fourth entry]]_ ] ] spadTypeTTT(getFortranType(a,decls)) @@ -402,7 +402,7 @@ vec2Lists u == [vec2Lists1 ELT(u,i) for i in 0..#u-1] spad2lisp(u) == -- Turn complexes into arrays of floats first first(u)="Complex" => - makeVector([makeVector([CADR u,CDDR u],"%DoubleFloat")],NIL) + makeVector([makeVector([second u,CDDR u],"%DoubleFloat")],NIL) -- Turn arrays of complexes into arrays of floats so that tarnsposing -- them puts them in the correct fortran order first first(u)="Matrix" and first SECOND first(u) = "Complex" => @@ -750,11 +750,11 @@ multiToUnivariate f == -- Take an AnonymousFunction, replace the bound variables by references to -- elements of a vector, and compile it. (first f) ~= "+->" => error "in multiToUnivariate: not an AnonymousFunction" - if CONSP CADR f then + if CONSP second f then vars := CDADR f -- throw away '%Comma at start of variable list else - vars := [CADR f] - body := COPY_-TREE CADDR f + vars := [second f] + body := COPY_-TREE third f newVariable := GENSYM() for index in 0..#vars-1 repeat -- Remember that AXIOM lists, vectors etc are indexed from 1 @@ -767,10 +767,10 @@ functionAndJacobian f == -- Take a mapping into n functions of n variables, produce code which will -- evaluate function and jacobian values. (first f) ~= "+->" => error "in functionAndJacobian: not an AnonymousFunction" - if CONSP CADR f then + if CONSP second f then vars := CDADR f -- throw away '%Comma at start of variable list else - vars := [CADR f] + vars := [second f] #(vars) ~= #(CDADDR f) => error "number of variables should equal number of functions" funBodies := COPY_-TREE CDADDR f @@ -795,10 +795,10 @@ vectorOfFunctions f == -- Take a mapping into n functions of m variables, produce code which will -- evaluate function values. (first f) ~= "+->" => error "in vectorOfFunctions: not an AnonymousFunction" - if CONSP CADR f then + if CONSP second f then vars := CDADR f -- throw away '%Comma at start of variable list else - vars := [CADR f] + vars := [second f] funBodies := COPY_-TREE CDADDR f newVariable := GENSYM() for index in 0..#vars-1 repeat diff --git a/src/interp/functor.boot b/src/interp/functor.boot index a5779a50..6430f17f 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -465,7 +465,7 @@ setVector4part3(catNames,catvecList) == --the names are those that will be applied to the various vectors generated:= nil for u in catvecList for uname in catNames repeat - for v in CADDR u.4 repeat + for v in third u.4 repeat if w:= assoc(first v,generated) then RPLACD(w,[[rest v,:uname],:rest w]) else generated:= [[first v,[rest v,:uname]],:generated] @@ -552,7 +552,7 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == where update(code,copyvec,sofar) == ATOM code =>nil QCAR code in '(getShellEntry ELT QREFELT) => - copyvec.(CADDR code):=union(copyvec.(CADDR code), sofar) + copyvec.(third code):=union(copyvec.(third code), sofar) true code is [x,name,number,u'] and x in '(setShellEntry SETELT QSETREFV) => update(u',copyvec,[[name,:number],:sofar]) @@ -719,18 +719,18 @@ SetFunctionSlots(sig,body,flag,mode) == --mode is either "original" or "adding" LookUpSigSlots(sig,siglist) == --+ must kill any implementations below of the form (ELT $ NIL) if $insideCategoryPackageIfTrue then - sig := substitute('$,CADR($functorForm),sig) + sig := substitute('$,second($functorForm),sig) siglist := $lisplibOperationAlist - REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=CADDR u) + REMDUP [implem for u in siglist | SigSlotsMatch(sig,first u,implem:=third u) and KADDR implem] SigSlotsMatch(sig,pattern,implem) == sig=pattern => true - not (LENGTH CADR sig=LENGTH CADR pattern) => nil - --CADR sig is the actual signature part + not (LENGTH second sig=LENGTH second pattern) => nil + --second sig is the actual signature part not (first sig=first pattern) => nil - pat' :=SUBSTQ($definition,'$,CADR pattern) - sig' :=SUBSTQ($definition,'$,CADR sig) + pat' :=SUBSTQ($definition,'$,second pattern) + sig' :=SUBSTQ($definition,'$,second sig) sig'=pat' => true --If we don't have this next test, then we'll recurse in SetFunctionSlots implem is ['Subsumed,:.] => nil @@ -785,8 +785,8 @@ InvestigateConditions catvecListMaker == if $principal is [op,:.] then [principal',:.]:=compMakeCategoryObject($principal,$e) --Rather like eval, but quotes parameters first - for u in CADR principal'.4 repeat - if not TruthP(cond:=CADR u) then + for u in second principal'.4 repeat + if not TruthP(cond:=second u) then new:=['CATEGORY,'domain,['IF,cond,['ATTRIBUTE,CAR u], '%noBranch]] $principal is ['Join,:l] => not member(new,l) => @@ -934,7 +934,7 @@ getPossibleViews u == --returns a list of all the categories that can be views of this one [vec,:.]:= compMakeCategoryObject(u,$e) or systemErrorHere ["getPossibleViews",u] - views:= [first u for u in CADR vec.4] + views:= [first u for u in second vec.4] null vec.0 => [CAAR vec.4,:views] --* [vec.0,:views] --* --the two lines marked ensure that the principal view comes first @@ -946,7 +946,7 @@ getViewsConditions u == --paired with the condition under which they are such views [vec,:.]:= compMakeCategoryObject(u,$e) or systemErrorHere ["getViewsConditions",u] - views:= [[first u,:CADR u] for u in CADR vec.4] + views:= [[first u,:second u] for u in second vec.4] null vec.0 => null CAR vec.4 => views [[CAAR vec.4,:true],:views] --* diff --git a/src/interp/g-boot.boot b/src/interp/g-boot.boot index 1d9507a2..b61dbed1 100644 --- a/src/interp/g-boot.boot +++ b/src/interp/g-boot.boot @@ -120,7 +120,7 @@ removeEXITFromCOND c == lastSE := QCAR cl' ATOM lastSE => z := CONS(cl,z) lastSE is ["EXIT",:.] => - z := CONS(REVERSE CONS(CADR lastSE,CDR cl'),z) + z := CONS(REVERSE CONS(second lastSE,CDR cl'),z) z := CONS(cl,z) CONS('COND,NREVERSE z) @@ -260,9 +260,9 @@ defLET1(lhs,rhs) == rhs' is ["PROGN",:.] => APPEND(rhs',[rhs]) if IDENTP CAR rhs' then rhs' := CONS(rhs',NIL) MKPROGN [:rhs',rhs] - rhs is [=$LET,:.] and IDENTP(name := CADR rhs) => + rhs is [=$LET,:.] and IDENTP(name := second rhs) => -- handle things like [a] := x := foo - l1 := defLET1(name,CADDR rhs) + l1 := defLET1(name,third rhs) l2 := defLET1(lhs,name) l2 is ["PROGN",:.] => MKPROGN [l1,:CDR l2] if IDENTP CAR l2 then l2 := cons(l2,nil) @@ -343,9 +343,9 @@ defISReverse(x,a) == -- reverses forms coming from APPENDs in patterns -- pretty much just a translation of DEF-IS-REV x is ['CONS,:.] => - NULL CADDR x => ['CONS,CADR x, a] - y := defISReverse(CADDR x, NIL) - RPLAC(CADDR y,['CONS,CADR x,a]) + NULL third x => ['CONS,second x, a] + y := defISReverse(third x, NIL) + RPLAC(third y,['CONS,second x,a]) y ERRHUH() diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 808c3d31..bbb6a81e 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -569,6 +569,6 @@ for x in '( (call optCall) _ (RECORDELT optRECORDELT)_ (SETRECORDELT optSETRECORDELT)_ (RECORDCOPY optRECORDCOPY)) _ - repeat MAKEPROP(CAR x,'OPTIMIZE, CADR x) + repeat MAKEPROP(CAR x,'OPTIMIZE, second x) --much quicker to call functions if they have an SBC diff --git a/src/interp/g-timer.boot b/src/interp/g-timer.boot index 6d09f945..10b0521a 100644 --- a/src/interp/g-timer.boot +++ b/src/interp/g-timer.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -219,7 +219,7 @@ makeLongSpaceString(listofnames,listofclasses) == '"bytes", $printStorageIfTrue) computeElapsedTime() == - -- in total time lists, CAR is VIRTCPU and CADR is TOTCPU + -- in total time lists, CAR is VIRTCPU and second is TOTCPU currentTime:= elapsedUserTime() currentGCTime:= elapsedGcTime() gcDelta := currentGCTime - $oldElapsedGCTime diff --git a/src/interp/guess.boot b/src/interp/guess.boot index db70c37c..531df6b5 100644 --- a/src/interp/guess.boot +++ b/src/interp/guess.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -51,7 +51,7 @@ buildWordTable u == HPUT(table,key, listSort(function GLESSEQP,removeDupOrderedAlist listSort(function GLESSEQP, HGET(table,key),function CAR), - function CADR)) + function second)) table measureWordTable u == @@ -268,7 +268,7 @@ rotateWordList u == v := u p := CAR v while QCDR v repeat - RPLACA(v,CADR v) + RPLACA(v,second v) v := QCDR v RPLACA(v,p) u diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 6789b78e..01c42858 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -137,7 +137,7 @@ pushDownTargetInfo(op,target,arglist) == if not getTarget(x) then putTarget(x,S) 2 = nargs => op = "*" => -- only push down on 1st arg if not immed - if not getTarget CADR arglist then putTarget(CADR arglist,target) + if not getTarget second arglist then putTarget(second arglist,target) getTarget(x := CAR arglist) => NIL if getUnname(x) ~= $immediateDataSymbol then putTarget(x,target) op = "**" or op = "^" => -- push down on base diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 612fa4db..efa79337 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -491,7 +491,7 @@ canCoerceTopMatching(t1,t2,tt1,tt2) == -- canCoerce will only be true if D1 = D2 not EQ(tt1,tt2) => 'maybe doms := '(Polynomial List Matrix FiniteSet Vector Stream Gaussian) - MEMQ(tt1,doms) => canCoerce(CADR t1, CADR t2) + MEMQ(tt1,doms) => canCoerce(second t1, second t2) not (MEMQ(tt1,$univariateDomains) or MEMQ(tt2,$multivariateDomains)) => 'maybe u2 := deconstructT t2 @@ -635,7 +635,7 @@ canCoercePermute(t1,t2) == -- as in t2. If length towers = 2 and t2 = last towers, we quit to -- avoid an infinte loop. NULL towers or NULL CDR towers => NIL - NULL CDDR towers and t2 = CADR towers => NIL + NULL CDDR towers and t2 = second towers => NIL -- do the coercions successively, quitting if any fail ok := true for t in CDR towers while ok repeat @@ -661,8 +661,8 @@ canCoerceByFunction1(m1,m2,fun) == for t1 in l1 while not ans repeat for t2 in l2 while not ans repeat l := selectMms1(fun,t2,[t1],[t1],NIL) - ans := [x for x in l | x is [sig,:.] and CADR sig=t2 and - CADDR sig=t1 and + ans := [x for x in l | x is [sig,:.] and second sig=t2 and + third sig=t1 and CAR(sig) isnt ['TypeEquivalence,:.]] and true ans @@ -1187,7 +1187,7 @@ coerceIntPermute(object,t2) == -- as in t2. If length towers = 2 and t2 = last towers, we quit to -- avoid an infinte loop. NULL towers or NULL CDR towers => NIL - NULL CDDR towers and t2 = CADR towers => NIL + NULL CDDR towers and t2 = second towers => NIL -- do the coercions successively, quitting if any fail ok := true for t in CDR towers while ok repeat diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index 3def27de..ff642d94 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -1533,13 +1533,13 @@ Un2E(x,source,target) == --% Variable Var2OV(u,source,target is [.,vl]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => member(sym,vl) member(sym,vl) => position1(sym,vl) coercionFailure() Var2Dmp(u,source,target is [dmp,vl,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len := #vl @@ -1550,7 +1550,7 @@ Var2Dmp(u,source,target is [dmp,vl,S]) == [[Zeros len,:objValUnwrap u]] Var2Gdmp(u,source,target is [dmp,vl,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len := #vl @@ -1561,7 +1561,7 @@ Var2Gdmp(u,source,target is [dmp,vl,S]) == [[Zeros len,:objValUnwrap u]] Var2Mp(u,source,target is [mp,vl,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) (n:= position1(u,vl)) ~= 0 => [1,n,[1,0,:getConstantFromDomain('(One),S)]] @@ -1569,7 +1569,7 @@ Var2Mp(u,source,target is [mp,vl,S]) == [0,:objValUnwrap u] Var2NDmp(u,source,target is [ndmp,vl,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => member(sym,vl) or canCoerce(source,S) len:= #vl @@ -1580,7 +1580,7 @@ Var2NDmp(u,source,target is [ndmp,vl,S]) == [[Zeros len,:objValUnwrap(u)]] Var2P(u,source,target is [poly,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => true -- first try to get it into an underdomain @@ -1594,7 +1594,7 @@ Var2QF(u,source,target is [qf,S]) == u = '_$fromCoerceable_$ => canCoerce(source,S) S = $Integer => coercionFailure() - sym := CADR source + sym := second source (u' := coerceInt(objNewWrap(u,source),S)) or coercionFailure() [objValUnwrap u',:getConstantFromDomain('(One),S)] @@ -1606,7 +1606,7 @@ Var2FS(u,source,target is [fs,S]) == objValUnwrap v Var2Up(u,source,target is [up,x,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => (sym = x) or canCoerce(source,S) x=sym => [[1,:getConstantFromDomain('(One),S)]] @@ -1614,7 +1614,7 @@ Var2Up(u,source,target is [up,x,S]) == [[0,:objValUnwrap u]] Var2SUP(u,source,target is [sup,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => (sym = "?") or canCoerce(source,S) sym = "?" => [[1,:getConstantFromDomain('(One),S)]] @@ -1622,7 +1622,7 @@ Var2SUP(u,source,target is [sup,S]) == [[0,:objValUnwrap u]] Var2UpS(u,source,target is [ups,x,S]) == - sym := CADR source + sym := second source u = '_$fromCoerceable_$ => (sym = x) or canCoerce(source,S) mid := ['UnivariatePolynomial,x,S] @@ -1635,7 +1635,7 @@ Var2UpS(u,source,target is [ups,x,S]) == objValUnwrap u Var2OtherPS(u,source,target is [.,x,S]) == - sym := CADR source + sym := second source mid := ['UnivariatePowerSeries,x,S] u = '_$fromCoerceable_$ => (sym = x) or (canCoerce(source,mid) and canCoerce(mid,target)) diff --git a/src/interp/i-eval.boot b/src/interp/i-eval.boot index 9e0d2743..f89d76d2 100644 --- a/src/interp/i-eval.boot +++ b/src/interp/i-eval.boot @@ -258,7 +258,7 @@ evalForm(op,opName,argl,mmS) == xbody is [['RECORDELT,.,ind,len]] => optRECORDELT([CAAR xbody,rec,ind,len]) xbody is [['SETRECORDELT,.,ind,len,.]] => - optSETRECORDELT([CAAR xbody,rec,ind,len,CADDR form]) + optSETRECORDELT([CAAR xbody,rec,ind,len,third form]) xbody is [['RECORDCOPY,.,len]] => optRECORDCOPY([CAAR xbody,rec,len]) ['FUNCALL,['function , ['LAMBDA,xargs,:xbody]],:TAKE(#xargs, form)] @@ -281,7 +281,7 @@ evalForm(op,opName,argl,mmS) == not form => nil -- not form => throwKeyedMsg("S2IE0008",[opName]) form='interpOnly => rewriteMap(op,opName,argl) - targetType := CADR sig + targetType := second sig if CONTAINED('_#,targetType) then targetType := NRTtypeHack targetType evalFormMkValue(op,form,targetType) diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index b3249958..47cd20ee 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -163,25 +163,25 @@ selectMms2(op,tar,args1,args2,$Coerce) == -- special case map for the time being $Coerce and (op = 'map) and (2 = nargs) and (first(args1) is ['Variable,fun]) => - null (ud := underDomainOf CADR args1) => NIL + null (ud := underDomainOf second args1) => NIL if tar then ut := underDomainOf(tar) else ut := nil null (mapMms := selectMms1(fun,ut,[ud],[NIL],true)) => NIL mapMm := CDAAR mapMms - selectMms1(op,tar,[['Mapping,:mapMm],CADR args1], - [NIL,CADR args2],$Coerce) + selectMms1(op,tar,[['Mapping,:mapMm],second args1], + [NIL,second args2],$Coerce) $Coerce and (op = 'map) and (2 = nargs) and (first(args1) is ['FunctionCalled,fun]) => - null (ud := underDomainOf CADR args1) => NIL + null (ud := underDomainOf second args1) => NIL if tar then ut := underDomainOf(tar) else ut := nil funNode := mkAtreeNode fun transferPropsToNode(fun,funNode) null (mapMms := selectLocalMms(funNode,fun,[ud],NIL)) => NIL mapMm := CDAAR mapMms - selectMms1(op,tar,[['Mapping,:mapMm],CADR args1], - [NIL,CADR args2],$Coerce) + selectMms1(op,tar,[['Mapping,:mapMm],second args1], + [NIL,second args2],$Coerce) -- get the argument domains and the target a := nil @@ -216,7 +216,7 @@ selectMms2(op,tar,args1,args2,$Coerce) == a' := append(reverse l,a') x is ['Mapping,:l] => a' := append(reverse l,a') x is ['Record,:l] => - a' := append(reverse [CADDR s for s in l],a') + a' := append(reverse [third s for s in l],a') x is ['FunctionCalled,name] => (xm := get(name,'mode,$e)) and not isPartialMode xm => a' := cons(xm,a') @@ -286,7 +286,7 @@ defaultTarget(opNode,op,nargs,args) == target target - a2 := CADR args + a2 := second args nargs >= 2 and op = "draw" and a1 is ['FunctionCalled,sym] and a2 is ['Segment,.] => @@ -295,7 +295,7 @@ defaultTarget(opNode,op,nargs,args) == symNode := mkAtreeNode sym transferPropsToNode(sym,symNode) - nargs >= 3 and CADDR args is ['Segment,.] => + nargs >= 3 and third args is ['Segment,.] => selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL) putTarget(opNode, target := '(ThreeDimensionalViewport)) target @@ -318,7 +318,7 @@ defaultTarget(opNode,op,nargs,args) == symNode := mkAtreeNode sym transferPropsToNode(sym,symNode) - nargs >= 3 and CADDR args is ['Segment,.] => + nargs >= 3 and third args is ['Segment,.] => selectLocalMms(symNode,sym,[$DoubleFloat, $DoubleFloat],NIL) target @@ -428,7 +428,7 @@ defaultTarget(opNode,op,nargs,args) == target target - a3 := CADDR args + a3 := third args nargs = 3 => op = "eval" => a3 is ['List, a3e] => @@ -492,9 +492,9 @@ getOpArgTypes1(opname, args) == [CAR getModeSetUseSubdomain d,CAR getModeSet c] opname = 'monom and args is [v,d,c] => [CAR getModeSet v,CAR getModeSetUseSubdomain d,CAR getModeSet c] - (opname = 'cons) and (2 = #args) and (CADR(args) = 'nil) => + (opname = 'cons) and (2 = #args) and (second(args) = 'nil) => ms := [CAR getModeSet x for x in args] - if CADR(ms) = '(List (None)) then + if second(ms) = '(List (None)) then ms := [first ms,['List,first ms]] ms nargs := #args @@ -532,7 +532,7 @@ CONTAINEDisDomain(symbol,cond) == QCAR cond in '(AND OR and or) => or/[CONTAINEDisDomain(symbol, u) for u in QCDR cond] EQ(QCAR cond,'isDomain) => - EQ(symbol,CADR cond) and CONSP(dom:=CADDR cond) and + EQ(symbol,second cond) and CONSP(dom:=third cond) and dom in '(PositiveInteger NonNegativeInteger) false @@ -594,7 +594,7 @@ getLocalMms(name,types,tar) == mmCost(name, sig,cond,tar,args1,args2) == cost := mmCost0(name, sig,cond,tar,args1,args2) - res := CADR sig + res := second sig res = $PositiveInteger => cost - 2 res = $NonNegativeInteger => cost - 1 res = $DoubleFloat => cost + 1 @@ -626,7 +626,7 @@ mmCost0(name, sig,cond,tar,args1,args2) == 4 else if sigArgs then n := n + 100000000000 - res := CADR sig + res := second sig res=tar => 10000*n 10000*n + 1000*domainDepth(res) + hitListOfTarget(res) @@ -1022,7 +1022,7 @@ selectMmsGen(op,tar,args1,args2) == if (op = 'map) and (2 = #args1) and (CAR(args1) is ['Mapping,., elem]) and - (a := isTowerWithSubdomain(CADR args1,elem)) + (a := isTowerWithSubdomain(second args1,elem)) then args1 := [CAR args1,a] -- we first split the modemaps into two groups: @@ -1106,7 +1106,7 @@ selectMmsGen(op,tar,args1,args2) == tar and not isPartialMode tar => -- throw in the target if it is not the same as one -- of the arguments - res := CADR sig + res := second sig member(res,CDDR sig) => NIL [[res,:tar]] NIL @@ -1217,7 +1217,7 @@ evalMmCond0(op,sig,st) == -- if we are looking at the result of a function, the coerce -- goes the opposite direction (t1 = $AnonymousFunction and t is ['Mapping, :.]) => t - CAR p = CADR sig and not member(CAR p, CDDR sig) => + CAR p = second sig and not member(CAR p, CDDR sig) => canCoerceFrom(t,t1) => 'T NIL canCoerceFrom(t1,t) => 'T @@ -1300,12 +1300,12 @@ orderMmCatStack st == -- tries to reorder stack so that free pattern variables appear -- as parameters first null(st) or null rest(st) => st - vars := DELETE_-DUPLICATES [CADR(s) for s in st | isPatternVar(CADR(s))] + vars := DELETE_-DUPLICATES [second(s) for s in st | isPatternVar(second(s))] null vars => st havevars := nil haventvars := nil for s in st repeat - cat := CADDR s + cat := third s mem := nil for v in vars while not mem repeat if MEMQ(v,cat) then @@ -1317,8 +1317,8 @@ orderMmCatStack st == SORT(st, function mmCatComp) mmCatComp(c1, c2) == - b1 := ASSQ(CADR c1, $Subst) - b2 := ASSQ(CADR c2, $Subst) + b1 := ASSQ(second c1, $Subst) + b2 := ASSQ(second c2, $Subst) b1 and null(b2) => true false @@ -1638,8 +1638,8 @@ unifyStruct(s1,s2,SL) == s1=s2 => SL if s1 is [":",x,.] then s1:= x if s2 is [":",x,.] then s2:= x - if not atom s1 and CAR s1 = '_# then s1:= LENGTH CADR s1 - if not atom s2 and CAR s2 = '_# then s2:= LENGTH CADR s2 + if not atom s1 and CAR s1 = '_# then s1:= LENGTH second s1 + if not atom s2 and CAR s2 = '_# then s2:= LENGTH second s2 s1=s2 => SL isPatternVar s1 => unifyStructVar(s1,s2,SL) isPatternVar s2 => unifyStructVar(s2,s1,SL) diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index 3c8eda00..8508b526 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -134,7 +134,7 @@ mkAtree2(x,op,argl) == if val = '$NoValue then val := '(void) [mkAtreeNode op,mkAtree1 val] [mkAtreeNode op,mkAtree1 '(void)] - op="exit" => mkAtree1 CADR argl + op="exit" => mkAtree1 second argl op = "QUOTE" => [mkAtreeNode op,:argl] op="SEGMENT" => argl is [a] => [mkAtreeNode op, mkAtree1 a] @@ -145,7 +145,7 @@ mkAtree2(x,op,argl) == op in '(pretend is isnt) => [mkAtreeNode op,mkAtree1 first argl,:rest argl] op = "::" => - [mkAtreeNode "COERCE",mkAtree1 first argl,CADR argl] + [mkAtreeNode "COERCE",mkAtree1 first argl,second argl] x is ["@", expr, type] => t := evaluateType unabbrev type t = $DoubleFloat and expr is [['_$elt, =$Float, 'float], :args] => @@ -160,7 +160,7 @@ mkAtree2(x,op,argl) == mkAtree1 ["::", expr, t] [mkAtreeNode 'TARGET,mkAtree1 expr, type] (op="case") and (nargl = 2) => - [mkAtreeNode "case",mkAtree1 first argl,unabbrev CADR argl] + [mkAtreeNode "case",mkAtree1 first argl,unabbrev second argl] op="REPEAT" => [mkAtreeNode op,:transformREPEAT argl] op="%LET" and argl is [['construct,:.],rhs] => [mkAtreeNode "%LET",first argl,mkAtree1 rhs] diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index f755f036..04cdb66d 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -579,7 +579,7 @@ rewriteMap0(op,opName,argl) == -- $genValue case of map rewriting putBodyInEnv(opName, #argl) if (s := get(opName,'mode,$e)) then - tar := CADR s + tar := second s argTypes := CDDR s else tar:= nil diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index e9c4386d..b4d1952e 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -78,8 +78,8 @@ objValUnwrap obj == unwrap CDR obj objMode obj == CAR obj objEnv obj == $EmptyEnvironment -objCodeVal obj == CADDR obj -objCodeMode obj == CADR obj +objCodeVal obj == third obj +objCodeMode obj == second obj --% Utility Functions Used Only by the Intepreter diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 23d9e6cb..e4b96a90 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -564,7 +564,7 @@ outputTran x == (op' = '"*") and ((foo3 is ['log,foo4]) or (foo2 is ['log,foo4])) => foo3 is ['log,foo4] => ["**", outputTran foo4, outputTran foo2] - foo4 := CADR foo2 + foo4 := second foo2 ["**", outputTran foo4, outputTran foo3] op = 'IF => outputTranIf x op = 'COLLECT => outputTranCollect x @@ -776,8 +776,8 @@ timesApp(u,x,y,d) == needBlankForRoot(lastOp,op,arg) == lastOp ~= "^" and lastOp ~= "**" and not(subspan(arg)>0) => false - op = "**" and keyp CADR arg = 'ROOT => true - op = "^" and keyp CADR arg = 'ROOT => true + op = "**" and keyp second arg = 'ROOT => true + op = "^" and keyp second arg = 'ROOT => true op = 'ROOT and CDDR arg => true false @@ -852,7 +852,7 @@ exptNeedsPren a == (key="SUB") or (null GETL(key,"Nud") and null GETL(key,"Led")) => false true -exptSub u == subspan CADR u +exptSub u == subspan second u exptSuper [.,a,b] == superspan a+height b+(superspan a=0 => 0;-1) @@ -865,7 +865,7 @@ needStar(wasSimple,wasQuotient,wasNumber,cur,op) == (atom op and not NUMBERP op and null GETL(op,"APP")) wasNumber => NUMBERP(cur) or isRationalNumber cur or - ((op="**" or op ="^") and NUMBERP(CADR cur)) + ((op="**" or op ="^") and NUMBERP(second cur)) isQuotient op == op="/" or op="OVER" @@ -1208,8 +1208,8 @@ LargeMatrixp(u,width, dist) == --Relying that falling out of a loop gives nil op in '(_+ _* ) => --Each of these prints the first argument in a width 3 smaller - (ans:=LargeMatrixp(CADR u,width-3,dist)) => largeMatrixAlist ans - n:=3+WIDTH CADR u + (ans:=LargeMatrixp(second u,width-3,dist)) => largeMatrixAlist ans + n:=3+WIDTH second u dist:=dist-n ans:= for v in CDDR u repeat @@ -1297,11 +1297,11 @@ SubstWhileDesizingList(u,m) == sigmaSub u == --The depth function for sigmas with lower limit only - MAX(1 + height CADR u, subspan CADDR u) + MAX(1 + height second u, subspan third u) sigmaSup u == --The height function for sigmas with lower limit only - MAX(1, superspan CADDR u) + MAX(1, superspan third u) sigmaApp(u,x,y,d) == u is [.,bot,arg] or THROW('outputFailure,'outputFailure) @@ -1362,19 +1362,19 @@ sigma2Width [.,bot,top,arg] == bigopWidth(bot,top,arg,'sigma) sigma2Sub u == --The depth function for sigmas with 2 limits - MAX(1 + height CADR u, subspan CADDDR u) + MAX(1 + height second u, subspan fourth u) sigma2Sup u == --The depth function for sigmas with 2 limits - MAX(1 + height CADDR u, superspan CADDDR u) + MAX(1 + height third u, superspan fourth u) piSub u == --The depth function for pi's (products) - MAX(1 + height CADR u, subspan CADDR u) + MAX(1 + height second u, subspan third u) piSup u == --The height function for pi's (products) - MAX(1, superspan CADDR u) + MAX(1, superspan third u) piApp(u,x,y,d) == u is [.,bot,arg] or THROW('outputFailure,'outputFailure) @@ -1385,11 +1385,11 @@ pi2Width [.,bot,top,arg] == bigopWidth(bot,top,arg,'pi) pi2Sub u == --The depth function for pi's with 2 limits - MAX(1 + height CADR u, subspan CADDDR u) + MAX(1 + height second u, subspan fourth u) pi2Sup u == --The depth function for pi's with 2 limits - MAX(1 + height CADDR u, superspan CADDDR u) + MAX(1 + height third u, superspan fourth u) pi2App(u,x,y,d) == [.,bot,top,arg]:=u @@ -1663,10 +1663,10 @@ isInitialMap u == (and/[x is [[ =i],.] for x in l for i in n+1..]) printMap1(x,initialFlag) == - initialFlag => printBasic CADR x + initialFlag => printBasic second x if CDAR x then printBasic first x else printBasic CAAR x printBasic " E " - printBasic CADR x + printBasic second x printBasic x == x='(One) => PRIN1(1,$algebraOutputStream) @@ -1856,11 +1856,11 @@ keyp(u) == absym x == (NUMBERP x) and (MINUSP x) => -x - not (atom x) and (keyp(x) = '_-) => CADR x + not (atom x) and (keyp(x) = '_-) => second x x agg(n,u) == - (n = 1) => CADR u + (n = 1) => second u agg(n - 1, rest u) aggwidth u == @@ -1953,16 +1953,16 @@ appelse(u,x,y,d) == appext(u,x,y,d) == xptr := x - yptr := y - (subspan CADR u + superspan agg(3,u) + 1) - d := APP(CADR u,x,y,d) + yptr := y - (subspan second u + superspan agg(3,u) + 1) + d := APP(second u,x,y,d) d := APP(agg(2,u),xptr,yptr,d) xptr := xptr + WIDTH agg(2,u) d := APP('"=", xptr, yptr,d) d := APP(agg(3,u), 1 + xptr, yptr, d) - yptr := y + 1 + superspan CADR u + SUBSPAD agg(4,u) + yptr := y + 1 + superspan second u + SUBSPAD agg(4,u) d := APP(agg(4,u), x, yptr, d) temp := 1 + WIDTH agg(2,u) + WIDTH agg(3,u) - n := MAX(WIDTH CADR u, WIDTH agg(4,u), temp) + n := MAX(WIDTH second u, WIDTH agg(4,u), temp) if first(z := agg(5,u)) is ["EXT",:.] and (n=3 or (n > 3 and not (atom z)) ) then n := 1 + n @@ -2006,21 +2006,21 @@ appparu(u, x, y, d) == apprpar(x + 1 + WIDTH u, y, bot, top, temparg2) appparu1(u, x, y, d) == - appparu(CADR u, x, y, d) + appparu(second u, x, y, d) appsc(u, x, y, d) == appagg1(rest u, x, y, d, '";") appsetq(u, x, y, d) == w := WIDTH first u - temparg1 := APP(CADR u, x, y, d) + temparg1 := APP(second u, x, y, d) temparg2 := APP('":", x + w, y, temparg1) - APP(CADR rest u, x + 2 + w, y, temparg2) + APP(second rest u, x + 2 + w, y, temparg2) appsub(u, x, y, d) == - temparg1 := x + WIDTH CADR u + temparg1 := x + WIDTH second u temparg2 := y - 1 - superspan CDDR u - temparg3 := APP(CADR u, x, y, d) + temparg3 := APP(second u, x, y, d) appagg(CDDR u, temparg1, temparg2, temparg3) eq0(u) == 0 @@ -2029,13 +2029,13 @@ height(u) == superspan(u) + 1 + subspan(u) extsub(u) == - MAX(subspan agg(5, u), height(agg(3, u)), subspan CADR u ) + MAX(subspan agg(5, u), height(agg(3, u)), subspan second u ) extsuper(u) == - MAX(superspan CADR u + height agg(4, u), superspan agg(5, u) ) + MAX(superspan second u + height agg(4, u), superspan agg(5, u) ) extwidth(u) == - n := MAX(WIDTH CADR u, + n := MAX(WIDTH second u, WIDTH agg(4, u), 1 + WIDTH agg(2, u) + WIDTH agg(3, u) ) nil or @@ -2049,48 +2049,48 @@ appfrac(u, x, y, d) == -- not possible, expressions are offset to the right rather than left. -- MCD 16-8-95 w := WIDTH u - tempx := x + QUOTIENT(1+w - WIDTH CADR rest u, 2) - tempy := y - superspan CADR rest u - 1 - temparg3 := APP(CADR rest u, tempx, tempy, d) + tempx := x + QUOTIENT(1+w - WIDTH second rest u, 2) + tempy := y - superspan second rest u - 1 + temparg3 := APP(second rest u, tempx, tempy, d) temparg4 := apphor(x, x + w - 1, y, temparg3,specialChar('hbar)) - APP(CADR u, - x + QUOTIENT(1+w - WIDTH CADR u, 2), - y + 1 + subspan CADR u, + APP(second u, + x + QUOTIENT(1+w - WIDTH second u, 2), + y + 1 + subspan second u, temparg4) -fracsub(u) == height CADR rest u +fracsub(u) == height second rest u -fracsuper(u) == height CADR u +fracsuper(u) == height second u fracwidth(u) == - numw := WIDTH (num := CADR u) - denw := WIDTH (den := CADDR u) + numw := WIDTH (num := second u) + denw := WIDTH (den := third u) if num is [[op,:.],:.] and op = 'OVER then numw := numw + 2 if den is [[op,:.],:.] and op = 'OVER then denw := denw + 2 MAX(numw,denw) slashSub u == - MAX(1,subspan(CADR u),subspan(CADR rest u)) + MAX(1,subspan(second u),subspan(second rest u)) slashSuper u == - MAX(1,superspan(CADR u),superspan(CADR rest u)) + MAX(1,superspan(second u),superspan(second rest u)) slashApp(u, x, y, d) == -- to print things as a/b as opposed to -- a -- - -- b - temparg1 := APP(CADR u, x, y, d) - temparg2 := APP('"/", x + WIDTH CADR u, y, temparg1) - APP(CADR rest u, - x + 1 + WIDTH CADR u, y, temparg2) + temparg1 := APP(second u, x, y, d) + temparg2 := APP('"/", x + WIDTH second u, y, temparg1) + APP(second rest u, + x + 1 + WIDTH second u, y, temparg2) slashWidth(u) == -- to print things as a/b as opposed to -- a -- - -- b - 1 + WIDTH CADR u + WIDTH CADR rest u + 1 + WIDTH second u + WIDTH second rest u longext(u, i, n) == x := REVERSE u @@ -2190,12 +2190,12 @@ nothingApp(u, x, y, d) == zagApp(u, x, y, d) == w := WIDTH u - denx := x + QUOTIENT(w - WIDTH CADR rest u, 2) - deny := y - superspan CADR rest u - 1 - d := APP(CADR rest u, denx, deny, d) - numx := x + QUOTIENT(w - WIDTH CADR u, 2) - numy := y+1 + subspan CADR u - d := APP(CADR u, numx, numy, d) + denx := x + QUOTIENT(w - WIDTH second rest u, 2) + deny := y - superspan second rest u - 1 + d := APP(second rest u, denx, deny, d) + numx := x + QUOTIENT(w - WIDTH second u, 2) + numy := y+1 + subspan second u + d := APP(second u, numx, numy, d) a := 1 + zagSuper u b := 1 + zagSub u d := appvertline(specialChar('vbar), x, y - b, y - 1, d) @@ -2205,10 +2205,10 @@ zagApp(u, x, y, d) == d := APP(specialChar('lrc), x + w - 1, y, d) zagSub(u) == - height CADR rest u + height second rest u zagSuper(u) == - height CADR u + height second u zagWidth(x) == #x = 1 => 0 @@ -2235,10 +2235,10 @@ appmat(u, x, y, d) == d := matrixBorder(x, y - q, y + p, d, 'left) x := 1 + x yc := 1 + y + p - w := CADR u + w := second u wl := CDAR w - subl := rest CADR w - superl := rest CADR rest w + subl := rest second w + superl := rest second rest w repeat null rows => return(matrixBorder(x + WIDTH u - 2, y - q, @@ -2358,13 +2358,13 @@ prnd(start, op) == TERPRI $algebraOutputStream qTSub(u) == - subspan CADR u + subspan second u qTSuper(u) == - superspan CADR u + superspan second u qTWidth(u) == - 2 + WIDTH CADR u + 2 + WIDTH second u remWidth(x) == atom x => x @@ -2443,9 +2443,9 @@ binomApp(u,x,y,d) == d := appChar(specialChar 'llc,x,y - hden,d) d := appChar(specialChar 'lrc,x + w,y - hden,d) -binomSub u == height CADDR u -binomSuper u == height CADR u -binomWidth u == 2 + MAX(WIDTH CADR u, WIDTH CADDR u) +binomSub u == height third u +binomSuper u == height second u +binomWidth u == 2 + MAX(WIDTH second u, WIDTH third u) altSuperSubApp(u, x, y, di) == a := first (u := rest u) @@ -2473,7 +2473,7 @@ everyNth(l, n) == altSuperSubSub u == - span := subspan CADR u + span := subspan second u sublist := everyNth(CDDR u, 2) for sub in sublist repeat h := height sub @@ -2481,7 +2481,7 @@ altSuperSubSub u == span altSuperSubSuper u == - span := superspan CADR u + span := superspan second u suplist := everyNth(IFCDR CDDR u, 2) for sup in suplist repeat h := height sup @@ -2489,7 +2489,7 @@ altSuperSubSuper u == span altSuperSubWidth u == - w := WIDTH CADR u + w := WIDTH second u suplist := everyNth(IFCDR CDDR u, 2) sublist := everyNth(CDDR u, 2) for sup in suplist for sub in sublist repeat diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index 03baca9e..dbd07152 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -173,7 +173,7 @@ resolveTTSpecial(t1,t2) == t1 = '(AlgebraicNumber) and (t2 = $Float or t2 = $DoubleFloat) => ['Expression, t2] t1 = '(AlgebraicNumber) and (t2 = ['Complex, $Float] or t2 = ['Complex, $DoubleFloat]) => - ['Expression, CADR t2] + ['Expression, second t2] t1 = '(AlgebraicNumber) and t2 is ['Complex,.] => resolveTT1('(Expression (Integer)), t2) @@ -511,10 +511,10 @@ resolveTMRecord(tr,mr) == tt := NIL for ta in tr for ma in mr while ok repeat -- element is [':,tag,mode] - CADR(ta) ~= CADR(ma) => ok := NIL -- match tags - ra := resolveTM1(CADDR ta, CADDR ma) -- resolve modes + second(ta) ~= second(ma) => ok := NIL -- match tags + ra := resolveTM1(third ta, third ma) -- resolve modes null ra => ok := NIL - tt := CONS([CAR ta,CADR ta,ra],tt) + tt := CONS([CAR ta,second ta,ra],tt) null ok => NIL ['Record,nreverse tt] @@ -627,9 +627,9 @@ resolveTMEq1(ct,cm) == xm := CAR cm cm := CDR cm if not (atom xm) and CAR xm = ":" -- i.e. Record - and CAR xt = ":" and CADR xm = CADR xt then - xm := CADDR xm - xt := CADDR xt + and CAR xt = ":" and second xm = second xt then + xm := third xm + xt := third xt b := xt=xm => 'T isPatternVar(xm) and diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 6851de3c..b99da141 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -217,7 +217,7 @@ upAlgExtension t == throwKeyedMsgCannotCoerceWithValue(objVal(triple), objMode(triple),upmode) newmode := objMode T - (field := resolveTCat(CADDR newmode,'(Field))) or + (field := resolveTCat(third newmode,'(Field))) or throwKeyedMsg("S2IS0002",[eq]) pd:= ['UnivariatePolynomial,a,field] null (canonicalAE:= coerceInteractive(T,pd)) => @@ -877,8 +877,8 @@ mkZipCode indexList == -- into a stream of nested record types. returns [form,:recordType] #indexList = 2 => [[.,:s2],[.,:s1]] := indexList - t1 := CADR objMode getValue s1 - t2 := CADR objMode getValue s2 + t1 := second objMode getValue s1 + t2 := second objMode getValue s2 zipType := ['Record,['_:,'part1,t1], ['_:,'part2,t2] ] zipFun := [mkAtreeNode 'Dollar, ['MakeRecord,mkEvalable t1, mkEvalable t2], @@ -887,7 +887,7 @@ mkZipCode indexList == [form,:zipType] [form,:zipType] := mkZipCode CDR indexList [[.,:s],:.] := indexList - t := CADR objMode getValue s + t := second objMode getValue s zipFun := [mkAtreeNode 'Dollar, ['MakeRecord,mkEvalable t, mkEvalable zipType], mkAtreeNode 'makeRecord] @@ -969,7 +969,7 @@ upconstruct t == CAR(tar) in aggs => ud := (l is [[realOp, :.]]) and (getUnname(realOp) = 'COLLECT) => tar - CADR tar + second tar for x in l repeat if not getTarget(x) then putTarget(x,ud) CAR(tar) in '(Matrix SquareMatrix RectangularMatrix) => vec := ['List,underDomainOf tar] diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index 10fff2dc..cd444eca 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -266,7 +266,7 @@ compileIF(op,cond,a,b,t) == -- if this was a return statement, we take the mode to be that -- of what is being returned. if getUnname a = 'return then - ms1 := bottomUp CADR a + ms1 := bottomUp second a [m1] := ms1 evalIF(op,rest t,m1) putModeSet(op,ms1) @@ -1077,7 +1077,7 @@ uptuple t == aggs := '(List) if tar and CONSP(tar) and not isPartialMode(tar) then CAR(tar) in aggs => - ud := CADR tar + ud := second tar for x in l repeat if not getTarget(x) then putTarget(x,ud) CAR(tar) in '(Matrix SquareMatrix RectangularMatrix) => vec := ['List,underDomainOf tar] diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 2305ecda..0a06f418 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -1364,7 +1364,7 @@ frameEnvironment fname == while ifr repeat [f,:ifr] := ifr if fname = frameName f then - e := CADR f + e := second f ifr := NIL e @@ -1927,7 +1927,7 @@ showHistory(arg) == if INTEGERP arg1 then n := arg1 nset := true - KDR arg => arg1 := CADR arg + KDR arg => arg1 := second arg arg1 := NIL arg1 => arg2 := selectOptionLC(arg1,'(input both),nil) @@ -2979,7 +2979,7 @@ filterListOfStrings(patterns,names) == filterListOfStringsWithFn(patterns,names,fn) == -- names and patterns are lists of strings - -- fn is something like CAR or CADR + -- fn is something like CAR or second -- returns: list of strings in names that contains any of the strings -- in patterns (null patterns) or (null names) => names diff --git a/src/interp/int-top.boot b/src/interp/int-top.boot index 9554b7b5..3b30ab03 100644 --- a/src/interp/int-top.boot +++ b/src/interp/int-top.boot @@ -297,7 +297,7 @@ ncloopEscaped x== ncloopDQlines (dq,stream)== StreamNull stream - a:= poGlobalLinePosn tokPosn CADR dq + a:= poGlobalLinePosn tokPosn second dq b:= poGlobalLinePosn CAAR stream streamChop (a-b+1,stream) @@ -435,6 +435,6 @@ getParserMacros() == displayParserMacro m == m := ASSQ(m, $pfMacros) null m => nil - pfPrintSrcLines CADDR m + pfPrintSrcLines third m diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 8005b868..c242ed94 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -274,7 +274,7 @@ instantiate domenv == -- following is a patch for a bug in runtime.as -- has a lazy dispatch vector with an instantiated domenv VECTORP CDR domenv => [$oldAxiomDomainDispatch ,: domenv] - callForm := CADR domenv + callForm := second domenv oldDom := CDDR domenv [functor,:args] := callForm -- if null(fn := GETL(functor,'instantiate)) then @@ -286,7 +286,7 @@ instantiate domenv == -- domvec := APPLY(fn, args) domvec := APPLY(functor, args) RPLACA(oldDom, $oldAxiomDomainDispatch) - RPLACD(oldDom, [CADR oldDom,: domvec]) + RPLACD(oldDom, [second oldDom,: domvec]) oldDom hashTypeForm([fn,: args], percentHash) == @@ -462,7 +462,7 @@ hashNewLookupInTable(op,sig,dollar,[domain,opvec],flag) == hashNewLookupInCategories(op,sig,dom,dollar) == slot4 := dom.4 - catVec := CADR slot4 + catVec := second slot4 SIZE catVec = 0 => nil --early exit if no categories INTEGERP KDR catVec.0 => newLookupInCategories1(op,sig,dom,dollar) --old style @@ -572,7 +572,7 @@ newHasCategory(domain,catform) == and/[newHasCategory(domain,cat) for cat in cats] slot4 := domain.4 auxvec := CAR slot4 - catvec := CADR slot4 + catvec := second slot4 $isDefaultingPackage: local := isDefaultPackageForm? devaluate domain #catvec > 0 and INTEGERP KDR catvec.0 => --old style predIndex := lazyMatchAssocV1(catform,catvec,domain) diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index 8e52317a..d240b632 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -401,7 +401,7 @@ compileDocumentation libName == getLisplibVersion libName == stream := RDEFIOSTREAM [['FILE,libName,$spadLibFT],['MODE, :'I]] - version:= CADR rread('VERSION, stream,nil) + version:= second rread('VERSION, stream,nil) RSHUT(stream) version diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 575d3d08..66e18a09 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -794,8 +794,8 @@ markInsertChanges(code,form,t,loc) == t = $EmptyMode => form ["pretend",form,t] t in '(rep per) => - t = 'rep and form is ["per",:.] => CADR form - t = 'per and form is ["rep",:.] => CADR form + t = 'rep and form is ["per",:.] => second form + t = 'per and form is ["rep",:.] => second form [t,form] code is [op,x,t1] and op in '(_@ _: _:_: _pretend) and t1 = t => form FIXP form and MEMQ(opOf t,$markPrimitiveNumbers) => ['_@,form,t] @@ -1204,8 +1204,8 @@ markInsertIterator x == markKillExpr m == --used to kill all but PART information for compilation m is [op,:.] => - op in '(MI WI) => markKillExpr CADDR m - op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillExpr CADDDR m + op in '(MI WI) => markKillExpr third m + op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillExpr fourth m m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillExpr x,m,e]] [markKillExpr x for x in m] m @@ -1213,18 +1213,18 @@ markKillExpr m == --used to kill all but PART information for compilation markKillButIfs m == --used to kill all but PART information for compilation m is [op,:.] => op = 'IF => m - op = 'PART => markKillButIfs CADDR m - op in '(MI WI) => markKillButIfs CADDR m - op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillButIfs CADDDR m + op = 'PART => markKillButIfs third m + op in '(MI WI) => markKillButIfs third m + op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillButIfs fourth m m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillButIfs x,m,e]] [markKillButIfs x for x in m] m markKillAll m == --used to prepare code for compilation m is [op,:.] => - op = 'PART => markKillAll CADDR m - op in '(MI WI) => markKillAll CADDR m - op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillAll CADDDR m + op = 'PART => markKillAll third m + op in '(MI WI) => markKillAll third m + op in '(AUTOHARD AUTOSUBSET AUTOREP) => markKillAll fourth m m is ['TAGGEDreturn,a,[x,m,e]] => ['TAGGEDreturn, a, [markKillAll x,m,e]] [markKillAll x for x in m] m diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index e24fcf07..1207dac1 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -268,7 +268,7 @@ augModemapsFromCategoryRep(domainName,repDefn,functorBody,categoryForm,e) == for [lhs:=[op,sig,:.],cond,fnsel] in fnAlist repeat u:=assoc(substitute("Rep",domainName,lhs),repFnAlist) u and not AMFCR_,redefinedList(op,functorBody) => - fnsel':=CADDR u + fnsel' := third u e:= addModemap(op,domainName,sig,cond,fnsel',e) e:= addModemap(op,domainName,sig,cond,fnsel,e) e @@ -338,7 +338,7 @@ getOperationAlist(name,functorForm,form) == substNames(domainName,viewName,functorForm,opalist) == functorForm := SUBSTQ("$$","$", functorForm) nameForDollar := - isCategoryPackageName functorForm => CADR functorForm + isCategoryPackageName functorForm => second functorForm domainName -- following calls to SUBSTQ must copy to save RPLAC's in diff --git a/src/interp/msg.boot b/src/interp/msg.boot index 07e2e174..6894bdf7 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -535,11 +535,11 @@ line? msg == getMsgTag msg = 'line getMsgPosTagOb msg == msg.1 getMsgPos msg == - getMsgFTTag? msg => CADR getMsgPosTagOb msg + getMsgFTTag? msg => second getMsgPosTagOb msg getMsgPosTagOb msg getMsgPos2 msg == - getMsgFTTag? msg => CADDR getMsgPosTagOb msg + getMsgFTTag? msg => third getMsgPosTagOb msg ncBug('"not a from to",[]) getMsgFTTag? msg == IFCAR member (IFCAR getMsgPosTagOb msg,_ diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index 475a8013..0f62de70 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -717,7 +717,7 @@ brightPrintHighlight(x, out == $OutputStream) == sayString('"(",out) brightPrint1(key,out) if EQ(key,'TAGGEDreturn) then - rst:=[CAR rst,CADR rst,CADDR rst, '"environment (omitted)"] + rst:=[CAR rst,second rst,third rst, '"environment (omitted)"] for y in rst repeat sayString('" ",out) brightPrint1(y,out) @@ -744,7 +744,7 @@ brightPrintHighlightAsTeX(x, out == $OutputStream) == sayString('"(",out) brightPrint1(key,out) if EQ(key,'TAGGEDreturn) then - rst:=[CAR rst,CADR rst,CADDR rst, '"environment (omitted)"] + rst:=[CAR rst,second rst,third rst, '"environment (omitted)"] for y in rst repeat sayString('" ",out) brightPrint1(y,out) diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index f8b4cb4a..909302a7 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -433,8 +433,8 @@ $symbolTable := nil exp2FortSpecial(op,args,nargs) == op = "CONCAT" and first args in ["<",">","<=",">=","~","and","or"] => mkFortFn(first args,CDADAR rest args,#(CDADAR rest args)) - op = "CONCAT" and CADR(args)="EQ" => - mkFortFn("EQ",[first args, CADDR args],2) + op = "CONCAT" and second(args)="EQ" => + mkFortFn("EQ",[first args, third args],2) --the next line is NEVER used by FORTRAN code but is needed when -- called to get a linearized form for the browser op = "QUOTE" => @@ -713,7 +713,7 @@ fortFormatCharacterTypes(names) == genuineArrays := [] for u in names repeat ATOM u => sortedByLength := insertEntry(0,u,sortedByLength) - #u=2 => sortedByLength := insertEntry(CADR u,CAR u,sortedByLength) + #u=2 => sortedByLength := insertEntry(second u,CAR u,sortedByLength) genuineArrays := [u,:genuineArrays] for u in sortedByLength repeat fortFormatTypes1(mkCharName car u, [STRINGIMAGE(s) for s in cdr(u)]) where diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index 9f548288..7042c23c 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -269,7 +269,7 @@ newLookupInDomain(op,sig,addFormDomain,dollar,index) == --======================================================= newLookupInCategories(op,sig,dom,dollar) == slot4 := dom.4 - catVec := CADR slot4 + catVec := second slot4 SIZE catVec = 0 => nil --early exit if no categories INTEGERP KDR catVec.0 => newLookupInCategories1(op,sig,dom,dollar) --old style @@ -454,8 +454,8 @@ lazyMatchArg2(s,a,dollar,domain,typeFlag) == IDENTP s and PNAME s = a atom a => a = s op := opOf a - op = 'NRTEVAL => s = nrtEval(CADR a,domain) - op = 'QUOTE => s = CADR a + op = 'NRTEVAL => s = nrtEval(second a,domain) + op = 'QUOTE => s = second a lazyMatch(s,a,dollar,domain) --above line is temporarily necessary until system is compiled 8/15/90 --s = a @@ -648,7 +648,7 @@ newHasTest(domform,catOrAtt) == [pred,:l] := x pred = "has" => l is [ w1,['ATTRIBUTE,w2]] => newHasTest(w1,w2) - l is [ w1,['SIGNATURE,:w2]] => compiledLookup(CAR w2,CADR w2, eval mkEvalable w1) + l is [ w1,['SIGNATURE,:w2]] => compiledLookup(CAR w2,second w2, eval mkEvalable w1) newHasTest(first l ,first rest l) pred = 'OR => or/[evalCond i for i in l] pred = 'AND => and/[evalCond i for i in l] diff --git a/src/interp/nrungo.boot b/src/interp/nrungo.boot index 3943f6cf..9b8d74b9 100644 --- a/src/interp/nrungo.boot +++ b/src/interp/nrungo.boot @@ -319,7 +319,7 @@ NRTcompiledLookup(op,sig,dom) == NRTtypeHack t == ATOM t => t - CAR t = '_# => # CADR t + CAR t = '_# => # second t [CAR t,:[NRTtypeHack tt for tt in CDR t]] NRTgetMinivectorIndex(u,op,sig,domVector) == diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index 0d62cbac..7f225a6c 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -130,9 +130,9 @@ orderBySubsumption items == for [a,b,:.] in subacc | b repeat --NOTE: b = nil means that the signature a will appear in acc, that this -- entry is be ignored (e.g. init: -> $ in ULS) - while (u := assoc(b,subacc)) repeat b := CADR u + while (u := assoc(b,subacc)) repeat b := second u u := assoc(b,acc) or systemError nil - if null CADR u then u := [CAR u,1] --mark as missing operation + if null second u then u := [CAR u,1] --mark as missing operation y := [[a,'Subsumed],u,:y] --makes subsuming signature follow one subsumed z := insert(b,z) --mark a signature as already present [:y,:[w for (w := [c,:.]) in acc | not member(c,z)]] --add those not subsuming @@ -166,7 +166,7 @@ stuffDomainSlots dollar == VECP CDDR proto4 => [COPY_-SEQ CAR proto4,:CDR proto4] --old style bitVector := dollar.3 predvec := CAR proto4 - packagevec := CADR proto4 + packagevec := second proto4 auxvec := LIST2VEC [fn for i in 0..MAXINDEX predvec] where fn() == null testBitVector(bitVector,predvec.i) => nil packagevec.i or true @@ -594,8 +594,8 @@ dcCats con == VECP CDDR u => dcCats1 con --old style slot4 $predvec:= getConstructorPredicatesFromDB con catpredvec := CAR u - catinfo := CADR u - catvec := CADDR u + catinfo := second u + catvec := third u for i in 0..MAXINDEX catvec repeat sayBrightlyNT bright i form := catvec.i @@ -612,7 +612,7 @@ dcCats con == dcCats1 con == $predvec:= getConstructorPredicatesFromDB con u := $infovec.3 - catvec := CADR u + catvec := second u catinfo := CAR u for i in 0..MAXINDEX catvec repeat sayBrightlyNT bright i @@ -674,8 +674,8 @@ dcSize(:options) == aSize := numberOfNodes infovec.2 slot4 := infovec.3 catvec := - VECP CDDR slot4 => CADR slot4 - CADDR slot4 + VECP CDDR slot4 => second slot4 + third slot4 n := MAXINDEX catvec cSize := sum(nodeSize(2),vectorSize(SIZE CAR slot4),vectorSize(n + 1), nodeSize(+/[numberOfNodes catvec.i for i in 0..n])) @@ -849,7 +849,7 @@ extendsCategoryBasic0(dom,u,v) == uVec := (compMakeCategoryObject(u,$EmptyEnvironment)).expr null atom c and isCategoryForm(c,nil) => slot4 := uVec.4 - LASSOC(c,CADR slot4) is [=p,:.] + LASSOC(c,second slot4) is [=p,:.] slot2 := uVec.2 LASSOC(c,slot2) is [=p,:.] extendsCategoryBasic(dom,u,v) @@ -879,7 +879,7 @@ catExtendsCat?(u,v,uvec) == PRINT similarForm sayBrightlyNT '" but not " PRINT v - or/[catExtendsCat?(x,v,nil) for x in ASSOCLEFT CADR slot4] + or/[catExtendsCat?(x,v,nil) for x in ASSOCLEFT second slot4] substSlotNumbers(form,template,domain) == form is [op,:.] and diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot index 3927d69a..20227e79 100644 --- a/src/interp/pf2atree.boot +++ b/src/interp/pf2atree.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -277,7 +277,7 @@ pfApplication2Atree pf == typeList := [pf2Atree1 arg for arg in (pf0TupleParts)(CAR args)] else typeList := [pf2Atree1 CAR args] - args := [pf2Atree1 CADR args, :typeList] + args := [pf2Atree1 second args, :typeList] [mkAtreeNodeWithSrcPos("Mapping", opPf), :args] (symEqual)(op, '":") and $insideRule = 'left => @@ -321,7 +321,7 @@ pfApplication2Atree pf == -- handle package call (pfFromdom?)(opPf) => opAtree := pf2Atree1 opPf - [CAR opAtree, CADR opAtree, [CADDR opAtree, :argAtree]] + [CAR opAtree, second opAtree, [third opAtree, :argAtree]] -- regular call [mkAtreeNodeWithSrcPos(op,opPf), :argAtree] @@ -337,7 +337,7 @@ pfApplication2Atree pf == -- handle package call (pfFromdom?)(opPf) => opAtree := pf2Atree1 opPf - [CAR opAtree, CADR opAtree, [CADDR opAtree, pf2Atree1 args]] + [CAR opAtree, second opAtree, [third opAtree, pf2Atree1 args]] -- regular call [mkAtreeNodeWithSrcPos(op,opPf), pf2Atree1 args] @@ -550,6 +550,6 @@ pfCollect2Atree pf == -- name := GENSYM() -- argList := pf0TupleParts args -- lhsSex := pf2Atree1 CAR argList --- rhsSex := pf2Atree CADR argList +-- rhsSex := pf2Atree second argList -- $predicateList := [[name, lhsSex, :rhsSex], :$predicateList] -- name diff --git a/src/interp/pile.boot b/src/interp/pile.boot index 68f040fe..4f749ba9 100644 --- a/src/interp/pile.boot +++ b/src/interp/pile.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -137,7 +137,7 @@ pileCforest x== else enPile separatePiles x firstTokPosn t== tokPosn CAAR t -lastTokPosn t== tokPosn CADR t +lastTokPosn t== tokPosn second t separatePiles x== if null x diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot index 4b17f3c1..032bca6a 100644 --- a/src/interp/pspad1.boot +++ b/src/interp/pspad1.boot @@ -267,7 +267,7 @@ format(x,:options) == 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 CAR argl).0 => - formatDollar1(CAR argl,CADR argl) + formatDollar1(CAR argl,second argl) fn:= GETL(op,"PSPAD") => formatFn(fn,x,$m,$c) if op in '(AND OR NOT) then op:= DOWNCASE op n=1 and GETL(op,'Nud) and (lbp:= formatOpBindingPower(op,"Nud","left")) => diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot index 6aa764af..16fe4168 100644 --- a/src/interp/ptrees.boot +++ b/src/interp/ptrees.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2008, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -275,7 +275,7 @@ pfAdd(pfbase, pfaddin,:addon) == pfAdd?(pf) == pfAbSynOp? (pf, 'Add) pfAddBase pf == second pf -- was ==> pfAddAddin pf == third pf -- was ==> -pfAddAddon pf == CADDDR pf -- was ==> +pfAddAddon pf == fourth pf -- was ==> pf0AddBase pf == pfParts pfAddBase pf @@ -296,7 +296,7 @@ pfWith(pfbase, pfwithin,pfwithon) == pfWith?(pf) == pfAbSynOp? (pf, 'With) pfWithBase pf == second pf -- was ==> pfWithWithin pf == third pf -- was ==> -pfWithWithon pf == CADDDR pf -- was ==> +pfWithWithon pf == fourth pf -- was ==> pf0WithBase pf == pfParts pfWithBase pf pf0WithWithin pf == pfParts pfWithWithin pf @@ -307,7 +307,7 @@ pfWIf(pfcond, pfthen, pfelse) == pfTree('WIf, [pfcond, pfthen, pfelse]) pfWIf?(pf) == pfAbSynOp? (pf, 'WIf) pfWIfCond pf == second pf -- was ==> pfWIfThen pf == third pf -- was ==> -pfWIfElse pf == CADDDR pf -- was ==> +pfWIfElse pf == fourth pf -- was ==> -- WDeclare := (Signature: Typed, Doc: ? Document) @@ -404,7 +404,7 @@ pfbody]) pfLambda?(pf) == pfAbSynOp? (pf, 'Lambda) pfLambdaArgs pf == second pf -- was ==> pfLambdaRets pf == third pf -- was ==> -pfLambdaBody pf == CADDDR pf -- was ==> +pfLambdaBody pf == fourth pf -- was ==> pf0LambdaArgs pf == pfParts pfLambdaArgs pf pfFix pf== pfApplication(pfId "Y",pf) @@ -415,7 +415,7 @@ pfTLambda(pfargs, pfrets, pfbody) == pfTree('TLambda, [pfargs, pfrets, pfbody]) pfTLambda?(pf) == pfAbSynOp? (pf, 'TLambda) pfTLambdaArgs pf == second pf -- was ==> pfTLambdaRets pf == third pf -- was ==> -pfTLambdaBody pf == CADDDR pf -- was ==> +pfTLambdaBody pf == fourth pf -- was ==> pf0TLambdaArgs pf == pfParts pfTLambdaArgs pf @@ -443,7 +443,7 @@ pfIf(pfcond, pfthen, pfelse) == pfTree('If, [pfcond, pfthen, pfelse]) pfIf?(pf) == pfAbSynOp? (pf, 'If) pfIfCond pf == second pf -- was ==> pfIfThen pf == third pf -- was ==> -pfIfElse pf == CADDDR pf -- was ==> +pfIfElse pf == fourth pf -- was ==> -- %Match := (Expr: Expr, Alts: [Exit]) diff --git a/src/interp/scan.boot b/src/interp/scan.boot index e6beeb2a..21b849f4 100644 --- a/src/interp/scan.boot +++ b/src/interp/scan.boot @@ -167,7 +167,7 @@ scanKeyWords == [ _ scanKeyTableCons()== KeyTable:=MAKE_-HASHTABLE("CVEC",true) for st in scanKeyWords repeat - HPUT(KeyTable,CAR st,CADR st) + HPUT(KeyTable,CAR st,second st) KeyTable scanKeyTable:=scanKeyTableCons() @@ -247,7 +247,7 @@ for i in [ _ ["LARROW" ,"<-"], _ ["BAR" ,"|"], _ ["SEG" ,".."] _ - ] repeat MAKEPROP(CAR i,'INFGENERIC,CADR i) + ] repeat MAKEPROP(CAR i,'INFGENERIC,second i) -- Scanner diff --git a/src/interp/sfsfun.boot b/src/interp/sfsfun.boot index a740f3d5..b26c2dd6 100644 --- a/src/interp/sfsfun.boot +++ b/src/interp/sfsfun.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -80,7 +80,7 @@ nangenericcomplex () == fracpart(x) == - CADR(MULTIPLE_-VALUE_-LIST(FLOOR(x))) + second(MULTIPLE_-VALUE_-LIST(FLOOR(x))) intpart(x) == CAR(MULTIPLE_-VALUE_-LIST(FLOOR(x))) @@ -157,7 +157,7 @@ gammaRatapprox (x) == Pi := PI lx := MULTIPLE_-VALUE_-LIST(FLOOR(x)) intpartx := CAR(lx)+1 - restx := CADR(lx) + restx := second(lx) if ZEROP restx -- case of negative non-integer value then FloatError ('"Gamma undefined for non-positive integers: ~D",x) @@ -237,7 +237,7 @@ cgammaG(z1,z2) == LOG(2*PI) + PI*z2 - COMPLEX(0.0,1.0)*PI*(z1-.5) logH(z1,z2,z) == - z1bar := CADR(MULTIPLE_-VALUE_-LIST(FLOOR(z1))) ---frac part of z1 + z1bar := second(MULTIPLE_-VALUE_-LIST(FLOOR(z1))) ---frac part of z1 piz1bar := PI*z1bar piz2 := PI*z2 twopiz2 := 2.0*piz2 @@ -814,7 +814,7 @@ besselIback(v,z) == lm := MULTIPLE_-VALUE_-LIST(FLOOR(rpv)) m := CAR(lm) --- floor of real part of v n := 2*MAX(20,m+10) --- how large the back recurrence should be - tv := CADR(lm)+(v-rpv) --- fractional part of real part of v + tv := second(lm)+(v-rpv) --- fractional part of real part of v --- plus imaginary part of v vp1 := tv+1.0; result := BesselIBackRecur(v,m,tv,z,'"I",n) diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 887af990..b70c3206 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007, Gabriel Dos Reis. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -163,7 +163,7 @@ devaluateSlotDomain(u,dollar) == getCategoriesOfDomain domain == predkeyVec := domain.4.0 - catforms := CADR domain.4 + catforms := second domain.4 [fn for i in 0..MAXINDEX predkeyVec | test] where test() == predkeyVec.i and (x := catforms . i) isnt ['DomainSubstitutionMacro,:.] diff --git a/src/interp/slam.boot b/src/interp/slam.boot index a53f8e1b..0851b32b 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -316,7 +316,7 @@ clearLocalModemaps x == compileInteractive fn == if $InteractiveMode then startTimingProcess 'compilation --following not used for common lisp - --removeUnnecessaryLastArguments CADR fn + --removeUnnecessaryLastArguments second fn if $reportCompilation then sayBrightlyI bright '"Generated LISP code for function:" pp fn diff --git a/src/interp/trace.boot b/src/interp/trace.boot index b21b18ad..ca3b3698 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -173,7 +173,7 @@ saveMapSig(funNames) == getMapSig(mapName,subName) == lmms:= get(mapName,'localModemap,$InteractiveFrame) => for mm in lmms until sig repeat - CADR mm = subName => sig:= CDAR mm + second mm = subName => sig:= CDAR mm sig getTraceOption (x is [key,:l]) == @@ -364,7 +364,7 @@ getMapSubNames(l) == subs:= nil for mapName in l repeat lmm:= get(mapName,'localModemap,$InteractiveFrame) => - subs:= APPEND([[mapName,:CADR mm] for mm in lmm],subs) + subs:= APPEND([[mapName,:second mm] for mm in lmm],subs) union(subs,getPreviousMapSubNames UNIONQ(_/TRACENAMES, $lastUntraced)) @@ -374,7 +374,7 @@ getPreviousMapSubNames(traceNames) == lmm:= get(mapName,'localModemap,$InteractiveFrame) => MEMQ(CADAR lmm,traceNames) => for mm in lmm repeat - subs:= [[mapName,:CADR mm],:subs] + subs:= [[mapName,:second mm],:subs] subs lassocSub(x,subs) == @@ -397,7 +397,7 @@ augmentTraceNames(l,mapSubNames) == res:= nil for traceName in l repeat mml:= get(traceName,'localModemap,$InteractiveFrame) => - res:= APPEND([CADR mm for mm in mml],res) + res:= APPEND([second mm for mm in mml],res) res:= [traceName,:res] res diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index 4d0fadc7..e182ef82 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -264,18 +264,18 @@ compNoStacking(xOrig,m,e) == markKillAllRecursive x == x is [op,:r] => ---->op = 'PART => markKillAllRecursive CADR r - op = 'PART => ['PART, CAR r, markKillAllRecursive CADR r] +--->op = 'PART => markKillAllRecursive second r + op = 'PART => ['PART, CAR r, markKillAllRecursive second r] ----------------------------------------------------------94/10/11 constructor? op => markKillAll x op = 'elt and constructor? opOf CAR r => - ['elt,markKillAllRecursive CAR r,CADR r] + ['elt,markKillAllRecursive CAR r,second r] x x compNoStackingAux($partExpression,m,e) == -----------------not used---------------------94/10/11 - x := CADDR $partExpression + x := third $partExpression T := compNoStacking0(x,m,e) or return nil markParts($partExpression,T) @@ -651,7 +651,7 @@ setqMultipleExplicit(nameList,valList,m,e) == canReturn(expr,level,exitCount,ValueFlag) == --SPAD: exit and friends atom expr => ValueFlag and level=exitCount (op:= first expr)="QUOTE" => ValueFlag and level=exitCount - op in '(WI MI) => canReturn(CADDR expr,level,count,ValueFlag) + op in '(WI MI) => canReturn(third expr,level,count,ValueFlag) op="TAGGEDexit" => expr is [.,count,data] => canReturn(data.expr,level,count,count=level) level=exitCount and not ValueFlag => nil @@ -740,16 +740,16 @@ compConstruct(form,m,e) == (T := compConstruct1(form,m,e)) and markConstruct(for compConstruct1(form is ["construct",:l],m,e) == y:= modeIsAggregateOf("List",m,e) => - T:= compList(l,["List",CADR y],e) => convert(T,m) + T:= compList(l,["List",second y],e) => convert(T,m) y:= modeIsAggregateOf("Vector",m,e) => - T:= compVector(l,["Vector",CADR y],e) => convert(T,m) + T:= compVector(l,["Vector",second y],e) => convert(T,m) T:= compForm(form,m,e) => T for D in getDomainsInScope e repeat (y:=modeIsAggregateOf("List",D,e)) and - (T:= compList(l,["List",CADR y],e)) and (T':= convert(T,m)) => + (T:= compList(l,["List",second y],e)) and (T':= convert(T,m)) => return T' (y:=modeIsAggregateOf("Vector",D,e)) and - (T:= compVector(l,["Vector",CADR y],e)) and (T':= convert(T,m)) => + (T:= compVector(l,["Vector",second y],e)) and (T':= convert(T,m)) => return T' compPretend(u := ["pretend",x,t],m,e) == @@ -811,7 +811,7 @@ coerce(T,m) == '"function coerce called from the interpreter."]) --==================> changes <====================== --The following line is inappropriate for our needs::: ---rplac(CADR T,substitute("$",$Rep,CADR T)) +--rplac(second T,substitute("$",$Rep,second T)) T' := coerce0(T,m) => T' T := [T.expr,fullSubstitute("$",$Representation,T.mode),T.env] --==================> changes <====================== diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 6e18448c..f11f6b4f 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -108,7 +108,7 @@ compDefineFunctor1(df, m,$e,$prefix,$formalArgList) == $uncondAlist: local := nil -->>-- next global initialized here, reset by buildFunctor $NRTslot1PredicateList: local := - REMDUP [CADR x for x in attributeList] + REMDUP [second x for x in attributeList] -->>-- next global initialized here, used by NRTgenAttributeAlist (NRUNOPT) $NRTattributeAlist: local := NRTgenInitialAttributeAlist attributeList $NRTslot1Info: local := nil --set in NRTmakeSlot1Info @@ -542,7 +542,7 @@ compFormWithModemap1(form,m,e,modemap,Rep2Dollar?) == op = "elt" and f is ['XLAM,:.] and IDENTP(z:=CAR argl) and (c:=get(z,'condition,e)) and c is [["case",=z,c1]] and - (c1 is ['_:,=(CADR argl),=m] or EQ(c1,CADR argl) ) => + (c1 is ['_:,=(second argl),=m] or EQ(c1,second argl) ) => -- first is a full tag, as placed by getInverseEnvironment -- second is what getSuccessEnvironment will place there ["CDR",z] @@ -855,7 +855,7 @@ compIterator(it,e) == stackMessage ["final value of index: ",final," must be an integer"] optFinal:= [final] indexmode:= - comp(CADDR it,$NonNegativeInteger,e) => $NonNegativeInteger + comp(third it,$NonNegativeInteger,e) => $NonNegativeInteger $Integer -- markImport ['Segment,indexmode] if null get(index,"mode",e) then [.,.,e]:= @@ -937,10 +937,10 @@ compRepeatOrCollect(form,m,e) == repeatOrCollect="COLLECT" => targetMode = '$EmptyMode => '$EmptyMode (u:=modeIsAggregateOf('List,targetMode,e)) => - CADR u + second u (u:=modeIsAggregateOf('Vector,targetMode,e)) => repeatOrCollect:='COLLECTV - CADR u + second u stackMessage('"Invalid collect bodytype") return nil -- If we're doing a collect, and the type isn't conformable @@ -1073,7 +1073,7 @@ doItSeq item == doItDomain item == -- convert naked top level domains to import u:= ["import", [first item,:rest item]] - markImport CADR u + markImport second u stackWarning ["Use: import ", [first item,:rest item]] --wiReplaceNode(item, u, 14) RPLACA(item, first u) @@ -1134,7 +1134,7 @@ doItDef item == chk(item,3) RPLACA(item,"CodeDefine") --Note that DescendCode, in CodeDefine, is looking for this - RPLACD(CADR item,[$signatureOfForm]) + RPLACD(second item,[$signatureOfForm]) chk(item,4) --This is how the signature is updated for buildFunctor to recognise --+ diff --git a/src/interp/word.boot b/src/interp/word.boot index b5fbaf71..93570f76 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -1,5 +1,7 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. +-- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without -- modification, are permitted provided that the following conditions are @@ -46,7 +48,7 @@ buildWordTable u == HPUT(table,key, listSort(function GLESSEQP,removeDupOrderedAlist listSort(function GLESSEQP, HGET(table,key),function CAR), - function CADR)) + function second)) table writeFunctionTables(filemode) == |