[MLton-commit] r5622

[Vesa Karvonen]

Added numElems.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
U   mltonlib/trunk/com/ssh/generic/unstable/public/value/type-info.sig

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml	2007-06-14 15:32:41 UTC (rev 5621)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/type-info.sml	2007-06-14 22:31:23 UTC (rev 5622)
@@ -31,6 +31,13 @@
               pure : Bool.t,
               recs : Int.t List.t}
 
+   datatype p =
+      INP of {base : Bool.t,
+              elems : Int.t,
+              exn : Bool.t,
+              pure : Bool.t,
+              recs : Int.t List.t}
+
    fun revMerge (xs, ys) = let
       fun lp ([], ys, zs) = (ys, zs)
         | lp (xs, [], zs) = (xs, zs)
@@ -60,7 +67,7 @@
      (structure Rep = struct
          type 'a t = t
          type 'a s = s
-         type ('a, 'k) p = 'a t
+         type ('a, 'k) p = p
       end
 
       val base = INT {base = true, exn = false, pure = true, recs = []}
@@ -71,10 +78,10 @@
       val isoProduct = const
       val isoSum = const
 
-      fun (INT {base = bl, exn = hl, recs = rl, ...}) *`
-          (INT {base = br, exn = hr, recs = rr, ...}) =
-          INT {base = bl andalso br, exn = hl orelse hr, pure = true,
-               recs = merge (rl, rr)}
+      fun (INP {base = bl, elems = el, exn = hl, recs = rl, ...}) *`
+          (INP {base = br, elems = er, exn = hr, recs = rr, ...}) =
+          INP {base = bl andalso br, elems = el + er, exn = hl orelse hr,
+               pure = true, recs = merge (rl, rr)}
 
       fun (INS {alts = al, base = bl, exn = hl, recs = rl, ...}) +`
           (INS {alts = ar, base = br, exn = hr, recs = rr, ...}) =
@@ -131,11 +138,14 @@
 
       (* Trivialities *)
 
-      val T = id
-      fun R _ = id
-      val tuple = id
-      val record = id
+      fun T (INT {base, exn, pure, recs}) =
+          INP {base = base, elems = 1, exn = exn, pure = pure, recs = recs}
+      fun R _ = T
 
+      fun tuple (INP {base, exn, pure, recs, ...}) =
+          INT {base = base, exn = exn, pure = pure, recs = recs}
+      val record = tuple
+
       fun C0 _ = INS {alts = 1, base = true, exn = false, pure = true, recs = []}
       fun C1 _ (INT {base, exn, pure, recs}) =
           INS {alts = 1, base = base, exn = exn, pure = pure, recs = recs}
@@ -146,16 +156,19 @@
 
    structure TypeInfo = Rep
 
-   fun outT (INT r, _) = r
+   fun out (INT r, _) = r
 
-   fun hasExn ? = (#exn o outT) ?
-   fun hasRecData ? = (not o null o #recs o outT) ?
-   fun isRefOrArray ? = (not o #pure o outT) ?
+   fun hasExn ? = (#exn o out) ?
+   fun hasRecData ? = (not o null o #recs o out) ?
+   fun isRefOrArray ? = (not o #pure o out) ?
    fun canBeCyclic ? = (isRefOrArray andAlso (hasExn orElse hasRecData)) ?
 
-   fun outS (INS r, _) = r
-   fun numAlts ? = (#alts o outS) ?
-   fun hasBaseCase ? = (#base o outS) ?
+   fun out (INS r, _) = r
+   fun numAlts ? = (#alts o out) ?
+   fun hasBaseCase ? = (#base o out) ?
+
+   fun out (INP r, _) = r
+   fun numElems ? = (#elems o out) ?
 end
 
 functor WithTypeInfo (Outer : OPEN_GENERIC) : TYPE_INFO_GENERIC = struct
@@ -170,4 +183,6 @@
    fun mk f = f o Outer.Rep.getS
    val hasBaseCase  = fn ? => mk hasBaseCase  ?
    val numAlts      = fn ? => mk numAlts      ?
+   fun mk f = f o Outer.Rep.getP
+   val numElems     = fn ? => mk numElems     ?
 end

Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/type-info.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/type-info.sig	2007-06-14 15:32:41 UTC (rev 5621)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/type-info.sig	2007-06-14 22:31:23 UTC (rev 5622)
@@ -48,9 +48,10 @@
     *)
 
    val numAlts : ('a, 'x) TypeInfo.s -> Int.t
-   (**
-    * Number of alternatives in the given incomplete sum.
-    *)
+   (** Number of alternatives in the given incomplete sum. *)
+
+   val numElems : ('a, 'k, 'x) TypeInfo.p -> Int.t
+   (** Number of elements in the given incomplete product. *)
 end
 
 signature TYPE_INFO_GENERIC = sig