* interp/functor.boot (setVector0, setVector12, setVector3,

	mkDomainFomer, setVector5, mkVectorWithDeferral): Remove as dead
	codes. 

5 files changed, 27 insertions, 95 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 05218fe2..9f01d7e0 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2011-08-15  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
+	* interp/functor.boot (setVector0, setVector12, setVector3,
+	mkDomainFomer, setVector5, mkVectorWithDeferral): Remove as dead
+	codes. 
+
 2011-08-14  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
 	* interp/g-opt.boot (optCollectVector): Generate VM forms.
diff --git a/src/interp/define.boot b/src/interp/define.boot
index e0b0aae1..d78c5770 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -778,12 +778,13 @@ compDefineCategory2(form,signature,specialCases,body,m,e,
     -- following line causes cats with no with or Join to be fresh copies
     if opOf(formalBody)~='Join and opOf(formalBody)~='mkCategory then
            formalBody := ['Join, formalBody]
-    body:= optFunctorBody compOrCroak(formalBody,signature'.target,e).expr
-    if $extraParms then
-      formals:=actuals:=nil
-      for u in $extraParms repeat
-        formals:=[first u,:formals]
-        actuals:=[MKQ rest u,:actuals]
+    body := optFunctorBody compOrCroak(formalBody,signature'.target,e).expr
+    if $extraParms ~= nil then
+      formals := nil
+      actuals := nil
+      for [u,:v] in $extraParms repeat
+        formals := [u,:formals]
+        actuals := [MKQ v,:actuals]
       body := ['sublisV,['pairList,['QUOTE,formals],['%list,:actuals]],body]
     if argl then body:=  -- always subst for args after extraparms
         ['sublisV,['pairList,['QUOTE,sargl],['%list,:
@@ -1946,30 +1947,26 @@ mkExplicitCategoryFunction(domainOrPackage,sigList,atList) ==
   wrapDomainSub(parameters,body)
 
 DomainSubstitutionFunction(parameters,body) ==
-  --see definition of DomainSubstitutionMacro in SPAD LISP
-  if parameters then
+  if parameters ~= nil then
     (body := Subst(parameters,body)) where
       Subst(parameters,body) ==
         body isnt [.,:.] =>
-          symbolMember?(body,parameters) => MKQ body
+          objectMember?(body,parameters) => MKQ body
           body
         listMember?(body,parameters) =>
           g := gensym()
-          $extraParms := PUSH([g,:body],$extraParms)
+          $extraParms := [[g,:body],:$extraParms]
            --Used in SetVector12 to generate a substitution list
            --bound in buildFunctor
            --For categories, bound and used in compDefineCategory
           MKQ g
-        body.op = "QUOTE" => body
-        cons? $definition and
-            isFunctor body.op and 
-              body.op ~= $definition.op
-          =>  ['QUOTE,simplifyVMForm body]
+        first body is "QUOTE" => body
+        cons? $definition and isFunctor body.op and 
+          body.op ~= $definition.op => quoteForm simplifyVMForm body
         [Subst(parameters,u) for u in body]
   body isnt ["Join",:.] => body
   $definition isnt [.,:.] => body
-  null $definition.args => body 
-           --should not bother if it will only be called once
+  $definition.args = nil => body 
   name := makeSymbol strconc(KAR $definition,";CAT")
   SETANDFILE(name,nil)
   body := ['%when,[name],['%otherwise,['%store,name,body]]]
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index be229149..70085b74 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -318,42 +318,13 @@ cons5(p,l) ==
   QCDDDDR(l).rest := nil
   [p,:l]
  
-setVector0(catNames,definition) ==
-          --returns code to set element 0 of the vector
-          --to the definition of the category
-  definition:= mkTypeForm definition
-  for u in catNames repeat
-    definition:= ['%store,['%tref,u,0],definition]
-  definition
- 
-setVector12 args ==
-            --The purpose of this function is to replace place holders
-            --e.g. argument names or gensyms, by real values
-  null args => nil
-  args1:=args2:=args
-  for u in $extraParms repeat
-            --A typical element of $extraParms, which is set in
-            --DomainSubstitutionFunction, would be (gensym) cons
-            --(category parameter), e.g. DirectProduct(length vl,NNI)
-            --as in DistributedMultivariatePolynomial
-    args1:=[u.op,:args1]
-    args2:=[u.args,:args2]
-  freeof(categoryExports $domainShell,args1) and
-      freeof($domainShell.2,args1) and
-          freeof($domainShell.4,args1) => nil  
-  [['SetDomainSlots124,'$,['QUOTE,args1],['%list,:args2]]]
- where freeof(a,b) ==
-         a isnt [.,:.] => null symbolMember?(a,b)
-         freeof(first a,b) => freeof(rest a,b)
-         false
- 
-SetDomainSlots124(vec,names,vals) ==
+SetDomainSlots124(dom,names,vals) ==
   l := pairList(names,vals)
-  vectorRef(vec,1) := sublisProp(l,vectorRef(vec,1))
-  vectorRef(vec,2) := sublisProp(l,vectorRef(vec,2))
+  domainDirectory(dom) := sublisProp(l,domainDirectory dom)
+  domainAttributes(dom) := sublisProp(l,domainAttributes dom)
   l := [[a,:devaluate b] for a in names for b in vals]
-  vectorRef(vec,4) := applySubst(l,vectorRef(vec,4))
-  vectorRef(vec,1) := applySubst(l,vectorRef(vec,1))
+  domainData(dom) := applySubst(l,domainData dom)
+  domainDirectory(dom) := sublisProp(l,domainDirectory dom)
  
 sublisProp(subst,props) ==
   null props => nil
@@ -365,7 +336,7 @@ sublisProp(subst,props) ==
       cond is ['or,:x] =>
         (or/[inspect(u,subst) for u in x] => [a,true,:l]; nil)
       cond is ["has",nam,b] and (val:= ASSQ(nam,subst)) =>
-        ev:=
+        ev :=
           b is ['ATTRIBUTE,c] => HasAttribute(rest val,c)
           b is ['SIGNATURE,c] => HasSignature(rest val,c)
           isDomainForm(b,$CategoryFrame) => b=rest val
@@ -378,22 +349,6 @@ sublisProp(subst,props) ==
   sameObject?(a',cp) and sameObject?(props',rest props) => props
   [a',:props']
  
-setVector3(name,instantiator) ==
-      --generates code to set element 3 of 'name' from 'instantiator'
-      --element 3 is data structure representing category
-      --returns a single LISP statement
-  instantiator is ['DomainSubstitutionMacro,.,body] => setVector3(name,body)
-  ['%store,['%tref,name,3],mkTypeForm instantiator]
- 
-mkDomainFormer x ==
-  if x is ['DomainSubstitutionMacro,parms,body] then
-    x := DomainSubstitutionFunction(parms,body)
-    x := applySubst($extraParms,x)
-    --The next line ensures that only one copy of this structure will
-    --appear in the BPI being generated, thus saving (some) space
-  x is ['Join,:.] => ['eval,['QUOTE,x]]
-  x
- 
 mkTypeForm x ==
   x isnt [.,:.] => mkDevaluate x
   x.op in '(CATEGORY mkCategory) => MKQ x
@@ -407,30 +362,6 @@ mkTypeForm x ==
     MKQ x
   ['%list,MKQ x.op,:[mkTypeForm a for a in x.args]]
  
-setVector5(catNames,locals) ==
-  generated:= nil
-  for u in locals for uname in catNames repeat
-    if w:= assoc(u,generated)
-       then w.rest := [uname,:rest w]
-       else generated:= [[u,uname],:generated]
-  [(w:= mkVectorWithDeferral(first u,second u);
-      for v in rest u repeat
-         w:= ['%store,['%tref,v,5],w];
-        w)
-          for u in generated]
- 
-mkVectorWithDeferral(objects,tag) ==
--- Construct a %vector form, but spots things that aren't safe to instantiate
--- and places them at the end of $ConstantAssignments, so that they get
--- called AFTER the constants of $ have been set up.   JHD 26.July.89
-  ['%vector,:
-   [if CONTAINED('$,u) then -- It's not safe to instantiate this now
-      $ConstantAssignments:=[:$ConstantAssignments,
-                             ['%store,['%tref,['%tref,tag,5],count],u]]
-      []
-    else u
-       for u in objects for count in 0..]]
- 
 DescendCodeAdd(base,flag) ==
   base isnt [.,:.] => DescendCodeVarAdd(base,flag)
   not (modemap:=get(opOf base,'modemap,$CategoryFrame)) =>
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 527b5bf5..ff071ab4 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -479,7 +479,7 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
   $ConstantAssignments: local := nil --code for creation of constants
   $epilogue: local := nil     --code to set slot 5, things to be done last
   $HackSlot4: local := nil  --Invention of JHD 13/July/86-set in InvestigateConditions
-  $extraParms:local := nil  --Set in DomainSubstitutionFunction, used in setVector12
+  $extraParms:local := nil  --Set in DomainSubstitutionFunction
   $devaluateList: local := nil --Bound to ((#1 . dv$1)..) where &1 := devaluate #1 later
   $devaluateList:= [[arg,:b] for arg in args for b in $ModeVariableList]
   $supplementaries: local := nil
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index c46ff38b..41b078fe 100644
--- a/src/interp/sys-globals.boot
+++ b/src/interp/sys-globals.boot
@@ -424,8 +424,6 @@ $m := nil
 _/SOURCEFILES := []
 _/SPACELIST := []
 
-$extraParms := []
-
 $categoryPredicateList := []
 
 $getDomainCode := nil