Commit 0d215ed7 authored by Axel Simon's avatar Axel Simon
Browse files

fix performance bug in size constraint merge

parent 03c3d2d0
......@@ -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")*)
......
......@@ -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)
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment