diff options
Diffstat (limited to 'src')
35 files changed, 118 insertions, 78 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 48ee4e22..47f9999e 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,11 @@ 2011-04-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/utility.boot (copyList): Define. + (append!): Likewise. + * boot/tokens.boot: Do not translate nconc. + +2011-04-21 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/tokens.boot: Don't translate lastNode anymore. * boot/utility.boot (lastNode): Define. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index e58179a2..0f09668b 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -1079,7 +1079,7 @@ bfWhere (context,expr)== a:=[[first d,second d,bfSUBLIS(opassoc,third d)] for d in defs] $wheredefs:=append(a,$wheredefs) - bfMKPROGN bfSUBLIS(opassoc,nconc(nondefs,[expr])) + bfMKPROGN bfSUBLIS(opassoc,append!(nondefs,[expr])) --shoeReadLispString(s,n)== -- n>= # s => nil diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index b903d432..36d45495 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1975,7 +1975,7 @@ (SETQ |bfVar#124| (CDR |bfVar#124|))))) (SETQ |$wheredefs| (APPEND |a| |$wheredefs|)) (|bfMKPROGN| - (|bfSUBLIS| |opassoc| (NCONC |nondefs| (LIST |expr|)))))))) + (|bfSUBLIS| |opassoc| (|append!| |nondefs| (LIST |expr|)))))))) (DEFUN |bfCompHash| (|op| |argl| |body|) (PROG (|computeFunction| |auxfn|) diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 0de0c434..d19d76d8 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -183,9 +183,9 @@ (LIST 'CONCAT "") (LIST 'MAX (- 999999)) (LIST 'MIN 999999) (LIST '* 1) (LIST '|times| 1) (LIST 'CONS NIL) (LIST 'APPEND NIL) - (LIST '|append| NIL) (LIST 'UNION NIL) - (LIST 'UNIONQ NIL) (LIST '|union| NIL) - (LIST 'NCONC NIL) (LIST '|and| T) (LIST '|or| NIL) + (LIST '|append| NIL) (LIST '|append!| NIL) + (LIST 'UNION NIL) (LIST 'UNIONQ NIL) + (LIST '|union| NIL) (LIST '|and| T) (LIST '|or| NIL) (LIST 'AND T) (LIST 'OR NIL))) (|i| NIL)) (LOOP @@ -224,7 +224,6 @@ (LIST '|lowerCase?| 'LOWER-CASE-P) (LIST '|makeSymbol| 'INTERN) (LIST '|maxIndex| 'MAXINDEX) (LIST '|mkpf| 'MKPF) - (LIST '|nconc| 'NCONC) (LIST '|newString| 'MAKE-STRING) (LIST '|newVector| 'MAKE-ARRAY) (LIST '|nil| NIL) (LIST '|not| 'NOT) (LIST '|null| 'NULL) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 9b7dbef4..5e6003fc 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -7,7 +7,7 @@ (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| - |lastNode|)) + |lastNode| |append!| |copyList|)) (DEFUN |objectMember?| (|x| |l|) (LOOP @@ -99,3 +99,23 @@ (T (SETQ |l| |l'|)))) |l|)))) +(DEFUN |copyList| (|l|) + (PROG (|l'| |t|) + (RETURN + (COND + ((NOT (CONSP |l|)) |l|) + (T (SETQ |l'| (SETQ |t| (LIST (CAR |l|)))) + (LOOP + (PROGN + (SETQ |l| (CDR |l|)) + (COND + ((CONSP |l|) (RPLACD |t| (LIST (CAR |l|))) + (SETQ |t| (CDR |t|))) + (T (RPLACD |t| |l|) (RETURN |l'|)))))))))) + +(DEFUN |append!| (|x| |y|) + (COND + ((NULL |x|) |y|) + ((NULL |y|) |x|) + (T (RPLACD (|lastNode| |x|) |y|) |x|))) + diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index b89a2b67..3843b785 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -225,10 +225,10 @@ for i in [ _ ["CONS", nil] , _ ["APPEND", nil] , _ ["append", nil] , _ + ["append!", nil] , _ ["UNION", nil] , _ ["UNIONQ", nil] , _ ["union", nil] , _ - ["NCONC", nil] , _ ["and", true] , _ ["or", false] , _ ["AND", true] , _ @@ -279,7 +279,6 @@ for i in [ _ ["makeSymbol", "INTERN"] , _ ["maxIndex", "MAXINDEX"] , _ ["mkpf", "MKPF"] , _ - ["nconc", "NCONC"] , _ ["newString", "MAKE-STRING"], _ ["newVector", "MAKE-ARRAY"], _ ["nil" ,NIL ] , _ diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 8b1f242f..bde1090b 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -33,7 +33,8 @@ import initial_-env namespace BOOTTRAN module utility (objectMember?, symbolMember?, stringMember?, - charMember?, scalarMember?, listMember?, reverse, reverse!, lastNode) + charMember?, scalarMember?, listMember?, reverse, reverse!, + lastNode, append!, copyList) --% membership operators @@ -112,3 +113,23 @@ lastNode l == while l is [.,:l'] and cons? l' repeat l := l' l + +--% list copying +copyList l == + not cons? l => l + l' := t := [first l] + repeat + l := rest l + cons? l => + t.rest := [first l] + t := rest t + t.rest := l + return l' + +--% append + +append!(x,y) == + x = nil => y + y = nil => x + lastNode(x).rest := y + x diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 82fb5d55..916b02df 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -157,7 +157,7 @@ bcHt line == if $saturn then htpAddToPageDescription($saturnPage, text) if $standard then htpAddToPageDescription($curPage, text) cons? line => - $htLineList := NCONC(reverse! mapStringize COPY_-LIST line, $htLineList) + $htLineList := append!(reverse! mapStringize copyList line, $htLineList) $htLineList := [basicStringize line, :$htLineList] --======================================================================= @@ -549,7 +549,7 @@ htMakeButtonSaturn(htCommand, message, func,options) == htpAddToPageDescription(htPage, pageDescrip) == newDescript := string? pageDescrip => [pageDescrip, :htPage.7] - nconc(reverse! COPY_-LIST pageDescrip, htPage.7) + append!(reverse! copyList pageDescrip, htPage.7) htPage.7 := newDescript diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index e8ebb419..855cf50c 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -373,7 +373,7 @@ intersectionContour(c,c') == --this loop will return NIL if not satisfied addContour(c,E is [cur,:tail]) == - [NCONC(fn(c,E),cur),:tail] where + [append!(fn(c,E),cur),:tail] where fn(c,e) == for [x,:proplist] in c repeat fn1(x,proplist,getProplist(x,e)) where @@ -1477,7 +1477,7 @@ massageBackendCode x == x.first := "MAKEPROP-SAY" u in '(DCQ RELET PRELET SPADLET SETQ %LET) => if u isnt 'DCQ and u isnt 'SETQ then - nconc(x,$FUNNAME__TAIL) + append!(x,$FUNNAME__TAIL) x.first := "LETT" massageBackendCode CDDR x if not (u in '(SETQ RELET)) then diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index 99fadcdc..bec950bc 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -1702,7 +1702,7 @@ #'(lambda () func) ;; constant domain #'(lambda (&rest args) (apply (|ClosFun| func) - (nconc + (|append!| (mapcar #'wrapDomArgs args (cdr cosig)) (list (|ClosEnv| func))))))) (apply cname args))))) @@ -1720,7 +1720,7 @@ #'(lambda (self &rest args) (let ((precat (apply (|ClosFun| func) - (nconc + (|append!| (mapcar #'wrapDomArgs args (cdr cosig)) (list (|ClosEnv| func)))))) (|CCall| (elt (car precat) 5) (cdr precat) (wrapDomArgs self t)))))) diff --git a/src/interp/fnewmeta.lisp b/src/interp/fnewmeta.lisp index 875a6875..f1cd15e0 100644 --- a/src/interp/fnewmeta.lisp +++ b/src/interp/fnewmeta.lisp @@ -775,7 +775,7 @@ (AND (|PARSE-GlyphTok| ".") (MUST (|PARSE-Sexpr1|)) (PUSH-REDUCTION '|PARSE-Sexpr1| - (NCONC (POP-STACK-2) (POP-STACK-1)))))))) + (|append!| (POP-STACK-2) (POP-STACK-1)))))))) (MUST (MATCH-ADVANCE-STRING ")"))))) diff --git a/src/interp/format.boot b/src/interp/format.boot index 0be7cf3d..ff57521d 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -268,7 +268,7 @@ formatAttribute x == atom x => [" ",x] x is [op,:argl] => for x in argl repeat - argPart:= NCONC(argPart,concat('",",formatAttributeArg x)) + argPart:= append!(argPart,concat('",",formatAttributeArg x)) argPart => concat('" ",op,'"(",rest argPart,'")") [" ",op] @@ -763,7 +763,7 @@ pkey keyStuff == keyStuff := IFCDR keyStuff next := IFCAR keyStuff oneMsg := returnStLFromKey(key,argL,dbN) - allMsgs := ['" ", :NCONC (oneMsg,allMsgs)] + allMsgs := ['" ", :append! (oneMsg,allMsgs)] allMsgs string2Float s == diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 88a4b6cf..1880e41e 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -601,13 +601,13 @@ listSort(pred,list,:optional) == mergeSort(pred,key,list,# list) -- non-destructive merge sort using NOT GGREATERP as predicate -MSORT list == listSort(function GLESSEQP, COPY_-LIST list) +MSORT list == listSort(function GLESSEQP, copyList list) -- destructive merge sort using NOT GGREATERP as predicate NMSORT list == listSort(function GLESSEQP, list) -- non-destructive merge sort using ?ORDER as predicate -orderList l == listSort(function _?ORDER, COPY_-LIST l) +orderList l == listSort(function _?ORDER, copyList l) -- dummy defn until clean-up -- order l == orderList l diff --git a/src/interp/ht-util.boot b/src/interp/ht-util.boot index 14607077..0c97430f 100644 --- a/src/interp/ht-util.boot +++ b/src/interp/ht-util.boot @@ -211,7 +211,7 @@ iht line == -- issue a single hyperteTeX line, or a group of lines $newPage => nil cons? line => - $htLineList := NCONC(reverse! mapStringize COPY_-LIST line, $htLineList) + $htLineList := append!(reverse! mapStringize copyList line, $htLineList) $htLineList := [basicStringize line, :$htLineList] bcIssueHt line == @@ -383,7 +383,7 @@ pvarCondList1(pvarList, activeConds, condList) == null condList => activeConds [cond, : restConds] := condList cond is [., pv, pattern] and pv in pvarList => - pvarCondList1(nconc(pvarList, pvarsOfPattern pattern), + pvarCondList1(append!(pvarList, pvarsOfPattern pattern), [cond, :activeConds], restConds) pvarCondList1(pvarList, activeConds, restConds) diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index fab869b2..d3244a37 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -1997,7 +1997,7 @@ SETANDFILEQ($CoerceTable, '( _ ))_ )) -SETANDFILEQ($CoerceTable,NCONC($CoerceTable,'( _ +SETANDFILEQ($CoerceTable,append!($CoerceTable,'( _ (Matrix . ( _ (List indeterm M2L) _ (RectangularMatrix partial M2Rm) _ diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 71229c9f..0879b47d 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -805,13 +805,13 @@ findFunctionInDomain(op,dc,tar,args1,args2,$Coerce,$SubDom) == else r := [mm,:r] q := allOrMatchingMms(q,args1,tar,dc) for mm in q repeat - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= append!(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) r := reverse r else r := rest p r := allOrMatchingMms(r,args1,tar,dc) if not fun then -- consider remaining modemaps for mm in r repeat - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= append!(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) if not fun and $reportBottomUpFlag then sayMSG concat ['" -> no appropriate",:bright op,'"found in", @@ -897,7 +897,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == impls and SL:= constructSubst dc for mm in impls repeat - fun:= nconc(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) + fun:= append!(fun,findFunctionInDomain1(mm,op,tar,args1,args2,SL)) if not fun and $reportBottomUpFlag then sayMSG concat ['" -> no appropriate",:bright op,'"found in", @@ -1111,7 +1111,7 @@ selectMmsGen(op,tar,args1,args2) == [c,t,:a] := sig if a then matchTypes(a,args1,args2) $Subst ~= 'failed => - mmS := nconc(evalMm(op,tar,sig,mmC),mmS) + mmS := append!(evalMm(op,tar,sig,mmC),mmS) mmS matchTypes(pm,args1,args2) == @@ -1148,11 +1148,11 @@ evalMm(op,tar,sig,mmC) == sig:= [subCopy(deepSubCopy(x,SL),$Subst) for x in sig] not containsVars sig => isFreeFunctionFromMmCond mmC and (m := evalMmFreeFunction(op,tar,sig,mmC)) => - mS:= nconc(m,mS) + mS:= append!(m,mS) "or"/[not isValidType(arg) for arg in sig] => nil [dc,t,:args]:= sig $Coerce or null tar or tar=t => - mS:= nconc(findFunctionInDomain(op,dc,t,args,args,NIL,'T),mS) + mS:= append!(findFunctionInDomain(op,dc,t,args,args,NIL,'T),mS) mS evalMmFreeFunction(op,tar,sig,mmC) == @@ -1166,7 +1166,7 @@ evalMmFreeFunction(op,tar,sig,mmC) == evalMmStack(mmC) == -- translates the modemap condition mmC into a list of stacks mmC is [op,:a] and op in '(AND and %and) => - ["NCONC"/[evalMmStackInner cond for cond in a]] + ["append!"/[evalMmStackInner cond for cond in a]] mmC is [op,:args] and op in '(OR or %or) => [:evalMmStack a for a in args] mmC is ['partial,:mmD] => evalMmStack mmD @@ -1312,7 +1312,7 @@ orderMmCatStack st == havevars := [s,:havevars] if not mem then haventvars := [s,:haventvars] null havevars => st - st := reverse! nconc(haventvars,havevars) + st := reverse! append!(haventvars,havevars) SORT(st, function mmCatComp) mmCatComp(c1, c2) == diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index e0e2b2f0..b9c8eec9 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -470,7 +470,7 @@ transformCollect [:itrl,body] == it is ["UNTIL",:.] => nil throwKeyedMsg("S2IS0061",nil) bodyTree:=mkAtree1 body - iterList:=nconc(iterList,[:iterTran2 for it in itrl]) where + iterList:=append!(iterList,[:iterTran2 for it in itrl]) where iterTran2() == it is ["STEP",:.] => nil it is ["IN",:.] => nil diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index ac5dab8b..2a8c6450 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -244,7 +244,7 @@ getUserIdentifiersIn body == "append"/[getUserIdentifiersIn y for y in l] bodyIdList := cons? op or not (GETL(op,'Nud) or GETL(op,'Led) or GETL(op,'up))=> - NCONC(getUserIdentifiersIn op, argIdList) + append!(getUserIdentifiersIn op, argIdList) argIdList removeDuplicates bodyIdList @@ -858,8 +858,8 @@ saveDependentMapInfo(op,opList) == gcl := [[op, :get(op, 'generatedCode, $e)]] for [dep1,dep2] in getFlag("$dependencies") | dep1=op repeat [lmml', :gcl'] := saveDependentMapInfo(dep2, [op, :opList]) - lmms := nconc(lmml', lmml) - gcl := nconc(gcl', gcl) + lmms := append!(lmml', lmml) + gcl := append!(gcl', gcl) [lmms, :gcl] nil diff --git a/src/interp/i-output.boot b/src/interp/i-output.boot index c2f53813..4406e5a1 100644 --- a/src/interp/i-output.boot +++ b/src/interp/i-output.boot @@ -461,7 +461,7 @@ appChar(string,x,y,d) == RPLACSTR(line,shiftedX,n:=#string,string,0,n) if bumpDeltaIfTrue=true then $highlightDelta:= $highlightDelta+1 d - appChar(string,x,y,nconc(d,[[y,:GETFULLSTR(10+$LINELENGTH+$MARGIN," ")]])) + appChar(string,x,y,append!(d,[[y,:GETFULLSTR(10+$LINELENGTH+$MARGIN," ")]])) print(x,domain) == dom:= devaluate domain @@ -943,7 +943,7 @@ appInfix(e,x,y,d) == [d,x]:= appInfixArg(arg,x,y,d,rightPrec,"left",opString) --app in right arg d -appconc(d,x,y,w) == NCONC(d,[[[x,:y],:w]]) +appconc(d,x,y,w) == append!(d,[[[x,:y],:w]]) infixArgNeedsParens(arg, prec, leftOrRight) == prec > getBindingPowerOf(leftOrRight, arg) + 1 diff --git a/src/interp/i-special.boot b/src/interp/i-special.boot index 5a7a4607..a167f8e3 100644 --- a/src/interp/i-special.boot +++ b/src/interp/i-special.boot @@ -2162,7 +2162,7 @@ transformREPEAT [:itrl,body] == [["SUCHTHAT",mkAtree1 pred]] it is [op,:.] and (op in '(VALUE UNTIL)) => nil bodyTree:=mkAtree1 body - iterList:=NCONC(iterList,[:iterTran2 for it in itrl]) where iterTran2() == + iterList:=append!(iterList,[:iterTran2 for it in itrl]) where iterTran2() == it is ["STEP",:.] => nil it is ["IN",:.] => nil it is ["ON",:.] => nil diff --git a/src/interp/i-syscmd.boot b/src/interp/i-syscmd.boot index 0ad608b3..255daac2 100644 --- a/src/interp/i-syscmd.boot +++ b/src/interp/i-syscmd.boot @@ -1395,14 +1395,14 @@ previousInterpreterFrame() == updateCurrentInterpreterFrame() null rest $interpreterFrameRing => NIL -- nothing to do [:b,l] := $interpreterFrameRing - $interpreterFrameRing := NCONC2([l],b) + $interpreterFrameRing := append!([l],b) updateFromCurrentInterpreterFrame() nextInterpreterFrame() == updateCurrentInterpreterFrame() null rest $interpreterFrameRing => NIL -- nothing to do $interpreterFrameRing := - NCONC2(rest $interpreterFrameRing,[first $interpreterFrameRing]) + append!(rest $interpreterFrameRing,[first $interpreterFrameRing]) updateFromCurrentInterpreterFrame() diff --git a/src/interp/interop.boot b/src/interp/interop.boot index 45019c39..5e4badcd 100644 --- a/src/interp/interop.boot +++ b/src/interp/interop.boot @@ -127,7 +127,7 @@ makeLazyOldAxiomDispatchDomain domform == getConstructorKindFromDB opOf domform = "category" => [$oldAxiomPreCategoryDispatch,: domform] dd := [$lazyOldAxiomDomainDispatch, hashTypeForm(domform,0), domform] - NCONC(dd,dd) -- installs back pointer to head of domain. + append!(dd,dd) -- installs back pointer to head of domain. dd makeOldAxiomDispatchDomain dom == diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index dfa30086..33e60ffe 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -185,7 +185,7 @@ (defun LISTOFATOMS (X) (COND ((NULL X) NIL) ((ATOM X) (LIST X)) - ((NCONC (LISTOFATOMS (CAR X)) (LISTOFATOMS (CDR X)))))) + ((|append!| (LISTOFATOMS (CAR X)) (LISTOFATOMS (CDR X)))))) (DEFUN LASTATOM (L) (if (ATOM L) L (LASTATOM (CDR L)))) diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 0b93ffaa..3b36cdc6 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -200,7 +200,7 @@ mergeModemap(entry is [[mc,:sig],[pred,:.],:.],modemapList,e) == return modemapList TruthP pred => mmtail:=rest mmtail --the thing we matched against is useless, by comparison - modemapList:= NCONC(reverse! newmm,[entry,:mmtail]) + modemapList:= append!(reverse! newmm,[entry,:mmtail]) entry:= nil return modemapList if entry then [:modemapList,entry] else modemapList diff --git a/src/interp/msg.boot b/src/interp/msg.boot index 156906a9..88873010 100644 --- a/src/interp/msg.boot +++ b/src/interp/msg.boot @@ -168,7 +168,7 @@ processChPosesForOneLine msgList == setMsgPrefix (msg,strconc(oldPre,_ MAKE_-FULL_-CVEC ($preLength - 4 - # oldPre),posLetter) ) leaderMsg := makeLeaderMsg chPosList - NCONC(msgList,[leaderMsg]) --a back cons + append!(msgList,[leaderMsg]) --a back cons posPointers msgList == --gets all the char posns for msgs on one line @@ -291,9 +291,9 @@ queueUpErrors(globalNumOfLine,msgList)== msgList := rest msgList if thisPosMsgs then thisPosMsgs := processChPosesForOneLine thisPosMsgs - $outputList := NCONC(thisPosMsgs,$outputList) + $outputList := append!(thisPosMsgs,$outputList) if notThisPosMsgs then - $outputList := NCONC(notThisPosMsgs,$outputList) + $outputList := append!(notThisPosMsgs,$outputList) msgList redundant(msg,thisPosMsgs) == diff --git a/src/interp/msgdb.boot b/src/interp/msgdb.boot index bd3742e8..c821ed45 100644 --- a/src/interp/msgdb.boot +++ b/src/interp/msgdb.boot @@ -180,11 +180,11 @@ substituteSegmentedMsg(msg,args) == -- x is a special case (n > 2) and c = char "%" and stringChar(x,1) = char "k" => - l := nconc(reverse! pkey subString(x,2),l) + l := append!(reverse! pkey subString(x,2),l) -- ?name gets replaced by '"Push PF10" or '"Type >b (enter)" stringChar(x,0) = char "?" and n > 1 and - (v := pushOrTypeFuture(makeSymbol x,nil)) => l := nconc(reverse! v,l) + (v := pushOrTypeFuture(makeSymbol x,nil)) => l := append!(reverse! v,l) -- x requires parameter substitution stringChar(x,0) = char "%" and n > 1 and digit? stringChar(x,1) => diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 71b401bc..75e58532 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -684,7 +684,7 @@ changeDirectoryInSlot1() == --called by buildFunctor [opsig,pred,[op,a,vectorLocation(first opsig,second opsig)]] [opsig,pred,fnsel] sortedOplist := listSort(function GLESSEQP, - COPY_-LIST $lisplibOperationAlist,function second) + copyList $lisplibOperationAlist,function second) $lastPred: local := false $newEnv: local := $e vectorRef($domainShell,1) := [fn entry for entry in sortedOplist] where diff --git a/src/interp/parsing.lisp b/src/interp/parsing.lisp index ffb2bc55..6a33d361 100644 --- a/src/interp/parsing.lisp +++ b/src/interp/parsing.lisp @@ -358,7 +358,7 @@ the stack, then stack a NIL. Return the value of prod." (loop (let ((m (length /gensymlist))) (if (< m n) - (setq /gensymlist (nconc /gensymlist `(,(intern (format nil "G~D" (1+ m)))))) + (setq /gensymlist (|append!| /gensymlist `(,(intern (format nil "G~D" (1+ m)))))) (return (nth (1- n) /gensymlist)))))) ; 3 D. Managing rule sets diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index 306c4d48..12cb1215 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -296,7 +296,7 @@ hasOptArgs? argSex == opt := [[lhs, rhs], :opt] nonOpt := [arg, :nonOpt] null opt => nil - NCONC (reverse! nonOpt, [["construct", :reverse! opt]]) + append!(reverse! nonOpt, [["construct", :reverse! opt]]) pfDefinition2Sex pf == $insideApplication > $insideQuasiquotation => diff --git a/src/interp/preparse.lisp b/src/interp/preparse.lisp index 1285de92..b3279119 100644 --- a/src/interp/preparse.lisp +++ b/src/interp/preparse.lisp @@ -353,8 +353,8 @@ (defun PARSEPILES (LOCS LINES) "Add parens and semis to lines to aid parsing." (mapl #'add-parens-and-semis-to-line - (NCONC LINES '(" ")) - (nconc locs '(nil))) + (|append!| LINES '(" ")) + (|append!| locs '(nil))) LINES) (defun add-parens-and-semis-to-line (slines slocs) diff --git a/src/interp/slam.boot b/src/interp/slam.boot index e0ff0c04..90c733c4 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -445,7 +445,7 @@ clearAllSlams x == someMoreToClear:= setDifference(LASSOC(x,$functorDependencyAlist),[:thoseToClear,: thoseCleared]) - NCONC(thoseToClear,someMoreToClear) + append!(thoseToClear,someMoreToClear) clearSlam("functor")== setDynamicBinding(mkCacheName functor,nil) diff --git a/src/interp/sys-macros.lisp b/src/interp/sys-macros.lisp index 33e18eb3..75beaa84 100644 --- a/src/interp/sys-macros.lisp +++ b/src/interp/sys-macros.lisp @@ -670,7 +670,7 @@ (LIST 'spadDO (|reverse!| IL) (LIST (MKPF (|reverse!| XCL) 'OR) XV) - (SEQOPT (CONS 'SEQ (NCONC (|reverse!| RSL) + (SEQOPT (CONS 'SEQ (|append!| (|reverse!| RSL) (LIST (LIST 'EXIT BD))))))) (COND ((ATOM (CAR X)) (FAIL))) @@ -873,7 +873,7 @@ (UNIONQ NIL) (|gcd| (|Zero|)) (|union| NIL) - (NCONC NIL) + (|append!| NIL) (|and| |true|) (|or| |false|) (AND 'T) @@ -1137,7 +1137,7 @@ (RETURN (COND ((AND $NEWSPAD) (CONS 'SEQ - (NCONC (DO_LET VARS INITS) + (|append!| (DO_LET VARS INITS) (LIST 'G190 ENDTEST BODYFORMS @@ -1159,7 +1159,7 @@ (ERROR (FORMAT NIL "BAD DO FORMAT~%~A" OL)))) (defmacro THETA (&rest LL) - (let (U (L (copy-list LL))) + (let (U (L (|copyList| LL))) (if (EQ (KAR L) '\,) `(theta CONS . ,(CDR L)) (progn @@ -1173,7 +1173,7 @@ (|reverse!| (CDR L))))))) (defmacro THETA1 (&rest LL) - (let (U (L (copy-list LL))) + (let (U (L (|copyList| LL))) (if (EQ (KAR L) '\,) (LIST 'NREVERSE-N (CONS 'THETA1 (CONS 'CONS (CDR L))) 1) (-REDUCE (CAR L) @@ -1210,7 +1210,7 @@ (defmacro COLLECT (&rest L) (let ((U (REPEAT-TRAN L NIL))) - (CONS 'THETA (CONS '\, (NCONC (CAR U) (LIST (CDR U))))))) + (CONS 'THETA (CONS '\, (|append!| (CAR U) (LIST (CDR U))))))) ;; ;; -*- Non-Local Gotos -*- diff --git a/src/interp/trace.boot b/src/interp/trace.boot index 4ea97d24..7cc14533 100644 --- a/src/interp/trace.boot +++ b/src/interp/trace.boot @@ -472,7 +472,7 @@ spadTrace(domain,options) == alias:= spadTraceAlias(domainId,op,n) $tracedModemap:= subTypes(mm,constructSubst(domain.0)) traceName:= BPITRACE(first domain.n,alias, options) - NCONC(pair,[listOfVariables,first domain.n,traceName,alias]) + append!(pair,[listOfVariables,first domain.n,traceName,alias]) domain.n.first := traceName sigSlotNumberAlist:= [x for x in sigSlotNumberAlist | CDDDR x] if $reportSpadTrace then diff --git a/src/interp/util.lisp b/src/interp/util.lisp index 9ba4839e..906b661b 100644 --- a/src/interp/util.lisp +++ b/src/interp/util.lisp @@ -562,8 +562,8 @@ (setq spads (directory "*.spad")) (dolist (spad spads) (multiple-value-setq (short long) (srcabbrevs spad)) - (setq names (nconc names short)) - (setq longnames (nconc longnames long))) + (setq names (|append!| names short)) + (setq longnames (|append!| longnames long))) (setq names (sort names #'string<)) (setq longnames (sort longnames #'string<)) (values names longnames)))) diff --git a/src/interp/vmlisp.lisp b/src/interp/vmlisp.lisp index b5eeb762..c6014d97 100644 --- a/src/interp/vmlisp.lisp +++ b/src/interp/vmlisp.lisp @@ -86,9 +86,6 @@ (defmacro closedfn (form) `(function ,form)) -(defmacro |copyList| (x) - `(copy-list ,x)) - (defmacro dcq (&rest args) (cons 'setqp args)) @@ -501,8 +498,8 @@ (DEQUOTE (cdr BV)))))) (defun lotsof (&rest items) - (setq items (copy-list items)) - (nconc items items)) + (setq items (|copyList| items)) + (|append!| items items)) ; 7.4 Using Macros @@ -797,8 +794,6 @@ (defun EFFACE (item list) (delete item list :count 1 :test #'equal)) -(defun NCONC2 (x y) (NCONC x y)) ;NCONC with exactly two arguments - ; 14.6 Miscellaneous (defun QSORT (l) @@ -1034,7 +1029,7 @@ (COND ((AND (NULL W) (OR (consp A) (simple-vector-p A))) (COND ((consp AVL) (setq W (car (RESETQ AVL (cdr AVL))))) ((setq PVL (CONS (setq W (GENSYM)) PVL)))))) - (setq C (NCONC (COND ((IDENTP A) `((setq ,a (ELT ,sv ,i)))) + (setq C (|append!| (COND ((IDENTP A) `((setq ,a (ELT ,sv ,i)))) ((OR (consp A) (simple-vector-p A)) `((setq ,w (ELT ,sv ,i)) ,@(dcqgenexp w a eqtag qflag)))) @@ -1066,7 +1061,7 @@ (DCQGENEXP (LIST 'CAR SV) A EQTAG QFLAG) ) (`((setq ,(or w sv) (CAR ,sv)) ,@(DCQGENEXP (OR W SV) A EQTAG QFLAG))))))) - (setq C (NCONC C (COND ((IDENTP D) `((setq ,d (CDR ,sv)))) + (setq C (|append!| C (COND ((IDENTP D) `((setq ,d (CDR ,sv)))) ((OR (consp D) (simple-vector-p D)) (COND ((OR W (IDENTP SV)) ) @@ -1131,7 +1126,7 @@ (if (AND (NULL W) (OR (consp A) (simple-vector-p A))) (push (setq W (GENSYM)) PVL)) (setq C - (NCONC + (|append!| (COND ( (OR (IDENTP A) @@ -1169,7 +1164,7 @@ `((setq ,w (CAR ,sv)) ,@(ECQGENEXP W A QFLAG))))) (setq C - (NCONC + (|append!| C (COND ( (OR (IDENTP D) (NUMP D) (AND (consp D) @@ -1232,7 +1227,7 @@ (simple-vector-p A))) (setq PVL (CONS (setq W (GENSYM)) PVL)) ) ) (setq C - (NCONC + (|append!| (COND ( (OR (IDENTP A) @@ -1273,7 +1268,7 @@ `((setq ,w (CAR ,sv)) ,@(RCQGENEXP W A QFLAG))))) (setq C - (NCONC + (|append!| C (COND ( (OR (IDENTP D) (NUMP D) (AND (consp D) (EQ (car D) 'QUOTE))) @@ -1453,7 +1448,7 @@ ( (AND (NOT (consp TMP1)) (NOT (simple-vector-p TMP1))) (FLAT-BV-LIST (QCDR BV-LIST)) ) ( 'T - (NCONC (FLAT-BV-LIST TMP1) (FLAT-BV-LIST (QCDR BV-LIST))) ) )) )) + (|append!| (FLAT-BV-LIST TMP1) (FLAT-BV-LIST (QCDR BV-LIST))) ) )) )) (defun VARP (TEST-ITEM) (COND |