[MLton-commit] r5572

[Vesa Karvonen]

Tweaked signature and separated non-primitive operations in the structure.

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

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-05-28 07:04:21 UTC (rev 5571)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/tie.sml	2007-05-28 12:14:08 UTC (rev 5572)
@@ -1,21 +1,22 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
  *)
 
 structure Tie :> TIE = struct
-   type 'a t_dom = Unit.t
-   type 'a t_cod = 'a * 'a UnOp.t
-   type 'a t = 'a t_dom -> 'a t_cod
+   type 'a dom = Unit.t
+   type 'a cod = 'a * 'a UnOp.t
+   type 'a t = 'a dom -> 'a cod
    fun fix a f = let val (a, ta) = a () in ta (f a) end
    val pure = Fn.id
-   fun tier th = (fn (a, ta) => (a, Fn.const a o ta)) o th
    fun iso tb iso = Pair.map (Iso.from iso, Fn.map iso) o tb
-   fun op *` (a, b) = Pair.map (Product.&, Product.map) o
-                      Pair.swizzle o Pair.map (a, b) o Sq.mk
-   fun tuple2 (a, b) = iso (op *` (a, b)) Product.isoTuple2
-   fun option () = (NONE, Fn.id)
+   fun op *` ab = Pair.map (Product.&, Product.map) o
+                  Pair.swizzle o Pair.map ab o Sq.mk
+   (* 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)
+   fun option ? = pure (Fn.const (NONE, Fn.id)) ?
    fun fromRef rf x = !rf x
    fun function ? =
        tier (fn () => Pair.map (fromRef, Fn.curry op :=)

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-05-28 07:04:21 UTC (rev 5571)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/tie.sig	2007-05-28 12:14:08 UTC (rev 5572)
@@ -1,4 +1,4 @@
-(* Copyright (C) 2006 SSH Communications Security, Helsinki, Finland
+(* Copyright (C) 2006-2007 SSH Communications Security, Helsinki, Finland
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
@@ -20,24 +20,23 @@
  * See also: http://mlton.org/Fixpoints
  *)
 signature TIE = sig
-   type 'a t_dom and 'a t_cod
-   type 'a t = 'a t_dom -> 'a t_cod
+   type 'a dom and 'a cod
+   type 'a t = 'a dom -> 'a cod
    (**
     * The type of fixpoint tiers.
     *
-    * The type constructors {t_dom} and {t_cod} are used to expose the
-    * arrow {->} type constructor (to allow eta-expansion) while
-    * preventing clients from actually applying tiers.
+    * The type constructors {dom} and {cod} are used to expose the arrow
+    * {->} type constructor (to allow eta-expansion) while preventing
+    * clients from actually applying tiers.
     *)
 
    val fix : 'a t -> 'a Fix.t
    (**
     * Produces a fixpoint combinator from the given tier.  For example,
-    * given a module {Fn} implementing a tier {Fn.Y} for functions, one
-    * could make a mutually recursive definition of functions:
+    * one can make a mutually recursive definition of functions:
     *
     *> val isEven & isOdd =
-    *>     let open Tie in fix (Fn *` Fn) end
+    *>     let open Tie in fix (function *` function) end
     *>        (fn isEven & isOdd =>
     *>            (fn 0w0 => true
     *>              | 0w1 => false
@@ -47,6 +46,8 @@
     *>              | n => isEven (n-0w1)))
     *)
 
+   (** == Making New Tiers == *)
+
    val pure : ('a * 'a UnOp.t) Thunk.t -> 'a t
    (**
     * {pure} is a more general version of {tier}.  It is mostly useful for
@@ -60,6 +61,8 @@
     * procedure for "tying" it.
     *)
 
+   (** == Combining Existing Tiers == *)
+
    val iso : 'b t -> ('a, 'b) Iso.t -> 'a t
    (**
     * Given an isomorphism between {'a} and {'b} and a tier for {'b},
@@ -80,6 +83,8 @@
     * 'b}.
     *)
 
+   (** == Particular Tiers == *)
+
    val option : 'a Option.t t
    (** Tier for options. *)