* interp/clam.boot (compClam): Remove.

	(compHash): Simplify.  Now take only 3 parameters.
	* interp/c-util.boot (compileQuietly): Remove as unused.
	* interp/sys-globals.boot ($clamList): Move to clam.boot.
	* interp/define.boot (compileConstructor1): Call compHash in lieu
	of compClam.
	* share/doc/msgs/s2-us.msgs: Remove unused diagnostics, due to
	compClam removal and compHash simplification.

6 files changed, 36 insertions, 187 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 235c92bd..4f3ddfee 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2012-05-05  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/clam.boot (compClam): Remove.
+	(compHash): Simplify.  Now take only 3 parameters.
+	* interp/c-util.boot (compileQuietly): Remove as unused.
+	* interp/sys-globals.boot ($clamList): Move to clam.boot.
+	* interp/define.boot (compileConstructor1): Call compHash in lieu
+	of compClam.
+	* share/doc/msgs/s2-us.msgs: Remove unused diagnostics, due to
+	compClam removal and compHash simplification.
+
 2012-05-04  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/define.boot (compileConstructor1): Don't call
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index e43cd164..72a75537 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -1768,16 +1768,6 @@ compQuietly fn ==
     "PRINT-DEFUN"
   quietlyIfInteractive backendCompile fn
 
-compileQuietly fn ==
-  _*COMP370_-APPLY_* :=
-     $InteractiveMode =>
-       $compileDontDefineFunctions => "COMPILE-DEFUN"
-       "EVAL-DEFUN"
-     "PRINT-DEFUN"
-  quietlyIfInteractive COMP370 fn
-
-
-
 COMP370 x ==
   first x is [.,:.] => [COMPILE1 y for y in x]
   [COMPILE1 x]
diff --git a/src/interp/clam.boot b/src/interp/clam.boot
index 64d9fc14..ef934368 100644
--- a/src/interp/clam.boot
+++ b/src/interp/clam.boot
@@ -65,112 +65,26 @@ namespace BOOT
 --     entries have their use count set
 --     to 0 on garbage collection; those with 0 use count at garbage collection
 --     are cleared
--- see definition of backendCompile2 in c-util which calls clamComp below
+
+++
+$clamList ==
+  '((canCoerce hash UEQUAL count)                 _
+    (canCoerceFrom hash UEQUAL count)             _
+    (coerceConvertMmSelection hash UEQUAL count)  _
+    (isLegitimateMode hash UEQUAL count)          _
+    (isValidType hash UEQUAL count)               _
+    (resolveTT hash UEQUAL count)                 _
+    (selectMms1 hash UEQUAL count)                _
+    (underDomainOf hash UEQUAL count))
 
 ++
 $failed := '"failed"
  
