[MLton-devel] cvs commit: fixed type inference bugs
Stephen Weeks
sweeks@users.sourceforge.net
Sun, 18 May 2003 16:57:51 -0700
sweeks 03/05/18 16:57:50
Modified: doc changelog
mlton/type-inference infer.fun type-env.fun type-env.sig
mlton/xml type-check.fun
Added: regression type-check.sml
Log:
Fixed two bugs in type inference that could cause the compiler to
raise the TypeError exception, along with a lot of XML IL. The
type-check.sml regression contains simple examples of what failed.
The problem that Ken saw was that there was a type variable in scope
that did not appear in the type environment. Hence, it was mistakenly
generalized over. The fix was to keep all type variables in scope
also in the type environment.
The second problem, unrelated to Ken's, but that I noticed when
reading the code, was that bound type variables were not kept if they
did not occur in the type of the variable at which they were bound.
This was incorrect because they might be used in some inner scope.
Another thing I noticed and fixed was an omission in the XML type
checker, which did not check that the argument types of exceptions
were in scope.
Revision Changes Path
1.33 +6 -0 mlton/doc/changelog
Index: changelog
===================================================================
RCS file: /cvsroot/mlton/mlton/doc/changelog,v
retrieving revision 1.32
retrieving revision 1.33
diff -u -r1.32 -r1.33
--- changelog 15 May 2003 20:12:27 -0000 1.32
+++ changelog 18 May 2003 23:57:50 -0000 1.33
@@ -1,5 +1,11 @@
Here are the changes since version 20030312.
+* 2003-05-18
+ - Fixed two bugs in type inference that could cause the compiler to
+ raise the TypeError exception, along with a lot of XML IL.
+ The type-check.sml regression contains simple examples of what
+ failed.
+
* 2003-05-15
- Fixed bug in Real.class introduced on 04-28 that cause many
regression failures with reals when using newer gccs.
1.23 +9 -2 mlton/mlton/type-inference/infer.fun
Index: infer.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/type-inference/infer.fun,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- infer.fun 14 Jan 2003 00:08:17 -0000 1.22
+++ infer.fun 18 May 2003 23:57:50 -0000 1.23
@@ -827,6 +827,10 @@
val ca = processException e
in
(cons (fn () => [Xdec.Exception ca]),
+ (* There is no need to extend the environment with the type
+ * of the exception argument, since all tyvars in it must
+ * be in scope and hence already occur in the type env.
+ *)
env)
end
| Cdec.Fun {tyvars, decs} =>
@@ -839,9 +843,10 @@
val args =
Promise.lazy
(fn () => Vector.map (valOf (!argsRef) (), Xtype.var))
+ val env' = Env.extendTyvars (env, tyvars)
val (decs, env') =
Vector.mapAndFold
- (decs, env, fn ({match, profile, types, var}, env) =>
+ (decs, env', fn ({match, profile, types, var}, env) =>
let
val argType = newType ()
val resultType = newType ()
@@ -934,7 +939,9 @@
(y, Scheme.ty (Env.lookupVar (env, y)))))})
end)
| Cdec.Val {tyvars, pat, exp, filePos} =>
- inferValDec (tyvars, pat, exp, filePos, inferExp (exp, env), env)
+ inferValDec (tyvars, pat, exp, filePos,
+ inferExp (exp, Env.extendTyvars (env, tyvars)),
+ env)
) arg
and inferDecs (ds: Cdec.t vector, env: Env.t): decCode * Env.t =
Vector.fold (ds, (emptyDec, env), fn (d, (d', env)) =>
1.11 +6 -0 mlton/mlton/type-inference/type-env.fun
Index: type-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/type-inference/type-env.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- type-env.fun 7 Dec 2002 02:21:54 -0000 1.10
+++ type-env.fun 18 May 2003 23:57:50 -0000 1.11
@@ -926,6 +926,10 @@
T (ref (Cons (VarRange.scheme r, e)))
end
+fun extendTyvars (env, ts: Tyvar.t vector) =
+ T (ref (Cons (InferScheme.Type (Type.tuple (Vector.map (ts, Type.var))),
+ env)))
+
fun lookupVarRange (_, x) = getVarRange x
val lookupVarRange =
@@ -958,6 +962,8 @@
val freeTyvars: Tyvar.t list ref = ref []
val freeUnknowns: Type.t list ref = ref []
val flexes: Type.t list ref = ref []
+ (* Add all of the ensures. *)
+ val _ = Vector.foreach (ensure, fn a => add (freeTyvars, a, Tyvar.equals))
(* Add all of the unknown types and all of the type variables. *)
val _ =
Vector.foreach
1.7 +8 -8 mlton/mlton/type-inference/type-env.sig
Index: type-env.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/type-inference/type-env.sig,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- type-env.sig 10 Apr 2002 07:02:21 -0000 1.6
+++ type-env.sig 18 May 2003 23:57:50 -0000 1.7
@@ -75,16 +75,15 @@
type t
- (* close (e, t, ts) = (ts', f) close type t with respect to environment
- * e, and ensure that no variable in ts occurs free in e.
- * ts' are the type variables in t that do not occur in e.
- * f is a function that returns type variables that occur in flexible
- * record types (which aren't known until the fields are determined, after
- * unification is complete).
- * if f is NONE, then there are no flexible record types in t.
+ (* close (e, t, ts, r) = {bound, mayHaveTyvars, scheme}
+ * close type t with respect to environment e, including all the tyvars in
+ * ts and ensuring than no tyvar in ts occurs free in e.
+ * bound returns the vector of type variables in t that do not occur in e,
+ * which isn't known until all flexible record fields are determined, after
+ * unification is complete.
*)
val close:
- t * Type.t * Tyvar.t vector * Region.t->
+ t * Type.t * Tyvar.t vector * Region.t ->
{bound: unit -> Tyvar.t vector,
mayHaveTyvars: bool,
scheme: InferScheme.t}
@@ -93,6 +92,7 @@
-> {bound: unit -> Tyvar.t vector,
schemes: InferScheme.t vector}
val empty: t
+ val extendTyvars: t * Tyvar.t vector -> t
val extendVar: t * Var.t * InferScheme.t -> t
val extendVarRange: t * Var.t * VarRange.t -> t
val layout: t -> Layout.t
1.11 +2 -1 mlton/mlton/xml/type-check.fun
Index: type-check.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/xml/type-check.fun,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -r1.10 -r1.11
--- type-check.fun 21 Apr 2003 15:16:19 -0000 1.10
+++ type-check.fun 18 May 2003 23:57:50 -0000 1.11
@@ -47,7 +47,8 @@
; set (con, {tyvars = tyvars,
ty = (case arg of
NONE => result
- | SOME ty => Type.arrow (ty, result))}))
+ | SOME ty => (checkType ty
+ ; Type.arrow (ty, result)))}))
fun checkConExp (c: Con.t, ts: Type.t vector): Type.t =
let
val _ = checkTypes ts
1.1 mlton/regression/type-check.sml
Index: type-check.sml
===================================================================
(* This example is interesting because at the time of generalization of f, the
* tyvar 'a is in scope, but does not appear in type types of any of the
* variables in the environment (x's type has not yet been determined to be 'a).
* Nevertheless, it is essential to not generalize 'a at g
*)
val 'a f = fn x =>
let
exception E of 'a
fun g (E y) = y
in
E x
end
(* This example is interesting because it binds a type variable at a scope where
* the type variable does not appear in the type. Nevertheless, it is essential
* to keep the type variable there, because it occurs in an inner scope.
*)
fun 'a f () =
let
val x: 'a = raise Fail "bug"
in
()
end
-------------------------------------------------------
This SF.net email is sponsored by: If flattening out C++ or Java
code to make your application fit in a relational database is painful,
don't do it! Check out ObjectStore. Now part of Progress Software.
http://www.objectstore.net/sourceforge
_______________________________________________
MLton-devel mailing list
MLton-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/mlton-devel