Optimized to avoid creating new type variables for function (and
constructor) applications when the arrow type has already been inferred.
----------------------------------------------------------------------
U mlton/trunk/mlton/elaborate/elaborate-core.fun
----------------------------------------------------------------------
Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun 2007-12-29 13:22:41 UTC (rev 6293)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun 2007-12-31 01:58:11 UTC (rev 6294)
@@ -496,17 +496,26 @@
val {args, instance} = Scheme.instantiate s
val args = args ()
val p = loop p
- val argType = Type.new ()
- val resultType = Type.new ()
+ val (argType, resultType) =
+ case Type.deArrowOpt instance of
+ SOME types => types
+ | NONE =>
+ let
+ val types =
+ (Type.new (), Type.new ())
+ val _ =
+ unify
+ (instance, Type.arrow types,
+ fn _ =>
+ (region,
+ str "constant constructor\
+ \ applied to argument",
+ seq [str "in: ", lay ()]))
+ in
+ types
+ end
val _ =
unify
- (instance, Type.arrow (argType, resultType),
- fn _ =>
- (region,
- str "constant constructor applied to argument",
- seq [str "in: ", lay ()]))
- val _ =
- unify
(Cpat.ty p, argType, fn (l, l') =>
(region,
str "constructor applied to incorrect argument",
@@ -2351,15 +2360,22 @@
let
val e1 = elab e1
val e2 = elab e2
- val argType = Type.new ()
- val resultType = Type.new ()
+ val (argType, resultType) =
+ case Type.deArrowOpt (Cexp.ty e1) of
+ SOME types => types
+ | NONE =>
+ let
+ val types = (Type.new (), Type.new ())
+ val _ =
+ unify (Cexp.ty e1, Type.arrow types,
+ fn (l, _) =>
+ (region,
+ str "function not of arrow type",
+ seq [str "function: ", l]))
+ in
+ types
+ end
val _ =
- unify (Cexp.ty e1, Type.arrow (argType, resultType),
- fn (l, _) =>
- (region,
- str "function not of arrow type",
- seq [str "function: ", l]))
- val _ =
unify
(argType, Cexp.ty e2, fn (l1, l2) =>
(region,