* interp/compiler.boot (evaluateConstructorModemap): Rename from

	substituteInfoFunctorModemap.
	(constructorCondition): New.
	* interp/define.boot (compDefineCategory2): Compute dual signature
	early on.
	(compDefineFunctor1): Likewise.
	(typingKind): New.
	(deduceImplicitParameters): Use it.
	* interp/database.boot (modemapsFromCategory): Take a first
	argument as a DB.  Tidy.  Adjust caller.  Add constructor condition.
	(modemapsFromFunctor): Likewise. Lose last argument.
	(mkDatabasePred): Remove.
	(formal2Pattern): Likewise.

3 files changed, 44 insertions, 21 deletions

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index 4afa3d4f..074d225e 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -589,8 +589,8 @@ compFormWithModemap(form,m,e,modemap) ==
   [map:= [.,target,:sig],[pred,impl]]:= modemap
   [op,:argl] := form := reshapeArgumentList(form,sig)
   if isCategoryForm(target,e) and isFunctor op then
-    [modemap,e]:= substituteIntoFunctorModemap(argl,modemap,e) or return nil
-    [map:= [.,target,:.],:cexpr]:= modemap
+    [modemap,e] := evaluateConstructorModemap(argl,modemap,e) or return nil
+    [map:=[.,target,:.],:cexpr] := modemap
   sv := listOfSharpVars map
   if sv ~= nil then
      -- SAY [ "compiling ", op, " in compFormWithModemap,
@@ -721,18 +721,27 @@ reshapeArgumentList(form,sig) ==
   wantArgumentsAsTuple(args,sig) => [op,["%Comma",:args]]
   form
 
-substituteIntoFunctorModemap(argl,modemap is [[dc,:sig],:.],e) ==
-  #dc~=#sig =>
-    keyedSystemError("S2GE0016",['"substituteIntoFunctorModemap",
+++ Return true is the constructor condition `cond' holds in the
+++ elaboration environmemt `e'.
+constructorCondition(cond,e) ==
+  cond --FIXME: solve it!
+
+++ The argument list `argl' is used to instantiate a constructor
+++ with `modemap' in environment `e'.  Return the resulting
+++ modemap is instantiation is legit.
+evaluateConstructorModemap(argl,modemap is [[dc,:sig],:.],e) ==
+  #dc ~= #sig =>
+    keyedSystemError("S2GE0016",['"evaluateConstructorModemap",
       '"Incompatible maps"])
-  #argl=#sig.source =>
-                        --here, we actually have a functor form
-    sig := applySubst(pairList(dc.args,argl),sig)
-      --make new modemap, subst. actual for formal parametersinto modemap
-    Tl:= [[.,.,e]:= compOrCroak(a,m,e) for a in argl for m in rest sig]
-    substitutionList:= [[x,:T.expr] for x in dc.args for T in Tl]
-    [applySubst(substitutionList,modemap),e]
-  nil
+  #argl ~= #sig.source => nil
+  constructorCondition(applySubst(sl,modemap.mmCondition),e) isnt true => nil
+  sl := pairList(dc.args,argl)
+    --make new modemap, subst. actual for formal parameters into modemap
+  Tl := [[.,.,e] := compOrCroak(a,m,e)
+           for a in argl for m in applySubst(sl,modemap.mmSource)]
+  sl := [[x,:T.expr] for x in dc.args for T in Tl]
+  [applySubst(sl,modemap),e]
+
 
 --% SPECIAL EVALUATION FUNCTIONS
 
diff --git a/src/interp/database.boot b/src/interp/database.boot
index 831de579..dc942f85 100644
--- a/src/interp/database.boot
+++ b/src/interp/database.boot
@@ -191,10 +191,14 @@ modemapsFromCategory(db,form,body,signature) ==
     :[['ofCategory,a,m] for a in form.args for m in signature.source
        for cat? in dbDualSignature(db).source | cat? ]]
   op := dbConstructor db
+  cond :=
+    dbImplicitData db is [isubst,icond] =>
+      [['%exist,ASSOCRIGHT isubst,applySubst(sl,applySubst(isubst,icond))]]
+    nil
   mms := nil
   for (entry:= [[op,sig,:.],pred,sel]) in opAlist |
     listMember?(sig,LASSOC(op,nonCategorySigAlist)) repeat
-      pred' := MKPF([pred,:catPredList],'AND)
+      pred' := mkpf([pred,:catPredList,:cond],'AND)
       modemap := [["*1",:sig],[pred',sel]]
       mms := [[op,:interactiveModemapForm modemap],:mms]
   mms
@@ -215,6 +219,10 @@ modemapsFromFunctor(db,form,opAlist) ==
       $e := put(u,'mode,v,$e)
   nonCategorySigAlist :=
     mkAlistOfExplicitCategoryOps signature.target or return nil
+  catCond :=
+    dbImplicitData db is [isubst,icond] =>
+      [['%exist,ASSOCRIGHT isubst,applySubst(f2p,applySubst(isubst,icond))]]
+    nil
   mms := nil
   for (entry := [[op,sig,:.],pred,sel]) in opAlist |
     or/[listMember?(sig,catSig) for catSig in
@@ -235,7 +243,7 @@ modemapsFromFunctor(db,form,opAlist) ==
                           '"by pattern match" ]
           skip := 'SKIP
         modemap := [[form,:substitute(form,"$",sig)],
-                     [mkpf([pred,:predList],'AND),
+                     [mkpf([pred,:predList,:catCond],'AND),
                        substitute(form,"$",sel),:skip]]
         mms := [[op,:interactiveModemapForm modemap],:mms]
   mms
diff --git a/src/interp/define.boot b/src/interp/define.boot
index ce4b8bbc..a90d49fc 100644
--- a/src/interp/define.boot
+++ b/src/interp/define.boot
@@ -994,6 +994,11 @@ mkCategoryPackage(form is [op,:argl],cat,def) ==
   $categoryPredicateList := substitute(nameForDollar,'$,$categoryPredicateList)
   substitute(nameForDollar,'$,['DEF,[packageName,:packageArgl],packageSig,def])
  
+++ Return the typing constraint operator for `t' in the environment `e'.
+typingKind(t,e) ==
+  isCategoryForm(t,e) => 'ofCategory
+  'ofType
+
 ++ Subroutine of compDefineFunctor1 and compDefineCategory2.
 ++ Given a constructor definition defining `db', compute implicit
 ++ parameters and store that list in `db'.
@@ -1012,12 +1017,13 @@ deduceImplicitParameters(db,e) ==
       stackAndThrow('"Parameter %1b cannot be of type implicit parameter %2pb",
                       [p,m])
     m isnt [.,:.] => nil
-    q :=
-      isCategoryForm(m,e) => 'ofCategory
-      'isDomain
-    preds := [[q,dbSubstituteFormals(db,p),m],:preds]
-    st := [[a,:v] for a in m.args for [v,:qvars] in tails qvars
-                | ident? a and symbolMember?(a,nonparms)]
+    preds := [[typingKind(m,e),dbSubstituteFormals(db,p),m],:preds]
+    st := [qpair for a in m.args for [v,:qvars] in tails qvars
+            | ident? a and symbolMember?(a,nonparms)] where
+                 qpair() ==
+                   t := getXmode(a,e)
+                   preds := [[typingKind(t,e),a,t],:preds]
+                   [a,:v]
     subst := [:st,:subst]
   -- Now, build the predicate for implicit parameters.
   for s in nonparms repeat