Merge pull request #126 from MatthewFluet/signature-withtype-updates

Fix elaboration of withtype in signatures
MLton · Oct 20, 2015 · 22f61a4 · 22f61a4
2 parents adfd227 + ac35f60
commit 22f61a4
Show file tree

Hide file tree

Showing 3 changed files with 17 additions and 12 deletions.
diff --git a/mlton/atoms/generic-scheme.fun b/mlton/atoms/generic-scheme.fun
@@ -1,4 +1,5 @@
-(* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
+(* Copyright (C) 2015 Matthew Fluet.
+ * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
  *
@@ -43,4 +44,8 @@ fun apply (T {tyvars, ty}, args) =
                *)
    else Type.substitute (ty, Vector.zip (tyvars, args))
 
+val apply =
+   Trace.trace ("GenericScheme.apply", Layout.tuple2 (layout, Vector.layout Type.layout), Type.layout)
+   apply
+
 end
diff --git a/mlton/elaborate/elaborate-sigexp.fun b/mlton/elaborate/elaborate-sigexp.fun
@@ -1,4 +1,4 @@
-(* Copyright (C) 2010,2012 Matthew Fluet.
+(* Copyright (C) 2010,2012,2015 Matthew Fluet.
  * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -204,18 +204,14 @@ fun elaborateTypedescs (typedescs: {tycon: Ast.Tycon.t,
 fun elabTypBind (typBind: TypBind.t, E) = 
    let
       val TypBind.T types = TypBind.node typBind
-      val () = (if (Vector.length (types) > 0)
-                then (check (Control.Elaborate.allowSigWithtype, "allowSigWithtype", TypBind.region typBind))
-                else ())
+      val () = if Vector.length types > 0
+                  then check (Control.Elaborate.allowSigWithtype, "allowSigWithtype", TypBind.region typBind)
+                  else ()
       val strs =
          Vector.map
          (types, fn {def, tyvars, ...} =>
-          (let
-              val (_, ty) = elaborateType (def, E)
-              val scheme = Scheme.make (tyvars, ty)
-           in
-              TypeStr.def (scheme, Kind.Arity (Vector.length tyvars))
-           end))
+          TypeStr.def (elaborateScheme (tyvars, def, E),
+                       Kind.Arity (Vector.length tyvars)))
    in
       Vector.foreach2
       (types, strs, fn ({tycon, ...}, str) =>

diff --git a/mlton/elaborate/interface.fun b/mlton/elaborate/interface.fun
@@ -1,4 +1,4 @@
-(* Copyright (C) 2009 Matthew Fluet.
+(* Copyright (C) 2009,2015 Matthew Fluet.
  * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
  *    Jagannathan, and Stephen Weeks.
  * Copyright (C) 1997-2000 NEC Research Institute.
@@ -359,6 +359,10 @@ structure TypeStr =
           | Scheme s => Scheme.apply (s, tys)
           | Tycon t => Type.con (t, tys)
 
+      val apply =
+         Trace.trace ("Interface.TypeStr.apply", Layout.tuple2 (layout, Vector.layout Type.layout), Type.layout)
+         apply
+
       fun cons t =
          case node t of
             Datatype {cons, ...} => cons