diff options
30 files changed, 125 insertions, 92 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 5a14afd2..47d574d0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,34 @@ +2010-05-23 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * boot/tokens.boot: gensym is now candidate for renaming. + * boot/ast.boot: Replace GENSYM with gensym. + * interp/buildom.boot: Likewise. + * interp/clam.boot: Likewise. + * interp/clammed.boot: Likewise. + * interp/compiler.boot: Likewise. + * interp/define.boot: Likewise. + * interp/fortcall.boot: Likewise. + * interp/g-opt.boot: Likewise. + * interp/i-coerce.boot: Likewise. + * interp/i-coerfn.boot: Likewise. + * interp/i-funsel.boot: Likewise. + * interp/i-map.boot: Likewise. + * interp/i-spec1.boot: Likewise. + * interp/i-spec2.boot: Likewise. + * interp/macex.boot: Likewise. + * interp/nruncomp.boot: Likewise. + * interp/nrunopt.boot: Likewise. + * interp/parse.boot: Likewise. + * interp/pf2atree.boot: Likewise. + * interp/pf2sex.boot: Likewise. + * interp/postpar.boot: Likewise. + * interp/ptrees.boot: Likewise. + * interp/server.boot: Likewise. + * interp/slam.boot: Likewise. + * interp/sys-constants.boot: Likewise. + * interp/wi1.boot: Likewise. + * interp/wi2.boot: Likewise. + 2010-05-22 Gabriel Dos Reis <gdr@cs.tamu.edu> * input/collect.input.pamphlet: Remove bogus expression. diff --git a/src/boot/ast.boot b/src/boot/ast.boot index 8de1ae5c..7f60ae1b 100644 --- a/src/boot/ast.boot +++ b/src/boot/ast.boot @@ -1455,7 +1455,7 @@ genECLnativeTranslation(op,s,t,op') == argtypes := nil for x in s repeat argtypes := [nativeArgumentType x,:argtypes] - args := [GENSYM(),:args] + args := [gensym(),:args] args := reverse args rettype := nativeReturnType t [["DEFUN",op, args, @@ -1500,7 +1500,7 @@ genCLISPnativeTranslation(op,s,t,op') == -- copy data there, pass pointers to them, and possibly copy -- them back. Ugh. n := INTERN strconc(PNAME op, '"%clisp-hack") - parms := [GENSYM '"parm" for x in s] -- parameters of the forward decl. + parms := [gensym '"parm" for x in s] -- parameters of the forward decl. -- Now, separate non-simple data from the rest. This is a triple-list -- of the form ((parameter boot-type . ffi-type) ...) @@ -1525,7 +1525,7 @@ genCLISPnativeTranslation(op,s,t,op') == -- gigantic buffer, you might find out that it is insanely inefficient. forwardingFun := unstableArgs = nil => ["DEFUN",op,parms, [n,:parms]] - localPairs := [[a,x,y,:GENSYM '"loc"] for [a,x,:y] in unstableArgs] + localPairs := [[a,x,y,:gensym '"loc"] for [a,x,:y] in unstableArgs] call := [n,:[actualArg(p,localPairs) for p in parms]] where actualArg(p,pairs) == @@ -1559,7 +1559,7 @@ genSBCLnativeTranslation(op,s,t,op') == rettype := nativeReturnType t argtypes := [nativeArgumentType x for x in s] - args := [GENSYM() for x in s] + args := [gensym() for x in s] unstableArgs := nil newArgs := nil for a in args for x in s repeat @@ -1591,7 +1591,7 @@ genCLOZUREnativeTranslation(op,s,t,op') == argtypes := [nativeArgumentType x for x in s] -- Build parameter list for the forwarding function - parms := [GENSYM '"parm" for x in s] + parms := [gensym '"parm" for x in s] -- Separate string arguments and array arguments from scalars. -- These array arguments need to be pinned down, and the string @@ -1599,8 +1599,8 @@ genCLOZUREnativeTranslation(op,s,t,op') == strPairs := nil aryPairs := nil for p in parms for x in s repeat - x = "string" => strPairs := [[p,:GENSYM '"loc"], :strPairs] - x is [.,["buffer",.]] => aryPairs := [[p,:GENSYM '"loc"], :aryPairs] + x = "string" => strPairs := [[p,:gensym '"loc"], :strPairs] + x is [.,["buffer",.]] => aryPairs := [[p,:gensym '"loc"], :aryPairs] -- Build the actual foreign function call. -- Note that Clozure CL does not mangle foreign function call for diff --git a/src/boot/strap/tokens.clisp b/src/boot/strap/tokens.clisp index 897bea78..88d2552a 100644 --- a/src/boot/strap/tokens.clisp +++ b/src/boot/strap/tokens.clisp @@ -206,6 +206,7 @@ (LIST '|exit| 'EXIT) (LIST '|false| 'NIL) (LIST '|first| 'CAR) (LIST '|fourth| 'CADDDR) (LIST '|function| 'FUNCTION) + (LIST '|gensym| 'GENSYM) (LIST '|genvar| 'GENVAR) (LIST '|integer?| 'INTEGERP) (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|) diff --git a/src/boot/tokens.boot b/src/boot/tokens.boot index 597ac295..74c5e437 100644 --- a/src/boot/tokens.boot +++ b/src/boot/tokens.boot @@ -247,6 +247,7 @@ for i in [ _ ["first", "CAR"] , _ ["fourth", "CADDDR"] , _ ["function","FUNCTION"] , _ + ["gensym", "GENSYM"] , _ ["genvar", "GENVAR"] , _ ["integer?","INTEGERP"] , _ ["lastNode", "LAST"] , _ diff --git a/src/interp/buildom.boot b/src/interp/buildom.boot index 175f1acb..e0a8bb71 100644 --- a/src/interp/buildom.boot +++ b/src/interp/buildom.boot @@ -195,7 +195,7 @@ UnionPrint(x, dom) == coerceUn2E(x, dom.0) coerceUn2E(x,source) == ["Union",:branches] := source predlist := mkPredList branches - byGeorge := byJane := GENSYM() + byGeorge := byJane := gensym() for b in stripUnionTags branches for p in predlist repeat typeFun := COERCE(["LAMBDA", '(_#1), p],"FUNCTION") if FUNCALL(typeFun,x) then return @@ -308,7 +308,7 @@ constructorCategory (title is [op,:.]) == --mkMappingFunList(nam,mapForm,e) == [[],e] mkMappingFunList(nam,mapForm,e) == nargs := #rest mapForm - dc := GENSYM() + dc := gensym() sigFunAlist:= [["=",[$Boolean,nam ,nam], ["ELT",dc,$FirstParamSlot + nargs]], ["~=",[$Boolean,nam,nam],["ELT",dc,0]], @@ -319,7 +319,7 @@ mkMappingFunList(nam,mapForm,e) == mkRecordFunList(nam,["Record",:Alist],e) == len:= #Alist - dc := GENSYM() + dc := gensym() sigFunAlist:= [["construct",[nam,:[A for [.,a,A] in Alist]],"mkRecord"], ["=",[$Boolean,nam ,nam],["ELT",dc,$FirstParamSlot + len]], @@ -352,7 +352,7 @@ mkNewUnionFunList(name,form is ["Union",:listOfEntries],e) == ["XLAM",["#1"],["QEQCAR","#1",i]]]] for [.,tag,type] in listOfEntries for i in 0..])] where cdownFun() == - gg:=GENSYM() + gg:=gensym() $InteractiveMode => ["XLAM",["#1"],["PROG1",["QCDR","#1"], ["check-union",["QEQCAR","#1",i],type,"#1"]]] @@ -376,7 +376,7 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) == nargs := #listOfEntries --1. create representations of subtypes predList:= mkPredList listOfEntries - g:=GENSYM() + g:=gensym() --2. create coercions from subtypes to subUnion cList:= [["=",[$Boolean,g ,g],["ELT",op,$FirstParamSlot + nargs]], @@ -393,7 +393,7 @@ mkUnionFunList(op,form is ["Union",:listOfEntries],e) == p is ["EQCAR",x,n] => ["XLAM",["#1"],["CONS",n,"#1"]] ["XLAM",["#1"],"#1"] cdownFun() == - gg:=GENSYM() + gg:=gensym() if p is ["EQCAR",x,n] then ref:=["QCDR",gg] q:= ["QEQCAR", gg, n] diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index ed49dc05..6fca669a 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1142,7 +1142,7 @@ replaceSimpleFunctions form == -- conservatively approximate eager semantics and/[isAtomicForm first as for as in tails args] => -- alpha rename before substitution. - newparms := [GENSYM() for p in parms] + newparms := [gensym() for p in parms] body := eqSubstAndCopy(newparms,parms,body) eqSubst(args,newparms,body) -- get cute later. @@ -1313,8 +1313,8 @@ backendCompileSLAM: (%Symbol,%List,%Code) -> %Symbol backendCompileSLAM(name,args,body) == al := INTERNL(name,'";AL") -- name of the cache alist. auxfn := INTERNL(name,'";") -- name of the worker function. - g1 := GENSYM() -- name for the parameter. - g2 := GENSYM() -- name for the cache value + g1 := gensym() -- name for the parameter. + g2 := gensym() -- name for the cache value u := -- body of the stub function null args => [nil,[auxfn]] null rest args => [[g1],[auxfn,g1]] @@ -1345,8 +1345,8 @@ backendCompileSPADSLAM: (%Symbol,%List,%Code) -> %Symbol backendCompileSPADSLAM(name,args,body) == al := INTERNL(name,'";AL") -- name of the cache hash table. auxfn := INTERNL(name,'";") -- name of the worker function. - g1 := GENSYM() -- name of the worker function parameter - g2 := GENSYM() -- name for the cache value. + g1 := gensym() -- name of the worker function parameter + g2 := gensym() -- name for the cache value. u := null args => [nil,nil,[auxfn]] null rest args => [[g1],["devaluate",g1],[auxfn,g1]] diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 0da5ffd9..c3349527 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -99,7 +99,7 @@ compClam(op,argl,body,$clamList) == [:bright cacheCount,'"computed values"] sayBrightly [:bright op,'"will save last",:phrase] auxfn:= INTERNL(op,'";") - g1:= GENSYM() --argument or argument list + g1:= gensym() --argument or argument list [arg,computeValue] := argl is [.] => [[g1],[auxfn,g1]] --g1 is a parameter [g1,['APPLX,['function,auxfn],g1]] --g1 is a parameter list @@ -111,8 +111,8 @@ compClam(op,argl,body,$clamList) == setDynamicBinding(callCounter,0) callCountCode:= [['SETQ,callCounter,['QSADD1,callCounter]]] hitCountCode:= [['SETQ,hitCounter,['QSADD1,hitCounter]]] - g2:= GENSYM() --length of cache or arg-value pair - g3:= GENSYM() --value computed by calling function + g2:= gensym() --length of cache or arg-value pair + g3:= gensym() --value computed by calling function lookUpFunction:= shiftFl => countFl => 'assocCacheShiftCount @@ -192,7 +192,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == --sayBrightly -- ["%b",op,"%d","hashes ",:middle,withWithout," reference counts"] auxfn:= INTERNL(op,'";") - g1:= GENSYM() --argument or argument list + g1:= gensym() --argument or argument list [arg,cacheArgKey,computeValue] := -- arg: to be used as formal argument of lambda construction; -- cacheArgKey: the form used to look up the value in the cache @@ -211,7 +211,7 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == setDynamicBinding(callCounter,0) callCountCode:= [['SETQ,callCounter,['QSADD1,callCounter]]] hitCountCode:= [['SETQ,hitCounter,['QSADD1,hitCounter]]] - g2:= GENSYM() --value computed by calling function + g2:= gensym() --value computed by calling function returnFoundValue:= null argl => -- if we have a global hastable, functions with no arguments are @@ -284,7 +284,7 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == if (not (eqEtc in '(UEQUAL))) then sayBrightly "for hash option, only EQ, CVEC, and UEQUAL are allowed" auxfn:= INTERNL(op,'";") - g1:= GENSYM() --argument or argument list + g1:= gensym() --argument or argument list [arg,cacheArgKey,computeValue] := -- arg: to be used as formal argument of lambda construction; -- cacheArgKey: the form used to look up the value in the cache @@ -294,7 +294,7 @@ compHashGlobal(op,argl,body,cacheName,eqEtc,countFl) == argl is [.] => [auxfn,g1] --g1 is a parameter ['APPLX,['function,auxfn],g1] --g1 is a parameter list [g1,['consForHashLookup,MKQ op,g1],application] - g2:= GENSYM() --value computed by calling function + g2:= gensym() --value computed by calling function returnFoundValue:= countFl => ['CDRwithIncrement,g2] g2 diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot index 12e6d458..b98e3349 100644 --- a/src/interp/compiler.boot +++ b/src/interp/compiler.boot @@ -1016,7 +1016,7 @@ compSeq1(l,$exitModeStack,e) == ($insideExpressionIfTrue:= NIL; compSeqItem(x,$NoValueMode,e) or return "failed")).expr for x in l] if c="failed" then return nil - catchTag:= MKQ GENSYM() + catchTag:= MKQ gensym() form:= ["SEQ",:replaceExitEtc(c,catchTag,"TAGGEDexit",$exitModeStack.(0))] [["CATCH",catchTag,form],$exitModeStack.(0),$finalEnv] @@ -1698,7 +1698,7 @@ coerceable(m,m',e) == coerceExit: (%Triple,%Mode) -> %Maybe %Triple coerceExit([x,m,e],m') == m':= resolve(m,m') - x':= replaceExitEtc(x,catchTag:= MKQ GENSYM(),"TAGGEDexit",$exitMode) + x':= replaceExitEtc(x,catchTag:= MKQ gensym(),"TAGGEDexit",$exitMode) coerce([["CATCH",catchTag,x'],m,e],m') compAtSign: (%Form,%Mode,%Env) -> %Maybe %Triple @@ -1967,7 +1967,7 @@ compRetractGuard(x,t,sn,sm,e) == -- view, that temporary needs to have a lifetime that covers both -- the condition and the body of the alternative, so just use -- assignment here and let the rest of the compiler deal with it. - z := GENSYM() + z := gensym() caseCode := ["PROGN",["%LET",z,retractCode],["QEQCAR",z,0]] restrictCode := ["QCDR",z] -- 1.3. Everything else failed; nice try. @@ -2071,7 +2071,7 @@ defineMatchScrutinee(m,e) == [[t for m' in rest m | [t,e] := defTemp(m',e)], e] defTemp(m,e) where defTemp(m,e) == - t := GENSYM() + t := gensym() [.,.,e] := compMakeDeclaration(t,m,e) [t,put(t,"value",[genSomeVariable(),m,$noEnv],e)] @@ -2208,9 +2208,9 @@ compReduce1(form is ["REDUCE",op,.,collectForm],m,e,$formalArgList) == itl:= [([.,$e]:= compIterator(x,$e) or return "failed").0 for x in itl] itl="failed" => return nil e:= $e - acc:= GENSYM() - afterFirst:= GENSYM() - bodyVal:= GENSYM() + acc:= gensym() + afterFirst:= gensym() + bodyVal:= gensym() [part1,m,e]:= comp(["%LET",bodyVal,body],m,e) or return nil [part2,.,e]:= comp(["%LET",acc,bodyVal],m,e) or return nil [part3,.,e]:= comp(["%LET",acc,parseTran [op,acc,bodyVal]],m,e) or return nil @@ -2285,7 +2285,7 @@ compRepeatOrCollect(form,m,e) == compOrCroak(body,bodyMode,e) or return nil -- Massage the loop body if we have a structured jump. if $iterateCount > 0 then - bodyTag := quoteForm GENSYM() + bodyTag := quoteForm gensym() body' := ["CATCH",bodyTag,NSUBST(bodyTag,"$loopBodyTag",body')] if $until then [untilCode,.,e']:= comp($until,$Boolean,e') diff --git a/src/interp/define.boot b/src/interp/define.boot index d8d1f0d6..b9dfc7af 100644 --- a/src/interp/define.boot +++ b/src/interp/define.boot @@ -501,7 +501,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, ['sublisV,['PAIR,['QUOTE,sargl],['LIST,: [['devaluate,u] for u in sargl]]],body] body:= - ["%Bind",[[g:= GENSYM(),body]], + ["%Bind",[[g:= gensym(),body]], ["setShellEntry",g,0,mkConstructor $form],g] fun:= compile [op',["LAM",sargl,body]] @@ -1027,7 +1027,7 @@ compDefineCapsuleFunction(df is ['DEF,form,signature,specialCases,body], prTriple T -- A THROW to the above CATCH occurs if too many semantic errors occur -- see stackSemanticError - catchTag:= MKQ GENSYM() + catchTag:= MKQ gensym() fun:= body':= replaceExitEtc(T.expr,catchTag,"TAGGEDreturn",$returnMode) body':= addArgumentConditions(body',$op) @@ -1242,7 +1242,7 @@ spadCompileOrSetq (form is [nam,[lam,vl,body]]) == vl := [ renameParameter for v in vl] where renameParameter() == NUMBERP v or IDENTP v or string? v => v - GENSYM '"flag" + gensym '"flag" clearReplacement nam -- Make sure we have fresh info if $optReplaceSimpleFunctions then body := replaceSimpleFunctions body @@ -1543,7 +1543,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == then nils:=[u,:nils] else - gv := GENSYM() + gv := gensym() ans:=[["%LET",gv,u],:ans] nils:=[gv,:nils] n:=n+1 @@ -1627,7 +1627,7 @@ DomainSubstitutionFunction(parameters,body) == MEMQ(body,parameters) => MKQ body body member(body,parameters) => - g:=GENSYM() + g:=gensym() $extraParms:=PUSH([g,:body],$extraParms) --Used in SetVector12 to generate a substitution list --bound in buildFunctor diff --git a/src/interp/fortcall.boot b/src/interp/fortcall.boot index cde953fc..fd3ad8b5 100644 --- a/src/interp/fortcall.boot +++ b/src/interp/fortcall.boot @@ -321,7 +321,7 @@ makeSpadFun(name,userArgs,args,dummies,decls,results,returnType,asps,aspInfo, [["$elt","Lisp","construct"],:mkQuote results],resPar] if asps then -- Make a unique(ish) id for asp files - aspId := strconc(getEnv('"SPADNUM"), GENSYM('"NAG")) + aspId := strconc(getEnv('"SPADNUM"), gensym('"NAG")) body := ["SEQ",:makeAspGenerators(asps,aspTypes,aspId),_ makeCompilation(asps,file,aspId),_ ["pretend",call,fType] ] @@ -673,9 +673,9 @@ readData(tmpFile,results) == results generateDataName()==strconc($fortranTmpDir,getEnv('"HOST"), - getEnv('"SPADNUM"), GENSYM('"NAG"),'"data") + getEnv('"SPADNUM"), gensym('"NAG"),'"data") generateResultsName()==strconc($fortranTmpDir,getEnv('"HOST"), - getEnv('"SPADNUM"), GENSYM('"NAG"),'"results") + getEnv('"SPADNUM"), gensym('"NAG"),'"results") fortCall(objFile,data,results) == @@ -755,7 +755,7 @@ multiToUnivariate f == else vars := [second f] body := COPY_-TREE third f - newVariable := GENSYM() + newVariable := gensym() for index in 0..#vars-1 repeat -- Remember that AXIOM lists, vectors etc are indexed from 1 body := NSUBST(["elt",newVariable,index+1],vars.(index),body) @@ -778,7 +778,7 @@ functionAndJacobian f == DF(fn,var) == ["@",["convert",["differentiate",fn,var]],"InputForm"] jacBodies := CDDR interpret [["$elt",["List",["InputForm"]],"construct"],:jacBodies] - newVariable := GENSYM() + newVariable := gensym() for index in 0..#vars-1 repeat -- Remember that AXIOM lists, vectors etc are indexed from 1 funBodies := NSUBST(["elt",newVariable,index+1],vars.(index),funBodies) @@ -800,7 +800,7 @@ vectorOfFunctions f == else vars := [second f] funBodies := COPY_-TREE CDADDR f - newVariable := GENSYM() + newVariable := gensym() for index in 0..#vars-1 repeat -- Remember that AXIOM lists, vectors etc are indexed from 1 funBodies := NSUBST(["elt",newVariable,index+1],vars.(index),funBodies) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 7b85a8e6..0b5d7169 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -576,9 +576,9 @@ optCollectVector form == ["MIN",:nreverse vecSize] -- if no suitable loop index was found, introduce one. if index = nil then - index := GENSYM() + index := gensym() iters := [:iters,["ISTEP",index,0,1]] - vec := GENSYM() + vec := gensym() ["LET",[[vec,["makeSimpleArray",["getVMType",eltType],vecSize]]], ["REPEAT",:iters,["setSimpleArrayEntry",vec,index,body]], vec] @@ -587,7 +587,7 @@ optCollectVector form == ++ defined by predicate `pred', optRetract ["%Retract",e,m,pred] == atom e => ["check-subtype",substitute(e,"#1",pred),MKQ m,e] - g := GENSYM() + g := gensym() ["LET",[[g,e]],["check-subtype",substitute(g,"#1",pred),MKQ m,g]] lispize x == first optimize [x] diff --git a/src/interp/i-coerce.boot b/src/interp/i-coerce.boot index 823e6df4..bd11d794 100644 --- a/src/interp/i-coerce.boot +++ b/src/interp/i-coerce.boot @@ -927,7 +927,7 @@ coerceSubDomain(val, tSuper, tSub) == getSubDomainPredicate(tSuper, tSub, pred) == predfn := HGET($superHash, [tSuper,:tSub]) => predfn - arg := GENSYM() + arg := gensym() predfn := COMPILE(nil,["LAMBDA",[arg],substitute(arg,"#1", pred)]) HPUT($superHash, [tSuper,:tSub], predfn) predfn diff --git a/src/interp/i-coerfn.boot b/src/interp/i-coerfn.boot index adc6ca62..ce8d47a2 100644 --- a/src/interp/i-coerfn.boot +++ b/src/interp/i-coerfn.boot @@ -35,7 +35,7 @@ import i_-coerce namespace BOOT -$coerceFailure := GENSYM() +$coerceFailure := gensym() position1(x,y) == -- this is used where we want to assume a 1-based index diff --git a/src/interp/i-funsel.boot b/src/interp/i-funsel.boot index 68cafbdb..1828ee27 100644 --- a/src/interp/i-funsel.boot +++ b/src/interp/i-funsel.boot @@ -896,7 +896,7 @@ findFunctionInCategory(op,dc,tar,args1,args2,$Coerce,$SubDom) == if maxargs ~= -1 then SL:= NIL for i in 1..maxargs repeat - impls := SUBSTQ(GENSYM(),INTERNL('"#",STRINGIMAGE i),impls) + impls := SUBSTQ(gensym(),INTERNL('"#",STRINGIMAGE i),impls) impls and SL:= constructSubst dc for mm in impls repeat diff --git a/src/interp/i-map.boot b/src/interp/i-map.boot index 7832613a..331c54fa 100644 --- a/src/interp/i-map.boot +++ b/src/interp/i-map.boot @@ -551,7 +551,7 @@ mkInterpFun(op,opName,argTypes) == for argName in parms]] where argCode() == ['putValueValue,['mkAtreeNode,MKQ argName], objNewCode(['wrap,argName],type)] - funName := GENSYM() + funName := gensym() body:=['rewriteMap1,MKQ opName,arglCode,MKQ sig] putMapCode(opName,body,sig,funName,parms,false) genMapCode(opName,body,sig,funName,parms,false) diff --git a/src/interp/i-spec1.boot b/src/interp/i-spec1.boot index 449e6e43..e87b8190 100644 --- a/src/interp/i-spec1.boot +++ b/src/interp/i-spec1.boot @@ -119,7 +119,7 @@ evalTargetedADEF(t,vars,types,body) == -- this is used in the interpret-code case, but isn't so bad any way -- since it makes the bodies look more like regular map bodies - sublist := [[var,:GENSYM()] for var in vars] + sublist := [[var,:gensym()] for var in vars] body := sublisNQ(sublist,body) vars := [rest v for v in sublist] @@ -788,7 +788,7 @@ mkIterFun([index,:s],funBody,$localVars) == body := checkForFreeVariables(getValue funBody,$localVars) parms := [index,"envArg"] val:=['function,['LAMBDA,parms,:declareUnusedParameters(parms,objVal body)]] - vec := mkAtreeNode GENSYM() + vec := mkAtreeNode gensym() putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode)) vec @@ -927,7 +927,7 @@ mkIterZippedFun(indexList,funBody,zipType,$localVars) == [checkForFreeVariables(form,$localVars) for form in getValue funBody] parms := [$index,'envArg] val:=['function,['LAMBDA,parms,:declareUnusedParameters(parms,objVal body)]] - vec := mkAtreeNode GENSYM() + vec := mkAtreeNode gensym() putValue(vec,objNew(['CONS,val,["VECTOR",:reverse $freeVariables]],mapMode)) vec @@ -950,7 +950,7 @@ iterVarPos var == index=var => return(i) mkNestedElts n == - n=0 => mkAtreeNode($index or ($index:= GENSYM())) + n=0 => mkAtreeNode($index or ($index:= gensym())) [mkAtreeNode "elt", mkNestedElts(n-1), mkAtreeNode 'part2] --% Handlers for construct diff --git a/src/interp/i-spec2.boot b/src/interp/i-spec2.boot index e5c2bb15..ebcdbf79 100644 --- a/src/interp/i-spec2.boot +++ b/src/interp/i-spec2.boot @@ -403,7 +403,7 @@ compileIs(val,pattern) == IDENTP(pat) and isLocalVar(pat) => vars:=[pat,:vars] pat is [":",var] => vars:= [var,:vars] pat is ["=",var] => vars:= [var,:vars] - predCode:=["%LET",g:=GENSYM(),["isPatternMatch", + predCode:=["%LET",g:=gensym(),["isPatternMatch", getArgValue(val,computedMode val),MKQ removeConstruct pattern]] for var in removeDuplicates vars repeat assignCode:=[["%LET",var,["CDR",["ASSQ",MKQ var,g]]],:assignCode] @@ -643,7 +643,7 @@ upLETWithFormOnLhs(op,lhs,rhs) == -- to first hold the assignments so that things like -- (t1,t2) := (t2,t1) will work. seq := [] - temps := [GENSYM() for l in rest lhs] + temps := [gensym() for l in rest lhs] for lvar in temps repeat mkLocalVar($mapName,lvar) for l in reverse rest lhs for t in temps repeat transferPropsToNode(getUnname l,l) @@ -911,9 +911,9 @@ transformREPEAT [:itrl,body] == upREPEAT t == -- REPEATS always return void() of Void -- assures throw to interpret-code mode goes to outermost loop - $repeatLabel : local := MKQ GENSYM() + $repeatLabel : local := MKQ gensym() $breakCount : local := 0 - $repeatBodyLabel : local := MKQ GENSYM() + $repeatBodyLabel : local := MKQ gensym() $iterateCount : local := 0 $compilingLoop => upREPEAT1 t upREPEAT0 t diff --git a/src/interp/macex.boot b/src/interp/macex.boot index 72287f85..6a0c727e 100644 --- a/src/interp/macex.boot +++ b/src/interp/macex.boot @@ -82,7 +82,7 @@ macLambdaParameterHandling( replist , pform ) == replist pfMLambda? pform => -- construct assoclist ( identifier . replacement ) parlist := pf0MLambdaArgs pform -- extract parameter list - [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,GENSYM(),pfLeafPosition par)] for par in parlist ] + [[pfIdSymbol par ,:pfLeaf( pfAbSynOp par,gensym(),pfLeafPosition par)] for par in parlist ] for p in pfParts pform repeat macLambdaParameterHandling( replist , p ) macSubstituteId( replist , pform ) == diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot index b21ecb6e..06448b37 100644 --- a/src/interp/nruncomp.boot +++ b/src/interp/nruncomp.boot @@ -556,7 +556,7 @@ NRTsetVector4(siglist,formlist,condlist) == $lisplibCategoriesExtended:= [$uncondList,:$condList] code := ['mapConsDB,MKQ reverse removeDuplicates $uncondList] if $condList then - localVariable := GENSYM() + localVariable := gensym() code := [["%LET",localVariable,code]] for [pred,list] in $condList repeat code := @@ -564,7 +564,7 @@ NRTsetVector4(siglist,formlist,condlist) == ['mergeAppend,['mapConsDB,MKQ list],localVariable]]]], :code] code := ['PROGN,:nreverse [['NREVERSE,localVariable],:code]] - g := GENSYM() + g := gensym() [$setelt,'$,4,['PROG2,["%LET",g,code], ['VECTOR,['catList2catPackageList,g],g]]] @@ -596,7 +596,7 @@ NRTsetVector4Part2(uncondList,condList) == $lisplibCategoriesExtended:= [uncondList,:condList] code := ['mapConsDB,MKQ reverse removeDuplicates uncondList] if condList then - localVariable := GENSYM() + localVariable := gensym() code := [["%LET",localVariable,code]] for [pred,list] in condList repeat code := @@ -604,7 +604,7 @@ NRTsetVector4Part2(uncondList,condList) == ['mergeAppend,['mapConsDB,MKQ list],localVariable]]]], :code] code := ['PROGN,:nreverse [['NREVERSE,localVariable],:code]] - g := GENSYM() + g := gensym() [$setelt,'$,4,['PROG2,["%LET",g,code], ['VECTOR,['catList2catPackageList,g],g]]] @@ -662,10 +662,10 @@ slot1Filter opList == NRToptimizeHas u == --u is a list ((pred cond)...) -- see optFunctorBody ---produces an alist: (((HasCategory a b) . GENSYM)...) +--produces an alist: (((HasCategory a b) . gensym)...) u is [a,:b] => a='HasCategory => LASSOC(u,$hasCategoryAlist) or - $hasCategoryAlist := [[u,:(y:=GENSYM())],:$hasCategoryAlist] + $hasCategoryAlist := [[u,:(y:=gensym())],:$hasCategoryAlist] y a="has" => NRToptimizeHas ['HasCategory,first b,MKQ second b] a = 'QUOTE => u diff --git a/src/interp/nrunopt.boot b/src/interp/nrunopt.boot index b7997fc3..e584bdf3 100644 --- a/src/interp/nrunopt.boot +++ b/src/interp/nrunopt.boot @@ -320,9 +320,9 @@ orderByContainment pl == for x in rest pl repeat if (y := CONTAINED(max,x)) then if null assoc(max,$predGensymAlist) - then $predGensymAlist := [[max,:GENSYM()],:$predGensymAlist] + then $predGensymAlist := [[max,:gensym()],:$predGensymAlist] else if CONTAINED(x,max) - then if null assoc(x,$predGensymAlist) then $predGensymAlist := [[x,:GENSYM()],:$predGensymAlist] + then if null assoc(x,$predGensymAlist) then $predGensymAlist := [[x,:gensym()],:$predGensymAlist] if y then max := x [max,:orderByContainment delete(max,pl)] diff --git a/src/interp/parse.boot b/src/interp/parse.boot index 3455ff2c..7b366cf2 100644 --- a/src/interp/parse.boot +++ b/src/interp/parse.boot @@ -359,7 +359,7 @@ makeSimplePredicateOrNil: %ParseForm -> %Form makeSimplePredicateOrNil p == isSimple p => nil u:= isAlmostSimple p => u - wrapSEQExit [["%LET",g:= GENSYM(),p],g] + wrapSEQExit [["%LET",g:= gensym(),p],g] parseWhere: %List -> %Form diff --git a/src/interp/pf2atree.boot b/src/interp/pf2atree.boot index 70b0edc6..fddbaf39 100644 --- a/src/interp/pf2atree.boot +++ b/src/interp/pf2atree.boot @@ -547,7 +547,7 @@ pfCollect2Atree pf == -- -- pfSuchThat2Atree args == --- name := GENSYM() +-- name := gensym() -- argList := pf0TupleParts args -- lhsSex := pf2Atree1 first argList -- rhsSex := pf2Atree second argList diff --git a/src/interp/pf2sex.boot b/src/interp/pf2sex.boot index 0e3904f1..1f8340d0 100644 --- a/src/interp/pf2sex.boot +++ b/src/interp/pf2sex.boot @@ -493,7 +493,7 @@ pfRhsRule2Sex rhs == pf2Sex1 rhs pfSuchThat2Sex args == - name := GENSYM() + name := gensym() argList := pf0TupleParts args lhsSex := pf2Sex1 first argList rhsSex := pf2Sex second argList diff --git a/src/interp/postpar.boot b/src/interp/postpar.boot index 770e44cf..5b7939c1 100644 --- a/src/interp/postpar.boot +++ b/src/interp/postpar.boot @@ -467,7 +467,7 @@ postReduce t == t isnt ["%Reduce",op,expr] => systemErrorHere ["postReduce",t] $InteractiveMode or expr is ["COLLECT",:.] => ["REDUCE",op,0,postTran expr] - postReduce ["%Reduce",op,["COLLECT",["IN",g:= GENSYM(),expr], + postReduce ["%Reduce",op,["COLLECT",["IN",g:= gensym(),expr], ["construct", g]]] postFlattenLeft: (%ParseTree, %Symbol) -> %ParseForm diff --git a/src/interp/ptrees.boot b/src/interp/ptrees.boot index 06ff0b65..7549f80d 100644 --- a/src/interp/ptrees.boot +++ b/src/interp/ptrees.boot @@ -673,7 +673,7 @@ pfTaggedToTyped x== rt:=if pfTagged? x then pfTaggedExpr x else pfNothing() form:= if pfTagged? x then pfTaggedTag x else x not pfId? form => - a:=pfId GENSYM() + a:=pfId gensym() pfTyped(pfSuch(a, pfInfApplication (pfId "=", a,form)),rt) pfTyped(form,rt) diff --git a/src/interp/server.boot b/src/interp/server.boot index 1aa9abbf..8173def3 100644 --- a/src/interp/server.boot +++ b/src/interp/server.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 @@ -64,7 +64,7 @@ serverReadLine(stream) == $NeedToSignalSessionManager := true return l action = $CreateFrame => - frameName := GENSYM('"frame") + frameName := gensym('"frame") addNewInterpreterFrame(frameName) $frameAlist := [[$frameNumber,:frameName], :$frameAlist] $currentFrameNum := $frameNumber diff --git a/src/interp/slam.boot b/src/interp/slam.boot index 42d10194..0da00e00 100644 --- a/src/interp/slam.boot +++ b/src/interp/slam.boot @@ -67,14 +67,14 @@ reportFunctionCompilation(op,nam,argl,body,isRecursive) == keyedSystemError("S2IM0019",[cacheCount,op]) sayKeyedMsg("S2IX0003",[op,num]) auxfn := mkAuxiliaryName nam - g1:= GENSYM() --argument or argument list + g1:= gensym() --argument or argument list [arg,computeValue] := null argl => [nil,[auxfn]] argl is [.] => [[g1, 'envArg],[auxfn,g1, 'envArg]] --g1 is a parameter [g1,['APPLX,MKQ auxfn,g1]] --g1 is a parameter list cacheName := mkCacheName nam - g2:= GENSYM() --length of cache or arg-value pair - g3:= GENSYM() --value computed by calling function + g2:= gensym() --length of cache or arg-value pair + g3:= gensym() --value computed by calling function secondPredPair:= null argl => [cacheName] [['SETQ,g3,['assocCircular,g1,cacheName]],['CDR,g3]] @@ -114,14 +114,14 @@ getCacheCount fn == reportFunctionCacheAll(op,nam,argl,body) == sayKeyedMsg("S2IX0004",[op]) auxfn:= mkAuxiliaryName nam - g1:= GENSYM() --argument or argument list + g1:= gensym() --argument or argument list [arg,computeValue] := null argl => [['envArg],[auxfn, 'envArg]] argl is [.] => [[g1, 'envArg],[auxfn,g1, 'envArg]] --g1 is a parameter [g1,["APPLX",MKQ auxfn,g1]] --g1 is a parameter list if null argl then g1:=nil cacheName:= mkCacheName nam - g2:= GENSYM() --value computed by calling function + g2:= gensym() --value computed by calling function secondPredPair:= [["SETQ",g2,["HGET",cacheName,g1]],g2] thirdPredPair:= ['(QUOTE T),["HPUT",cacheName,g1,computeValue]] codeBody:= ["PROG",[g2],["RETURN",["COND",secondPredPair,thirdPredPair]]] @@ -170,14 +170,14 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == extraArguments is [x] => x ['LIST,:extraArguments] nil - g:= GENSYM() - gIndex:= GENSYM() - gsList:= [GENSYM() for x in initCode] + g:= gensym() + gIndex:= gensym() + gsList:= [gensym() for x in initCode] auxfn := mkAuxiliaryName(nam) $compiledOpNameList := [:$compiledOpNameList,auxfn] stateNam:= GENVAR() - stateVar:= GENSYM() - stateVal:= GENSYM() + stateVar:= gensym() + stateVal:= gensym() lastArg := INTERNL strconc('"#",STRINGIMAGE QSADD1 # argl) decomposeCode:= [["%LET",gIndex,["ELT",lastArg,0]],:[["%LET",g,["ELT",lastArg,i]] @@ -209,7 +209,7 @@ compileRecurrenceRelation(op,nam,argl,junk,[body,sharpArg,n,:initCode]) == :[["%LET",g,["%ELT",stateVar,i]] for g in gsList for i in 1..]] mainFunction:= [nam,["LAM",margl,:declareUnusedParameters(margl,mbody)]] where margl:= [:argl,'envArg] - max:= GENSYM() + max:= gensym() tripleCode := ["CONS",n,["LIST",:initCode]] -- initialSetCode initializes the global variable if necessary and diff --git a/src/interp/sys-constants.boot b/src/interp/sys-constants.boot index b27e8aa4..a9ea9abb 100644 --- a/src/interp/sys-constants.boot +++ b/src/interp/sys-constants.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 @@ -629,7 +629,7 @@ $EmptyVector == ++ A symbol denoting failure $failure == - GENSYM() + gensym() ++ The initial modemap frame $InitialModemapFrame == @@ -719,7 +719,7 @@ $quitTag == )elseif %hasFeature KEYWORD::SBCL QUOTE SB_-INT::TOPLEVEL_-CATCHER )else - GENSYM() + gensym() )endif --% Constants for OpenAxiom IPC diff --git a/src/interp/wi1.boot b/src/interp/wi1.boot index 19a968cc..b2941ba7 100644 --- a/src/interp/wi1.boot +++ b/src/interp/wi1.boot @@ -918,7 +918,7 @@ compCoerce1(x,m',e) == T':= coerce(T,m') => T' T':= coerceByModemap(T,m') => T' pred:=isSubset(m',T.mode,e) => - gg:=GENSYM() + gg:=gensym() pred:= substitute(gg,"#1",pred) code:= ['PROG1,["%LET",gg,T.expr], ['check_-subtype,pred,MKQ m',gg]] [code,m',T.env] @@ -1217,7 +1217,7 @@ compDefineCategory2(form,signature,specialCases,body,m,e, ['sublisV,['PAIR,['QUOTE,sargl],['LIST,: [['devaluate,u] for u in sargl]]],body] body:= - ['PROG1,["%LET",g:= GENSYM(),body], + ['PROG1,["%LET",g:= gensym(),body], ["setShellEntry",g,0,mkConstructor $functorForm]] fun:= compile [op',['LAM,sargl,body]] diff --git a/src/interp/wi2.boot b/src/interp/wi2.boot index 2be969a7..3689f052 100644 --- a/src/interp/wi2.boot +++ b/src/interp/wi2.boot @@ -994,7 +994,7 @@ doItIf(item is [.,p,x,y],$predl,$e) == then nils:=[u,:nils] else - gv := GENSYM() + gv := gensym() ans:=[["%LET",gv,u],:ans] nils:=[gv,:nils] n:=n+1 |