[MLton-commit] r5596

[Vesa Karvonen]

Added revealing constraints to keep signatures otherwise simple.

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

U   mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun
U   mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun
U   mltonlib/trunk/com/ssh/generic/unstable/public/export.sml

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun	2007-06-07 15:05:52 UTC (rev 5595)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/ground-generic.fun	2007-06-07 15:50:28 UTC (rev 5596)
@@ -4,7 +4,12 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-functor GroundGeneric (Arg : EXT_GENERIC) :> GENERIC = struct
+functor GroundGeneric (Arg : EXT_GENERIC) :>
+   GENERIC
+      where type 'a Index.t = ('a, Unit.t) Arg.Index.t
+      where type 'a Index.s = ('a, Unit.t) Arg.Index.s
+      where type ('a, 'k) Index.p = ('a, 'k, Unit.t) Arg.Index.p =
+struct
    (* <-- SML/NJ workaround *)
    open Fn
    (* SML/NJ workaround --> *)

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun	2007-06-07 15:05:52 UTC (rev 5595)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/lift-generic.fun	2007-06-07 15:50:28 UTC (rev 5596)
@@ -4,7 +4,12 @@
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
-functor LiftGeneric (Arg : GENERIC) :> EXT_GENERIC = struct
+functor LiftGeneric (Arg : GENERIC) :>
+   EXT_GENERIC
+      where type ('a, 'x) Index.t = 'a Arg.Index.t * 'x
+      where type ('a, 'x) Index.s = 'a Arg.Index.s * 'x
+      where type ('a, 'k, 'x) Index.p = ('a, 'k) Arg.Index.p * 'x =
+struct
    (* <-- SML/NJ workaround *)
    open Fn
    (* SML/NJ workaround --> *)

Modified: mltonlib/trunk/com/ssh/generic/unstable/public/export.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/export.sml	2007-06-07 15:05:52 UTC (rev 5595)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/export.sml	2007-06-07 15:50:28 UTC (rev 5596)
@@ -23,10 +23,20 @@
 
 (** == Exported Functors == *)
 
-functor GroundGeneric (Arg : EXT_GENERIC) : GENERIC = GroundGeneric (Arg)
+functor GroundGeneric (Arg : EXT_GENERIC) :
+   GENERIC
+      where type 'a Index.t = ('a, Unit.t) Arg.Index.t
+      where type 'a Index.s = ('a, Unit.t) Arg.Index.s
+      where type ('a, 'k) Index.p = ('a, 'k, Unit.t) Arg.Index.p =
+   GroundGeneric (Arg)
 (** Grounds an extensible generic to an ordinary generic. *)
 
-functor LiftGeneric (Arg : GENERIC) : EXT_GENERIC = LiftGeneric (Arg)
+functor LiftGeneric (Arg : GENERIC) :
+   EXT_GENERIC
+      where type ('a, 'x) Index.t = 'a Arg.Index.t * 'x
+      where type ('a, 'x) Index.s = 'a Arg.Index.s * 'x
+      where type ('a, 'k, 'x) Index.p = ('a, 'k) Arg.Index.p * 'x =
+   LiftGeneric (Arg)
 (** Lifts an ordinary generic to an extensible generic. *)
 
 functor JoinGenerics (Arg : JOIN_GENERICS_DOM) :