[MLton-commit] r5626

[Vesa Karvonen]

Minor tweaks.
----------------------------------------------------------------------

U   mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml
U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml
U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml
U   mltonlib/trunk/com/ssh/generic/unstable/public/value/dummy.sig

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml	2007-06-16 09:10:51 UTC (rev 5625)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/generics-util.sml	2007-06-16 09:32:54 UTC (rev 5626)
@@ -14,3 +14,9 @@
    fun failExn e = failCat ["unregistered exn ", `e]
    fun failExnSq (l, r) = failCat ["unregistered exns ", `l, " and ", `r]
 end
+
+functor MkClosedGenericRep (type 'a t) : CLOSED_GENERIC_REP = struct
+   type 'a t = 'a t
+   type 'a s = 'a t
+   type ('a, 'k) p = 'a t
+end

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml	2007-06-16 09:10:51 UTC (rev 5625)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/dummy.sml	2007-06-16 09:32:54 UTC (rev 5626)
@@ -13,11 +13,7 @@
    (* SML/NJ workaround --> *)
 
    structure Dummy : CLOSED_GENERIC = struct
-      structure Rep = struct
-         type 'a t = 'a Option.t
-         type 'a s = 'a t
-         type ('a, 'k) p = 'a t
-      end
+      structure Rep = MkClosedGenericRep (type 'a t = 'a Option.t)
 
       fun iso b = flip Option.map b o Iso.from
 
@@ -81,13 +77,13 @@
       open Dummy
 
       structure Dummy = Rep
-      exception Dummy
+      exception Dummy of Exn.t
 
       val dummy : ('a, 'x) Dummy.t -> 'a =
           fn (SOME v, _) => v
-           | (NONE,   _) => raise Dummy
+           | (NONE,   _) => raise Dummy Option
 
-      fun noDummy (_, x) = (NONE, x)
+      fun withDummy v (_, x) = (v, x)
    end
 end
 
@@ -96,5 +92,5 @@
    open Dummy Joined
    structure Dummy = Rep
    val dummy = fn ? => dummy (Arg.Rep.getT ?)
-   val noDummy = fn ? => Arg.Rep.mapT noDummy ?
+   val withDummy = fn v => fn ? => Arg.Rep.mapT (withDummy v) ?
 end

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml	2007-06-16 09:10:51 UTC (rev 5625)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/eq.sml	2007-06-16 09:32:54 UTC (rev 5626)
@@ -13,11 +13,7 @@
    (* SML/NJ workaround --> *)
 
    structure Eq : CLOSED_GENERIC = struct
-      structure Rep = struct
-         type 'a t = 'a BinPr.t
-         type 'a s = 'a t
-         type ('a, 'k) p = 'a t
-      end
+      structure Rep = MkClosedGenericRep (type 'a t = 'a BinPr.t)
 
       fun iso b (a2b, _) = b o Pair.map (Sq.mk a2b)
 

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml	2007-06-16 09:10:51 UTC (rev 5625)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/ord.sml	2007-06-16 09:32:54 UTC (rev 5626)
@@ -13,11 +13,7 @@
    (* SML/NJ workaround --> *)
 
    structure Ord : CLOSED_GENERIC = struct
-      structure Rep = struct
-         type 'a t = 'a Cmp.t
-         type 'a s = 'a t
-         type ('a, 'k) p = 'a t
-      end
+      structure Rep = MkClosedGenericRep (type 'a t = 'a Cmp.t)
 
       fun inj b a2b = b o Pair.map (Sq.mk a2b)
       fun iso b = inj b o Iso.to

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml	2007-06-16 09:10:51 UTC (rev 5625)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/show.sml	2007-06-16 09:32:54 UTC (rev 5626)
@@ -65,11 +65,7 @@
          val c2s = Con.toString
       end
 
-      structure Rep = struct
-         type 'a t = exn list * 'a -> u
-         type 'a s = 'a t
-         type ('a, 'k) p = 'a t
-      end
+      structure Rep = MkClosedGenericRep (type 'a t = exn list * 'a -> u)
 
       fun inj b a2b = b o Pair.map (id, a2b)
       fun iso b = inj b o Iso.to

Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/dummy.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/dummy.sig	2007-06-16 09:10:51 UTC (rev 5625)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/dummy.sig	2007-06-16 09:32:54 UTC (rev 5626)
@@ -15,7 +15,7 @@
 signature DUMMY = sig
    structure Dummy : OPEN_GENERIC_REP
 
-   exception Dummy
+   exception Dummy of Exn.t
    (**
     * This is raised when trying to extract the dummy value in case of
     * unfounded recursion or an abstract type that has not been given a
@@ -25,10 +25,11 @@
    val dummy : ('a, 'x) Dummy.t -> 'a
    (** Extracts the dummy value or raises {Dummy}. *)
 
-   val noDummy : ('a, 'x) Dummy.t UnOp.t
+   val withDummy : 'a Option.t -> ('a, 'x) Dummy.t UnOp.t
    (**
-    * Removes the dummy value from the given representation.  This can be
-    * used for encoding abstract types that can not be given dummy values.
+    * {withDummy NONE t} removes the dummy value from the given
+    * representation {t} and {withDummy (SOME v) t} sets the dummy value
+    * to {v} in the given representation {t}.
     *)
 end