aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2012-05-03 16:42:34 +0000
committerdos-reis <gdr@axiomatics.org>2012-05-03 16:42:34 +0000
commit2a7428b80002f6a01d4b182996675d8c0f7d2df0 (patch)
tree0cb930a48c967ef72ee6139317e4e305a2842617
parent3e7657640d8a37d7bb3e9226854b68d91efe7f7f (diff)
downloadopen-axiom-2a7428b80002f6a01d4b182996675d8c0f7d2df0.tar.gz
* interp/c-util.boot (makeWorkerName): New.
(backendCompileSLAM): Use it. (backendCompileSPADSLAM): Likewise. * interp/clam.boot (compHash): Likewise. Do not synthetize new parameter for unary constructors.
-rw-r--r--src/ChangeLog8
-rw-r--r--src/interp/c-util.boot8
-rw-r--r--src/interp/clam.boot22
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