[MLton-commit] r5591

[Vesa Karvonen]

Tier for units and refined tier for functions.
----------------------------------------------------------------------

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

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml	2007-06-06 07:43:08 UTC (rev 5590)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml	2007-06-07 09:31:39 UTC (rev 5591)
@@ -16,9 +16,12 @@
    (* 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 fromRef rf x = !rf x
    fun function ? =
-       tier (fn () => Pair.map (fromRef, Fn.curry op :=)
-                               (Sq.mk (ref (Basic.raising Fix.Fix)))) ?
+       pure (fn () => let
+                   val r = ref (Basic.raising Fix.Fix)
+                in
+                   (fn x => !r x, fn f => (r := f ; f))
+                end) ?
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-06-06 07:43:08 UTC (rev 5590)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-06-07 09:31:39 UTC (rev 5591)
@@ -85,6 +85,9 @@
 
    (** == Particular Tiers == *)
 
+   val unit : Unit.t t
+   (** NOP tier for unit values. *)
+
    val option : 'a Option.t t
    (** Tier for options. *)