* interp/compiler.boot (compSymbol): Don't handle possible

	case views here.
	(hasUniqueCaseView): Rename from getUniqueCaseView.  Take the
	target mode as second argument.
	(compForm2): Use calling convention vector to determine infer flag
	parameter types.
	(compCase1): Uniformly handle `case-expressions'.  Call
	genDeltaEntry for selected operator.
	(coerceExtraHard): Handle coercions from UnionType domains.
	(autoCoerceByModemap): Tidy.
	* interp/g-opt.boot (optCall): Be more verbose in diagnostics.
	* algebra/syntax.spad (Syntax): Rework.
	* algebra/coerce.spad.pamphlet (UnionType): New.
	* algebra/Makefile.pamphlet (axiom_algebra_layer_0): 
	Include UTYPE.o
	* share/algebra: Update databases.

3 files changed, 44 insertions, 33 deletions

diff --git a/src/interp/compiler.boot b/src/interp/compiler.boot
index b6c72840..c6841f5b 100644
--- a/src/interp/compiler.boot
+++ b/src/interp/compiler.boot
@@ -308,14 +308,6 @@ compSymbol(s,m,e) ==
         NRTgetLocalIndex s
         [s,v.mode,e] --s will be replaced by an ELT form in beforeCompile
 
-    -- If the symbol s has a type given by a condition as the result of
-    -- a `case' form or a `suchthat' form, then we want to take 
-    -- advantage of that mode knowledge.  However, we must ensure that
-    -- we are not messing with members of Union objects which need
-    -- extra indirections to get to the actual object representation.
-    not isUnionMode(v.mode,e) and (t := getUniqueCaseView(s,e)) => 
-      coerce([s,t,e],m)
-
     [s,v.mode,e] --s has been SETQd
   m':= getmode(s,e) =>
     if not member(s,$formalArgList) and not MEMQ(s,$FormalMapVariableList) and
