[MLton-commit] r6047
Matthew Fluet
fluet at mlton.org
Sat Sep 22 09:33:07 PDT 2007
When required to conjure up a bogus type, do so at the appropriate
arity.
This avoids both cascading type-errors and an Error.bug abort of
elaboration.
The following program demonstrates the cascading type-error;
uncommenting the 'where type' constraint demonstrates the Error.bug.
signature Z = sig type ('a, 'b) zzz end
functor cpZ (Arg : Z) : Z (* where type ('a, 'b) zzz = ('a, 'b) Arg.zzz *) =
struct
open Arg
end
structure Z1 = struct datatype ('a, 'b) zzz = Z end
structure Z2 = cpZ(structure Arg = Z1)
Previously, this would yield:
[fluet at shadow temp]$ mlton z.sml
Error: z.sml 7.20.
Type zzz in argument signature but not in structure.
Error: z.sml 2.25.
Type zzz has arity n-ary in structure but arity 2 in signature.
compilation aborted: parseAndElaborate reported errors
[fluet at shadow temp]$ mlton z.sml
Error: z.sml 7.20.
Type zzz in argument signature but not in structure.
ElaborateEnv.transparentCut.handleType: Nary tycon
Now, this yields:
[fluet at shadow temp]$ ../mlton.svn.trunk/build/bin/mlton z.sml
Error: z.sml 7.20.
Type zzz in argument signature but not in structure.
compilation aborted: parseAndElaborate reported errors
[fluet at shadow temp]$ ../mlton.svn.trunk/build/bin/mlton z.sml
Error: z.sml 7.20.
Type zzz in argument signature but not in structure.
compilation aborted: parseAndElaborate reported errors
----------------------------------------------------------------------
U mlton/trunk/mlton/elaborate/elaborate-env.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/elaborate/elaborate-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-env.fun 2007-09-20 22:16:47 UTC (rev 6046)
+++ mlton/trunk/mlton/elaborate/elaborate-env.fun 2007-09-22 16:33:06 UTC (rev 6047)
@@ -404,11 +404,6 @@
fun tycon (c, kind) = T {kind = kind,
node = Tycon c}
-
- fun ignoreNone (s: t option): t =
- case s of
- NONE => tycon (Tycon.tuple, Kind.Nary)
- | SOME s => s
end
local
@@ -575,6 +570,11 @@
val toEnv = typeStrToEnv
+ fun toEnvNoNone s =
+ case toEnv s of
+ NONE => EtypeStr.tycon (EtypeStr.Tycon.tuple, TypeStr.kind s)
+ | SOME s => s
+
fun fromEnv (s: EtypeStr.t) =
let
val kind = EtypeStr.kind s
@@ -588,10 +588,6 @@
| EtypeStr.Tycon c =>
tycon (Tycon.fromEnv (c, kind), kind)
end
-
- val fromEnv =
- Trace.trace ("ElaborateEnv.Interface.TypeStr.fromEnv", EtypeStr.layout, layout)
- fromEnv
end
end
@@ -1519,8 +1515,7 @@
val types =
Array.map (types, fn (name, s) =>
{domain = name,
- range = (TypeStr.ignoreNone
- (Interface.TypeStr.toEnv s)),
+ range = Interface.TypeStr.toEnvNoNone s,
time = time,
uses = Uses.new ()})
val vals =
@@ -2849,7 +2844,7 @@
val types =
map (structTypes, sigTypes, strids,
"type", Ast.Tycon.equals, Ast.Tycon.layout,
- TypeStr.ignoreNone o Interface.TypeStr.toEnv,
+ Interface.TypeStr.toEnvNoNone,
fn (name, s, s') => handleType (s, s', strids, name))
val vals =
map
More information about the MLton-commit
mailing list