[MLton-commit] r4082: fixed bug in flexible record type inference
Stephen Weeks
MLton@mlton.org
Thu, 8 Sep 2005 22:50:17 -0700
MAIL fixed bug in flexible record type inference
The bug was tickled by the following program.
val g = fn {...} => ()
and h = fn () => ()
val () = (h (); g {a = 13})
The bug showed as an IL type error indicating that "h" was applied to
the wrong number of type arguments. The problem was that the
declaration of "h" expected one type argument but the application had
none.
The extra type variable arises because of the generalized flexrecord
in the type of g (note that the bug goes away without the "and"). The
bug was that type variable was not instantiated at the use of "h"
because the genflex did not occur in the type of h. Prior to r3799,
this would have raised an internal bug message ("missing flexInst"),
and indeed this is what happens if you run MLton 20041109 on the
example. However, in r3799, we removed the bug message and replaced
it with code that would silently continue, under the mistaken
impression that any genflexrecord must have had an instance, or the
user code must have already shown a type error. This fix missed
exactly the case above.
The correct fix is to instantiate *all* genflexrecords that occur in
any type in the declaration, whether or not they actually occur in the
type of the function. In the simple case above, that means that h
does get the extra type argument (unit) corresponding to the flexible
record field "a" in the argument to "g".
This fix also handles the problem that led to r3799, because the
missing flexinst will still be silently instantiated.
As a side note, only Poly/ML and MLton are able to infer the simple
example above. Hamlet, Moscow ML, ML Kit, and SML/NJ all report
unresolved flexible record types.
----------------------------------------------------------------------
U mlton/trunk/doc/changelog
U mlton/trunk/mlton/elaborate/type-env.fun
U mlton/trunk/regression/flexrecord.sml
----------------------------------------------------------------------
Modified: mlton/trunk/doc/changelog
===================================================================
--- mlton/trunk/doc/changelog 2005-09-09 05:27:33 UTC (rev 4081)
+++ mlton/trunk/doc/changelog 2005-09-09 05:50:10 UTC (rev 4082)
@@ -1,5 +1,9 @@
Here are the changes since version 20041109.
+* 2005-09-08
+ - Fixed bug in type inference of flexible records that would show up
+ as "Type error: variable applied to wrong number of type args"
+
* 2005-09-06
- Fixed bug in Real.signBit, which had assumed that the underlying
C signbit returned 0 or 1, when in fact any nonzero value is
Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun 2005-09-09 05:27:33 UTC (rev 4081)
+++ mlton/trunk/mlton/elaborate/type-env.fun 2005-09-09 05:50:10 UTC (rev 4082)
@@ -1488,42 +1488,46 @@
(List.fold
(flexes, Vector.toList types,
fn ({fields, spine, ...}, ac) =>
- Exn.withEscape (fn escape =>
let
- val flex =
- case List.peek (flexInsts,
- fn {spine = spine', ...} =>
- Spine.equals (spine, spine')) of
- NONE => escape ac (* Error.bug "missing flexInst" *)
- | SOME {flex, ...} => flex
- fun peekFields (fields, f) =
- Option.map
- (List.peek (fields, fn (f', _) =>
- Field.equals (f, f')),
- #2)
- val peek =
- case Type.toType flex of
- FlexRecord {fields, ...} =>
- (fn f => peekFields (fields, f))
- | GenFlexRecord {extra, fields, ...} =>
- (fn f =>
- case peekFields (fields, f) of
- NONE =>
- Option.map
- (List.peek
- (extra (), fn {field, ...} =>
- Field.equals (f, field)),
- Type.var o #tyvar)
- | SOME t => SOME t)
- | Record r => (fn f => Srecord.peek (r, f))
- | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst"
+ fun done peek =
+ Spine.foldOverNew
+ (spine, fields, ac, fn (f, ac) =>
+ (case peek f of
+ NONE => Type.unit
+ | SOME t => t) :: ac)
in
- Spine.foldOverNew
- (spine, fields, ac, fn (f, ac) =>
- (case peek f of
- NONE => Type.unit
- | SOME t => t) :: ac)
- end)))
+ case List.peek (flexInsts,
+ fn {spine = spine', ...} =>
+ Spine.equals (spine, spine')) of
+ NONE => done (fn _ => NONE)
+ | SOME {flex, ...} =>
+ let
+ fun peekFields (fields, f) =
+ Option.map
+ (List.peek (fields, fn (f', _) =>
+ Field.equals (f, f')),
+ #2)
+ in
+ done
+ (case Type.toType flex of
+ FlexRecord {fields, ...} =>
+ (fn f => peekFields (fields, f))
+ | GenFlexRecord {extra, fields, ...} =>
+ (fn f =>
+ case peekFields (fields, f) of
+ NONE =>
+ Option.map
+ (List.peek
+ (extra (),
+ fn {field, ...} =>
+ Field.equals (f, field)),
+ Type.var o #tyvar)
+ | SOME t => SOME t)
+ | Record r =>
+ (fn f => Srecord.peek (r, f))
+ | _ => Error.bug "TypeEnv.instantiate': General:strange flexInst")
+ end
+ end))
in
{args = args,
instance = ty}
Modified: mlton/trunk/regression/flexrecord.sml
===================================================================
--- mlton/trunk/regression/flexrecord.sml 2005-09-09 05:27:33 UTC (rev 4081)
+++ mlton/trunk/regression/flexrecord.sml 2005-09-09 05:50:10 UTC (rev 4082)
@@ -93,3 +93,9 @@
()
end
(* flexrecord8 *)
+
+(* flexrecord9 *)
+val g = fn {...} => ()
+and h = fn () => ()
+val () = (h (); g {a = 13})
+(* flexrecord9 *)