Commit ed41f6ad authored by Axel Simon's avatar Axel Simon
Browse files

fix three type inference errors

parent f151f84a
......@@ -224,7 +224,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
end
val env = E.meetFlow (envCall, envFun)
handle (S.UnificationFailure str) =>
(raiseError str; envCall)
(raiseError str; envFun)
val (changed, env) = E.popToUsage (sym, s, oldCtxt, env)
val _ = sm := List.foldl
(fn (sym,sm) => (sym, E.getFunctionInfo (sym, env)) ::
......@@ -389,13 +389,16 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
val envHave = infExp (st,env) e1
val env = E.meet (envWant, envHave)
val env = E.popKappa env
val envM = E.pushTop env
val envT = infExp (st,env) e2
(*val _ = TextIO.print ("**** after if-then:\n" ^ E.topToString envT)*)
val envM = E.meetFlow (envM,envT)
val envE = infExp (st,env) e3
(*val _ = TextIO.print ("**** after if-else:\n" ^ E.topToString envE)*)
val env = E.meet (envE,envT)
val envM = E.meetFlow (envM,envE)
(*val _ = TextIO.print ("**** after if-merge:\n" ^ E.topToString envM)*)
in
env
envM
end
| infExp (st,env) (AST.CASEexp (e,l)) =
let
......
......@@ -44,7 +44,7 @@ end
structure SymbolTable :> SymbolTableSig = struct
val concisePrint : bool = false
val concisePrint : bool = true
structure SymbolTable = IntBinaryMap
structure Reverse = AtomRedBlackMap
......
......@@ -735,11 +735,17 @@ end = struct
let
fun aFL (ss, []) =
aF (ss, substsFilter (substs, Scope.getVars env), env)
| aFL (ss, {name, ty = NONE, width, uses} :: l) = aFL (ss, l)
(*| aFL (ss, {name, ty = NONE, width, uses} :: l) = aFL (ss, l)
| aFL (ss, {name = n, ty = SOME (t,_), width, uses} :: l) =
if isEmpty (substsFilter (substs,
texpVarset (t,TVar.empty)))
then aFL (ss, l)
else aFL (SymbolSet.add' (n, ss), l)*)
| aFL (ss, {name = n, ty, width, uses = us} :: l) =
if List.all (fn (_,t) => isEmpty
(substsFilter (substs, texpVarset (t,TVar.empty))))
(SpanMap.listItems us)
then aFL (ss, l)
else aFL (SymbolSet.add' (n, ss), l)
in
aFL (ss, l)
......@@ -780,7 +786,7 @@ end = struct
SOME f => SOME f
| NONE => affectedField (bVar, env)) fOpt envs
val fStr = case fOpt of
NONE => "some other field" (*" with var " ^ BD.showVar bVar*)
NONE => "some field" (*" with var " ^ BD.showVar bVar*)
| SOME f => "field " ^
SymbolTable.getString(!SymbolTables.fieldTable, f)
in
......@@ -1024,14 +1030,15 @@ end = struct
Scope.getVars env2))
fun substBinding (KAPPA {ty=t}, newUses, ei) =
(case applySubstsToExp substs (t,ei) of (t,ei) =>
(KAPPA {ty = t}, TVar.empty, ei))
(KAPPA {ty = t}, TVar.empty, newUses, ei))
| substBinding (SINGLE {name = n, ty = t}, newUses, ei) =
(case applySubstsToExp substs (t,ei) of (t,ei) =>
(SINGLE {name = n, ty = t}, TVar.empty, ei))
(SINGLE {name = n, ty = t}, TVar.empty, newUses, ei))
| substBinding (GROUP bs, newUses, ei) =
let
val eiRef = ref ei
val varSet = ref TVar.empty
val usesRef = ref newUses
fun optSubst (SOME t) =
(case applySubstsToExp substs (t,!eiRef) of (t,ei) =>
(eiRef := ei; SOME t))
......@@ -1050,6 +1057,7 @@ end = struct
NONE => us
| SOME nUs =>
let
val _ = usesRef := #1 (SymMap.remove (!usesRef,n))
val _ = varSet :=
List.foldl (fn ((_,(_,t)),set) =>
texpVarset (t,set)) (!varSet) nUs
......@@ -1057,7 +1065,7 @@ end = struct
List.foldl SpanMap.insert' us nUs
end)}
in
(GROUP (List.map substB bs), !varSet, !eiRef)
(GROUP (List.map substB bs), !varSet, !usesRef, !eiRef)
end
fun genImpl (t1,t2) ((contra1,f1), (contra2,f2),bFun) =
if contra1<>contra2 then
......@@ -1150,13 +1158,14 @@ end = struct
end
| uniteFlowInfo _ = raise InferenceBug
in
if isEmpty substs then (ei, bFun, env1) else
if isEmpty substs andalso SymMap.isEmpty newUses1 andalso
SymMap.isEmpty newUses2 then (ei, bFun, env1) else
let
val curVars = Scope.getVars env1
val (b1, env1) = Scope.unwrap env1
val (b2, env2) = Scope.unwrap env2
val (b1', extraVars, ei) = substBinding (b1, newUses1, ei)
val (b2', _, ei) = substBinding (b2, newUses2, ei)
val (b1', extraVars, newUses1, ei) = substBinding (b1, newUses1, ei)
val (b2', _, newUses2, ei) = substBinding (b2, newUses2, ei)
val (b,bFun) = uniteFlowInfo (b1', b2', bFun)
val (ei, bFun, env) =
applySubsts (substs, ei, bFun, false, newUses1, newUses2, env1, env2)
......
......@@ -6,7 +6,7 @@ structure Types = struct
type varset = TVar.set
val freshTVar = TVar.freshTVar
val concisePrint = true
val concisePrint = false
datatype texp =
(* a function taking at least one argument *)
......
# tests that both branches of an if-statement are flowing into the result
val ite c t e = if c then t else e
val res = $bar (ite '1' {bar=1,sum=7} {sum=8,zoo=9})
# tests that both branches of an if-statement are flowing into the result
val ite c t e = if c then t else e
val res = $sum (ite '1' {bar=1,sum=7} {sum=8,zoo=9})
# tests that both branches of an if-statement are flowing into the result
val foo = if '1' then {bar=1,sum=7} else {sum=8,zoo=9}
val bar = $zoo foo
# tests that both branches of an if-statement are flowing into the result
val foo = if '1' then {bar=1,sum=7} else {sum=8,zoo=9}
val bar = $sum foo
# applying a function to the wrong number of arguments
val f x y z = { sum = x + y, diff = x - z}
val res x = f x 7
# applying a function to the wrong number of arguments
val f x y z = { sum = x + y, diff = x - z}
val res x = f x 7 x
# tests checking of no of arguments of recursive calls
val f x y z = if x then f '0' z else 7
# tests checking of no of arguments of recursive calls
val f x y z = if x then f '0' z y else 7
# tests if unknown definitions are checked correctly
val res = $foobar (id {bar=7, foo="Hi", baz='1'})
val id x = x
# tests if unknown definitions are checked correctly
val res = $foo (id {bar=7, foo="Hi", baz='1'})
val id x = x
# test record field
val r = { foo = "a string", bar = 7 }
val s = $baz r
# test record field
val r = { foo = "a string", bar = 7 }
val s = $foo r
# test if fields flow properly in monadic results
val act = do
y <- return {num=7};
z <- return {add=8};
return (@{ add = $add z} y)
end
val res = do
r <- act;
return ($number r + $add r)
end
\ No newline at end of file
# test if fields flow properly in monadic results
val act = do
y <- return {num=7};
z <- return {add=8};
return (@{ add = $add z} y)
end
val res = do
r <- act;
return ($num r + $add r)
end
\ No newline at end of file
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