[MLton] cvs commit: another change in the behavior of undetermined types.

Stephen Weeks sweeks@mlton.org
Thu, 22 Jan 2004 23:32:20 -0800


sweeks      04/01/22 23:32:20

  Modified:    mlton/elaborate elaborate-core.fun type-env.fun type-env.sig
               regression undetermined.sml
  Added:       regression/warn undetermined.sml
  Removed:     regression/fail undetermined.1.sml undetermined.2.sml
                        undetermined.3.sml
  Log:
  MAIL another change in the behavior of undetermined types.
  
  Changed MLton to be more accepting, issuing a warning instead of
  rejecting programs like
  
  val x = ref nil;
  val _ = 13 :: !x

Revision  Changes    Path
1.72      +4 -4      mlton/mlton/elaborate/elaborate-core.fun

Index: elaborate-core.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/elaborate-core.fun,v
retrieving revision 1.71
retrieving revision 1.72
diff -u -r1.71 -r1.72
--- elaborate-core.fun	23 Jan 2004 06:38:39 -0000	1.71
+++ elaborate-core.fun	23 Jan 2004 07:32:20 -0000	1.72
@@ -1075,11 +1075,12 @@
 			if b
 			   then
 			      let
+				 val _ = preError ()
 				 open Layout
 			      in
-				 Control.error
+				 Control.warning
 				 (region,
-				  seq [str "unable to infer type for ",
+				  seq [str "unable to determine type of variable within declaration: ",
 				       Var.layout x],
 				  align [seq [str "type: ", Scheme.layoutPretty s],
 					 lay ()])
@@ -2227,7 +2228,6 @@
 
 fun reportUndeterminedTypes () =
    (List.foreach (rev (!freeTyvarChecks), fn p => p ())
-    ; freeTyvarChecks := []
-    ; TypeEnv.closeTop ())
+    ; freeTyvarChecks := [])
 
 end



1.19      +18 -47    mlton/mlton/elaborate/type-env.fun

Index: type-env.fun
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.fun,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- type-env.fun	23 Jan 2004 06:38:39 -0000	1.18
+++ type-env.fun	23 Jan 2004 07:32:20 -0000	1.19
@@ -1414,39 +1414,29 @@
 	    Type.unknown {canGeneralize = canGeneralize,
 			  equality = Equality.truee})))
 
-      val reportFrees = false
       fun haveFrees (v: t vector, newTycon): bool vector =
 	 let
-	    exception Yes
-	    val unknown =
-	       if reportFrees
-		  then fn _ => raise Yes
-	       else (fn (t, _) =>
-		     (Type.unify (t, Type.con (newTycon (), Vector.new0 ()),
-				  fn () => Error.bug "haveFrees unify")
-		      ; ()))
+	    fun con (_, _, bs) = Vector.exists (bs, fn b => b)
+	    fun no _ = false
 	    val {destroy, hom} =
-	       Type.makeHom {con = fn _ => (),
-			     expandOpaque = false,
-			     flexRecord = fn _ => (),
-			     genFlexRecord = fn _ => (),
-			     int = fn _ => (),
-			     real = fn _ => (),
-			     record = fn _ => (),
-			     recursive = fn _ => (),
-			     unknown = unknown,
-			     var = fn _ => (),
-			     word = fn _ => ()}
+	       Type.makeHom
+	       {con = con,
+		expandOpaque = false,
+		flexRecord = fn (_, {fields, ...}) => List.exists (fields, #2),
+		genFlexRecord = (fn (_, {fields, ...}) =>
+				 List.exists (fields, #2)),
+		int = no,
+		real = no,
+		record = fn (_, r) => Srecord.exists (r, fn b => b),
+		recursive = no,
+		unknown = fn _ => true,
+		var = no,
+		word = no}
 	    val res =
 	       Vector.map (v, fn s =>
-			   let
-			      val _ =
-				 case s of
-				    General {ty, ...} => hom ty
-				  | Type ty => hom ty
-			   in
-			      false
-			   end handle Yes => true)
+			   case s of
+			      General {ty, ...} => hom ty
+			    | Type ty => hom ty)
 	    val _ = destroy ()
 	 in
 	    res
@@ -1572,25 +1562,6 @@
 	 {bound = bound,
 	  schemes = schemes}
       end
-   end
-
-fun closeTop (): unit =
-   let
-      val _ =
-	 List.foreach
-	 (!Type.freeUnknowns, fn t =>
-	  case Type.toType t of
-	     Type.Unknown _ => (Type.unify (t, Type.unit, fn () => ())
-				; ())
-	   | _ => ())
-      val _ = Type.freeUnknowns := []
-      val _ = List.foreach (!Type.freeFlexes, fn t =>
-			    case Type.toType t of
- 			       Type.FlexRecord _ => Error.bug "free flex\n"
-			     | _ => ())
-      val _ = Type.freeFlexes := []
-   in
-      ()
    end
 
 structure Type =



1.12      +0 -1      mlton/mlton/elaborate/type-env.sig

Index: type-env.sig
===================================================================
RCS file: /cvsroot/mlton/mlton/mlton/elaborate/type-env.sig,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- type-env.sig	23 Jan 2004 06:38:39 -0000	1.11
+++ type-env.sig	23 Jan 2004 07:32:20 -0000	1.12
@@ -93,7 +93,6 @@
 	 -> Type.t vector
 	 -> {bound: unit -> Tyvar.t vector,
 	     schemes: Scheme.t vector}
-      val closeTop: unit -> unit
       val setOpaqueTyconExpansion: Tycon.t * (Type.t vector -> Type.t) -> unit
       val tyconAdmitsEquality: Tycon.t -> Tycon.AdmitsEquality.t ref
    end



1.4       +1 -17     mlton/regression/undetermined.sml

Index: undetermined.sml
===================================================================
RCS file: /cvsroot/mlton/mlton/regression/undetermined.sml,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- undetermined.sml	23 Jan 2004 06:38:40 -0000	1.3
+++ undetermined.sml	23 Jan 2004 07:32:20 -0000	1.4
@@ -19,11 +19,6 @@
 end
 ;
 
-structure B : sig end =
-struct
-    val a = ref nil
-end
-;
 val x = ref nil
 val _ = 1 :: !x
 ;
@@ -37,13 +32,6 @@
       ()
    end
 ;
-val x = ref []
-;
-val _ = let val x = ref [] in () end
-;
-(* 1.sml *)
-val id = (fn x => x) (fn x => x)
-;
 (* 2.sml *)
 val id = (fn x => x) (fn x => x)
 val _ = id 13
@@ -53,7 +41,7 @@
     val id = (fn x => x) (fn x => x)
     val _ = id 13
 end
-
+;
 (* 4.sml *)
 val id = (fn x => x) (fn x => x)
 datatype t = T
@@ -65,10 +53,6 @@
 in
    val _ = id 13
 end
-;
-(* 6.sml *)
-val id = (fn x => x) (fn x => x)
-val id = ()
 ;
 (* 7.sml *)
 val id = (fn x => x) (fn x => x)



1.1                  mlton/regression/warn/undetermined.sml

Index: undetermined.sml
===================================================================
(* 1.sml *)
val id = (fn x => x) (fn x => x)
;
structure B : sig end =
struct
    val a = ref nil
end
;
(* 3.sml *)
val id = (fn x => x) (fn x => x)
;
val _ = id 13
;
(* 6.sml *)
val id = (fn x => x) (fn x => x)
val id = ()
;
val x = ref [];
val _ = 1 :: !x
;
val x = ref nil
signature S = sig end
val _ = 1 :: !x
;
val x = ref nil;
val _ = () :: !x