diff options
| -rw-r--r-- | src/ChangeLog | 8 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 8 | ||||
| -rw-r--r-- | src/interp/clam.boot | 22 |
3 files changed, 21 insertions, 17 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 2c7c9ce6..bd88baab 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,11 @@ +2012-05-03 Gabriel Dos Reis <gdr@cs.tamu.edu> + + * interp/c-util.boot (makeWorkerName): New. + (backendCompileSLAM): Use it. + (backendCompileSPADSLAM): Likewise. + * interp/clam.boot (compHash): Likewise. + Do not synthetize new parameter for unary constructors. + 2012-05-02 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/c-util.boot: Use APPLY, not APPLX. diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index ae89bf04..5ef19f19 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -37,6 +37,7 @@ import g_-opt namespace BOOT module c_-util where + makeWorkerName: %Symbol -> %Symbol clearReplacement: %Symbol -> %Thing replaceSimpleFunctions: %Form -> %Form foldExportedFunctionReferences: %List %Form -> %List %Form @@ -911,7 +912,8 @@ wrapSEQExit l == --% UTILITY FUNCTIONS ---appendOver x == "append"/x +makeWorkerName op == + makeSymbol strconc(symbolName op,'";") removeEnv t == [t.expr,t.mode,$EmptyEnvironment] -- t is a triple @@ -1514,7 +1516,7 @@ backendCompileNEWNAM x == backendCompileSLAM: (%Symbol,%List %Symbol,%Code) -> %Symbol backendCompileSLAM(name,args,body) == al := mkCacheName name -- name of the cache alist. - auxfn := makeSymbol strconc(name,'";") -- name of the worker function. + auxfn := makeWorkerName name -- name of the worker function. g1 := gensym() -- name for the parameter. g2 := gensym() -- name for the cache value u := -- body of the stub function @@ -1546,7 +1548,7 @@ backendCompileSLAM(name,args,body) == backendCompileSPADSLAM: (%Symbol,%List %Symbol,%Code) -> %Symbol backendCompileSPADSLAM(name,args,body) == al := mkCacheName name -- global name for the cache hash table. - auxfn := makeSymbol strconc(name,'";") -- name of the worker function. + auxfn := makeWorkerName name -- name of the worker function. g2 := gensym() -- local name for the cache value. u := args = nil => [nil,[auxfn]] diff --git a/src/interp/clam.boot b/src/interp/clam.boot index 4f1969c9..496a1f0c 100644 --- a/src/interp/clam.boot +++ b/src/interp/clam.boot @@ -179,27 +179,21 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) == keyedSystemError("S2GE0010",[op]) --restriction due to omission of call to hputNewValue (see *** lines below) - if null argl then - null cacheNameOrNil => keyedSystemError("S2GE0011",[op]) - nil - (not cacheNameOrNil) and not (eqEtc in '(EQ EQL EQUAL CVEC UEQUAL)) => + argl = nil and cacheNameOrNil = nil => keyedSystemError("S2GE0011",[op]) + cacheNameOrNil = nil and not (eqEtc in '(EQ EQL EQUAL CVEC UEQUAL)) => keyedSystemError("S2GE0012",[op]) ---withWithout := (countFl => "with"; "without") ---middle:= --- cacheNameOrNil => ["on","%b",cacheNameOrNil,"%d"] --- '"privately " ---sayBrightly --- ["%b",op,"%d","hashes ",:middle,withWithout," reference counts"] - auxfn:= makeSymbol strconc(op,'";") - g1:= gensym() --argument or argument list + auxfn := makeWorkerName op + g1 := --argument or argument list + argl is [g] => g + gensym() [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 -- computeValue: the form used to compute the value from arg null argl => [nil,nil,[auxfn]] argl is [.] => - key:= (cacheNameOrNil => ['devaluate,g1]; g1) - [[g1],['%list,key],[auxfn,g1]] --g1 is a parameter + key := (cacheNameOrNil => ['devaluate,g1]; g1) + [argl,['%list,key],[auxfn,g1]] --g1 is a parameter key:= (cacheNameOrNil => ['devaluateList,g1] ; g1) [g1,key,['APPLY,['function,auxfn],g1]] --g1 is a parameter list cacheName:= cacheNameOrNil or mkCacheName op |