Remove $domainShell.

7 files changed, 40 insertions, 31 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 67a73452..0f7983ef 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,9 @@
+2013-05-28  Gabriel Dos Reis  <gdr@integrable-solutions.net>
+
+	* interp/sys-globals.boot ($domainShell): Remove.
+	* interp/c-util.boot (%CompilationData): Add shell field.
+	(dbDomainShell): New accessor.  Replace $domainShell variable.
+
 2013-05-27  Gabriel Dos Reis  <gdr@integrable-solutions.net>
 
 	* interp/compiler.boot(compNoStacking): Add DB parameter.
diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot
index bc0c6726..9ac95081 100644
--- a/src/interp/c-util.boot
+++ b/src/interp/c-util.boot
@@ -145,15 +145,17 @@ macro domainData d ==
 
 structure %CompilationData ==
   Record(subst: %Substitution,idata: %Substitution,bytes: List %Fixnum,
-    items: %Buffer %Pair(%SourceEntity,%Elaboration)) with
-      cdSubstitution == (.subst)
-      cdImplicits == (.idata)
-      cdBytes == (.bytes)
-      cdItems == (.items)
+    shell: %Vector %Thing,
+      items: %Buffer %Pair(%SourceEntity,%Elaboration)) with
+        cdSubstitution == (.subst)
+        cdImplicits == (.idata)
+        cdBytes == (.bytes)
+        cdShell == (.shell)
+        cdItems == (.items)
 
 ++ Make a fresh compilation data structure.
 makeCompilationData() ==
-  mk%CompilationData(nil,nil,nil,[nil,:0])
+  mk%CompilationData(nil,nil,nil,nil,[nil,:0])
 
 ++ Subsitution that replaces parameters with formals.
 macro dbFormalSubst db ==
@@ -174,6 +176,11 @@ macro dbImplicitData db ==
 macro dbByteList db ==
   cdBytes dbCompilerData db
 
+++ Return the domain shell of the category object (or the category object
+++ of the domain) being elaborated.
+macro dbDomainShell db ==
+  cdShell dbCompilerData db
+
 ++ Return a buffer of entities referenced during elaboration
 ++ of current functor.
 macro dbEntityBuffer db ==
diff --git a/src/interp/database.boot b/src/interp/database.boot
index d96fba4a..f4786648 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -212,7 +212,7 @@ modemapsFromCategory(db,form,body,signature) ==
   form := applySubst(sl,form)
   body := applySubst(sl,body)
   signature := applySubst(sl,signature)
