[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