@@ -325,14 +317,13 @@ compSymbol(s,m,e) ==
   m = $OutputForm or m = $Symbol => [['QUOTE,s],m,e]
   not isFunction(s,e) => errorRef s
 
-++ Return the more recent unique type case assumption on `x' (if any) 
-++ that predates its declaration in environment `e'.  Note, this cannot 
-++ be the same thing as just asking for the 'condition' property of `x'.
-getUniqueCaseView(s,e) ==
-  props := getProplist(s,e)
+++ Return true if `m' is the most recent unique type case assumption 
+++ on `x' that predates its declaration in environment `e'.
+hasUniqueCaseView(x,m,e) ==
+  props := getProplist(x,e)
   for [p,:v] in props repeat
-    p = "condition" and v is [["case",.,t],:.] => return t
-    p = "value" => return nil
+    p = "condition" and v is [["case",.,t],:.] => return modeEqual(t,m)
+    p = "value" => return false
 
 
 convertOrCroak(T,m) ==
@@ -437,11 +428,16 @@ compForm2(form is [op,:argl],m,e,modemapList) ==
   -- We can use MEMQ since deleteList was built out of members of modemapList
   -- its important that subsumed ops (newList) be considered last
   if newList then modemapList := append(modemapList,newList)
+
+  -- The calling convention vector is used to determine when it is
+  -- appropriate to infer type by compiling the argument vs. just
+  -- looking up the parameter type for flag arguments.
+  cc := checkCallingConvention([sig for [[.,:sig],:.] in modemapList], #argl)
   Tl:=
-    [[.,.,e]:= T for x in argl for z in first modemapList
-       while (T := inferMode(x,z,e))] where
-      inferMode(x,z,e) ==
-        isQuasiquote z => [x,quasiquote x,e]
+    [[.,.,e]:= T for x in argl for i in 0..
+       while (T := inferMode(x,cc.i > 0,e))] where
+      inferMode(x,flag,e) ==
+        flag => [x,quasiquote x,e]
         isSimple x and compUniquely(x,$EmptyMode,e)
 
   or/[x for x in Tl] =>
@@ -1090,14 +1086,16 @@ compCase(["case",x,m'],m,e) ==
 
 compCase1(x,m,e) ==
   [x',m',e']:= comp(x,$EmptyMode,e) or return nil
-  -- `case' operations for non-Union types are function calls
-  not isUnionMode(m',e') => compForm(["case",x',m],$Boolean,e')
   u:=
-    [cexpr
-      for (modemap:= [map,cexpr]) in getModemapList("case",2,e') 
-        | map is [.,.,s,t] and modeEqual(maybeSpliceMode t,m) 
+    [modemap
+      for (modemap := [map,cexpr]) in getModemapList("case",2,e') 
+        | map is [.,=$Boolean,s,t] and modeEqual(maybeSpliceMode t,m) 
             and modeEqual(s,m')] or return nil
-  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+  fn:= (or/[mm for (mm := [.,[cond,selfn]]) in u | cond=true]) or return nil
+  fn := genDeltaEntry ["case",:fn]
+  -- user-defined `case' functions really are binary, as opposed to
+  -- the compiler-synthetized versions for Union instances.  
+  not isUnionMode(m',e') => [["call",fn,x',MKQ m],$Boolean,e']
   [["call",fn,x'],$Boolean,e']
 
 
@@ -1244,8 +1242,19 @@ coerceExtraHard(T is [x,m',e],m) ==
       (T'':= coerce(T',m)) => T''
   m' is ['Record,:.] and m = $Expression =>
       [['coerceRe2E,x,['ELT,COPY m',0]],m,e]
+  belongsTo?(m',["UnionType"],e) and hasUniqueCaseView(x,m,e) =>
+    coerceByModemap(T,m)
   nil
 
+++ returns true if mode `m' is known to belong to category `cat' in
+++ the environment `e'.  This function is different from its cousines
+++ `ofCategory', or `has'.  The latter perform runtime checks.  Here,
+++ we are interested in a static approximation.  So, use with care.
+belongsTo?(m,cat,e) ==
+  c := get(m,"mode",e)
+  c isnt ["Join",:cats] => nil
+  cat in cats
+
 coerceable(m,m',e) ==
   m=m' => m
   -- must find any free parameters in m
@@ -1301,17 +1310,19 @@ coerceByModemap([x,m,e],m') ==
 
 autoCoerceByModemap([x,source,e],target) ==
   u:=
-    [cexpr
-      for (modemap:= [map,cexpr]) in getModemapList("autoCoerce",1,e) | map is [
-        .,t,s] and modeEqual(t,target) and modeEqual(s,source)] or return nil
-  fn:= (or/[selfn for [cond,selfn] in u | cond=true]) or return nil
+    [modemap
+      for (modemap:= [map,cexpr]) in getModemapList("autoCoerce",1,e)
+        | map is [.,t,s] and modeEqual(t,target) 
+            and modeEqual(s,source)] or return nil
+  fn:= (or/[mm for (mm := [.,[cond,selfn]]) in u | cond=true]) or return nil
+
   source is ["Union",:l] and member(target,l) =>
     (y:= get(x,"condition",e)) and (or/[u is ["case",., =target] for u in y])
-       => [["call",fn,x],target,e]
+       => [["call",genDeltaEntry ["autoCoerce", :fn],x],target,e]
     x="$fromCoerceable$" => nil
     stackMessage ["cannot coerce: ",x,"%l","      of mode: ",source,"%l",
       "      to: ",target," without a case statement"]
-  [["call",fn,x],target,e]
+  [["call",genDeltaEntry ["autoCoerce", :fn],x],target,e]
 
 --% Very old resolve
 -- should only be used in the old (preWATT) compiler
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 2c13097d..a1b91344 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -158,7 +158,7 @@ optCall (x is ["call",:u]) ==
     if $QuickCode then RPLACA(fn,"QREFELT")
     RPLAC(rest x,[:a,fn])
     x
-  systemErrorHere '"optCall"
+  systemErrorHere ['"optCall with", :bright x]
  
 optCallSpecially(q,x,n,R) ==
     y:= LASSOC(R,$specialCaseKeyList) => optSpecialCall(x,y,n)
diff --git a/src/interp/nrunfast.boot b/src/interp/nrunfast.boot
index 663ed874..d8e6736f 100644
--- a/src/interp/nrunfast.boot
+++ b/src/interp/nrunfast.boot
@@ -513,7 +513,7 @@ newExpandLocalTypeForm([functorName,:argl],dollar,domain) ==
   MEMQ(functorName, '(Record Union)) and first argl is [":",:.] =>
     [functorName,:[['_:,tag,newExpandLocalTypeArgs(dom,dollar,domain,true)]
                                  for [.,tag,dom] in argl]]
-  MEMQ(functorName, '(Union Mapping)) =>
+  MEMQ(functorName, '(Union Mapping _[_|_|_])) =>
           [functorName,:[newExpandLocalTypeArgs(a,dollar,domain,true) for a in argl]]
   functorName = "QUOTE"  => [functorName,:argl]
   coSig := GETDATABASE(functorName,'COSIG)