-  opAlist := applySubst(sl,categoryExports $domainShell) or return nil
+  opAlist := applySubst(sl,categoryExports dbDomainShell db) or return nil
   nonCategorySigAlist :=
     mkAlistOfExplicitCategoryOps substitute("*1","$",body)
   catPredList := [['ofCategory,"*1",form],
diff --git a/src/interp/define.boot b/src/interp/define.boot
index 443f93cb..bb4f541a 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -1179,7 +1179,7 @@ compDefineCategory2(form,signature,body,m,e,$formalArgList) ==
     parForm := applySubst(pairlis,form)
  
     -- 6. put modemaps into InteractiveModemapFrame
-    $domainShell := eval [op',:[MKQ f for f in sargl]]
+    dbDomainShell(db) := eval [op',:[MKQ f for f in sargl]]
     dbConstructorModemap(db) :=
       [[parForm,:parSignature],[buildConstructorCondition db,$op]]
     dbPrincipals(db) := getParentsFor db
@@ -1194,7 +1194,6 @@ mkConstructor form ==
   ['%list,MKQ form.op,:[mkConstructor x for x in form.args]]
  
 compDefineCategory(df,m,e,fal) ==
-  $domainShell: local := nil -- holds the category of the object being compiled
   -- since we have so many ways to say state the kind of a constructor,
   -- make sure we do have some minimal internal coherence.
   lhs := second df
@@ -1342,8 +1341,8 @@ getOperationAlist(db,name,functorForm,form) ==
   (u:= get(functorForm,'isFunctor,$CategoryFrame)) and not
     ($insideFunctorIfTrue and first functorForm=first $functorForm) => u
   $insideFunctorIfTrue and name is "$" =>
-    $domainShell => categoryExports $domainShell
-    systemError '"$ has no shell now"
+    dbDomainShell db = nil => systemError '"$ has no shell now"
+    categoryExports dbDomainShell db
   T:= compMakeCategoryObject(form,$e) => ([.,.,$e]:= T; categoryExports T.expr)
   stackMessage('"not a category form: %1bp",[form])
  
@@ -1444,7 +1443,6 @@ getDollarName env ==
   get('%compilerData,'%dollar,env)
 
 compDefineFunctor(df,m,e,fal) ==
-  $domainShell: local := nil -- holds the category of the object being compiled
   $profileCompiler: local := true
   $profileAlist:    local := nil
   compDefineLisplib(df,m,e,fal,'compDefineFunctor1)
@@ -1493,7 +1491,7 @@ compDefineFunctor1(df is ['DEF,form,signature,body],m,$e,$formalArgList) ==
     $e := giveFormalParametersValues(form.args,$e)
     [ds,.,$e] := compMakeCategoryObject(target,$e) or return
        stackAndThrow('"   cannot produce category object: %1pb",[target])
-    $domainShell: local := copyVector ds
+    dbDomainShell(db) := copyVector ds
     attributeList := categoryAttributes ds --see below under "loadTimeAlist"
     $condAlist: local := nil
     $uncondAlist: local := nil
@@ -1568,7 +1566,7 @@ incompleteFunctorBody(db,m,body,e) ==
   -- Nullify them so people don't think they bear any meaningful
   -- semantics (well, they should not think these are forwarding either).
   ops := nil
-  for [opsig,pred,funsel] in categoryExports $domainShell repeat
+  for [opsig,pred,funsel] in categoryExports dbDomainShell db repeat
     if pred isnt true then
       pred := simpBool pred
     if funsel is [op,.,.] and op in '(ELT CONST) then
@@ -1778,7 +1776,7 @@ orderByDependency(vl,dl) ==
  
 ++ Subroutine of compDefineCapsuleFunction.
 assignCapsuleFunctionSlot(db,op,sig) ==
-  kind := or/[u.mapKind for u in categoryExports $domainShell
+  kind := or/[u.mapKind for u in categoryExports dbDomainShell db
                 | symbolEq?(op,u.mapOperation) and sig = u.mapSignature]
   kind = nil => nil -- op is local and need not be assigned
   if $insideCategoryPackageIfTrue then
@@ -1804,8 +1802,8 @@ compareMode2Arg(x,m) == null x or modeEqual(x,m)
 ++ Determine whether the function with possibly partial signature `target'
 ++ is exported.  Return the complete signature if yes; otherwise
 ++ return nil, with diagnostic in ambiguity case.
-hasSigInTargetCategory(form,target,e) ==
-  sigs := candidateSignatures(form.op,#form,categoryExports $domainShell)
+hasSigInTargetCategory(db,form,target,e) ==
+  sigs := candidateSignatures(form.op,#form,categoryExports dbDomainShell db)
   cc := checkCallingConvention(sigs,#form.args)
   mList:= [(cc.i > 0 => quasiquote x; getArgumentMode(x,e))
             for x in form.args for i in 0..]
@@ -1872,10 +1870,10 @@ partialSignature? sig ==
 ++ We are about to elaborate a definition with `form' as head, and
 ++ parameter types specified in `signature'.  Refine that signature
 ++ in case some or all of the parameter types are missing.
-refineDefinitionSignature(form,signature,e) ==
+refineDefinitionSignature(db,form,signature,e) ==
   --let target and local signatures help determine modes of arguments
   signature' :=
-    x := hasSigInTargetCategory(form,signature.target,e) => x
+    x := hasSigInTargetCategory(db,form,signature.target,e) => x
     x := getSignatureFromMode(form,e) => x
     [signature.target,:[getArgumentMode(a,e) for a in form.args]]
   signature'.source := stripOffSubdomainConditions(signature'.source,form.args)
@@ -1956,7 +1954,7 @@ compDefineCapsuleFunction(db,df is ['DEF,form,signature,body],
     $form := [$op,:argl]
     argl:= stripOffArgumentConditions argl
     $formalArgList:= [:argl,:$formalArgList]
-    signature := refineDefinitionSignature(form,signature,e) or return nil
+    signature := refineDefinitionSignature(db,form,signature,e) or return nil
     $signatureOfForm := signature --this global is bound in compCapsuleItems
     e := processDefinitionParameters(db,form,signature,e)
     rettype := resolve(signature.target,$returnMode)
diff --git a/src/interp/functor.boot b/src/interp/functor.boot
index 2955caa6..19711b83 100644
--- a/src/interp/functor.boot
+++ b/src/interp/functor.boot
@@ -581,7 +581,7 @@ InvestigateConditions(db,catvecListMaker,env) ==
   null $Conditions => [true,:[true for u in secondaries]]
   PrincipalSecondaries:= getViewsConditions principal'
   MinimalPrimary:= first first PrincipalSecondaries
-  MaximalPrimary := first categoryPrincipals $domainShell
+  MaximalPrimary := first categoryPrincipals dbDomainShell db
   necessarySecondaries:= [first u for u in PrincipalSecondaries | rest u=true]
   and/[listMember?(u,necessarySecondaries) for u in secondaries] =>
     [true,:[true for u in secondaries]]
@@ -736,8 +736,8 @@ getViewsConditions u ==
  
 DescendCodeVarAdd(db,base,flag) ==
    [SetFunctionSlots(sig,implem,flag,'adding) repeat
-       for i in 6..maxIndex $domainShell |
-         categoryRef($domainShell,i) is [sig:=[op,types],:.] and
+       for i in 6..maxIndex dbDomainShell db |
+         categoryRef(dbDomainShell db,i) is [sig:=[op,types],:.] and
            LASSOC([base,:substitute(base,'$,types)],get(op,'modemap,$e)) is
                   [[pred,implem]]]
  
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index d73344de..33539fa0 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -437,7 +437,6 @@ buildFunctor(db,sig,code,$locals,$e) ==
 --           this list is not augmented by this function
 --  $e: environment
 --GLOBAL VARIABLES REFERENCED:
---  $domainShell: passed in from compDefineFunctor1
 --  $QuickCode: compilation flag
   $definition: local := dbConstructorForm db
   [name,:args] := $definition
@@ -466,7 +465,7 @@ buildFunctor(db,sig,code,$locals,$e) ==
   [$catsig,:argsig] := sig
   catvecListMaker := removeDuplicates
     [comp($catsig,$EmptyMode,$e).expr,
-      :[compCategories(u,$e) for [u,:.] in categoryAncestors $domainShell]]
+      :[compCategories(u,$e) for [u,:.] in categoryAncestors dbDomainShell db]]
   condCats := InvestigateConditions(db,[$catsig,:rest catvecListMaker],$e)
   -- a list, one %for each element of catvecListMaker
   -- indicating under what conditions this
@@ -555,7 +554,7 @@ NRTsetVector4a(db,sig,form,cond) ==
   sig is '$ =>
      domainList :=
        [optimize comp(d,$EmptyMode,$e).expr or d
-         for d in categoryPrincipals $domainShell]
+         for d in categoryPrincipals dbDomainShell db]
      $uncondList := append(domainList,$uncondList)
      if isCategoryForm(form,$e) then $uncondList := [form,:$uncondList]
      $uncondList
@@ -575,7 +574,7 @@ NRTmakeSlot1Info db ==
       [[first dbParameters db,:'_$],:dbFormalSubst db]
     dbFormalSubst db
   exports :=
-    transformOperationAlist applySubst(pairlis,categoryExports $domainShell)
+    transformOperationAlist applySubst(pairlis,categoryExports dbDomainShell db)
   opList :=
     $NRTderivedTargetIfTrue => 'derived
     $insideCategoryPackageIfTrue => slot1Filter exports
@@ -613,7 +612,7 @@ changeDirectoryInSlot1 db ==  --called by buildFunctor
   --  if called inside buildFunctor, dbEntityCount gives different locs
   --  otherwise called from compFunctorBody (all lookups are forwarded):
   --    dbUsedEntities = nil  ===> all slot numbers become nil
-  $lisplibOperationAlist := [sigloc(db,entry) for entry in categoryExports $domainShell] where
+  $lisplibOperationAlist := [sigloc(db,entry) for entry in categoryExports dbDomainShell db] where
     sigloc(db,[opsig,pred,fnsel]) ==
       if pred isnt true then
         pred := simpBool pred
@@ -627,7 +626,7 @@ changeDirectoryInSlot1 db ==  --called by buildFunctor
                            copyList $lisplibOperationAlist,function second)
   $lastPred: local := false
   $newEnv: local := $e
-  categoryExports($domainShell) := [fn(db,entry) for entry in sortedOplist] where
+  categoryExports(dbDomainShell db) := [fn(db,entry) for entry in sortedOplist] where
     fn(db,[[op,sig],pred,fnsel]) ==
        if $lastPred ~= pred then
             $newEnv := deepChaseInferences(pred,$e)
diff --git a/src/interp/sys-globals.boot b/src/interp/sys-globals.boot
index d9433cfe..282d5969 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-2012, Gabriel Dos Reis.
+-- Copyright (C) 2007-2013, Gabriel Dos Reis.
 -- All rights reserved.
 --
 -- Redistribution and use in source and binary forms, with or without
@@ -382,7 +382,6 @@ $categoryPredicateList := []
 
 $getDomainCode := nil
 $addForm := nil
-$domainShell := nil
 
 --%