[MLton-commit] r5011

[Stephen Weeks]

Fixed bug, introduced in r3901, which change had caused extra "new"
types to be created when instantiating a constructor pattern.  These
new types would then be generalized over (not occuring freely in the
environment), and appear as unused type arguments.  This didn't
actually cause bad code -- but it did cause larger and larger lists of
type variable list to be created, which would cause performance
problems during elaboration of large programs.  (e.g. I saw over a
million tyvar arguments to a single var when elaborating a 300k line
program)


----------------------------------------------------------------------

U   mlton/trunk/mlton/elaborate/elaborate-core.fun
U   mlton/trunk/mlton/elaborate/type-env.fun
U   mlton/trunk/mlton/elaborate/type-env.sig

----------------------------------------------------------------------

Modified: mlton/trunk/mlton/elaborate/elaborate-core.fun
===================================================================
--- mlton/trunk/mlton/elaborate/elaborate-core.fun	2006-12-29 22:42:15 UTC (rev 5010)
+++ mlton/trunk/mlton/elaborate/elaborate-core.fun	2006-12-30 08:28:52 UTC (rev 5011)
@@ -658,10 +658,7 @@
                                            val {args, instance} =
                                               Scheme.instantiate s
                                         in
-                                           if Type.canUnify
-                                              (instance,
-                                               Type.arrow (Type.new (),
-                                                           Type.new ()))
+                                           if Type.isArrow instance
                                               then
                                                  (Control.error
                                                   (region,

Modified: mlton/trunk/mlton/elaborate/type-env.fun
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.fun	2006-12-29 22:42:15 UTC (rev 5010)
+++ mlton/trunk/mlton/elaborate/type-env.fun	2006-12-30 08:28:52 UTC (rev 5011)
@@ -720,6 +720,8 @@
       fun new () = unknown {canGeneralize = true,
                             equality = Equality.unknown ()}
 
+      val new = Trace.trace ("TypeEnv.Type.new", Unit.layout, layout) new
+
       fun newFlex {fields, spine} =
          newTy (FlexRecord {fields = fields,
                             spine = spine},
@@ -776,6 +778,11 @@
 
       val unit = tuple (Vector.new0 ())
 
+      fun isArrow t =
+         case toType t of
+            Con (c, _) => Tycon.equals (c, Tycon.arrow)
+          | _ => false
+
       fun isBool t =
          case toType t of
             Con (c, _) => Tycon.isBool c
@@ -1654,7 +1661,7 @@
                                        Time.layout (!time),
                                        str " where getTime is ",
                                        Time.layout genTime],
-                                  Out.standard)
+                                  Out.error)
                       end
              in
                 if not (Time.<= (genTime, !time))

Modified: mlton/trunk/mlton/elaborate/type-env.sig
===================================================================
--- mlton/trunk/mlton/elaborate/type-env.sig	2006-12-29 22:42:15 UTC (rev 5010)
+++ mlton/trunk/mlton/elaborate/type-env.sig	2006-12-30 08:28:52 UTC (rev 5011)
@@ -38,6 +38,7 @@
                           record: 'a SortedRecord.t -> 'a,
                           replaceSynonyms: bool,
                           var: Tyvar.t -> 'a} -> 'a
+            val isArrow: t -> bool
             val isBool: t -> bool
             val isCharX: t -> bool
             val isExn: t -> bool