diff options
32 files changed, 223 insertions, 163 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 4353c654..d0c98595 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,22 @@ 2011-04-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * boot/utility.boot (assocSymbol): New. + (applySubst): Likewise. Export. + * boot/ast.boot: Use it. Remove SUBLIS and SUBLISLIS. + * interp/ax.boot: Likewise. + * interp/br-con.boot: Likewise. + * interp/br-op1.boot: Likewise. + * interp/br-op2.boot: Likewise. + * interp/br-prof.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/compiler.boot: Likewise. + +2011-04-29 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/cattable.boot (hasCat): Add type. Accept only instantiation forms. (simpHasPred): Adjust call to hasCat. diff --git a/src/boot/strap/ast.clisp b/src/boot/strap/ast.clisp index 1ab3b6dd..a6f77349 100644 --- a/src/boot/strap/ast.clisp +++ b/src/boot/strap/ast.clisp @@ -1804,7 +1804,13 @@ (PROGN (SETQ |args| (CDR |ISTMP#2|)) T)))))) - (CONS 'VECTOR |args|)) + (RPLACA |x| 'VECTOR) (RPLACD |x| |args|)) + ((AND (CONSP |x|) (EQ (CAR |x|) '|vector|) + (PROGN + (SETQ |ISTMP#1| (CDR |x|)) + (AND (CONSP |ISTMP#1|) (NULL (CDR |ISTMP#1|)) + (EQ (CAR |ISTMP#1|) 'NIL)))) + (RPLACA |x| 'VECTOR) (RPLACD |x| NIL)) (T (|shoeCompTran1| (CAR |x|)) (|shoeCompTran1| (CDR |x|))))))))) diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp index 38951dd9..97428682 100644 --- a/src/boot/strap/utility.clisp +++ b/src/boot/strap/utility.clisp @@ -8,7 +8,7 @@ (EXPORT '(|objectMember?| |symbolMember?| |stringMember?| |charMember?| |scalarMember?| |listMember?| |reverse| |reverse!| |lastNode| |append!| |copyList| |substitute| |substitute!| - |setDifference|)) + |setDifference| |applySubst|)) (DEFUN |objectMember?| (|x| |l|) (LOOP @@ -120,6 +120,18 @@ ((NULL |y|) |x|) (T (RPLACD (|lastNode| |x|) |y|) |x|))) +(DEFUN |assocSymbol| (|s| |al|) + (PROG (|x|) + (RETURN + (LOOP + (COND + ((AND (CONSP |al|) + (PROGN (SETQ |x| (CAR |al|)) (SETQ |al| (CDR |al|)) T)) + (COND + ((AND (CONSP |x|) (EQ |s| (CAR |x|))) + (IDENTITY (RETURN |x|))))) + (T (RETURN NIL))))))) + (DEFUN |substitute!| (|y| |x| |s|) (COND ((NULL |s|) NIL) @@ -142,6 +154,21 @@ (T (CONS |h| |t|)))) (T |s|))))) +(DEFUN |applySubst| (|sl| |t|) + (PROG (|tl| |hd| |p|) + (RETURN + (COND + ((SYMBOLP |t|) + (COND + ((SETQ |p| (|assocSymbol| |t| |sl|)) (CDR |p|)) + (T |t|))) + ((CONSP |t|) (SETQ |hd| (|applySubst| |sl| (CAR |t|))) + (SETQ |tl| (|applySubst| |sl| (CDR |t|))) + (COND + ((AND (EQ |hd| (CAR |t|)) (EQ |tl| (CDR |t|))) |t|) + (T (CONS |hd| |tl|)))) + (T |t|))))) + (DEFUN |setDifference| (|x| |y|) (PROG (|a| |l| |p|) (RETURN diff --git a/src/boot/utility.boot b/src/boot/utility.boot index 0b15569c..e344dc63 100644 --- a/src/boot/utility.boot +++ b/src/boot/utility.boot @@ -34,7 +34,8 @@ import initial_-env namespace BOOTTRAN module utility (objectMember?, symbolMember?, stringMember?, charMember?, scalarMember?, listMember?, reverse, reverse!, - lastNode, append!, copyList, substitute, substitute!, setDifference) + lastNode, append!, copyList, substitute, substitute!, setDifference, + applySubst) --% membership operators @@ -133,6 +134,15 @@ append!(x,y) == lastNode(x).rest := y x +--% a-list + +assocSymbol(s,al) == + repeat + al is [x,:al] => + cons? x and symbolEq?(s,first x) => + return x + return nil + --% substitution substitute!(y,x,s) == @@ -153,6 +163,17 @@ substitute(y,x,s) == [h,:t] s +applySubst(sl,t) == + symbol? t => + p := assocSymbol(t,sl) => rest p + t + cons? t => + hd := applySubst(sl,first t) + tl := applySubst(sl,rest t) + sameObject?(hd,first t) and sameObject?(tl,rest t) => t + [hd,:tl] + t + --% set operations setDifference(x,y) == diff --git a/src/interp/as.boot b/src/interp/as.boot index fba80995..d85b4743 100644 --- a/src/interp/as.boot +++ b/src/interp/as.boot @@ -91,9 +91,9 @@ asyParents(conform) == modemap := LASSOC(con,$mmAlist) $constructorCategory :local := asySubstMapping modemap.mmTarget for x in folks $constructorCategory repeat --- x := SUBLISLIS(formalParams,formals,x) --- x := SUBLISLIS(IFCDR conform,formalParams,x) --- x := SUBST('Type,'Object,x) +-- x := applySubst(pairList(formals,formalParams),x) +-- x := applySubst(pairList(formalParams,IFCDR conform),x) +-- x := substitute('Type,'Object,x) acc := [:explodeIfs x,:acc] reverse! acc @@ -148,12 +148,13 @@ asMakeAlist con == parents := mySort HGET($parentsHash,con) --children:= mySort HGET($childrenHash,con) alists := HGET($opHash,con) - opAlist := SUBLISLIS($FormalMapVariableList,KDR form,CDDR alists) - ancestorAlist:= SUBLISLIS($FormalMapVariableList,KDR form,first alists) + opAlist := applySubst(pairList(KDR form,$FormalMapVariableList),CDDR alists) + ancestorAlist := + applySubst(pairList(KDR form,$FormalMapVariableList),first alists) catAttrs := [[x,:true] for x in getAttributesFromCATEGORY $constructorCategory] attributeAlist := removeDuplicates [:second alists,:catAttrs] documentation := - SUBLISLIS($FormalMapVariableList,KDR form,LASSOC(con,$docAlist)) + applySubst(pairList(KDR form,$FormalMapVariableList),LASSOC(con,$docAlist)) filestring := strconc(PATHNAME_-NAME STRINGIMAGE filename,'".as") constantPart := HGET($constantHash,con) and [['constant,:true]] niladicPart := symbolMember?(con,$niladics) and [['NILADIC,:true]] @@ -161,11 +162,11 @@ asMakeAlist con == constructorCategory := kind is 'category => talist := TAKE(#KDR form, $TriangleVariableList) - SUBLISLIS(talist, falist, $constructorCategory) - SUBLISLIS(falist,KDR form,$constructorCategory) + applySubst(pairList(falist,talist),$constructorCategory) + applySubst(pairList(KDR form,falist),$constructorCategory) if constructorCategory='Category then kind := 'category exportAlist := asGetExports(kind, form, constructorCategory) - constructorModemap := SUBLISLIS(falist,KDR form,modemap) + constructorModemap := applySubst(pairList(KDR form,falist),modemap) --TTT fix a niladic category constructormodemap (remove the joins) if kind is 'category then constructorModemap.mmTarget := $Category @@ -277,15 +278,15 @@ asGetModemaps(opAlist,oform,kind,modemap) == catPredList:= kind is 'function => [["isFreeFunction","*1",opOf form]] [['ofCategory,:u] for u in [:pred1,:domainList]] --- for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat +-- for [op,:itemlist] in applySubst(pairList($FormalMapVariableList,rpvl),opAlist) repeat -- the code seems to oscillate between generating $FormalMapVariableList -- and generating $TriangleVariableList - for [op,:itemlist] in SUBLISLIS(rpvl, $FormalMapVariableList,opAlist) repeat + for [op,:itemlist] in applySubst(pairList($FormalMapVariableList,rpvl),opAlist) repeat for [sig0, pred] in itemlist repeat sig := substitute(dc,"$",sig0) pred:= substitute(dc,"$",pred) - sig := SUBLISLIS(rpvl,KDR oform,sig) - pred:= SUBLISLIS(rpvl,KDR oform,pred) + sig := applySubst(pairList(KDR oform,rpvl),sig) + pred:= applySubst(pairList(KDR oform,rpvl),pred) pred := pred or 'T ----------> Constants change <-------------- if IDENTP sig0 then @@ -772,7 +773,7 @@ asyConstructorModemap con == signature := asySignature(sig,false) formals := ['_$,:TAKE(#$constructorArgs,$FormalMapVariableList)] mm := [[[con,:$constructorArgs],:signature],['T,con]] - SUBLISLIS(formals,['_%,:$constructorArgs],mm) + applySubst(pairList(['_%,:$constructorArgs],formals),mm) asySignature(sig,names?) == sig is ['Join,:.] => [asySig(sig,nil)] @@ -1119,7 +1120,7 @@ asCategoryParts(kind,conform,category,:options) == main where if cons? then res := [listSort(function GLESSEQP,$conslist),:res] if kind is 'category then tvl := TAKE(#rest conform,$TriangleVariableList) - res := SUBLISLIS($FormalMapVariableList,tvl,res) + res := applySubst(pairList(tvl,$FormalMapVariableList),res) res where build(item,pred) == diff --git a/src/interp/ax.boot b/src/interp/ax.boot index 1c56ab71..efd54a99 100644 --- a/src/interp/ax.boot +++ b/src/interp/ax.boot @@ -107,7 +107,7 @@ modemapToAx(modemap) == resultType := axFormatType stripType target categoryForm? constructor => categoryInfo := getConstructorCategoryFromDB constructor - categoryInfo := SUBLISLIS($FormalMapVariableList, $TriangleVariableList, + categoryInfo := applySubst(pairList($TriangleVariableList,$FormalMapVariableList), categoryInfo) null args => ['Define,['Declare, constructor,'Category], @@ -174,7 +174,7 @@ axFormatType(typeform) == ['RestrictTo, ['LitInteger, STRINGIMAGE typeform ], 'PositiveInteger] FLOATP typeform => ['LitFloat, STRINGIMAGE typeform] symbolMember?(typeform,$TriangleVariableList) => - SUBLISLIS($FormalMapVariableList, $TriangleVariableList, typeform) + applySubst(pairList($TriangleVariableList, $FormalMapVariableList), typeform) symbolMember?(typeform, $FormalMapVariableList) => typeform axAddLiteral('string, 'Symbol, 'Literal) ['RestrictTo, ['LitString, symbolName typeform], 'Symbol] @@ -364,7 +364,7 @@ get1defaultOp(op,index) == signumList := -- following substitution fixes the problem that default packages -- have $ added as a first arg, thus other arg counts are off by 1. - SUBLISLIS($FormalMapVariableList, rest $FormalMapVariableList, + applySubst(pairList(rest $FormalMapVariableList,$FormalMapVariableList), dcSig(numvec,index,numOfArgs)) index := index + numOfArgs + 1 slotNumber := numvec.index diff --git a/src/interp/br-con.boot b/src/interp/br-con.boot index e7263dbb..93ee91ea 100644 --- a/src/interp/br-con.boot +++ b/src/interp/br-con.boot @@ -246,7 +246,7 @@ reportAO(kind,oplist) == htSay '"\newline " mkDomTypeForm(typeForm,conform,domname) == --called by kargPage - domname => SUBLISLIS(rest domname,rest conform,typeForm) + domname => applySubst(pairList(conform.args,domname.args),typeForm) typeForm is ['Join,:r] => ['Join,:[mkDomTypeForm(t,conform,domname) for t in r]] null hasIdent typeForm => typeForm nil @@ -397,10 +397,11 @@ dbSearchOrder(conform,domname,$domain) == --domain = nil or set to live domain catforms := [[pakform,:pred] for i in 0..maxIndex catvec | test ] where test() == pred := simpCatPredicate - p:=SUBLISLIS(rest conform,$FormalMapVariableList,kTestPred catpredvec.i) + p := applySubst(pairList($FormalMapVariableList,conform.args),kTestPred catpredvec.i) $domain => eval p p - if domname and CONTAINED('$,pred) then pred := substitute(domname,'$,pred) + if domname and CONTAINED('$,pred) then + pred := substitute(domname,'$,pred) -- which = '"attribute" => pred --all categories (pak := catinfo . i) and pred --only those with default packages pakform() == @@ -502,7 +503,8 @@ kcpPage(htPage,junk) == conname := opOf conform page := htInitPage(['"Parents of ",:heading],htCopyProplist htPage) parents := parentsOf conname --was listSort(function GLESSEQP, =this) - if domname then parents := SUBLISLIS(rest domname,rest conform,parents) + if domname then + parents := applySubst(pairList(conform.args,domname.args),parents) htpSetProperty(htPage,'cAlist,parents) htpSetProperty(htPage,'thing,'"parent") choice := @@ -511,7 +513,7 @@ kcpPage(htPage,junk) == dbShowCons(htPage,choice) reduceAlistForDomain(alist,domform,conform) == --called from kccPage - alist := SUBLISLIS(rest domform,rest conform,alist) + alist := applySubst(pairList(conform.args,domform.args),alist) for pair in alist repeat pair.rest := simpHasPred(rest pair,domform) [pair for (pair := [.,:pred]) in alist | pred] @@ -625,7 +627,7 @@ kcnPage(htPage,junk) == opOf conform domList := getImports pakname if domname then - domList := SUBLISLIS([domname,:rest domname],['$,:rest conform],domList) + domList := applySubst(pairList(['$,:conform.args],[domname,:domname.args]),domList) cAlist := [[x,:true] for x in domList] htpSetProperty(htPage,'cAlist,cAlist) htpSetProperty(htPage,'thing,'"benefactor") @@ -836,7 +838,7 @@ dbConstructorDoc(conform,$op,$sig) == fn conform where gn([op,:alist]) == op = $op and "or"/[doc or '("") for [sig,:doc] in alist | hn sig] hn sig == - #$sig = #sig and $sig = SUBLISLIS($args,$FormalMapVariableList,sig) + #$sig = #sig and $sig = applySubst(pairList($FormalMapVariableList,$args),sig) dbDocTable conform == --assumes $docTableHash bound --see dbExpandOpAlistIfNecessary @@ -860,9 +862,9 @@ originsInOrder conform == --domain = nil or set to live domain dbAddDocTable conform == conname := opOf conform - storedArgs := rest getConstructorForm conname - for [op,:alist] in SUBLISLIS(["$",:rest conform], - ["%",:storedArgs],getConstructorDocumentationFromDB opOf conform) + storedArgs := getConstructorForm(conname).args + for [op,:alist] in applySubst(pairList(["%",:storedArgs],["$",:conform.args]), + getConstructorDocumentationFromDB opOf conform) repeat op1 := op = '(Zero) => 0 @@ -895,7 +897,7 @@ dbGetDocTable(op,$sig,docTable,$which,aux) == main where hn [sig,:doc] == $which = '"attribute" => sig is ['attribute,: =$sig] and doc pred := #$sig = #sig and - alteredSig := SUBLISLIS(KDR $conform,$FormalMapVariableList,sig) + alteredSig := applySubst(pairList($FormalMapVariableList,KDR $conform),sig) alteredSig = $sig pred => doc => @@ -1068,7 +1070,7 @@ dbShowConsDoc1(htPage,conform,indexOrNil) == signature := getConstructorSignature conname sig := getConstructorKindFromDB conname = "category" => - SUBLISLIS(conargs,$TriangleVariableList,signature) + applySubst(pairList($TriangleVariableList,conargs),signature) sublisFormal(conargs,signature) htSaySaturn '"\begin{description}" displayDomainOp(htPage,'"constructor",conform,conname,sig,true,doc,indexOrNil,'dbSelectCon,null exposeFlag,nil) diff --git a/src/interp/br-data.boot b/src/interp/br-data.boot index 4d20e105..394d3d95 100644 --- a/src/interp/br-data.boot +++ b/src/interp/br-data.boot @@ -131,11 +131,11 @@ buildLibdbString [x,:u] == libConstructorSig [conname,:argl] == [[.,:sig],:.] := getConstructorModemapFromDB conname formals := TAKE(#argl,$FormalMapVariableList) - sig := SUBLISLIS(formals,$TriangleVariableList,sig) + sig := applySubst(pairList($TriangleVariableList,formals),sig) keys := [g(f,sig,i) for f in formals for i in 1..] where g(x,u,i) == --does x appear in any but i-th element of u? or/[CONTAINED(x,y) for y in u for j in 1.. | j ~= i] - sig := fn SUBLISLIS(argl,$FormalMapVariableList,sig) where + sig := fn applySubst(pairList($FormalMapVariableList,argl),sig) where fn x == atom x => x x is ['Join,a,:r] => ['Join,fn a,'etc] @@ -169,8 +169,8 @@ buildLibOps oplist == for [op,sig,:pred] in oplist repeat buildLibOp(op,sig,pred buildLibOp(op,sig,pred) == --operations OKop \#\sig \conname\pred\comments (K is U or C) - nsig := SUBLISLIS(rest $conform,$FormalMapVariableList,sig) - pred := SUBLISLIS(rest $conform,$FormalMapVariableList,pred) + nsig := applySubst(pairList($FormalMapVariableList,$conform.args),sig) + pred := applySubst(pairList($FormalMapVariableList,$conform.args),pred) nsig := substitute("T","T$",nsig) --this ancient artifact causes troubles! pred := substitute("T","T$",pred) sigpart:= form2LispString ['Mapping,:nsig] @@ -217,7 +217,7 @@ buildLibAttr(name,argl,pred) == --attributes AKname\#\args\conname\pred\comments (K is U or C) header := strconc('"a",STRINGIMAGE name) argPart:= subString(form2LispString ['f,:argl],1) - pred := SUBLISLIS(rest $conform,$FormalMapVariableList,pred) + pred := applySubst(pairList($FormalMapVariableList,$conform.args),pred) predString := (pred = 'T => '""; form2LispString pred) header := strconc('"a",STRINGIMAGE name) conname := strconc($kind,form2LispString $conname) @@ -496,7 +496,7 @@ getImports conname == --called by mkUsersHashTable x = "$$" => "$$" string? x => x systemError '"bad argument in template" - listSort(function GLESSEQP,SUBLISLIS(rest conform,$FormalMapVariableList,u)) + listSort(function GLESSEQP,applySubst(pairList($FormalMapVariableList,conform.args),u)) --============================================================================ @@ -508,8 +508,8 @@ getParentsFor(cname,formalParams,constructorCategory) == formals := TAKE(#formalParams,$TriangleVariableList) constructorForm := getConstructorFormFromDB cname for x in folks constructorCategory repeat - x := SUBLISLIS(formalParams,formals,x) - x := SUBLISLIS(IFCDR constructorForm,formalParams,x) + x := applySubst(pairList(formals,formalParams),x) + x := applySubst(pairList(formalParams,IFCDR constructorForm),x) x := substitute('Type,'Object,x) acc := [:explodeIfs x,:acc] reverse! acc @@ -528,7 +528,7 @@ parentsOfForm [op,:argl] == parents := parentsOf op null argl or argl = (newArgl := rest getConstructorFormFromDB op) => parents - SUBLISLIS(argl, newArgl, parents) + applySubst(pairList(newArgl,argl),parents) getParentsForDomain domname == --called by parentsOf acc := nil @@ -572,7 +572,7 @@ descendantsOf(conform,domform) == --called by kcdPage [op,:argl] := conform null argl or argl = (newArgl := rest getConstructorFormFromDB op) => cats - SUBLISLIS(argl, newArgl, cats) + applySubst(pairList(newArgl,argl),cats) 'notAvailable childrenOf conform == @@ -638,11 +638,11 @@ ancestorsRecur(conform,domform,pred,firstTime?) == --called by ancestorsOf firstTime? and ($insideCategoryIfTrue or $insideFunctorIfTrue) => $form getConstructorForm op if conform ~= originalConform then - parents := SUBLISLIS(IFCDR conform,IFCDR originalConform,parents) + parents := applySubst(pairList(IFCDR originalConform,IFCDR conform),parents) for [newform,:p] in parents repeat if domform and rest domform then - newdomform := SUBLISLIS(rest domform,rest conform,newform) - p := SUBLISLIS(rest domform,rest conform,p) + newdomform := applySubst(pairList(conform.args,domform.args),newform) + p := applySubst(pairList(conform.args,domform.args),p) newPred := quickAnd(pred,p) ancestorsAdd(simpHasPred newPred,newdomform or newform) ancestorsRecur(newform,newdomform,newPred,false) diff --git a/src/interp/br-op1.boot b/src/interp/br-op1.boot index aa0be712..41409eb1 100644 --- a/src/interp/br-op1.boot +++ b/src/interp/br-op1.boot @@ -737,7 +737,7 @@ reduceOpAlistForDomain(opAlist,domform,conform) == pair.rest := [test for item in rest pair | test] where test() == [head,:tail] := item first tail = true => item - pred := simpHasPred SUBLISLIS(form1,form2,first tail) + pred := simpHasPred applySubst(pairList(form2,form1),first tail) null pred => false item.rest := [pred] item @@ -858,8 +858,8 @@ dbExpandOpAlistIfNecessary(htPage,opAlist,which,needOrigins?,condition?) == u := tail is [.,origin,:.] and origin => -- must change any % into $ otherwise we will not pick up comments properly --- delete the SUBLISLIS when we fix on % or $ - dbGetDocTable(op,SUBLISLIS(['$],['%],sig),dbDocTable origin,which,nil) +-- delete the substitute when we fix on % or $ + dbGetDocTable(op,substitute('%,'$,sig),dbDocTable origin,which,nil) if packageSymbol then sig := substitute('_$,packageSymbol,sig) dbGetDocTable(op,sig,docTable,which,nil) origin := IFCAR u or origin diff --git a/src/interp/br-op2.boot b/src/interp/br-op2.boot index f8fc5cc9..a7f186e9 100644 --- a/src/interp/br-op2.boot +++ b/src/interp/br-op2.boot @@ -258,7 +258,7 @@ whoUsesOperation(htPage,which,key) == --see dbPresentOps opl := nil for [op,:alist] in opAlist repeat for [sig,:.] in alist repeat - opl := [[op,:SUBLISLIS($FormalMapVariableList,rest conform,sig)],:opl] + opl := [[op,:applySubst(pairList(conform.args,$FormalMapVariableList),sig)],:opl] opl := reverse! opl u := whoUses(opl,conform) prefix := pluralSay(#u,'"constructor uses",'"constructors use") @@ -370,7 +370,7 @@ koOps(conform,domname,:options) == main where -- if relatives? then -- relatives := relativesOf(conform,domname) -- if domname then relatives := --- SUBLISLIS([domname,:rest domname],['_$,:rest conform],relatives) +-- applySubst(pairList(['_$,:conform.args],[domname,:domname.args]),relatives) -- --kill all relatives that have a sharp variable remaining in them -- for x in relatives repeat -- or/[y for y in CDAR x | isSharpVar y] => 'skip @@ -559,7 +559,7 @@ modemap2Sig(op,mm) == false condlist := modemap2SigConds conds [origin, vlist, flist] := getDcForm(dc, condlist) or return nil - subcondlist := SUBLISLIS(flist, vlist, condlist) + subcondlist := applySubst(pairList(vlist,flist),condlist) [predList,vlist, flist] := getSigSubst(subcondlist, nil, vlist, flist) if partial? then target := dcSig . 1 diff --git a/src/interp/br-prof.boot b/src/interp/br-prof.boot index aa867a79..f0117bd6 100644 --- a/src/interp/br-prof.boot +++ b/src/interp/br-prof.boot @@ -83,7 +83,7 @@ dbShowInfoOp(htPage,op,sig,alist) == faTypes := CDDAR getConstructorModemapFromDB conname conArgTypes := - SUBLISLIS(IFCDR conform,TAKE(#faTypes,$FormalMapVariableList),faTypes) + applySubst(pairList(TAKE(#faTypes,$FormalMapVariableList),IFCDR conform),faTypes) conform := htpProperty(htPage,'conform) conname := opOf conform --argTypes := reverse ASSOCRIGHT symbolLassoc('arguments,alist) diff --git a/src/interp/br-saturn.boot b/src/interp/br-saturn.boot index 916b02df..f380a334 100644 --- a/src/interp/br-saturn.boot +++ b/src/interp/br-saturn.boot @@ -1,6 +1,6 @@ -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -942,7 +942,7 @@ addParameterTemplates(page, conform) == htSaySaturn '" = }" htSaySaturnAmpersand() htSaySaturn '"\colorbuttonbox{lightgray}{\inputbox[2.5in]{\" - htSaySaturn SUBLIS(argSublis,par) + htSaySaturn applySubst(argSublis,par) htSaySaturn '"}{" htSaySaturn argstring htSaySaturn '"}}" @@ -1251,7 +1251,7 @@ displayDomainOp(htPage,which,origin,op,sig,predicate, --that forgets to substitute #variables for t#variables; --check the signature for SegmentExpansionCategory, e.g. tvarlist := TAKE(# $conargs,$TriangleVariableList) - $signature := SUBLISLIS($FormalMapVariableList,tvarlist,$signature) + $signature := applySubst(pairList(tvarlist,$FormalMapVariableList),$signature) $sig := which = '"attribute" or which = '"constructor" => sig $conkind ~= '"package" => sig diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 7720c423..89115403 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -95,9 +95,9 @@ lookupPred(pred,dollar,domain) == keyedSystemError("S2NR0002",[pred]) substDollarArgs(dollar,domain,object) == - form := devaluate domain - SUBLISLIS([devaluate dollar,:rest form], - ["$",:$FormalMapVariableList],object) + form := devaluate domain + applySubst(pairList(["$",:$FormalMapVariableList],[devaluate dollar,:rest form]), + object) compareSig(sig,tableSig,dollar,domain) == not (#sig = #tableSig) => false @@ -215,8 +215,8 @@ NRTreplaceLocalTypes(t,dom) == t substDomainArgs(domain,object) == - form := devaluate domain - SUBLISLIS([form,:rest form],["$$",:$FormalMapVariableList],object) + form := devaluate domain + applySubst(pairList(["$$",:$FormalMapVariableList],[form,:rest form]),object) --======================================================= -- Category Default Lookup (from goGet or lookupInAddChain) diff --git a/src/interp/c-doc.boot b/src/interp/c-doc.boot index 6353531e..8d912a86 100644 --- a/src/interp/c-doc.boot +++ b/src/interp/c-doc.boot @@ -46,10 +46,10 @@ getDoc(conName,op,modemap) == sig := [target,:sl] cons? dc => sig := MSUSBT('$,dc,sig) - sig := SUBLISLIS($FormalMapVariableList,rest dc,sig) + sig := applySubst(pairList(dc.args,$FormalMapVariableList),sig) getDocForDomain(conName,op,sig) if argList := IFCDR getOfCategoryArgument pred then - SUBLISLIS($FormalMapArgumentList,argList,sig) + applySubst(pairList(argList,$FormalMapArgumentList),sig) sig := MSUBST('$,dc,sig) getDocForCategory(conName,op,sig) @@ -179,7 +179,7 @@ finalizeDocumentation() == fn(x,e) == atom x => [x,nil] if #x > 2 then x := TAKE(2,x) - SUBLISLIS($FormalMapVariableList,rest $lisplibForm, + applySubst(pairList($lisplibForm.args,$FormalMapVariableList), macroExpand(x,e)) hn u == -- ((op,sig,doc), ...) --> ((op ((sig doc) ...)) ...) diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index f6a0ede4..df690293 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -951,7 +951,7 @@ substituteOp(op',op,x) == [(op=(f:= first x) => op'; f),:[substituteOp(op',op,y) for y in rest x]] --substituteForFormalArguments(argl,expr) == --- SUBLIS([[v,:a] for a in argl for v in $FormalMapVariableList],expr) +-- applySubst([[v,:a] for a in argl for v in $FormalMapVariableList],expr) -- following is only intended for substituting in domains slots 1 and 4 -- signatures and categories @@ -1141,7 +1141,7 @@ registerFunctionReplacement(name,body) == eqSubstAndCopy: (%List %Form, %List %Symbol, %Form) -> %Form eqSubstAndCopy(args,parms,body) == - SUBLIS(pairList(parms,args),body,KEYWORD::TEST,function EQ) + applySubst(pairList(parms,args),body) eqSubst: (%List %Form, %List %Symbol, %Form) -> %Form eqSubst(args,parms,body) == diff --git a/src/interp/cattable.boot b/src/interp/cattable.boot index 7d3198e1..977ae46b 100644 --- a/src/interp/cattable.boot +++ b/src/interp/cattable.boot @@ -1,6 +1,6 @@ -- Copyright (C) 1991-2002, The Numerical Algorithms Group Ltd. -- All rights reserved. --- Copyright (C) 2007-2010, Gabriel Dos Reis. +-- Copyright (C) 2007-2011, Gabriel Dos Reis. -- All rights reserved. -- -- Redistribution and use in source and binary forms, with or without @@ -165,7 +165,7 @@ simpCatHasAttribute(domform,attr) == u := LASSOC(attr,catval . 2) => first u return false --exit: not there pred = true => true - eval SUBLISLIS(rest domform,rest conform,pred) + eval applySubst(pairList(conform.args,domform.args),pred) hasIdent pred == pred is [op,:r] => @@ -385,7 +385,7 @@ categoryParts(conform,category,:options) == main where res := [listSort(function GLESSEQP,$conslist),:res] if getConstructorKindFromDB conname is "category" then tvl := TAKE(#rest conform,$TriangleVariableList) - res := SUBLISLIS($FormalMapVariableList,tvl,res) + res := applySubst(pairList(tvl,$FormalMapVariableList),res) res build(item,pred) == item is ['SIGNATURE,op,sig,:.] => $oplist := [[opOf op,sig,:pred],:$oplist] diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index cd75e326..508248a9 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -219,9 +219,9 @@ applyMapping([op,:argl],m,e,ml) == #argl ~= #ml-1 => nil isCategoryForm(first ml,e) => --is op a functor? - pairlis:= pairList($FormalMapVariableList,argl) - ml' := SUBLIS(pairlis, ml) - argl':= + pairlis := pairList($FormalMapVariableList,argl) + ml' := applySubst(pairlis,ml) + argl' := [T.expr for x in argl for m' in rest ml'] where T() == [.,.,e]:= comp(x,m',e) or return "failed" if argl'="failed" then return nil @@ -238,7 +238,7 @@ applyMapping([op,:argl],m,e,ml) == u ~= nil and u.expr is ["XLAM",:.] => ['%call,u.expr,:argl'] ['%call,['applyFun,op],:argl'] pairlis := pairList($FormalMapVariableList,argl') - convert([form,SUBLIS(pairlis,first ml),e],m) + convert([form,applySubst(pairlis,first ml),e],m) -- This version tends to give problems with #1 and categories -- applyMapping([op,:argl],m,e,ml) == @@ -247,7 +247,7 @@ applyMapping([op,:argl],m,e,ml) == -- isCategoryForm(first ml,e) => --is op a functor? -- form:= [op,:argl'] -- pairlis:= [[v,:a] for a in argl for v in $FormalMapVariableList] --- ml:= SUBLIS(pairlis,ml) +-- ml:= applySubst(pairlis,ml) -- true -- false -- argl':= @@ -261,7 +261,7 @@ applyMapping([op,:argl],m,e,ml) == -- op':= makeSymbol strconc(STRINGIMAGE $prefix,";",STRINGIMAGE op) -- ['%call,["applyFun",op],:argl'] -- pairlis:= [[v,:a] for a in argl' for v in $FormalMapVariableList] --- convert([form,SUBLIS(pairlis,first ml),e],m) +-- convert([form,applySubst(pairlis,first ml),e],m) hasFormalMapVariable(x, vl) == $formalMapVariables: local := vl @@ -516,7 +516,7 @@ compForm1(form is [op,:argl],m,e) == compForm2(form is [op,:argl],m,e,modemapList) == aList := pairList($TriangleVariableList,argl) - modemapList := SUBLIS(aList,modemapList) + modemapList := applySubst(aList,modemapList) deleteList := [] newList := [] -- now delete any modemaps that are subsumed by something else, @@ -723,11 +723,11 @@ substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) == '"Incompatible maps"]) #argl=#sig.source => --here, we actually have a functor form - sig:= EQSUBSTLIST(argl,dc.args,sig) + sig := applySubst(pairList(dc.args,argl),sig) --make new modemap, subst. actual for formal parametersinto modemap Tl:= [[.,.,e]:= compOrCroak(a,m,e) for a in argl for m in rest sig] substitutionList:= [[x,:T.expr] for x in dc.args for T in Tl] - [SUBLIS(substitutionList,modemap),e] + [applySubst(substitutionList,modemap),e] nil --% SPECIAL EVALUATION FUNCTIONS @@ -1216,9 +1216,9 @@ compHas(pred is ["has",a,b],m,$e) == compHasFormat (pred is ["has",olda,b]) == argl := rest $form formals := TAKE(#argl,$FormalMapVariableList) - a := SUBLISLIS(argl,formals,olda) + a := applySubst(pairList(formals,argl),olda) [a,:.] := comp(a,$EmptyMode,$e) or return nil - a := SUBLISLIS(formals,argl,a) + a := applySubst(pairList(argl,formals),a) b is ["ATTRIBUTE",c] => ["HasAttribute",a,["QUOTE",c]] b is ["SIGNATURE",op,sig,:.] => ["HasSignature",a, diff --git a/src/interp/daase.lisp b/src/interp/daase.lisp index c51f8ef2..20c13873 100644 --- a/src/interp/daase.lisp +++ b/src/interp/daase.lisp @@ -1217,9 +1217,10 @@ (unless make-database? (if (eq kind '|category|) (setf (database-ancestors dbstruct) - (SUBLISLIS |$FormalMapVariableList| - (cdr constructorform) - (fetchdata alist in "ancestors")))) + (|applySubst| + (|pairList| (cdr constructorform) + |$FormalMapVariableList|) + (fetchdata alist in "ancestors")))) (|updateDatabase| key key systemdir?) ;makes many hashtables??? (|installConstructor| key kind) ;used to be key cname ... (|updateCategoryTable| key kind) diff --git a/src/interp/database.boot b/src/interp/database.boot index 1286a98a..6d6409d2 100644 --- a/src/interp/database.boot +++ b/src/interp/database.boot @@ -172,10 +172,10 @@ getConstructorKind ctor == augLisplibModemapsFromCategory(form is [op,:argl],body,signature) == sl := [["$",:"*1"],:pairList(argl,rest $PatternVariableList)] - form:= SUBLIS(sl,form) - body:= SUBLIS(sl,body) - signature:= SUBLIS(sl,signature) - opAlist:= SUBLIS(sl,$domainShell.(1)) or return nil + form:= applySubst(sl,form) + body:= applySubst(sl,body) + signature:= applySubst(sl,signature) + opAlist:= applySubst(sl,vectorRef($domainShell,1)) or return nil nonCategorySigAlist:= mkAlistOfExplicitCategoryOps substitute("*1","$",body) domainList:= @@ -633,7 +633,7 @@ mkDatabasePred [a,t] == ['ofType,a,t] formal2Pattern x == - SUBLIS(pairList($FormalMapVariableList,rest $PatternVariableList),x) + applySubst(pairList($FormalMapVariableList,rest $PatternVariableList),x) updateDatabase(fname,cname,systemdir?) == -- for now in NRUNTIME do database update only if forced @@ -684,8 +684,8 @@ getOplistForConstructorForm (form := [op,:argl]) == getOplistWithUniqueSignatures(op,pairlis,signatureAlist) == alist:= nil for [sig,:[slotNumber,pred,kind]] in signatureAlist | kind isnt 'Subsumed repeat - alist:= insertAlist(SUBLIS(pairlis,[op,sig]), - SUBLIS(pairlis,[pred,[kind,nil,slotNumber]]), + alist:= insertAlist(applySubst(pairlis,[op,sig]), + applySubst(pairlis,[pred,[kind,nil,slotNumber]]), alist) alist diff --git a/src/interp/define.boot b/src/interp/define.boot index 9b1cb4ed..0d5ea4c9 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -236,7 +236,7 @@ NRTmakeCategoryAlist() == $levelAlist: local := depthAssocList [CAAR x for x in pcAlist] opcAlist := reverse! SORTBY(function NRTcatCompare,pcAlist) newPairlis := [[5 + i,:b] for [.,:b] in $pairlis for i in 1..] - slot1 := [[a,:k] for [a,:b] in SUBLIS($pairlis,opcAlist) + slot1 := [[a,:k] for [a,:b] in applySubst($pairlis,opcAlist) | (k := predicateBitIndex b) ~= -1] slot0 := [hasDefaultPackage opOf a for [a,:b] in slot1] sixEtc := [5 + i for i in 1..#$pairlis] @@ -271,8 +271,8 @@ hasDefaultPackage catname == -- Compute the lookup function (complete or incomplete) --======================================================================= NRTgetLookupFunction(domform,exCategory,addForm) == - domform := SUBLIS($pairlis,domform) - addForm := SUBLIS($pairlis,addForm) + domform := applySubst($pairlis,domform) + addForm := applySubst($pairlis,addForm) $why: local := nil atom addForm => 'lookupComplete extends := NRTextendsCategory1(domform,exCategory,getExportCategory addForm) @@ -644,7 +644,7 @@ macroExpand(x,e) == --not worked out yet nil msg => (stackMessage(strconc(msg,'" to macro %1bp"),[op]); x) args' := macroExpandList(args,e) - SUBLISLIS(args',parms,body) + applySubst(pairList(parms,args'),body) macroExpandList(x,e) macroExpandList(l,e) == @@ -726,8 +726,9 @@ mkCategoryPackage(form is [op,:argl],cat,def) == [['SIGNATURE,op1,sig] for [[op1,sig],:.] in fullCatOpList | assoc(op1,capsuleDefAlist)] null catOpList => nil - packageCategory := ['CATEGORY,'domain, - :SUBLISLIS(argl,$FormalMapVariableList,catOpList)] + packageCategory := + ['CATEGORY,'domain, + :applySubst(pairList($FormalMapVariableList,argl),catOpList)] nils:= [nil for x in argl] packageSig := [packageCategory,form,:nils] $categoryPredicateList := substitute(nameForDollar,'$,$categoryPredicateList) @@ -761,8 +762,8 @@ compDefineCategory2(form,signature,specialCases,body,m,e, $functorForm:= $form:= [$op,:sargl] $formalArgList:= [:sargl,:$formalArgList] aList := pairList(argl,sargl) - formalBody:= SUBLIS(aList,body) - signature' := SUBLIS(aList,signature') + formalBody:= applySubst(aList,body) + signature' := applySubst(aList,signature') --Begin lines for category default definitions $functionStats: local:= [0,0] $functorStats: local:= [0,0] @@ -793,8 +794,8 @@ compDefineCategory2(form,signature,specialCases,body,m,e, -- 5. give operator a 'modemap property pairlis := pairList(argl,$FormalMapVariableList) - parSignature:= SUBLIS(pairlis,signature') - parForm:= SUBLIS(pairlis,form) + parSignature:= applySubst(pairlis,signature') + parForm:= applySubst(pairlis,form) -- If we are only interested in the defaults, there is no point -- in writing out compiler info and load-time stuff for -- the category which is assumed to have already been translated. @@ -949,8 +950,8 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], if not $insideCategoryPackageIfTrue then $e:= augModemapsFromCategory('_$,'_$,'_$,target,$e) $signature:= signature' - parSignature:= SUBLIS($pairlis,signature') - parForm:= SUBLIS($pairlis,form) + parSignature:= applySubst($pairlis,signature') + parForm:= applySubst($pairlis,form) -- (3.1) now make a list of the functor's local parameters; for -- domain D in argl,check its signature: if domain, its type is Join(A1,..,An); @@ -978,9 +979,9 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], body':= T.expr lamOrSlam:= if $mutableDomain then 'LAM else 'SPADSLAM - fun:= compile SUBLIS($pairlis, [op',[lamOrSlam,argl,body']]) + fun:= compile applySubst($pairlis, [op',[lamOrSlam,argl,body']]) --The above statement stops substitutions gettting in one another's way - operationAlist := SUBLIS($pairlis,$lisplibOperationAlist) + operationAlist := applySubst($pairlis,$lisplibOperationAlist) if $LISPLIB then augmentLisplibModemapsFromFunctor(parForm,operationAlist,parSignature) reportOnFunctorCompilation() @@ -1005,7 +1006,7 @@ compDefineFunctor1(df is ['DEF,form,signature,nils,body], $isOpPackageName: local := isCategoryPackageName $op if $isOpPackageName then lisplibWrite('"slot1DataBase", ['updateSlot1DataBase,MKQ $NRTslot1Info],$libFile) - $lisplibFunctionLocations := SUBLIS($pairlis,$functionLocations) + $lisplibFunctionLocations := applySubst($pairlis,$functionLocations) libFn := getConstructorAbbreviationFromDB op' $lookupFunction: local := NRTgetLookupFunction($functorForm,$lisplibModemap.mmTarget,$NRTaddForm) @@ -1163,7 +1164,7 @@ genDomainViewList(id,catlist) == mkOpVec(dom,siglist) == dom:= getPrincipalView dom substargs := [['$,:vectorRef(dom,0)], - :pairList($FormalMapVariableList,rest vectorRef(dom,0))] + :pairList($FormalMapVariableList,vectorRef(dom,0).args)] oplist:= getConstructorOperationsFromDB opOf dom.0 --new form is (<op> <signature> <slotNumber> <condition> <kind>) ops := newVector #siglist @@ -1171,7 +1172,7 @@ mkOpVec(dom,siglist) == u:= ASSQ(op,oplist) assoc(sig,u) is [.,n,.,'ELT] => vectorRef(ops,i) := vectorRef(dom,n) - noplist:= SUBLIS(substargs,u) + noplist := applySubst(substargs,u) -- following variation on assoc needed for GENSYMS in Mutable domains AssocBarGensym(substitute(dom.0,'$,sig),noplist) is [.,n,.,'ELT] => vectorRef(ops,i) := vectorRef(dom,n) diff --git a/src/interp/format.boot b/src/interp/format.boot index ff57521d..57b35ad0 100644 --- a/src/interp/format.boot +++ b/src/interp/format.boot @@ -407,7 +407,7 @@ form2String1 u == application2String(constructorName op,[form2String1(a) for a in argl], u1) ml := rest conSig if not freeOfSharpVars ml then - ml:=SUBLIS([[pvar,:val] for pvar in $FormalMapVariableList + ml := applySubst([[pvar,:val] for pvar in $FormalMapVariableList for val in argl], ml) argl:= formArguments2String(argl,ml) -- extra null check to handle mutable domain hack. diff --git a/src/interp/functor.boot b/src/interp/functor.boot index 2b71c72f..ab8d74fd 100644 --- a/src/interp/functor.boot +++ b/src/interp/functor.boot @@ -329,11 +329,11 @@ setVector12 args == SetDomainSlots124(vec,names,vals) == l := pairList(names,vals) - vec.1 := sublisProp(l,vec.1) - vec.2 := sublisProp(l,vec.2) + vectorRef(vec,1) := sublisProp(l,vectorRef(vec,1)) + vectorRef(vec,2) := sublisProp(l,vectorRef(vec,2)) l:= [[a,:devaluate b] for a in names for b in vals] - vec.4 := SUBLIS(l,vec.4) - vec.1 := SUBLIS(l,vec.1) + vectorRef(vec,4) := applySubst(l,vectorRef(vec,4)) + vectorRef(vec,1) := applySubst(l,vectorRef(vec,1)) sublisProp(subst,props) == null props => nil @@ -368,7 +368,7 @@ setVector3(name,instantiator) == mkDomainFormer x == if x is ['DomainSubstitutionMacro,parms,body] then x:=DomainSubstitutionFunction(parms,body) - x:=SUBLIS($extraParms,x) + x := applySubst($extraParms,x) --The next line ensures that only one copy of this structure will --appear in the BPI being generated, thus saving (some) space x is ['Join,:.] => ['eval,['QUOTE,x]] @@ -428,10 +428,10 @@ DescendCodeAdd(base,flag) == ans DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == - slist:= pairList(formalArgs,rest $addFormLhs) + slist := pairList(formalArgs,rest $addFormLhs) --base = comp $addFormLhs-- bound in compAdd e:= $e - newModes:= SUBLIS(slist,formalArgModes) + newModes := applySubst(slist,formalArgModes) or/[not comp(u,m,e) for u in rest $addFormLhs for m in newModes] => return nil --I should check that the actual arguments are of the right type @@ -448,7 +448,7 @@ DescendCodeAdd1(base,flag,target,formalArgs,formalArgModes) == for i in 6..n | cons? cat.i and cons? (sig:= first cat.i) and (u:= - SetFunctionSlots(SUBLIS(slist,sig),['ELT,instantiatedBase,i],flag, + SetFunctionSlots(applySubst(slist,sig),['ELT,instantiatedBase,i],flag, 'adding))~=nil] --The code from here to the end is designed to replace repeated LOAD/STORE --combinations (SETELT ...(ELT ..)) by MVCs where this is practicable @@ -565,7 +565,7 @@ ConstantCreator u == true ProcessCond cond == - ncond := SUBLIS($pairlis,cond) + ncond := applySubst($pairlis,cond) integer? POSN1(ncond,$NRTslot1PredicateList) => predicateBitRef ncond cond @@ -627,7 +627,7 @@ SigSlotsMatch(sig,pattern,implem) == sig' = pat' makeMissingFunctionEntry(alist,i) == - tran SUBLIS(alist,$SetFunctions.i) where + tran applySubst(alist,$SetFunctions.i) where tran x == x is ["HasCategory",a,["QUOTE",b]] => ["has",a,b] x is [op,:l] and op in '(AND OR NOT) => [op,:[tran y for y in l]] @@ -828,8 +828,8 @@ DescendCodeVarAdd(base,flag) == [[pred,implem]]] resolvePatternVars(p,args) == - p := SUBLISLIS(args, $TriangleVariableList, p) - SUBLISLIS(args, $FormalMapVariableList, p) + p := applySubst(pairList($TriangleVariableList,args),p) + applySubst(pairList($FormalMapVariableList,args),p) --% Code Processing Packages diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index ab1006e9..eceeae89 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -261,7 +261,7 @@ optCall (x is ['%call,:u]) == u is [['XLAM,vars,body],:args] => atom vars => body #vars > #args => systemErrorHere ['optCall,x] - resetTo(x,optXLAMCond SUBLIS(pairList(vars,args),body)) + resetTo(x,optXLAMCond applySubst(pairList(vars,args),body)) [fn,:a] := u atom fn => opt := fn has OPTIMIZE => resetTo(x,FUNCALL(opt,u)) @@ -595,9 +595,9 @@ optLET u == clause isnt [test,stmt] => continue := false -- Stop inlining at least one test is not simple not isSimpleVMForm test => continue := false - clause.first := SUBLIS(substPairs,test) + clause.first := applySubst(substPairs,test) isSimpleVMForm stmt => - clause.rest.first := SUBLIS(substPairs,stmt) + clause.rest.first := applySubst(substPairs,stmt) continue := false continue => body u @@ -610,7 +610,7 @@ optLET u == def := first defs atom def => systemErrorHere ["optLET",def] -- cannot happen def.rest := second def - SUBLIS(inits,body) + applySubst(inits,body) optBind form == form isnt ['%bind,inits,.] => form -- accept only simple bodies diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index 6f04fea8..47522a3b 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -292,7 +292,8 @@ addIntSymTabBinding(var,proplist,e is [[curContour,:.],:.]) == putMacro(lhs,rhs,e) == atom lhs => put(lhs,'macro,rhs,e) parms := [gensym() for p in lhs.args] - put(lhs.op,'macro,['%mlambda,parms,SUBLISLIS(parms,lhs.args,rhs)],e) + put(lhs.op,'macro, + ['%mlambda,parms,applySubst(pairList(lhs.args,parms),rhs)],e) --% Syntax manipulation diff --git a/src/interp/i-intern.boot b/src/interp/i-intern.boot index b9c8eec9..1e3cfab2 100644 --- a/src/interp/i-intern.boot +++ b/src/interp/i-intern.boot @@ -309,7 +309,7 @@ signatureFromModemap m == pred = true => rest sig pred.op in '(AND %and) => sl := [[a,:b] for [.,a,b] in rest pred] - rest SUBLIS(sl,sig) + rest applySubst(sl,sig) collectDefTypesAndPreds args == -- given an arglist to a DEF-like form, this function returns diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 2a8c6450..127e5d7c 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -429,13 +429,13 @@ simplifyMapPattern (x,alias) == lhs is ["|",y,pred] => pred:= predTran pred sl:= getEqualSublis pred => - y':= SUBLIS(sl,y) - pred:= unTrivialize SUBLIS(sl,pred) where unTrivialize x == + y' := applySubst(sl,y) + pred:= unTrivialize applySubst(sl,pred) where unTrivialize x == x is [op,:l] and op in '(and or) => MKPF([unTrivialize y for y in l],op) x is [op,a,=a] and op in '(_= is)=> true x - rhs':= SUBLIS(sl,rhs) + rhs':= applySubst(sl,rhs) pred=true => [y',:rhs'] [["PAREN",["|",y',pred]],:rhs'] pred=true => [y,:rhs] @@ -473,7 +473,7 @@ predTran x == x getEqualSublis pred == fn(pred,nil) where fn(x,sl) == - (x:= SUBLIS(sl,x)) is [op,:l] and op in '(and or) => + (x:= applySubst(sl,x)) is [op,:l] and op in '(and or) => for y in l repeat sl:= fn(y,sl) sl x is ["is",a,b] => [[a,:b],:sl] diff --git a/src/interp/lisplib.boot b/src/interp/lisplib.boot index a91b5d1d..a9bb318e 100644 --- a/src/interp/lisplib.boot +++ b/src/interp/lisplib.boot @@ -51,7 +51,7 @@ NRTgenInitialAttributeAlist attributeList == alist := [x for x in attributeList | -- throw out constructors not symbolMember?(opOf first x,allConstructors())] $lisplibAttributes := simplifyAttributeAlist - [[a,:b] for [a,b] in SUBLIS($pairlis,alist) | a isnt 'nothing] + [[a,:b] for [a,b] in applySubst($pairlis,alist) | a isnt 'nothing] simplifyAttributeAlist al == al is [[a,:b],:r] => @@ -107,8 +107,8 @@ makePredicateBitVector pl == --called by buildFunctor for q in stripOutNonDollarPreds pred repeat firsts := insert(q,firsts) else firsts := insert(pred,firsts) - firstPl := SUBLIS($pairlis,reverse! orderByContainment firsts) - lastPl := SUBLIS($pairlis,reverse! orderByContainment lasts) + firstPl := applySubst($pairlis,reverse! orderByContainment firsts) + lastPl := applySubst($pairlis,reverse! orderByContainment lasts) firstCode:= ['buildPredVector,0,0,mungeAddGensyms(firstPl,$predGensymAlist)] lastCode := augmentPredCode(# firstPl,lastPl) @@ -857,9 +857,9 @@ compDefineExports(form,ops,sig,e) == not $LISPLIB => systemErrorHere "compDefineExports" op := first form -- Ensure constructor parameters appear as formals - sig := SUBLIS($pairlis, sig) - ops := SUBLIS($pairlis,ops) - form := SUBLIS($pairlis,form) + sig := applySubst($pairlis, sig) + ops := applySubst($pairlis,ops) + form := applySubst($pairlis,form) -- In case we are not compiling the capsule, the slot numbers are -- most likely bogus. Nullify them so people don't think they -- bear any meaningful semantics (well, they should not think diff --git a/src/interp/macros.lisp b/src/interp/macros.lisp index 39ee68f4..0bc2adb5 100644 --- a/src/interp/macros.lisp +++ b/src/interp/macros.lisp @@ -212,21 +212,6 @@ ; 15.4 Substitution of Expressions -(DEFUN SUBSTEQ (NEW OLD FORM) - "Version of SUBST that uses EQ rather than EQUAL on the world." - (PROG (NFORM HNFORM ITEM) - (SETQ HNFORM (SETQ NFORM (CONS () ()))) - LP (RPLACD NFORM - (COND ((EQ FORM OLD) (SETQ FORM ()) NEW ) - ((NOT (PAIRP FORM)) FORM ) - ((EQ (SETQ ITEM (CAR FORM)) OLD) (CONS NEW ()) ) - ((PAIRP ITEM) (CONS (SUBSTEQ NEW OLD ITEM) ()) ) - ((CONS ITEM ())))) - (if (NOT (PAIRP FORM)) (RETURN (CDR HNFORM))) - (SETQ NFORM (CDR NFORM)) - (SETQ FORM (CDR FORM)) - (GO LP))) - (DEFUN SUBLISNQ (KEY E) (declare (special KEY)) (if (NULL KEY) E (SUBANQ E))) (DEFUN SUBANQ (E) @@ -240,9 +225,6 @@ ((EQ (CAAR X) E) (CDAR X)) ((SUBB (CDR X) E)))) -(defun SUBLISLIS (newl oldl form) - (sublis (mapcar #'cons oldl newl) form)) - ; 15.5 Using Lists as Sets (DEFUN PREDECESSOR (TL L) diff --git a/src/interp/modemap.boot b/src/interp/modemap.boot index 6d0c700b..16fc9084 100644 --- a/src/interp/modemap.boot +++ b/src/interp/modemap.boot @@ -79,7 +79,7 @@ domainMember(dom,domList) == or/[modeEqual(dom,d) for d in domList] getModemap(x is [op,:.],e) == for modemap in get(op,'modemap,e) repeat if u:= compApplyModemap(x,modemap,e) then return - ([.,.,sl]:= u; SUBLIS(sl,modemap)) + ([.,.,sl]:= u; applySubst(sl,modemap)) getUniqueSignature(form,e) == [[.,:sig],:.]:= getUniqueModemap(first form,#rest form,e) or return nil @@ -251,7 +251,7 @@ augModemapsFromDomain1(name,functorForm,e) == substituteCategoryArguments(argl,catform) == argl:= substitute("$$","$",argl) arglAssoc:= [[INTERNL("#",STRINGIMAGE i),:a] for i in 1.. for a in argl] - SUBLIS(arglAssoc,catform) + applySubst(arglAssoc,catform) --Called, by compDefineFunctor, to add modemaps for $ that may --be equivalent to those of Rep. We must check that these @@ -308,7 +308,7 @@ augModemapsFromCategory(domainName,domainView,functorForm,categoryForm,e) == -- --this is particularly dirty and should be cleaned up, say, by wrapping -- -- an appropriate lambda expression around mapping forms -- domainForm is [op,:l] and l => --- get(op,'modemap,e) is [[[mc,:.],:.]] => SUBLIS(PAIR(rest mc,l),catForm) +-- get(op,'modemap,e) is [[[mc,:.],:.]] => applySubst(PAIR(rest mc,l),catForm) -- catForm evalAndSub(domainName,viewName,functorForm,form,$e) == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index 1f014733..24978fbf 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -632,13 +632,14 @@ NRTmakeSlot1Info() == [:argl,dollarName] := rest $form [[dollarName,:'_$],:mkSlot1sublis argl] mkSlot1sublis rest $form - $lisplibOpAlist := transformOperationAlist SUBLIS(pairlis,$domainShell.1) + $lisplibOpAlist := + transformOperationAlist applySubst(pairlis,vectorRef($domainShell,1)) opList := $NRTderivedTargetIfTrue => 'derived $insideCategoryPackageIfTrue => slot1Filter $lisplibOpAlist $lisplibOpAlist - addList := SUBLIS(pairlis,$NRTaddForm) - [first $form,[addList,:opList]] + addList := applySubst(pairlis,$NRTaddForm) + [$form.op,[addList,:opList]] mkSlot1sublis argl == pairList(argl,$FormalMapVariableList) diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot index fe17142e..3b6952f8 100644 --- a/src/interp/nrunfast.boot +++ b/src/interp/nrunfast.boot @@ -685,7 +685,7 @@ newHasTest(domform,catOrAtt) == -- on second thoughts we won't! categoryForm? domform => domform = catOrAtt => 'T - for [aCat,:cond] in [:ancestorsOf(domform,NIL),:SUBLISLIS (rest domform,$FormalMapVariableList,getConstructorAttributesFromDB(opOf domform))] | aCat = catOrAtt repeat + for [aCat,:cond] in [:ancestorsOf(domform,NIL),:applySubst(pairList($FormalMapVariableList,rest domform),getConstructorAttributesFromDB(opOf domform))] | aCat = catOrAtt repeat return evalCond cond where evalCond x == atom x => x diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 4cdbeb82..6ab39d19 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -403,12 +403,12 @@ transCategoryItem x == $transCategoryAssoc:= [[lhs,:rhs],:$transCategoryAssoc] postError ['" Invalid signature: ",x] [op,:argl]:= lhs - extra:= nil + extra := nil if rhs is ["Mapping",:m] then if rest m then extra:= rest m --should only be 'constant' or 'variable' rhs:= first m - [["SIGNATURE",op,[rhs,:SUBLIS($transCategoryAssoc,argl)],:extra]] + [["SIGNATURE",op,[rhs,:applySubst($transCategoryAssoc,argl)],:extra]] [x] |