From 2a7428b80002f6a01d4b182996675d8c0f7d2df0 Mon Sep 17 00:00:00 2001
From: dos-reis <gdr@axiomatics.org>
Date: Thu, 3 May 2012 16:42:34 +0000
Subject: 	* interp/c-util.boot (makeWorkerName): New. 
 (backendCompileSLAM): Use it. 	(backendCompileSPADSLAM): Likewise. 	*
 interp/clam.boot (compHash): Likewise. 	Do not synthetize new
 parameter for unary constructors.

---
 src/interp/c-util.boot |  8 +++++---
 src/interp/clam.boot   | 22 ++++++++--------------
 2 files changed, 13 insertions(+), 17 deletions(-)

(limited to 'src/interp')

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
-- 
cgit v1.2.3