[MLton-commit] r6732

[Matthew Fluet]

Explicit conversion from SXML types to SSA types.
----------------------------------------------------------------------

U   mlton/trunk/mlton/closure-convert/closure-convert.fun
U   mlton/trunk/mlton/ssa/ssa-tree.sig

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

Modified: mlton/trunk/mlton/closure-convert/closure-convert.fun
===================================================================
--- mlton/trunk/mlton/closure-convert/closure-convert.fun	2008-08-19 22:11:55 UTC (rev 6731)
+++ mlton/trunk/mlton/closure-convert/closure-convert.fun	2008-08-19 22:12:03 UTC (rev 6732)
@@ -423,8 +423,45 @@
       end
       val {get = lambdasInfoOpt, ...} =
          Property.get (Lambdas.plist, Property.initFun (fn _ => ref NONE))
-      val {hom = convertType, destroy = destroyConvertType} =
-         Stype.makeMonoHom {con = fn (_, c, ts) => Type.con (c, ts)}
+      val (convertType, destroyConvertType) =
+         let
+            val {get, set, destroy, ...} =
+               Property.destGetSetOnce (Tycon.plist, Property.initConst NONE)
+
+            fun nullary c v =
+               if Vector.isEmpty v
+                  then c
+               else Error.bug "ClosureConvert.convertType.nullary: bogus application of nullary tycon"
+
+            fun unary make v =
+               if 1 = Vector.length v
+                  then make (Vector.sub (v, 0))
+               else Error.bug "ClosureConvert.convertType.unary: bogus application of unary tycon"
+            val tycons =
+               [(Tycon.arrow, fn _ => Error.bug "ClosureConvert.convertType.array"),
+                (Tycon.array, unary Type.array),
+                (Tycon.cpointer, nullary Type.cpointer),
+                (Tycon.intInf, nullary Type.intInf),
+                (Tycon.reff, unary Type.reff),
+                (Tycon.thread, nullary Type.thread),
+                (Tycon.tuple, Type.tuple),
+                (Tycon.vector, unary Type.vector),
+                (Tycon.weak, unary Type.weak)]
+               @ Vector.toListMap (Tycon.reals, fn (t, s) => (t, nullary (Type.real s)))
+               @ Vector.toListMap (Tycon.words, fn (t, s) => (t, nullary (Type.word s)))
+
+            val _ = List.foreach (tycons, fn (tycon, f) => set (tycon, SOME f))
+
+            val {hom = convertType, destroy = destroyConvertType} =
+               Stype.makeMonoHom
+               {con = fn (_, tycon, ts) =>
+                case get tycon of
+                   NONE => nullary (Type.datatypee tycon) ts
+                 | SOME f => f ts}
+         in
+            (convertType,
+             fn () => (destroy () ; destroyConvertType ()))
+         end
       (* newDatatypes accumulates the new datatypes built for sets of lambdas. *)
       val newDatatypes: Datatype.t list ref = ref []
       fun valueType arg: Type.t =

Modified: mlton/trunk/mlton/ssa/ssa-tree.sig
===================================================================
--- mlton/trunk/mlton/ssa/ssa-tree.sig	2008-08-19 22:11:55 UTC (rev 6731)
+++ mlton/trunk/mlton/ssa/ssa-tree.sig	2008-08-19 22:12:03 UTC (rev 6732)
@@ -78,8 +78,7 @@
                                args: t vector,
                                prim: t Prim.t,
                                result: t} -> bool
-            val con: Tycon.t * t vector -> t
-            (* val cpointer: t *)
+            val cpointer: t
             val datatypee: Tycon.t -> t
             val dest: t -> dest
             val deArray: t -> t
@@ -92,15 +91,15 @@
             val deWeak: t -> t
             val equals: t * t -> bool
             val hash: t -> word
-            (* val intInf: t *)
+            val intInf: t
             val isTuple: t -> bool
             val isUnit: t -> bool
             val layout: t -> Layout.t
             val ofConst: Const.t -> t
             val plist: t -> PropertyList.t
-            (* val real: RealSize.t -> t *)
+            val real: RealSize.t -> t
             val reff: t -> t
-            (* val thread: t *)
+            val thread: t
             val tuple: t vector -> t
             val vector: t -> t
             val weak: t -> t