[MLton-commit] r5831

[Vesa Karvonen]

Replaced Tie.unit and Tie.option by the more general id combinator.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig
U   mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml	2007-08-07 08:10:39 UTC (rev 5830)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml	2007-08-07 18:19:06 UTC (rev 5831)
@@ -26,8 +26,7 @@
    (* The rest are not primitive operations. *)
    fun tuple2 ab = iso (op *` ab) Product.isoTuple2
    fun tier th = pure ((fn (a, ua) => (a, Fn.const a o ua)) o th)
-   val unit = pure (Thunk.mk ((), Effect.nop))
-   fun option ? = pure (Fn.const (NONE, Fn.id)) ?
+   fun id x = pure (Fn.const (x, Fn.id))
    fun function ? =
        pure (fn () => let
                    val r = ref (Basic.raising Fix.Fix)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-08-07 08:10:39 UTC (rev 5830)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-08-07 18:19:06 UTC (rev 5831)
@@ -61,6 +61,9 @@
     * procedure for "tying" it.
     *)
 
+   val id : 'a -> 'a t
+   (** {id x} is equivalent to {pure (const (x, id))}. *)
+
    (** == Combining Existing Tiers == *)
 
    val iso : 'b t -> ('a, 'b) Iso.t -> 'a t
@@ -85,12 +88,6 @@
 
    (** == Particular Tiers == *)
 
-   val unit : Unit.t t
-   (** NOP tier for unit values. *)
-
-   val option : 'a Option.t t
-   (** Tier for options. *)
-
    val function : ('a -> 'b) t
    (** Tier for functions. *)
 end

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun	2007-08-07 08:10:39 UTC (rev 5830)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/close-generic.fun	2007-08-07 18:19:06 UTC (rev 5831)
@@ -42,7 +42,7 @@
    fun C1 ? = Arg.C1 (const ignore) ?
    fun data ? = Arg.data ignore ?
    val unit = Arg.unit ()
-   fun Y ? = Arg.Y Tie.unit ?
+   fun Y ? = Arg.Y (Tie.id ()) ?
    fun op --> ? = Arg.--> ignore ?
    val exn = Arg.exn ()
    fun regExn ? = Arg.regExn (const ignore) ?