diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-05-08 16:42:11 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-05-08 16:42:11 +0000 |
| commit | 20462739ac81a89fa81ff9576969c7a8d8952ea3 (patch) | |
| tree | 7a244e33858c5d50dfd225d1405d4487bfe8fc08 /src | |
| parent | 9306af57a53ceace77f8f0cfea65f6ceed76d5c1 (diff) | |
| download | open-axiom-20462739ac81a89fa81ff9576969c7a8d8952ea3.tar.gz | |
* interp/as.boot: Replace uses of RPLACA and RPLACD with explicit
assignment to first and rest fields.
* interp/astr.boot: Likewise.
* interp/br-con.boot: Likewise.
* interp/br-data.boot: Likewise.
* interp/br-op1.boot: Likewise.
* interp/br-saturn.boot: Likewise.
* interp/buildom.boot: Likewise.
* interp/c-doc.boot: Likewise.
* interp/c-util.boot: Likewise.
* interp/cattable.boot: Likewise.
* interp/clam.boot: Likewise.
* interp/compiler.boot: Likewise.
* interp/compress.boot: Likewise.
* interp/cparse.boot: Likewise.
* interp/cstream.boot: Likewise.
* interp/database.boot: Likewise.
* interp/define.boot: Likewise.
* interp/dq.boot: Likewise.
* interp/functor.boot: Likewise.
* interp/g-opt.boot: Likewise.
* interp/g-util.boot: Likewise.
* interp/guess.boot: Likewise.
* interp/ht-util.boot: Likewise.
* interp/i-analy.boot: Likewise.
* interp/i-coerfn.boot: Likewise.
* interp/i-funsel.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/i-util.boot: Likewise.
* interp/interop.boot: Likewise.
* interp/mark.boot: Likewise.
* interp/modemap.boot: Likewise.
* interp/msgdb.boot: Likewise.
* interp/newfort.boot: Likewise.
* interp/nruncomp.boot: Likewise.
* interp/nrunopt.boot: Likewise.
* interp/packtran.boot: Likewise.
* interp/showimp.boot: Likewise.
* interp/termrw.boot: Likewise.
* interp/topics.boot: Likewise.
* interp/trace.boot: Likewise.
* interp/wi2.boot: Likewise.
* interp/word.boot: Likewise.
Diffstat (limited to 'src')
48 files changed, 299 insertions, 243 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index e61b253f..4e398ec1 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,56 @@ 2010-05-08 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/as.boot: Replace uses of RPLACA and RPLACD with explicit + assignment to first and rest fields. + * interp/astr.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/br-data.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-saturn.boot: Likewise. + * interp/buildom.boot: Likewise. + * interp/c-doc.boot: Likewise. + * interp/c-util.boot: Likewise. + * interp/cattable.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/compress.boot: Likewise. + * interp/cparse.boot: Likewise. + * interp/cstream.boot: Likewise. + * interp/database.boot: Likewise. + * interp/define.boot: Likewise. + * interp/dq.boot: Likewise. + * interp/functor.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/g-util.boot: Likewise. + * interp/guess.boot: Likewise. + * interp/ht-util.boot: Likewise. + * interp/i-analy.boot: Likewise. + * interp/i-coerfn.boot: Likewise. + * interp/i-funsel.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/i-util.boot: Likewise. + * interp/interop.boot: Likewise. + * interp/mark.boot: Likewise. + * interp/modemap.boot: Likewise. + * interp/msgdb.boot: Likewise. + * interp/newfort.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/packtran.boot: Likewise. + * interp/showimp.boot: Likewise. + * interp/termrw.boot: Likewise. + * interp/topics.boot: Likewise. + * interp/trace.boot: Likewise. + * interp/wi2.boot: Likewise. + * interp/word.boot: Likewise. + +2010-05-08 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/parser.boot (bpArgumentList): New. (bpParenthesizedApplication): Use it. New. (bpPrimary1): Use it to implement function call with explicit diff --git a/src/interp/as.boot b/src/interp/as.boot index bf51cee0..06c61e6c 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -248,7 +248,7 @@ displayDatabase x == main where zeroOneConversion opAlist == opAlist -- for u in opAlist repeat -- [op,:.] := u --- DIGITP (PNAME op).0 => RPLACA(u, string2Integer PNAME op) +-- DIGITP (PNAME op).0 => u.first := string2Integer PNAME op -- opAlist asyDisplay(con,alist) == diff --git a/src/interp/astr.boot b/src/interp/astr.boot index 16a3764c..32f656fb 100644 --- a/src/interp/astr.boot +++ b/src/interp/astr.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -77,8 +77,8 @@ ncPutQ(x,k,v) == r := QASSQ(k,ncAlist x) if null r then r := [[k,:v], :ncAlist x] - RPLACA(x,[ncTag x,:r]) + x.first := [ncTag x,:r] else - RPLACD(r,v) + r.rest := v v diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index 90ab75ed..beead1b9 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -105,7 +105,7 @@ conPageConEntry entry == --% form := IFCAR options --% isFile := null kind --% kind := kind or '"package" ---% RPLACA(parts,kind) +--% parts.first := kind --% conform := mkConform(kind,name,args) --% conname := opOf conform --% capitalKind := capitalize kind @@ -267,7 +267,8 @@ domainDescendantsOf(conform,domform) == main where --called by kargPage u := assoc(item,alist) => keepList := [[item,:quickAnd(rest u,pred)],:keepList] alist := keepList - for pair in alist repeat RPLACD(pair,simpHasPred rest pair) + for pair in alist repeat + pair.rest := simpHasPred rest pair listSort(function GLESSEQP, alist) catScreen(r,alist) == for x in r repeat @@ -510,7 +511,8 @@ kcpPage(htPage,junk) == reduceAlistForDomain(alist,domform,conform) == --called from kccPage alist := SUBLISLIS(rest domform,rest conform,alist) - for pair in alist repeat RPLACD(pair,simpHasPred(rest pair,domform)) + for pair in alist repeat + pair.rest := simpHasPred(rest pair,domform) [pair for (pair := [.,:pred]) in alist | pred] kcaPage(htPage,junk) == @@ -747,7 +749,7 @@ conOpPage1(conform,:options) == [kind,name,nargs,xflag,sig,args,abbrev,comments]:=parts:= dbXParts(line,7,1) isFile := null kind kind := kind or '"package" - RPLACA(parts,kind) + parts.first := kind constring := STRCONC(name,args) conform := mkConform(kind,name,args) capitalKind := capitalize kind @@ -1189,7 +1191,7 @@ dbSpecialExpandIfNecessary(conform,opAlist) == for [op,:u] in opAlist repeat for pair in u repeat [sig,comments] := pair - RPLACD(pair,['T,conform,'T,comments]) --[sig,pred,origin,exposeFg,doc] + pair.rest := ['T,conform,'T,comments] --[sig,pred,origin,exposeFg,doc] opAlist X := '"{\sf Record(a:A,b:B)} is used to create the class of pairs of objects made up of a value of type {\em A} selected by the symbol {\em a} and a value of type {\em B} selected by the symbol {\em b}. " diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 56f74854..3c2a0ec0 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -651,7 +651,7 @@ ancestorsAdd(pred,form) == --called by ancestorsRecur op := IFCAR form or form alist := HGET($if,op) existingNode := assoc(form,alist) => - RPLACD(existingNode,quickOr(rest existingNode,pred)) + existingNode.rest := quickOr(rest existingNode,pred) HPUT($if,op,[[form,:pred],:alist]) domainsOf(conform,domname,:options) == @@ -698,8 +698,8 @@ transKCatAlist(conform,domname,s) == main where --conform has no arguments so each pair has form [con,:pred] for pair in s repeat leftForm := getConstructorForm first pair or systemError nil - RPLACA(pair,leftForm) - RPLACD(pair,sublisFormal(KDR leftForm,rest pair)) + pair.first := leftForm + pair.rest := sublisFormal(KDR leftForm,rest pair) s --no domname, so look for special argument combinations acc := nil @@ -720,8 +720,8 @@ transKCatAlist(conform,domname,s) == main where nreverse acc for pair in s repeat --pair has form [con,:pred] leftForm := getConstructorForm first pair - RPLACA(pair,leftForm) - RPLACD(pair,sublisFormal(KDR leftForm,rest pair)) + pair.first := leftForm + pair.rest := sublisFormal(KDR leftForm,rest pair) s mkHasArgsPred subargs == @@ -745,7 +745,7 @@ sublisFormal(args,exp,:options) == main where r := nreverse acc if y then nd := LASTNODE r - RPLACD(nd,sublisFormal1(args,y,n)) + nd.rest := sublisFormal1(args,y,n) r IDENTP x => j := or/[i for f in $formals for i in 0..n | EQ(f,x)] => diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index 3bc64cf3..2a213f67 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -535,13 +535,14 @@ dbShowOpAllDomains(htPage,opAlist,which) == | LASSQ(rest key,catOriginAlist)] for pair in u repeat [dom,:cat] := pair - LASSQ(cat,catOriginAlist) = 'etc => RPLACD(pair,'etc) - RPLACD(pair,simpOrDumb(constructorHasCategoryFromDB pair,true)) + LASSQ(cat,catOriginAlist) = 'etc => pair.rest := 'etc + pair.rest := simpOrDumb(constructorHasCategoryFromDB pair,true) --now add all of the domains for [dom,:pred] in domOriginAlist repeat u := insertAlist(dom,simpOrDumb(pred,LASSQ(dom,u) or true),u) cAlist := listSort(function GLESSEQP,u) - for pair in cAlist repeat RPLACA(pair,getConstructorForm first pair) + for pair in cAlist repeat + pair.first := getConstructorForm first pair htpSetProperty(htPage,'cAlist,cAlist) htpSetProperty(htPage,'thing,'"constructor") htpSetProperty(htPage,'specialHeading,'"hoho") @@ -660,7 +661,7 @@ dbShowOpDocumentation(htPage,opAlist,which,data) == MEMQ(k,'(0 1)) => '"" dbReadComments k tail := CDDDDR item - RPLACA(tail,comments) + tail.first := comments doc := (string? comments and comments ~= '"" => comments; nil) pred := predicate or true index := (exactlyOneOpSig => nil; base + j) @@ -733,12 +734,12 @@ reduceOpAlistForDomain(opAlist,domform,conform) == form1 := [domform,:rest domform] form2 := ['$,:rest conform] for pair in opAlist repeat - RPLACD(pair,[test for item in rest pair | test]) where test() == + pair.rest := [test for item in rest pair | test] where test() == [head,:tail] := item first tail = true => item pred := simpHasPred SUBLISLIS(form1,form2,QCAR tail) null pred => false - RPLACD(item,[pred]) + item.rest := [pred] item opAlist @@ -833,7 +834,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == exposeFlag := dbExposed?(line,char 'o) acc := [[sig,predicate,origin,exposeFlag,comments],:acc] --always store the fruits of our labor: - RPLACD(pair,nreverse acc) --at least partially expand it + pair.rest := nreverse acc --at least partially expand it condition? and value => return value --early exit value => value condition? => nil @@ -865,7 +866,7 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == docCode := IFCDR u --> (doc . code) -- if null FIXP rest docCode then harhar(op) --> if null doc and which = '"attribute" then doc := getRegistry(op,sig) - RPLACD(tail,[origin,isExposedConstructor opOf origin,:docCode]) + tail.rest := [origin,isExposedConstructor opOf origin,:docCode] $value => return $value $value => $value condition? => nil diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index e5bcb8b6..261137b2 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -621,7 +621,7 @@ kPage(line,:options) == --any cat, dom, package, default package form := IFCAR options isFile := null kind kind := kind or '"package" - RPLACA(parts,kind) + parts.first := kind conform := mkConform(kind,name,args) $kPageSaturnArguments: local := rest conform conname := opOf conform diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 94d9a775..175f1acb 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -113,11 +113,11 @@ RecordEqual(x,y,dom) == cons? x => b:= SPADCALL(first x, first y, first(dom.(nargs + 9)) or - first RPLACA(dom.(nargs + 9),findEqualFun(dom.$FirstParamSlot))) + first (dom.(nargs + 9).first := findEqualFun(dom.$FirstParamSlot))) nargs = 1 => b b and SPADCALL(rest x, rest y, rest (dom.(nargs + 9)) or - rest RPLACD(dom.(nargs + 9),findEqualFun(dom.($FirstParamSlot+1)))) + rest (dom.(nargs + 9).rest := findEqualFun(dom.($FirstParamSlot+1)))) VECP x => equalfuns := dom.(nargs + 9) and/[SPADCALL(x.i,y.i,equalfuns.i or _ diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 0aa8a5f9..32332448 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -127,7 +127,7 @@ collectAndDeleteAssoc x == while s and first s is [=x,:r] repeat res := [:res,:r] s := rest s - RPLACD(y,s) + y.rest := s res finalizeDocumentation() == @@ -508,7 +508,7 @@ appendOver [head,:tail] == acc := LASTNODE head for x in tail repeat end := LASTNODE x - RPLACD(acc,x) + acc.rest := x acc := end head diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index 566a6dad..c98f668c 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -267,7 +267,7 @@ unErrorRef s == consProplistOf(var,proplist,prop,val) == semchkProplist(var,proplist,prop,val) $InteractiveMode and (u:= assoc(prop,proplist)) => - RPLACD(u,val) + u.rest := val proplist [[prop,:val],:proplist] @@ -360,7 +360,7 @@ addContour(c,E is [cur,:tail]) == if member(x,$getPutTrace) then pp([x,"has",pv]) if p="conditionalmode" then - RPLACA(pv,"mode") + pv.first := "mode" --check for conflicts with earlier mode if vv:=LASSOC("mode",e) then if v ~=vv then @@ -1290,7 +1290,7 @@ backendCompileNEWNAM x == if y = "CLOSEDFN" then u := MAKE_-CLOSEDFN_-NAME() PUSH([u,second x], $CLOSEDFNS) - RPLACA(x,"FUNCTION") + x.first := "FUNCTION" RPLACA(rest x,u) backendCompileNEWNAM first x backendCompileNEWNAM rest x @@ -1481,14 +1481,14 @@ mutateToBackendCode x == isAtomicForm x => nil -- temporarily have TRACELET report MAKEPROPs. if (u := first x) = "MAKEPROP" and $TRACELETFLAG then - RPLACA(x,"MAKEPROP-SAY") + x.first := "MAKEPROP-SAY" u in '(DCQ RELET PRELET SPADLET SETQ %LET) => if u ~= "DCQ" then $NEWSPAD or $FUNAME in $traceletFunctions => nconc(x,$FUNNAME__TAIL) - RPLACA(x,"LETT") - $TRACELETFLAG => RPLACA(x,"/TRACE-LET") - u = "%LET" => RPLACA(x,"SPADLET") + x.first := "LETT" + $TRACELETFLAG => x.first := "/TRACE-LET" + u = "%LET" => x.first := "SPADLET" mutateToBackendCode CDDR x if not (u in '(SETQ RELET)) then IDENTP second x => pushLocalVariable second x @@ -1497,7 +1497,7 @@ mutateToBackendCode x == rplac(second x, CADADR x) MAPC(function pushLocalVariable, LISTOFATOMS second x) IDENTP u and GET(u,"ILAM") ~= nil => - RPLACA(x, eval u) + x.first := eval u mutateToBackendCode x u in '(PROG LAMBDA) => newBindings := [] @@ -1574,8 +1574,8 @@ transformToBackendCode x == RPLACD(rest x, body) else null fluids => - RPLACD(lastdecl, body) - RPLACD(lastdecl, [declareGlobalVariables fluids,:body]) + lastdecl.rest := body + lastdecl.rest := [declareGlobalVariables fluids,:body] x backendCompile1 x == diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index f487146e..b55d6b62 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -77,7 +77,7 @@ genCategoryTable() == simpTempCategoryTable() == for id in HKEYS _*ANCESTORS_-HASH_* repeat for (u:=[a,:b]) in getConstructorAncestorsFromDB id repeat - RPLACD(u,simpHasPred b) + u.rest := simpHasPred b simpCategoryTable() == main where main() == @@ -199,7 +199,7 @@ genTempCategoryTable() == for id in HKEYS _*ANCESTORS_-HASH_* repeat item := HGET(_*ANCESTORS_-HASH_*, id) for (u:=[.,:b]) in item repeat - RPLACD(u,simpCatPredicate simpBool b) + u.rest := simpCatPredicate simpBool b HPUT(_*ANCESTORS_-HASH_*,id,listSort(function GLESSEQP,item)) addToCategoryTable con == @@ -217,9 +217,9 @@ encodeCategoryAlist(id,alist) == argl => [[argl,:b]] b u:= assoc(key,newAl) => - argl => RPLACD(u,encodeUnion(id,first newEntry,rest u)) + argl => u.rest := encodeUnion(id,first newEntry,rest u) if newEntry ~= rest u then - p:= moreGeneralCategoryPredicate(id,newEntry,rest u) => RPLACD(u,p) + p:= moreGeneralCategoryPredicate(id,newEntry,rest u) => u.rest := p sayMSG '"Duplicate entries:" PRINT [newEntry,rest u] newAl:= [[key,:newEntry],:newAl] @@ -227,7 +227,7 @@ encodeCategoryAlist(id,alist) == encodeUnion(id,new:=[a,:b],alist) == u := assoc(a,alist) => - RPLACD(u,moreGeneralCategoryPredicate(id,b,rest u)) + u.rest := moreGeneralCategoryPredicate(id,b,rest u) alist [new,:alist] @@ -310,7 +310,7 @@ catPairUnion(oldList,newList,op,cat) == for pair in newList repeat u:= assoc(first pair,oldList) => rest u = rest pair => nil - RPLACD(u,addConflict(rest pair,rest u)) where addConflict(new,old) == + u.rest := addConflict(rest pair,rest u) where addConflict(new,old) == quickOr(new,old) oldList:= [pair,:oldList] oldList @@ -424,8 +424,8 @@ compressSexpr(x,left,right) == -- recursive version of compressHashTable atom x => nil u:= HGET($found,x) => - left => RPLACA(left,u) - right => RPLACD(right,u) + left => left.first := u + right => right.rest := u nil compressSexpr(first x,x,nil) compressSexpr(rest x,nil,x) @@ -444,14 +444,14 @@ squeeze1(l) == z:= member(x,$found) => first z $found:= CONS(x,$found) squeeze1 x - RPLACA(l,y) + l.first := y x:= rest l y:= atom x => x z:= member(x,$found) => first z $found:= CONS(x,$found) squeeze1 x - RPLACD(l,y) + l.rest := y updateCategoryTable(cname,kind) == $updateCatTableIfTrue => @@ -469,7 +469,7 @@ updateCategoryTableForCategory(cname) == addToCategoryTable(cname) for id in HKEYS _*ANCESTORS_-HASH_* repeat for (u:=[.,:b]) in getConstructorAncestorsFromDB id repeat - RPLACD(u,simpCatPredicate simpBool b) + u.rest := simpCatPredicate simpBool b updateCategoryTableForDomain(cname,category) == clearCategoryTable(cname) diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 0028ffe1..7b3dde2a 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -314,17 +314,17 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == op consForHashLookup(a,b) == - RPLACA($hashNode,a) - RPLACD($hashNode,b) + $hashNode.first := a + $hashNode.rest := b $hashNode CDRwithIncrement x == - RPLACA(x,QSADD1 first x) + x.first := QSADD1 first x rest x HGETandCount(hashTable,prop) == u:= HGET(hashTable,prop) or return nil - RPLACA(u,QSADD1 first u) + u.first := QSADD1 first u u clearClams() == @@ -395,7 +395,7 @@ displayCacheFrequency al == mkCircularCountAlist(cl,len) == for [x,count,:.] in cl for i in 1..len while x ~= '_$failed repeat - u:= assoc(count,al) => RPLACD(u,1 + rest u) + u:= assoc(count,al) => u.rest := 1 + rest u if integer? $reportFavoritesIfNumber and count >= $reportFavoritesIfNumber then sayBrightlyNT [" ",count," "] pp x @@ -412,7 +412,7 @@ reportHashCacheStats fn == mkHashCountAlist vl == for [count,:.] in vl repeat - u:= assoc(count,al) => RPLACD(u,1 + rest u) + u:= assoc(count,al) => u.rest := 1 + rest u al:= [[count,:1],:al] al @@ -454,8 +454,8 @@ assocCacheShift(x,cacheName,fn) == --like ASSOC except that al is circular until EQ(forwardPointer,al) repeat FUNCALL(fn, first (y:=first forwardPointer),x) => if not EQ(forwardPointer,al) then --shift referenced entry to front - RPLACA(forwardPointer,first al) - RPLACA(al,y) + forwardPointer.first := first al + al.first := y return (val:= y) backPointer := forwardPointer --first is slot replaced on failure forwardPointer:= rest forwardPointer @@ -482,8 +482,8 @@ assocCacheShiftCount(x,al,fn) == forwardPointer:= rest forwardPointer if not EQ(newFrontPointer,al) then --shift referenced entry to front temp:= first newFrontPointer --or entry with smallest count - RPLACA(newFrontPointer,first al) - RPLACA(al,temp) + newFrontPointer.first := first al + al.first := temp val clamStats() == @@ -530,8 +530,8 @@ haddProp(ht,op,prop,val) == stopTimingProcess 'debug u:= HGET(ht,op) => --hope that one exists most of the time assoc(prop,u) => val --value is already there--must = val; exit now - RPLACD(u,[first u,:rest u]) - RPLACA(u,[prop,:val]) + u.rest := [first u,:rest u] + u.first := [prop,:val] $op: local := op listTruncate(u,20) --save at most 20 instantiations val @@ -561,11 +561,11 @@ recordInstantiation1(op,prop,dropIfTrue) == v := LASSOC(prop,u) => dropIfTrue => RPLAC(rest v,1+rest v) RPLAC(first v,1+first v) - RPLACD(u,[first u,:rest u]) + u.rest := [first u,:rest u] val := dropIfTrue => [0,:1] [1,:0] - RPLACA(u,[prop,:val]) + u.first := [prop,:val] val := dropIfTrue => [0,:1] [1,:0] @@ -617,7 +617,7 @@ listTruncate(l,n) == if null atom u then if null atom rest u and $reportInstantiations = true then recordInstantiation($op,CAADR u,true) - RPLACD(u,nil) + u.rest := nil l lassocShift(x,l) == @@ -627,8 +627,8 @@ lassocShift(x,l) == y:= QCDR y result => if not EQ(y,l) then - QRPLACA(y,first l) - QRPLACA(l,result) + y.first := first l + l.first := result QCDR result nil @@ -639,8 +639,8 @@ lassocShiftWithFunction(x,l,fn) == y:= QCDR y result => if not EQ(y,l) then - QRPLACA(y,first l) - QRPLACA(l,result) + y.first := first l + l.first := result QCDR result nil @@ -651,8 +651,8 @@ lassocShiftQ(x,l) == y:= rest y result => if not EQ(y,l) then - RPLACA(y,first l) - RPLACA(l,result) + y.first := first l + l.first := result rest result nil @@ -663,8 +663,8 @@ lassocShiftQ(x,l) == -- y:= rest y -- result => -- if not EQ(y,l) then --- RPLACA(y,first l) --- RPLACA(l,result) +-- y.first := first l +-- l.first := result -- first result -- nil diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 78cc6188..45b8300d 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -301,7 +301,7 @@ compWithMappingMode(x,m is ["Mapping",m',:sl],oldE) == not IDENTP u => free MEMQ(u,bound) => free v:=ASSQ(u,free) => - RPLACD(v,1 + rest v) + v.rest := 1 + rest v free null getmode(u,e) => free [[u,:1],:free] diff --git a/src/interp/compress.boot b/src/interp/compress.boot index 1d32a223..f644c037 100644 --- a/src/interp/compress.boot +++ b/src/interp/compress.boot @@ -50,9 +50,9 @@ minimalise x == -- This circular way of doing things is an attempt to deal with Lucid -- Who may place quoted cells in read-only memory z:=min first x - if not EQ(z,first x) then RPLACA(x,z) + if not EQ(z,first x) then x.first := z z:=min rest x - if not EQ(z,rest x) then RPLACD(x,z) + if not EQ(z,rest x) then x.rest := z HashCheck x REFVECP x => for i in 0..MAXINDEX x repeat diff --git a/src/interp/cparse.boot b/src/interp/cparse.boot index 9e1c1237..caeb18b8 100644 --- a/src/interp/cparse.boot +++ b/src/interp/cparse.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -111,7 +111,7 @@ npPop1()== npPop2()== a:= second $stack - RPLACD($stack,CDDR $stack) + $stack.rest := CDDR $stack a npPop3()== diff --git a/src/interp/cstream.boot b/src/interp/cstream.boot index 941faef6..b5ce37fb 100644 --- a/src/interp/cstream.boot +++ b/src/interp/cstream.boot @@ -43,8 +43,8 @@ StreamNull x== null x or x is ["nullstream",:.] => true while x is ["nonnullstream",:.] repeat st:=APPLY(second x,CDDR x) - RPLACA(x,first st) - RPLACD(x,rest st) + x.first := first st + x.rest := rest st x is ["nullstream",:.] Delay(f,x)==cons("nonnullstream",[f,:x]) diff --git a/src/interp/database.boot b/src/interp/database.boot index 93c1b632..f90e5ea6 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -673,8 +673,8 @@ loadDependents fn == markUnique x == u := first x - RPLACA(x,'(_$unique)) - RPLACD(x,[u,:rest x]) + x.first := '(_$unique) + x.rest := [u,:rest x] rest x @@ -699,10 +699,10 @@ getOperationAlistFromLisplib x == if r is [.,:s] then if s is [.,:t] then if t is [.] then nil - else RPLACD(s,QCDDR f) - else RPLACD(r,QCDR f) + else s.rest := QCDDR f + else r.rest := QCDR f else RPLACD(first items,f) - RPLACA(items,addConsDB first items) + items.first := addConsDB first items u and markUnique u getOplistForConstructorForm (form := [op,:argl]) == diff --git a/src/interp/define.boot b/src/interp/define.boot index 9ec731df..19fe2bd1 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -343,8 +343,8 @@ macroExpandInPlace: (%Form,%Env) -> %Form macroExpandInPlace(x,e) == y:= macroExpand(x,e) atom x or atom y => y - RPLACA(x,first y) - RPLACD(x,rest y) + x.first := first y + x.rest := rest y x macroExpand: (%Form,%Env) -> %Form @@ -1408,13 +1408,13 @@ compSingleCapsuleItem(item,$predl,$e) == ++ subroutine of doIt. Called to generate runtime noop insn. mutateToNothing item == - RPLACA(item,'PROGN) - RPLACD(item,NIL) + item.first := 'PROGN + item.rest := NIL doIt(item,$predl) == $GENNO: local:= 0 item is ['SEQ,:l,['exit,1,x]] => - RPLACA(item,"PROGN") + item.first := "PROGN" RPLACA(LASTNODE item,x) for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e) --This will RPLAC as appropriate @@ -1425,8 +1425,8 @@ doIt(item,$predl) == -- a cycle otherwise. u:= ["import", [first item,:rest item]] stackWarning('"Use: import %1p",[[first item,:rest item]]) - RPLACA(item,first u) - RPLACD(item,rest u) + item.first := first u + item.rest := rest u doIt(item,$predl) item is ["%LET",lhs,rhs,:.] => compOrCroak(item,$EmptyMode,$e) isnt [code,.,$e] => @@ -1434,8 +1434,8 @@ doIt(item,$predl) == not (code is ["%LET",lhs',rhs',:.] and atom lhs') => code is ["PROGN",:.] => stackSemanticError(["multiple assignment ",item," not allowed"],nil) - RPLACA(item,first code) - RPLACD(item,rest code) + item.first := first code + item.rest := rest code lhs:= lhs' if not member(KAR rhs,$NonMentionableDomainNames) and not MEMQ(lhs, $functorLocalParameters) then @@ -1447,11 +1447,11 @@ doIt(item,$predl) == if $optimizeRep then nominateForInlining $Representation code is ["%LET",:.] => - RPLACA(item,"setShellEntry") + item.first := "setShellEntry" rhsCode := rhs' - RPLACD(item,['$,NRTgetLocalIndex lhs,rhsCode]) - RPLACA(item,first code) - RPLACD(item,rest code) + item.rest := ['$,NRTgetLocalIndex lhs,rhsCode] + item.first := first code + item.rest := rest code item is [":",a,t] => [.,.,$e]:= compOrCroak(item,$EmptyMode,$e) item is ["import",:doms] => for dom in doms repeat @@ -1470,7 +1470,7 @@ doIt(item,$predl) == item is ['DEF,[op,:.],:.] => body:= isMacro(item,$e) => $e:= put(op,"macro",body,$e) [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e) - RPLACA(item,"CodeDefine") + item.first := "CodeDefine" --Note that DescendCode, in CodeDefine, is looking for this RPLACD(second item,[$signatureOfForm]) --This is how the signature is updated for buildFunctor to recognise @@ -1478,7 +1478,7 @@ doIt(item,$predl) == RPLACA(CDDR item,functionPart) RPLACD(CDDR item,nil) u:= compOrCroak(item,$EmptyMode,$e) => - ([code,.,$e]:= u; RPLACA(item,first code); RPLACD(item,rest code)) + ([code,.,$e]:= u; item.first := first code; item.rest := rest code) systemErrorHere ["doIt", item] isMacro(x,e) == @@ -1522,8 +1522,8 @@ doItIf(item is [.,p,x,y],$predl,$e) == if y~="%noBranch" then compSingleCapsuleItem(y,[["not",p],:$predl],getInverseEnvironment(p,olde)) y':=localExtras(oldFLP) - RPLACA(item,"COND") - RPLACD(item,[[p',x,:x'],['(QUOTE T),y,:y']]) + item.first := "COND" + item.rest := [[p',x,:x'],['(QUOTE T),y,:y']] where localExtras(oldFLP) == EQ(oldFLP,$functorLocalParameters) => NIL flp1:=$functorLocalParameters diff --git a/src/interp/dq.boot b/src/interp/dq.boot index e46e4897..7dbde640 100644 --- a/src/interp/dq.boot +++ b/src/interp/dq.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-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -58,7 +58,7 @@ dqAppend(x,y)== then x else RPLACD (rest x,first y) - RPLACD (x, rest y) + x.rest := rest y x dqConcat ld== @@ -77,5 +77,5 @@ dqAddAppend(x,y)== then nil else RPLACD (rest x,first y) - RPLACD (x, rest y) + x.rest := rest y x diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 54a79f75..31564fa8 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -445,7 +445,7 @@ setVector4part3(catNames,catvecList) == for u in catvecList for uname in catNames repeat for v in third u.4 repeat if w:= assoc(first v,generated) - then RPLACD(w,[[rest v,:uname],:rest w]) + then w.rest := [[rest v,:uname],:rest w] else generated:= [[first v,[rest v,:uname]],:generated] codeList := nil for [w,:u] in generated repeat @@ -462,7 +462,7 @@ setVector5(catNames,locals) == generated:= nil for u in locals for uname in catNames repeat if w:= assoc(u,generated) - then RPLACD(w,[uname,:rest w]) + then w.rest := [uname,:rest w] else generated:= [[u,uname],:generated] [(w:= mkVectorWithDeferral(first u,second u); for v in rest u repeat @@ -620,7 +620,7 @@ DescendCode(code,flag,viewAssoc,EnvToPass) == $ConstantAssignments:= [u,:$ConstantAssignments] nil u - code is ['_:,:.] => (RPLACA(code,'LIST); RPLACD(code,NIL)) + code is ['_:,:.] => (code.first := 'LIST; code.rest := NIL) --Yes, I know that's a hack, but how else do you kill a line? code is ['LIST,:.] => nil code is ['devaluate,:.] => nil diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 783900ed..73b252f8 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -250,7 +250,7 @@ optCond (x is ['COND,:l]) == if l is [[p1,:c1],[p2,:c2],:.] then if (p1 is ["NOT",=p2]) or (p2 is ["NOT",=p1]) then l:=[[p1,:c1],['(QUOTE T),:c2]] - RPLACD( x,l) + x.rest := l c1 is ['NIL] and p2 = '(QUOTE T) and first c2 = '(QUOTE T) => p1 is ["NOT",p1']=> return p1' return ["NOT",p1] diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 5e0bdd82..0e72381a 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -232,11 +232,11 @@ putIntSymTab(x,prop,val,e) == pl := null pl => [[prop,:val]] u := ASSQ(prop,pl) => - RPLACD(u,val) + u.rest := val pl lp := LASTPAIR pl u := [[prop,:val]] - RPLACD(lp,u) + lp.rest := u pl EQ(pl0,pl) => e addIntSymTabBinding(x,pl,e) @@ -244,7 +244,7 @@ putIntSymTab(x,prop,val,e) == addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) == -- change proplist of var in e destructively u := ASSQ(var,curContour) => - RPLACD(u,proplist) + u.rest := proplist e RPLAC(CAAR e,[[var,:proplist],:curContour]) e @@ -351,7 +351,7 @@ PUTALIST(alist,prop,val) == pair := assoc(prop,alist) => rest pair = val => alist -- else we fall over Lucid's read-only storage feature again - QRPLACD(pair,val) + pair.rest := val alist QRPLACD(LASTPAIR alist,[[prop,:val]]) alist @@ -360,8 +360,8 @@ REMALIST(alist,prop) == null alist => alist alist is [[ =prop,:.],:r] => null r => NIL - QRPLACA(alist,first r) - QRPLACD(alist,rest r) + alist.first := first r + alist.rest := rest r alist null rest alist => alist l := alist @@ -370,7 +370,7 @@ REMALIST(alist,prop) == [.,[p,:.],:r] := l p = prop => ok := NIL - QRPLACD(l,r) + l.rest := r if null (l := QCDR l) or null rest l then ok := NIL alist @@ -394,7 +394,7 @@ deleteAssocWOC(x,y) == x=a => t (fn(x,y);y) where fn(x,y is [h,:t]) == t is [[a,:.],:t1] => - x=a => RPLACD(y,t1) + x=a => y.rest := t1 fn(x,t) nil @@ -403,8 +403,8 @@ insertWOC(x,y) == (fn(x,y); y) where fn(x,y is [h,:t]) == x=h => nil null t => - RPLACD(y,[h,:t]) - RPLACA(y,x) + y.rest := [h,:t] + y.first := x fn(x,t) @@ -580,24 +580,24 @@ mergeInPlace(f,g,p,q) == else (r := t := q; q := QCDR q) while not null p and not null q repeat if FUNCALL(f,FUNCALL(g,QCAR p),FUNCALL(g,QCAR q)) - then (QRPLACD(t,p); t := p; p := QCDR p) - else (QRPLACD(t,q); t := q; q := QCDR q) - if null p then QRPLACD(t,q) else QRPLACD(t,p) + then (t.rest := p; t := p; p := QCDR p) + else (t.rest := q; t := q; q := QCDR q) + if null p then t.rest := q else t.rest := p r mergeSort(f,g,p,n) == if n=2 and FUNCALL(f,FUNCALL(g,QCADR p),FUNCALL(g,QCAR p)) then t := p p := QCDR p - QRPLACD(p,t) - QRPLACD(t,NIL) + p.rest := t + t.rest := NIL if QSLESSP(n,3) then return p -- split the list p into p and q of equal length l := QSQUOTIENT(n,2) t := p for i in 1..l-1 repeat t := QCDR t q := rest t - QRPLACD(t,NIL) + t.rest := NIL p := mergeSort(f,g,p,l) q := mergeSort(f,g,q,QSDIFFERENCE(n,l)) mergeInPlace(f,g,p,q) @@ -733,14 +733,14 @@ addBinding(var,proplist,e is [[curContour,:tailContour],:tailEnv]) == addBindingInteractive(var,proplist,e is [[curContour,:.],:.]) == -- change proplist of var in e destructively u := ASSQ(var,curContour) => - RPLACD(u,proplist) + u.rest := proplist e RPLAC(CAAR e,[[var,:proplist],:curContour]) e augProplistInteractive(proplist,prop,val) == u := ASSQ(prop,proplist) => - RPLACD(u,val) + u.rest := val proplist [[prop,:val],:proplist] diff --git a/src/interp/guess.boot b/src/interp/guess.boot index 87d2002e..43113eea 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-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -61,7 +61,7 @@ removeDupOrderedAlist u == -- removes duplicate entries in ordered alist -- (where duplicates are adjacent) for x in tails u repeat - (y := rest x) and first first x = first first y => RPLACD(x,rest y) + (y := rest x) and first first x = first first y => x.rest := rest y u wordsOfString(s) == [UPCASE x for x in wordsOfStringKeepCase s] @@ -182,7 +182,7 @@ findApproximateWords(word,table) == consAlist(x,y,alist) == u := ASSOC(x,alist) => - RPLACD(u,[y,:rest u]) + u.rest := [y,:rest u] alist [[x,y],:alist] @@ -268,9 +268,9 @@ rotateWordList u == v := u p := first v while QCDR v repeat - RPLACA(v,second v) + v.first := second v v := QCDR v - RPLACA(v,p) + v.first := p u deltaWordEntry(word,entry) == diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 924110d8..b7cdb90d 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -114,7 +114,7 @@ htpProperty(htPage, propName) == htpSetProperty(htPage, propName, val) == pair := assoc(propName, ELT(htPage, 6)) - pair => RPLACD(pair, val) + pair => pair.rest := val SETELT(htPage, 6, [[propName, :val], :ELT(htPage, 6)]) htpLabelInputString(htPage, label) == @@ -220,8 +220,8 @@ bcIssueHt line == mapStringize l == atom l => l - RPLACA(l, basicStringize first l) - RPLACD(l, mapStringize rest l) + l.first := basicStringize first l + l.rest := mapStringize rest l l basicStringize s == diff --git a/src/interp/i-analy.boot b/src/interp/i-analy.boot index 29319472..e1f84b04 100644 --- a/src/interp/i-analy.boot +++ b/src/interp/i-analy.boot @@ -573,7 +573,7 @@ removeUnionsAtStart(argl,modeSets) == m' := objMode val' putValue(arg,val') putModeSet(arg,[m']) - RPLACA(ms,m') + ms.first := m' modeSets printableArgModeSetList() == @@ -761,7 +761,7 @@ bottomUpFormRetract(t,op,opName,argl,amsl) == putAtree(x,'retracted,nil) ms := [m, :ms] b:= true - RPLACA(m,objMode(object)) + m.first := objMode(object) ms := [COPY_-TREE m, :ms] putAtree(x,'retracted,true) putValue(x,object) @@ -805,7 +805,7 @@ bottomUpFormAnyUnionRetract(t,op,opName,argl,amsl) == if ( (m0 = $Any) or (first m0 = 'Union) ) and ('failed ~= (object:=retract getValue x)) then b := true - RPLACA(m,objMode(object)) + m.first := objMode(object) putModeSet(x,[objMode(object)]) putValue(x,object) a := cons(x,a) @@ -828,7 +828,7 @@ bottomUpFormUntaggedUnionRetract(t,op,opName,argl,amsl) == if (m0 is ['Union, :.] and null getUnionOrRecordTags m0) and ('failed ~= (object:=retract getValue x)) then b := true - RPLACA(m,objMode(object)) + m.first := objMode(object) putModeSet(x,[objMode(object)]) putValue(x,object) a := cons(x,a) diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index c0e16277..7397569d 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -305,7 +305,7 @@ Dmp2Up(u, source is [dmp,vl,S],target is [up,var,T]) == p:= ASSQ(exp,x) => c' := SPADCALL(rest p,objValUnwrap(y),plusfunc) c' = zero => x := REMALIST(x,exp) - RPLACD(p,c') + p.rest := c' zero = objValUnwrap(y) => 'iterate x := CONS(CONS(exp,objValUnwrap(y)),x) y => nreverse SORTBY('CAR,x) @@ -377,7 +377,7 @@ Expr2Dmp(u,source is [Expr,S], target is [dmp,v2,T]) == for term in z repeat [., :c] := term not (c := coerceInt(objNewWrap(c, source), T)) => coercionFailure() - RPLACD(term, objValUnwrap c) + term.rest := objValUnwrap c z univ := objValUnwrap univ @@ -386,7 +386,7 @@ Expr2Dmp(u,source is [Expr,S], target is [dmp,v2,T]) == null rest v2 => for term in univ repeat - RPLACA(term, VECTOR first term) + term.first := VECTOR first term univ -- more than one variable diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 7bb306f4..5ac3cc8a 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -115,7 +115,7 @@ selectMms(op,args,$declaredMode) == bottomUp tree val := getValue tree types1 := [objMode val,:rest types1] - RPLACA(args,tree) + args.first := tree if numArgs = 1 and (n = "numer" or n = "denom") and isEqualOrSubDomain(first types1,$Integer) and null dc then @@ -646,7 +646,7 @@ orderMms(name, mmS,args1,args2,tar) == S:= mS until b repeat b:= null rest S or m < CAADR S => - RPLACD(S,CONS(p,rest S)) + S.rest := CONS(p,rest S) S:= rest S mS mmS and [rest p for p in mS] @@ -1127,12 +1127,12 @@ matchTypes(pm,args1,args2) == t=t1 => $Coerce and t1 = $Symbol and (q := ASSQ(v,$SymbolType)) and t2 and (t3 := resolveTT(rest q, t2)) and - RPLACD(q, t3) + (q.rest := t3) $Coerce => if t = $Symbol and (q := ASSQ(v,$SymbolType)) then t := rest q if t1 = $Symbol and t2 then t1:= t2 - t0 := resolveTT(t,t1) => RPLACD(p,t0) + t0 := resolveTT(t,t1) => p.rest := t0 $Subst:= 'failed $Subst:= 'failed $Subst:= CONS(CONS(v,t1),$Subst) @@ -1222,15 +1222,15 @@ evalMmCond0(op,sig,st) == canCoerceFrom(t,t1) => 'T NIL canCoerceFrom(t1,t) => 'T - isSubDomain(t,t1) => RPLACD(p,t1) + isSubDomain(t,t1) => p.rest := t1 t1 = $Symbol and canCoerceFrom(getSymbolType first p,t) ( SL and p1 and not b and 'failed ) or evalMmCat(op,sig,st,SL) fixUpTypeArgs SL == for (p := [v, :t2]) in SL repeat t1 := LASSOC(v, $Subst) - null t1 => RPLACD(p,replaceSharpCalls t2) - RPLACD(p, coerceTypeArgs(t1, t2, SL)) + null t1 => p.rest := replaceSharpCalls t2 + p.rest := coerceTypeArgs(t1, t2, SL) SL replaceSharpCalls t == @@ -1351,7 +1351,7 @@ evalMmCat1(mmC is ['ofCategory,d,c],op, SL) == NSL:= hasCate(d,c,SL) NSL='failed and isPatternVar d and $Coerce and ( p:= ASSQ(d,$Subst) ) and (rest(p) is ["Variable",:.] or rest(p) = $Symbol) => - RPLACD(p,getSymbolType d) + p.rest := getSymbolType d hasCate(d,c,SL) NSL='failed and isPatternVar d => -- following is hack to take care of the case where we have a diff --git a/src/interp/i-object.boot b/src/interp/i-object.boot index ab1b1fd8..401ed7fc 100644 --- a/src/interp/i-object.boot +++ b/src/interp/i-object.boot @@ -70,8 +70,8 @@ $useIntegerSubdomain := true objNew(val, mode) == CONS(mode,val) -- new names as of 10/14/93 objNewWrap(val, mode) == CONS(mode,wrap val) objNewCode(val, mode) == ["CONS", MKQ mode,val ] -objSetVal(obj,val) == RPLACD(obj,val) -objSetMode(obj,mode) == RPLACA(obj,mode) +objSetVal(obj,val) == obj.rest := val +objSetMode(obj,mode) == obj.first := mode objVal obj == rest obj objValUnwrap obj == unwrap rest obj @@ -355,7 +355,7 @@ computedMode t == insertShortAlist(prop,val,al) == pair := QASSQ(prop,al) => - RPLACD(pair,val) + pair.rest := val al [[prop,:val],:al] diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index 21a3c31a..a42cd712 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -1067,7 +1067,8 @@ putWidth u == argsWidth:= l is [firstArg,:restArg] => RPLACA(rest u,putWidth firstArg) - for y in tails restArg repeat RPLACA(y,putWidth first y) + for y in tails restArg repeat + y.first := putWidth first y widthFirstArg:= 0=interSpace and infixArgNeedsParens(firstArg,leftPrec,"right")=> 2+WIDTH firstArg @@ -1084,7 +1085,7 @@ putWidth u == if l then ll := rest l else ll := nil [oldFirst,:opWidth(oldFirst,ll)+argsWidth] [putWidth oldFirst,:2+WIDTH oldFirst+argsWidth] - RPLACA(u,newFirst) + u.first := newFirst u opWidth(op,has2Arguments) == @@ -1288,7 +1289,8 @@ SubstWhileDesizingList(u,m) == [SubstWhileDesizing(a,m)] tail:=res for i in b repeat - if atom i then RPLACD(tail,[i]) else RPLACD(tail,[SubstWhileDesizing(i,m)]) + if atom i then tail.rest := [i] + else tail.rest := [SubstWhileDesizing(i,m)] tail:=rest tail res u @@ -1813,20 +1815,20 @@ charySplit(u,v,start,linelength) == for i in 0.. repeat dm := rest m ddm := rest dm - RPLACD(dm,nil) + dm.rest := nil WIDTH v > linelength - 2 => return nil RPLAC(first v, first v.0) - RPLACD(dm,ddm) + dm.rest := ddm m := rest m RPLAC(first v,first v.0) - RPLACD(m,nil) + m.rest := nil charybdis(v,start + 2,linelength - 2) split2(u,dm,ddm,start,linelength) split2(u,dm,ddm,start,linelength) == --prnd(start,(d:= GETL(keyp u,'INFIXOP) => d; opSrch(keyp u,OPLIST))) prnd(start,(d:= GETL(keyp u,'INFIXOP) => d; '",")) - RPLACD(dm,ddm) + dm.rest := ddm m:= WIDTH [keyp u,:dm]<linelength-2 charybdis([keyp u,:dm],(m => start+2; start),(m => linelength-2; linelength)) '" " @@ -2333,10 +2335,10 @@ bracketagglist(u, start, linelength, tchr, open, close) == null rest x => return(s := -1) nil or s = -1 => (nextu := nil) - EQ(lastx, u) => ((nextu := rest u); RPLACD(u, nil) ) + EQ(lastx, u) => ((nextu := rest u); u.rest := nil) true => ((nextu := lastx); RPLACD(PREDECESSOR(lastx, u), nil)) for x in tails u repeat - RPLACA(x, LIST('CONCAT, first x, tchr)) + x.first := LIST('CONCAT, first x, tchr) if null nextu then RPLACA(CDDR LAST u, close) x := ASSOCIATER('CONCAT, CONS(ichr, u)) charybdis(ASSOCIATER('CONCAT, u), start, linelength) diff --git a/src/interp/i-resolv.boot b/src/interp/i-resolv.boot index 6b803015..111e430e 100644 --- a/src/interp/i-resolv.boot +++ b/src/interp/i-resolv.boot @@ -423,12 +423,12 @@ getConditionalCategoryOfType1(cat,conditions,match,seen) == match,seen) cat is ['IF,., cond,.] => matchUpToPatternVars(cond,match,NIL) => - RPLACD(conditions,CONS(cat,rest conditions)) + conditions.rest := CONS(cat,rest conditions) conditions conditions cat is [catName,:.] and (getConstructorKindFromDB catName = "category") => member(cat, rest seen) => conditions - RPLACD(seen,[cat,:rest seen]) + seen.rest := [cat,:rest seen] subCat := getConstructorCategoryFromDB catName -- substitute vars of cat into category for v in rest cat for vv in $TriangleVariableList repeat @@ -486,7 +486,7 @@ resolveTM1(t,m) == isPatternVar m => p := ASSQ(m,$Subst) => $Coerce => - tt := resolveTT1(t,rest p) => RPLACD(p,tt) and tt + tt := resolveTT1(t,rest p) => (p.rest := tt) and tt NIL t=rest p and t $Subst := CONS(CONS(m,t),$Subst) diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 8e1a4480..300f181b 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -486,7 +486,7 @@ upLoopIters itrl == upLoopIterSTEP(index,lower,step,upperList) -- following is an optimization typeIsASmallInteger(get(index,'mode,$env)) => - RPLACA(iter,'ISTEP) + iter.first := 'ISTEP -- at this point, the AST may already be badly corrupted, -- but better late than never. throwKeyedMsg("S2IS0061",nil) @@ -513,8 +513,8 @@ upLoopIterIN(iter,index,s) == NIL upLoopIterSTEP(index,lower,step,upperList) newIter := ['STEP,index,lower,step,:upperList] - RPLACA(iter,first newIter) - RPLACD(iter,rest newIter) + iter.first := first newIter + iter.rest := rest newIter iterMs isnt [['List,ud]] => throwKeyedMsg("S2IS0006",[index]) put(index,'mode,ud,$env) @@ -686,8 +686,8 @@ upStreamIterIN(iter,index,s) == NIL upStreamIterSTEP(index,lower,step,upperList) newIter := ['STEP,index,lower,step,:upperList] - RPLACA(iter,first newIter) - RPLACD(iter,rest newIter) + iter.first := first newIter + iter.rest := rest newIter (iterMs isnt [['List,ud]]) and (iterMs isnt [['Stream,ud]]) and (iterMs isnt [['InfinitTuple, ud]]) => diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index 3de947f7..8c654f0f 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -201,7 +201,7 @@ uperror t == t isnt [op,msg] => NIL msgMs := bottomUp putCallInfo(msg,"error",1,1) msgMs isnt [=$String] => NIL - RPLACD(t,[mkAtree object2String $mapName,msg]) + t.rest := [mkAtree object2String $mapName,msg] bottomUp t --% Handlers for free and local @@ -432,8 +432,8 @@ removeConstruct pat == if pat is ["construct",:p] then pat:=p if pat is ["cons", a, b] then pat := [a, [":", b]] atom pat => pat - RPLACA(pat,removeConstruct first pat) - RPLACD(pat,removeConstruct rest pat) + pat.first := removeConstruct first pat + pat.rest := removeConstruct rest pat pat isPatternMatch(l,pats) == diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 54e57973..c75796f3 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -372,7 +372,7 @@ clearCmdParts(l is [opt,:vl]) == p2:= assoc(option,rest p1) => recordOldValue(x,option,rest p2) recordNewValue(x,option,NIL) - RPLACD(p2,NIL) + p2.rest := NIL nil --% )close @@ -1480,7 +1480,7 @@ updateFromCurrentInterpreterFrame() == updateCurrentInterpreterFrame() == - RPLACA($interpreterFrameRing,createCurrentInterpreterFrame()) + $interpreterFrameRing.first := createCurrentInterpreterFrame() updateFromCurrentInterpreterFrame() NIL @@ -1601,7 +1601,7 @@ initHistList() == $HistList:= LIST NIL li:= $HistList for i in 1..$HistListLen repeat li:= CONS(NIL,li) - RPLACD($HistList,li) + $HistList.rest := li $HistListAct:= 0 $HistRecord:= NIL @@ -1715,7 +1715,7 @@ resetInCoreHist() == $HistListAct:= 0 for i in 1..$HistListLen repeat $HistList:= rest $HistList - RPLACA($HistList,NIL) + $HistList.first := NIL changeHistListLen(n) == -- changes the length of $HistList. n must be nonnegative @@ -1728,7 +1728,7 @@ changeHistListLen(n) == if dif < 0 then for i in 1..-dif repeat l:= rest l if $HistListAct > n then $HistListAct:= n - RPLACD($HistList,l) + $HistList.rest := l 'done updateHist() == @@ -1748,7 +1748,7 @@ updateHist() == updateInCoreHist() == -- updates $HistList and $IOindex $HistList:= rest($HistList) - RPLACA($HistList,NIL) + $HistList.first := NIL if $HistListAct < $HistListLen then $HistListAct:= $HistListAct+1 putHist(x,prop,val,e) == @@ -1773,8 +1773,8 @@ recordNewValue0(x,prop,val) == -- updateHist writes this stuff out into the history file p1:= ASSQ(x,$HistRecord) => p2:= ASSQ(prop,rest p1) => - RPLACD(p2,val) - RPLACD(p1,CONS(CONS(prop,val),rest p1)) + p2.rest := val + p1.rest := CONS(CONS(prop,val),rest p1) p:= CONS(x,list CONS(prop,val)) $HistRecord:= CONS(p,$HistRecord) @@ -1787,9 +1787,9 @@ recordOldValue0(x,prop,val) == -- writes (prop . val) into $HistList p1:= ASSQ(x,first $HistList) => not ASSQ(prop,rest p1) => - RPLACD(p1,CONS(CONS(prop,val),rest p1)) + p1.rest := CONS(CONS(prop,val),rest p1) p:= CONS(x,list CONS(prop,val)) - RPLACA($HistList,CONS(p,first $HistList)) + $HistList.first := CONS(p,first $HistList) undoInCore(n) == -- undoes the last n>0 steps using $HistList @@ -1823,7 +1823,7 @@ undoFromFile(n) == val => if not (x='%) then recordOldValue(x,prop,val) if $HiFiAccess then recordNewValue(x,prop,val) - RPLACD(p,NIL) + p.rest := NIL for i in 1..n repeat vec:= UNWIND_-PROTECT(rest readHiFi(i),disableHist()) for p1 in vec repeat @@ -2070,8 +2070,8 @@ writify ob == HPUT($seen, nob, nob) qcar := writifyInner qcar qcdr := writifyInner qcdr - QRPLACA(nob, qcar) - QRPLACD(nob, qcdr) + nob.first := qcar + nob.rest := qcdr nob VECP ob => isDomainOrPackage ob => @@ -2099,11 +2099,11 @@ writify ob == HPUT($seen, ob, nob) HPUT($seen, nob, nob) keys := HKEYS ob - QRPLACD(nob, + nob.rest := ['HASHTABLE, HASHTABLE_-CLASS ob, writifyInner keys, - [writifyInner HGET(ob,k) for k in keys]]) + [writifyInner HGET(ob,k) for k in keys]] nob PLACEP ob => nob := ['WRITIFIED_!_!, 'PLACE] @@ -2219,8 +2219,8 @@ dewritify ob == nob := CONS(qcar, qcdr) HPUT($seen, ob, nob) HPUT($seen, nob, nob) - QRPLACA(nob, dewritifyInner qcar) - QRPLACD(nob, dewritifyInner qcdr) + nob.first := dewritifyInner qcar + nob.rest := dewritifyInner qcdr nob VECP ob => n := QVMAXINDEX ob @@ -2789,10 +2789,10 @@ undoSingleStep(changes,env) == pairlist := ASSQ(name,env) => proplist := rest pairlist => for (pair := [prop,:value]) in changeList repeat - node := ASSQ(prop,proplist) => RPLACD(node,value) - RPLACD(proplist,[first proplist,:rest proplist]) - RPLACA(proplist,pair) - RPLACD(pairlist,changeList) + node := ASSQ(prop,proplist) => node.rest := value + proplist.rest := [first proplist,:rest proplist] + proplist.first := pair + pairlist.rest := changeList env := [change,:env] env @@ -2828,7 +2828,7 @@ removeUndoLines u == --called by writeInputLines s1 = '")redo" => 0 s2 ~= '"" => undoCount PARSE_-INTEGER s2 -1 - RPLACA(y,CONCAT('">",code,STRINGIMAGE n)) + y.first := CONCAT('">",code,STRINGIMAGE n) nil $IOindex := $IOindex + 1 --referenced by undoCount acc := nil diff --git a/src/interp/i-util.boot b/src/interp/i-util.boot index a48dbbe7..708f07d5 100644 --- a/src/interp/i-util.boot +++ b/src/interp/i-util.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -117,7 +117,7 @@ variableNumber(x) == null p => $variableNumberAlist := [[x,:0], :$variableNumberAlist] 0 - RPLACD(p, 1+rest p) + p.rest := 1+rest p rest p newType? t == nil diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 48ed5ebd..cf26b9d4 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -285,8 +285,8 @@ instantiate domenv == -- PUT(functor, 'instantiate, fn) -- domvec := APPLY(fn, args) domvec := APPLY(functor, args) - RPLACA(oldDom, $oldAxiomDomainDispatch) - RPLACD(oldDom, [second oldDom,: domvec]) + oldDom.first := $oldAxiomDomainDispatch + oldDom.rest := [second oldDom,: domvec] oldDom hashTypeForm([fn,: args], percentHash) == @@ -318,7 +318,7 @@ oldAxiomDomainLookupExport _ oldCompLookup(op, sig, domainVec, self) null val => val if constant then val := SPADCALL val - RPLACA(box, val) + box.first := val box oldAxiomDomainHashCode(domenv, env) == first domenv diff --git a/src/interp/mark.boot b/src/interp/mark.boot index 2ce85383..f67c7755 100644 --- a/src/interp/mark.boot +++ b/src/interp/mark.boot @@ -770,7 +770,7 @@ markInsertChanges(code,form,t,loc) == if $hohum then pp [i, '" >>> ", x] SETQ($CHANGE,COPY x) if x is ['elt,:y] and r then x := y - RPLACA(x,markInsertChanges(code,first x,t,rest loc)) + x.first := markInsertChanges(code,first x,t,rest loc) chk(x,100) form -- pp ['"Making change: ",code,form,t] @@ -1307,7 +1307,7 @@ moveLinesAfter(alist, lines) == acc := nil for i in 0..(n - 1) for x in lines repeat (p := ASSOC(i, alist)) and string? rest p => acc := [rest p, x, :acc] - (p := lookupRight(i, alist)) and (first p) > i => RPLACD(p, x) + (p := lookupRight(i, alist)) and (first p) > i => p.rest := x acc := [x, :acc] reverse acc @@ -1429,7 +1429,7 @@ combineDefinitions() == item := [predl, :defs] op := opOf form oldAlist := HGET($hash,opOf form) - pair := ASSOC(sig, oldAlist) => RPLACD(pair, [item,:rest pair]) + pair := ASSOC(sig, oldAlist) => pair.rest := [item,:rest pair] HPUT($hash, op, [[sig, item], :oldAlist]) --extract and combine multiple definitions Xdeflist := nil @@ -1441,7 +1441,7 @@ combineDefinitions() == ['DEF, form, :.] := def ops := PNAME op opName := INTERN(STRCONC(ops,'"X",STRINGIMAGE i)) - RPLACA(form, opName) + form.first := opName -- rplacaSubst(op, opName, def) $acc := [[form,:predl], :$acc] Xdeflist := [buildNewDefinition(op,sig,$acc),:Xdeflist] @@ -1450,7 +1450,7 @@ combineDefinitions() == rplacaSubst(x, y, u) == (fn(x, y, u); u) where fn(x,y,u) == atom u => nil while u is [p, :q] repeat - if EQ(p, x) then RPLACA(u, y) + if EQ(p, x) then u.first := y if null atom p then fn(x, y, p) u := q diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index f64ac59e..6b36e297 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -211,8 +211,8 @@ mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) == --mergeModemap(entry:=((mc,:sig),:.),modemapList,e) == -- for (mmtail:= (((mc',:sig'),:.),:.)) in tails modemapList do -- mc=mc' or isSubset(mc,mc',e) => --- RPLACD(mmtail,(first mmtail,: rest mmtail)) --- RPLACA(mmtail,entry) +-- mmtail.rest := (first mmtail,: rest mmtail) +-- mmtail.first := entry -- entry := nil -- return modemapList -- if entry then (:modemapList,entry) else modemapList diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index b048b07a..7559ffce 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -1005,7 +1005,7 @@ splitListSayBrightly u == y := rest x null y => nil first y = '%l => - RPLACD(x,nil) + x.rest := nil ans:= [u,:rest y] ans diff --git a/src/interp/newfort.boot b/src/interp/newfort.boot index 4fafac33..f7b567b4 100644 --- a/src/interp/newfort.boot +++ b/src/interp/newfort.boot @@ -202,11 +202,11 @@ beenHere(e,n) == loc := first exprStk fun := first n.3 fun = 'CAR => - RPLACA(loc,var) + loc.first := var fun = 'CDR => if cons? QCDR loc - then RPLACD(loc,[var]) - else RPLACD(loc,var) + then loc.rest := [var] + else loc.rest := var SAY '"whoops" var n.1 -- been here before, so just get variable @@ -227,7 +227,7 @@ exp2FortOptimizeCS1 e == pushCsStacks(f,'CAR) where pushCsStacks(x,y) == $fortCsExprStack := [x,:$fortCsExprStack] $fortCsFuncStack := [y,:$fortCsFuncStack] - RPLACA(f,exp2FortOptimizeCS1 QCAR f) + f.first := exp2FortOptimizeCS1 QCAR f popCsStacks(0) where popCsStacks(x) == $fortCsFuncStack := QCDR $fortCsFuncStack $fortCsExprStack := QCDR $fortCsExprStack @@ -235,7 +235,7 @@ exp2FortOptimizeCS1 e == -- check to see of we have an non-NIL atomic CDR g and atom g => pushCsStacks(f,'CDR) - RPLACD(f,exp2FortOptimizeCS1 g) + f.rest := exp2FortOptimizeCS1 g popCsStacks(0) f := NIL f := g @@ -705,7 +705,7 @@ fortFormatTypes1(typeName,names) == insertEntry(size,el,aList) == entry := assoc(size,aList) null entry => CONS(CONS(size,LIST el),aList) - RPLACD(entry,CONS(el,rest entry)) + entry.rest := CONS(el,rest entry) aList fortFormatCharacterTypes(names) == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index c5b5bbec..b0848142 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -213,7 +213,7 @@ genDeltaEntry(opMmPair,e) == saveNRTdeltaListComp:= $NRTdeltaListComp:=[nil,:$NRTdeltaListComp] $NRTdeltaLength := $NRTdeltaLength+1 compEntry:= (compOrCroak(odc,$EmptyMode,e)).expr - RPLACA(saveNRTdeltaListComp,compEntry) + saveNRTdeltaListComp.first := compEntry u := [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index() == (n:= POSN1(opModemapPair,$NRTdeltaList)) => n + 1 @@ -265,7 +265,7 @@ NRTgetLocalIndex item == -- ??? That we do is likely a bug. flag => item (compOrCroak(item,$EmptyMode,$e)).expr - RPLACA(saveNRTdeltaListComp,compEntry) + saveNRTdeltaListComp.first := compEntry saveIndex NRTassignCapsuleFunctionSlot(op,sig) == @@ -365,8 +365,8 @@ NRTdescendCodeTran(u,condList) == u is ['LIST] => nil u is [op,.,i,a] and op in '(setShellEntry SETELT QSETREFV) => null condList and a is ['CONS,fn,:.] => - RPLACA(u,'LIST) - RPLACD(u,nil) + u.first := 'LIST + u.rest := nil $template.i := fn = 'IDENTITY => a fn is ['dispatchFunction,fn'] => fn' @@ -589,7 +589,7 @@ reverseCondlist cl == u := assoc(z,alist) null u => alist := [[z,x],:alist] member(x,rest u) => nil - RPLACD(u,[x,:rest u]) + u.rest := [x,:rest u] alist NRTsetVector4Part2(uncondList,condList) == @@ -752,7 +752,7 @@ addConsDB x == cons? x => for z in tails x repeat u:=min first z - if not EQ(u,first z) then RPLACA(z,u) + if not EQ(u,first z) then z.first := u HashCheck x REFVECP x => for i in 0..MAXINDEX x repeat @@ -802,9 +802,9 @@ NRTputInTail x == atom (u := first y) => u='$ or LASSOC(u,$devaluateList) => nil k:= NRTassocIndex u => - atom u => RPLACA(y,[$elt,'_$,k]) + atom u => y.first := [$elt,'_$,k] -- u atomic means that the slot will always contain a vector - RPLACA(y,['SPADCHECKELT,'_$,k]) + y.first := ['SPADCHECKELT,'_$,k] --this reference must check that slot is a vector nil NRTputInHead u diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index 4b5cdae4..8c3df67a 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -179,8 +179,8 @@ getLookupFun infovec == makeSpadConstant [fn,dollar,slot] == val := FUNCALL(fn,dollar) u:= dollar.slot - RPLACA(u,function IDENTITY) - RPLACD(u,val) + u.first := function IDENTITY + u.rest := val val stuffSlot(dollar,i,item) == @@ -362,7 +362,7 @@ NRTmakeCategoryAlist() == sixEtc := [5 + i for i in 1..#$pairlis] formals := ASSOCRIGHT $pairlis for x in slot1 repeat - RPLACA(x,EQSUBSTLIST(CONS("$$",sixEtc),CONS('$,formals),first x)) + x.first := EQSUBSTLIST(CONS("$$",sixEtc),CONS('$,formals),first x) -----------code to make a new style slot4 ----------------- predList := ASSOCRIGHT slot1 --is list of predicate indices maxPredList := "MAX"/predList diff --git a/src/interp/packtran.boot b/src/interp/packtran.boot index 260cac44..52f34d7c 100644 --- a/src/interp/packtran.boot +++ b/src/interp/packtran.boot @@ -46,8 +46,8 @@ packageTran sex == EQ(_*PACKAGE_*, SYMBOL_-PACKAGE sex) => sex INTERN STRING sex cons? sex => - RPLACA(sex, packageTran first sex) - RPLACD(sex, packageTran rest sex) + sex.first := packageTran first sex + sex.rest := packageTran rest sex sex sex diff --git a/src/interp/showimp.boot b/src/interp/showimp.boot index 4ee43028..d9273326 100644 --- a/src/interp/showimp.boot +++ b/src/interp/showimp.boot @@ -102,7 +102,7 @@ showFrom(D,:option) == $predicateList: local := getConstructorPredicatesFromDB nam for (opSig := [op,sig]) in getDomainSigs1(D,ops) repeat u := from?(D,op,sig) - x := assoc(u,alist) => RPLACD(x,[opSig,:rest x]) + x := assoc(u,alist) => x.rest := [opSig,:rest x] alist := [[u,opSig],:alist] for [conform,:l] in alist repeat sayBrightly concat('"From ",form2String conform,'":") diff --git a/src/interp/termrw.boot b/src/interp/termrw.boot index 4fd3b1f9..e46a08d0 100644 --- a/src/interp/termrw.boot +++ b/src/interp/termrw.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-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -100,7 +100,7 @@ augmentSub(v,t,SL) == -- t doesn't contain any of the variables of SL q:= CONS(v,t) null SL => [q] --- for p in SL repeat RPLACD(p,SUBSTQ(t,v,rest p)) +-- for p in SL repeat p.rest := SUBSTQ(t,v,rest p) CONS(q,SL) mergeSubs(S1,S2) == diff --git a/src/interp/topics.boot b/src/interp/topics.boot index d37c8909..d47f41fe 100644 --- a/src/interp/topics.boot +++ b/src/interp/topics.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-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -116,7 +116,7 @@ mkTopicHashTable() == --given $groupAssoc = ((extended . for con in HKEYS $conTopicHash repeat conCode := 0 for pair in HGET($conTopicHash,con) repeat - RPLACD(pair,code := topicCode rest pair) + pair.rest := code := topicCode rest pair conCode := LOGIOR(conCode,code) HPUT($conTopicHash,con, [['constructor,:conCode],:HGET($conTopicHash,con)]) diff --git a/src/interp/trace.boot b/src/interp/trace.boot index a6259f30..2fedf5c2 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -810,7 +810,7 @@ breaklet(fn,vars) == vars $letAssoc:= null fnEntry => [[fn,:LIST ["BREAK",:vars]],:$letAssoc] - pair => (RPLACD(pair,vars); $letAssoc) + pair => (pair.rest := vars; $letAssoc) if $letAssoc then SETLETPRINTFLAG true $QuickLet:local := false not MEMQ(fn,$traceletFunctions) and not stupidIsSpadFunction fn diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index e0e3cef6..c08ad9c7 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -668,7 +668,7 @@ genDeltaEntry(opMmPair,e) == $NRTdeltaLength := $NRTdeltaLength+1 compEntry:= dc - RPLACA(saveNRTdeltaListComp,compEntry) + saveNRTdeltaListComp.first := compEntry chk(saveNRTdeltaListComp,102) u := [eltOrConst,'$,$NRTbase+$NRTdeltaLength-index] where index() == @@ -727,7 +727,7 @@ mkUserConstructorAbbreviation(c,a,type) == compreduce(form is [.,op,x],m,e) == T := compForm(form,m,e) or return nil y := T.expr - RPLACA(y,"REDUCE") + y.first := "REDUCE" ------------------<== distinquish this as the special reduce form (y is ["REDUCE",:.]) and (id:= getIdentity(op,e)) and (u := comp0(id,m,e)) and # getNumberTypesInScope() > 1 => markSimpleReduce([:y, ["@",u.expr,m]], T) @@ -1011,7 +1011,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == doItSeq item == ['SEQ,:l,['exit,1,x]] := item - RPLACA(item,"PROGN") + item.first := "PROGN" RPLACA(LASTNODE item,x) for it1 in rest item repeat $e:= compSingleCapsuleItem(it1,$predl,$e) @@ -1021,8 +1021,8 @@ doItDomain item == markImport second u stackWarning ["Use: import ", [first item,:rest item]] --wiReplaceNode(item, u, 14) - RPLACA(item, first u) - RPLACD(item, rest u) + item.first := first u + item.rest := rest u doIt(item,$predl) doItLet item == @@ -1077,7 +1077,7 @@ doItDef item == body:= isMacro(item,$e) => $e:= put(op,"macro",body,$e) [.,.,$e]:= t:= compOrCroak(item,$EmptyMode,$e) chk(item,3) - RPLACA(item,"CodeDefine") + item.first := "CodeDefine" --Note that DescendCode, in CodeDefine, is looking for this RPLACD(second item,[$signatureOfForm]) chk(item,4) @@ -1101,8 +1101,8 @@ wiReplaceNode(node,ocode,key) == SETQ($NODE,COPY node) SETQ($NODE1, COPY first code) SETQ($NODE2, COPY rest code) - RPLACA(node,first code) - RPLACD(node,rest code) + node.first := first code + node.rest := rest code chk(code, key) chk(node, key + 1) diff --git a/src/interp/word.boot b/src/interp/word.boot index 3e299010..2f6feac1 100644 --- a/src/interp/word.boot +++ b/src/interp/word.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2009, Gabriel Dos Reis. +-- Copyright (C) 2007-2010, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -88,7 +88,7 @@ removeDupOrderedAlist u == -- removes duplicate entries in ordered alist -- (where duplicates are adjacent) for x in tails u repeat - (y := rest x) and first first x = first first y => RPLACD(x,rest y) + (y := rest x) and first first x = first first y => x.rest := rest y u getListOfFunctionNames(fnames) == |