[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