fix performance bug in size constraint merge

detail/semantic/inference.sml

@@ -131,7 +131,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
    (* define a second traversal that is a full inference of the tree *)
    
    (*local helper function to infer types for a binding group*)
-   val maxIter = 1
+   val maxIter = 2
    fun checkUsages printWarn (sym, env) =
       let
          (*val _ = TextIO.print ("***** usages of " ^ SymbolTable.getString(!SymbolTables.varTable, sym) ^ "\n")*)

detail/semantic/typing/environment.sml

@@ -1189,6 +1189,8 @@ end = struct
    fun forceNoInputs (sym, env) = case Scope.lookup (sym,env) of
          (_,COMPOUND {ty = SOME (t,bFun), width, uses}) =>
          let
+            val t = case t of (MONAD (r,inp,out)) => inp
+                            | t => t
             fun onlyInputs ((true,v),vs) = v :: vs
               | onlyInputs ((false,v),vs) = vs
             val bVars = texpBVarset onlyInputs (t,[])
@@ -1283,8 +1285,6 @@ end = struct
 
    fun meetGeneral (env1, env2, directed) =
       let
-         (*val (e1Str', si) = topToStringSI (env1,TVar.emptyShowInfo)
-         val (e2Str', si) = topToStringSI (env2,si)*)
 
          val substs = unify (env1, env2, emptySubsts)
          (*val (scs, cons) = env1
@@ -1299,6 +1299,12 @@ end = struct
       
          val (env1,env2) = mergeUses (env1, env2)
 
+         (*val (e1Str,si) = kappaToStringSI (env1, TVar.emptyShowInfo)
+         val (e2Str,si) = kappaToStringSI (env2, si)
+         val (sStr,si) = showSubstsSI (substs,si)
+         val kind = if directed then "directed" else "equalizing"
+         val _ = TextIO.print ("**** meet " ^ kind ^ ":\n" ^ e1Str ^ "++++ intersected with\n" ^ e2Str)*)
+
          val (_, state1) = env1
          val (_, state2) = env2
          val sCons = SC.merge (Scope.getSize state1,Scope.getSize state2)
@@ -1307,12 +1313,6 @@ end = struct
          val (ei, bFunFlow, env) =
             applySubsts (substs, emptyExpandInfo, BD.empty, directed, env1, env2)
          
-         (*val (e1Str,si) = kappaToStringSI (env1, si)
-         val (e2Str,si) = kappaToStringSI (env2, si)
-         val (sStr,si) = showSubstsSI (substs,si)
-         val kind = if directed then "directed" else "equalizing"
-         val _ = TextIO.print ("**** meet " ^ kind ^ ":\n" ^ e1Str' ^ "++++ intersected with\n" ^ e2Str')*)
-
          val bVars1 = Scope.getBVars env1
          val bVars2 = Scope.getBVars env2
          val bVars = BD.union (bVars1,bVars2)

detail/semantic/typing/size-constraint.sml

@@ -186,9 +186,26 @@ end = struct
       in
          List.foldl gV TVar.empty scs
       end
-      
+   
+   fun diff (scs1, scs2) =
+      let
+         fun cmp ({terms=(_,v1)::_, const=_},{terms=(_,v2)::_, const=_}) =
+                  TVar.compare (v1,v2)
+           | cmp _ = raise SizeConstraintBug
+         fun genDiff (sc1 :: scs1, sc2 :: scs2) =
+            (case cmp (sc1,sc2) of
+                 LESS => sc1 :: genDiff (scs1, sc2 :: scs2)
+               | GREATER => genDiff (sc1 :: scs1, scs2)
+               | EQUAL => genDiff (scs1, scs2)
+            )
+           | genDiff (scs1, _) = scs1
+      in
+         genDiff (scs1, scs2)
+      end
+
    fun merge (scs1, scs2) =
       let
+         val scs1 = diff (scs1,scs2)
          fun m ([], scs) = scs
            | m (eq :: eqs, scs) = case add (eq, scs) of
                 RESULT (_, scs) => m (eqs, scs)
@@ -215,6 +232,8 @@ end = struct
          fun renameVar sc = case lookupVarSC (v1,sc) of f1 =>
                addTermToSC (f1,v2, addTermToSC (~f1,v1, sc))
          val renamed = List.map renameVar withVar
+         val renamed = List.filter
+               (fn {terms=ts,const} => not (List.null ts)) renamed
       in
          merge (renamed, retained)
       end