-compClam(op,argl,body,$clamList) ==
-  --similar to reportFunctionCompilation in SLAM BOOT
-  if $InteractiveMode then startTimingProcess 'compilation
-  if (u := symbolTarget(op,$clamList)) isnt [kind,eqEtc,:options]
-    then keyedSystemError("S2GE0004",[op])
-  $clamList:= nil            --clear to avoid looping
-  if u:= S_-(options,'(shift count)) then
-    keyedSystemError("S2GE0006",[op,:u])
-  shiftFl := 'shift in options
-  countFl := 'count in options
-  if #argl > 1 and eqEtc= 'EQ then
-    keyedSystemError("S2GE0007",[op])
-  (not ident? kind) and (not integer? kind or kind < 1) =>
-    keyedSystemError("S2GE0005",[op])
-  ident? kind =>
-    shiftFl => keyedSystemError("S2GE0008",[op])
-    compHash(op,argl,body,(kind='hash => nil; kind),eqEtc,countFl)
-  cacheCount:= kind
-  if argl = nil then keyedSystemError("S2GE0009",[op])
-  phrase:=
-    cacheCount=1 => ['"computed value only"]
-    [:bright cacheCount,'"computed values"]
-  sayBrightly [:bright op,'"will save last",:phrase]
-  auxfn:= makeSymbol strconc(op,'";")
-  g1:= gensym()  --argument or argument list
-  [arg,computeValue] :=
-    argl is [.] => [[g1],[auxfn,g1]]  --g1 is a parameter
-    [g1,['APPLY,['function,auxfn],g1]]          --g1 is a parameter list
-  cacheName:= mkCacheName op
-  if $reportCounts then
-    hitCounter:= makeSymbol strconc(op,'";hit")
-    callCounter:= makeSymbol strconc(op,'";calls")
-    symbolValue(hitCounter) := 0
-    symbolValue(callCounter) := 0
-    callCountCode:= [['%store,callCounter,['%iinc,callCounter]]]
-    hitCountCode:=  [['%store,hitCounter,['%iinc,hitCounter]]]
-  g2:= gensym()  --length of cache or arg-value pair
-  g3:= gensym()  --value computed by calling function
-  lookUpFunction:=
-    shiftFl =>
-      countFl => 'assocCacheShiftCount
-      'assocCacheShift
-    countFl => 'assocCacheCount
-    'assocCache
-  returnFoundValue:=
-    countFl => ['CDDR,g3]
-    ['%tail,g3]
-  namePart:=
-    countFl => cacheName
-    MKQ cacheName
-  secondPredPair:=
-    [['%store,g3,[lookUpFunction,g1,namePart,eqEtc]],
-      :hitCountCode,
-        returnFoundValue]
-  resetCacheEntry:=
-    countFl => ['%pair,1,g2]
-    g2
-  thirdPredPair:=
-    ['%otherwise,
-      ['%store,g2,computeValue],
-        ['%store,g3,['%head,cacheName]],
-          ['%store,['%head,g3],g1],
-            ['%store,['%tail,g3],resetCacheEntry],
-              g2]
-  codeBody:= ['PROG,[g2,g3],
-                :callCountCode,
-                  ['RETURN,['%when,secondPredPair,thirdPredPair]]]
-  mainFunction:= [op,['LAMBDA,arg,codeBody]]
-  computeFunction:= [auxfn,['LAMBDA,argl,:body]]
- 
-  -- compile generated function stub
-  compileInteractive mainFunction
- 
-  -- compile main body: this has already been compTran'ed
-  if $reportCompilation then
-    sayBrightlyI bright '"Generated LISP code for function:"
-    pp computeFunction
-  compileQuietly [computeFunction]
- 
-  cacheType:= 'function
-  cacheResetCode:= ['%store,cacheName,['initCache,cacheCount]]
-  cacheCountCode:= ['countCircularAlist,cacheName,cacheCount]
-  cacheVector:= mkCacheVec(op,cacheName,cacheType,
-    cacheResetCode,cacheCountCode)
-  LAM_,EVALANDFILEACTQ ['PUT, MKQ op, MKQ 'cacheInfo, MKQ cacheVector]
-  LAM_,EVALANDFILEACTQ cacheResetCode
-  if $InteractiveMode then stopTimingProcess 'compilation
-  op
- 
-compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
+compHash(op,argl,body) ==
 --   Entries will be stored on the global hashtable in a uniform way:
 --        (<argument list>, <reference count>,:<value>)
 --   where the reference count is optional
  
-  if cacheNameOrNil and cacheNameOrNil ~= '_$ConstructorCache then
-    keyedSystemError("S2GE0010",[op])
-    --restriction due to omission of call to hputNewValue (see *** lines below)
- 
-  argl = nil and cacheNameOrNil = nil => keyedSystemError("S2GE0011",[op])
-  cacheNameOrNil = nil and not (eqEtc in '(EQ EQL EQUAL CVEC UEQUAL)) =>
-    keyedSystemError("S2GE0012",[op])
   auxfn := makeWorkerName op
   g1 :=              --argument or argument list
     argl = nil => nil
@@ -182,11 +96,11 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
   --    computeValue: the form used to compute the value from arg
     argl = nil => [nil,nil,[auxfn]]
     argl is [.] =>
-      key := (cacheNameOrNil => ['devaluate,g1]; g1)
+      key := ['devaluate,g1]
       [argl,['%list,key],[auxfn,g1]]  --g1 is a parameter
-    key:= (cacheNameOrNil => ['devaluateList,g1] ; g1)
+    key := ['devaluateList,g1]
     [g1,key,['APPLY,['function,auxfn],g1]]   --g1 is a parameter list
-  cacheName:= cacheNameOrNil or mkCacheName op
+  cacheName := "$ConstructorCache"
   if $reportCounts then
     hitCounter:= makeSymbol strconc(op,'";hit")
     callCounter:= makeSymbol strconc(op,'";calls")
@@ -201,33 +115,19 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
     --  stored in the same format as those with several arguments, e.g.
     --  to cache the value <val> given by f(), the structure
     --  ((nil <count> <val>)) is stored in the cache
-      countFl => ['CDRwithIncrement,['CDAR,g2]]
-      ['CDAR,g2]
-    countFl => ['CDRwithIncrement,g2]
-    g2
+      ['CDRwithIncrement,['CDAR,g2]]
+    ['CDRwithIncrement,g2]
   getCode:=
     argl = nil => ['tableValue,cacheName,MKQ op]
-    cacheNameOrNil =>
-      eqEtc ~= 'EQUAL =>
-        ['lassocShiftWithFunction,cacheArgKey,
-          ['tableValue,cacheNameOrNil,MKQ op],['%function,eqEtc]]
-      ['lassocShift,cacheArgKey,['tableValue,cacheNameOrNil,MKQ op]]
-    ['tableValue,cacheName,g1]
+    ['lassocShiftWithFunction,cacheArgKey,
+      ['tableValue,cacheName,MKQ op],['%function,'domainEqualList]]
   secondPredPair:= [g2,mkSeq [:hitCountCode,returnFoundValue]]
   putCode:=
     argl = nil =>
-      cacheNameOrNil =>
-        countFl =>
-          ['CDDAR,['%store,['tableValue,cacheNameOrNil,MKQ op],
-            ['%list,['%pair,'%nil,['%pair,1,computeValue]]]]]
-        ['%store,['tableValue,cacheNameOrNil,MKQ op],
-          ['%list,['%pair,'%nil,computeValue]]]
-      systemError '"unexpected"
-    cacheNameOrNil => computeValue
-    countFl =>
-      ['%tail,['%store,['tableValue,cacheName,g1],['%pair,1,computeValue]]]
-    ['%store,['tableValue,cacheName,g1],computeValue]
-  if cacheNameOrNil then putCode :=
+      ['CDDAR,['%store,['tableValue,cacheName,MKQ op],
+        ['%list,['%pair,'%nil,['%pair,1,computeValue]]]]]
+    computeValue
+  putCode :=
      ['UNWIND_-PROTECT,['PROG1,putCode,['%store,g2,'%true]],
                   ['%when,[['%not,g2],['tableRemove!,cacheName,MKQ op]]]]
   thirdPredPair:= ['%otherwise,putCode]
@@ -244,20 +144,6 @@ compHash(op,argl,body,cacheNameOrNil,eqEtc,countFl) ==
     sayBrightlyI bright '"Generated LISP code for function:"
     pp computeFunction
   compQuietly [computeFunction]
- 
-  if cacheNameOrNil = nil then
-    cacheType:=
-      countFl => 'hash_-tableWithCounts
-      'hash_-table
-    weakStrong:= (countFl => 'STRONG; 'WEAK)
-      --note: WEAK means that key/value pairs disappear at garbage collection
-    cacheResetCode:=
-      ['SETQ,cacheName,['hashTable,MKQ eqEtc]]
-    cacheCountCode:= ['hashCount,cacheName]
-    cacheVector:=
-      mkCacheVec(op,cacheName,cacheType,cacheResetCode,cacheCountCode)
-    LAM_,EVALANDFILEACTQ ['PUT, MKQ op, MKQ 'cacheInfo, MKQ cacheVector]
-    LAM_,EVALANDFILEACTQ cacheResetCode
   op
  
 CDRwithIncrement x ==
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 25ab7aea..fa24ec4a 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -2097,7 +2097,7 @@ compileConstructor1(db,form:=[fn,[key,vl,:bodyl]]) ==
     first compAndDefine [[fn,['SPADSLAM,vl,:bodyl]]]
   dbInstanceCache db = nil =>
     first backendCompile [[fn,['LAMBDA,vl,:bodyl]]]
-  compClam(fn,vl,bodyl,[[fn,"$ConstructorCache",'domainEqualList,'count]])
+  compHash(fn,vl,bodyl)
  
 constructMacro: %Form -> %Form
 constructMacro (form is [nam,[lam,vl,body]]) ==
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index 5304caea..f611e829 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -1,6 +1,6 @@
 -- Copyright (c) 1991-2002, The Numerical Algorithms Group Ltd.
 -- All rights reserved.
--- Copyright (C) 2007-2011, Gabriel Dos Reis.
+-- Copyright (C) 2007-2012, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -60,18 +60,6 @@ $BreakMode := "query"
 $cacheAlist := nil
 $cacheCount := 0
 
-
-++
-$clamList :=
-  '((canCoerce hash UEQUAL count)                 _
-    (canCoerceFrom hash UEQUAL count)             _
-    (coerceConvertMmSelection hash UEQUAL count)  _
-    (isLegitimateMode hash UEQUAL count)          _
-    (isValidType hash UEQUAL count)               _
-    (resolveTT hash UEQUAL count)                 _
-    (selectMms1 hash UEQUAL count)                _
-    (underDomainOf hash UEQUAL count))
-
 ++
 $compCount := 0
 
diff --git a/src/share/doc/msgs/s2-us.msgs b/src/share/doc/msgs/s2-us.msgs
index a9f281bd..c5e1ef48 100644
--- a/src/share/doc/msgs/s2-us.msgs
+++ b/src/share/doc/msgs/s2-us.msgs
@@ -1066,32 +1066,6 @@ S2GE0002
 S2GE0003
  The cache for %1b cannot be cleared because that function is not
  privately clammed.
-S2GE0004
- The structure for the clammed function %1b
- on $clammedList is not correct. It must have three entries after the
- function name.
-S2GE0005
- Illegal cache count for %1b
-S2GE0006
- Illegal options for  CLAMming function %1b: %2 %3 %4
-S2GE0007
- EQ cannot be used to CLAM a function with more than 1 argument and you
- are trying to that for %1b
-S2GE0008
- The shift option not meaningful for hash type of cache and you
- are trying to that for %1b
-S2GE0009
- Circular CLAMing illegal for 0-argument functions and you
- are trying to that for %1b
-S2GE0010
- Private CLAMing illegal for 0-argument functions and you
- are trying to that for %1b
-S2GE0011
- $ConstructorCache is only global cache now allowed and you are trying
- to do otherwise for %1b
-S2GE0012
- For hash option, only EQ, CVEC, and UEQUAL are allowed and you are
- trying to do otherwise for %1b
 S2GE0013
  %1b has the wrong format: the reference counts are missing.
 S2GE0014