[MLton-commit] r6294

Vesa Karvonen vesak at mlton.org
Sun Dec 30 17:58:12 PST 2007


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,




More information about the MLton-commit mailing list