[MLton-commit] r5822

[Vesa Karvonen]

Changed Thunk.iso to Thunk.isoValue flipping the direction for
consistency.  Added isomorphisms and isomorphism lifters.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/thunk.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/thunk.sig
U   mltonlib/trunk/org/mlton/vesak/tech/generics/lgd.sml

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml	2007-08-05 10:10:22 UTC (rev 5821)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/effect.sml	2007-08-05 11:09:23 UTC (rev 5822)
@@ -11,4 +11,6 @@
    fun obs ef x = (ef x : Unit.t ; x)
    fun past ef x = (ef () : Unit.t ; x)
    fun tabulate n ef = ignore (Basic.repeat (fn i => (ef i : Unit.t ; i+1)) n 0)
+   fun map b2a a = a o b2a
+   fun iso (a2b, b2a) = (map b2a, map a2b)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/thunk.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/thunk.sml	2007-08-05 10:10:22 UTC (rev 5821)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/thunk.sml	2007-08-05 11:09:23 UTC (rev 5822)
@@ -7,5 +7,7 @@
 structure Thunk :> THUNK = struct
    open Thunk
    val mk = Fn.const
-   val iso = (mk, fn th => th ())
+   fun map a2b a = a2b o a
+   val isoValue = (fn th => th (), mk)
+   fun iso (a2b, b2a) = (map a2b, map b2a)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig	2007-08-05 10:10:22 UTC (rev 5821)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/effect.sig	2007-08-05 11:09:23 UTC (rev 5822)
@@ -32,4 +32,10 @@
 
    val tabulate : Int.t -> Int.t t t
    (** {tabulate n f == (f 0; ... ; f (n - 1))} *)
+
+   val map : ('b -> 'a) -> 'a t -> 'b t
+   (** Change the type of an effect. *)
+
+   val iso : ('a, 'b) Iso.t -> ('a t, 'b t) Iso.t
+   (** Lifts an iso between values to an iso between effects. *)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/thunk.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/thunk.sig	2007-08-05 10:10:22 UTC (rev 5821)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/thunk.sig	2007-08-05 11:09:23 UTC (rev 5822)
@@ -12,6 +12,12 @@
    val mk : 'a -> 'a t
    (** Constant thunk ({thunk x = let val x = x in fn () => x end}). *)
 
-   val iso : ('a, 'a t) Iso.t
+   val map : ('a -> 'b) -> 'a t -> 'b t
+   (** Change the type of a thunk. *)
+
+   val isoValue : ('a t, 'a) Iso.t
    (** The trivial isomorphism between values and thunks. *)
+
+   val iso : ('a, 'b) Iso.t -> ('a t, 'b t) Iso.t
+   (** Lifts an iso between values to an iso between thunks. *)
 end

Modified: mltonlib/trunk/org/mlton/vesak/tech/generics/lgd.sml
===================================================================
--- mltonlib/trunk/org/mlton/vesak/tech/generics/lgd.sml	2007-08-05 10:10:22 UTC (rev 5821)
+++ mltonlib/trunk/org/mlton/vesak/tech/generics/lgd.sml	2007-08-05 11:09:23 UTC (rev 5822)
@@ -43,9 +43,10 @@
  *)
 
 
-(* First a shorthand. *)
+(* First shorthands. *)
 
 val op <--> = Iso.<-->
+val swap = Iso.swap
 
 
 (* Signature for "structural cases". *)
@@ -184,11 +185,11 @@
    fun lookup r = Option.map Pair.snd o List.find (eq r o Pair.fst) o !
    fun insert (r, g) p = if isSome (lookup r p) then () else List.push p (r, g)
 
-   val unit = iso unit (Iso.swap isoUnit)
-   val int  = iso int  (Iso.swap isoInt)
+   val unit = iso unit (swap isoUnit)
+   val int  = iso int  (swap isoInt)
 
-   val isoSum  = Iso.swap (isoSum  <--> Thunk.iso)
-   val isoProd = Iso.swap (isoProd <--> Thunk.iso)
+   val isoSum  = swap (isoSum  <--> swap Thunk.isoValue)
+   val isoProd = swap (isoProd <--> swap Thunk.isoValue)
 
    fun mk (p, t) =
        case t