[MLton-commit] r5806

Vesa Karvonen vesak at mlton.org
Sun Jul 29 20:10:54 PDT 2007


Moved isomorphism lifters from Iso to other modules and added a few more
lifters.  Isomorphisms are quite hand in generic programming.

Also changed the type of the Fn.iso lifter (compared to the now removed
Iso.-->).  I'm not sure whether it is ultimately better to reflect the
contravariance in the type or not, but it seems that handling the
contravariance once in Fn.iso is better than swapping isomorphisms
everywhere when Fn.iso is used.

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

U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/sum.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/fn.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/iso.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/list.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/vector.sml
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/product-type.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/sum.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/iso.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig
U   mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/vector.sig

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

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/option.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -12,4 +12,5 @@
                       | (SOME _, NONE)     => GREATER
                       | (NONE, SOME _)     => LESS
                       | (SOME x1, SOME x2) => cmp (x1, x2)
+   fun iso ? = Pair.map (map, map) ?
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/pair.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -48,4 +48,6 @@
    fun foldr (fa, fb) ((a, b), s) = fa (a, fb (b, s))
 
    fun thunk (na, nb) () = (na (), nb ())
+
+   fun iso isos = map (map, map) (swizzle isos)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/product.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -50,4 +50,6 @@
    fun foldr (fA, fB) (a & b, s) = fA (a, fB (b, s))
 
    fun thunk (nA, nB) () = nA () & nB ()
+
+   fun iso isos = Pair.map (map, map) (Pair.swizzle isos)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/sum.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/sum.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/data/sum.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -42,4 +42,6 @@
         | (INL _, INR _) => LESS
         | (INR _, INL _) => GREATER
         | (INR l, INR r) => cmpB (l, r)
+
+   fun iso isos = Pair.map (map, map) (Pair.swizzle isos)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/fn.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/fn.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fn/fn.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -12,6 +12,7 @@
    fun flip f x y = f y x
    fun id x = x
    fun map (f, g) h = g o h o f
+   fun iso ((a2c, c2a), (b2d, d2b)) = (map (c2a, b2d), map (a2c, d2b))
    fun pass x f = f x
    fun seal f x () = f x
    fun uncurry f (x, y) = f x y

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/iso.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/iso.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/generic/iso.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -18,13 +18,4 @@
    fun (a2b, b2a) <--> (c2a, a2c) = (a2b o c2a, a2c o b2a)
 
    fun map (l, r) iso = r <--> iso <--> l
-
-   local
-      fun mk map = Pair.map map o Pair.swizzle
-   in
-      fun op --> ? = mk (Fn.map, Fn.map) ?
-      fun op  +` ? = mk (Sum.map, Sum.map) ?
-      fun op  *` ? = mk (Product.map, Product.map) ?
-      fun pair   ? = mk (Pair.map, Pair.map) ?
-   end
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/list.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/list.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/list.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -163,4 +163,5 @@
       push ([], xs)
    end
    val sort = stableSort
+   fun iso ? = Pair.map (map, map) ?
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/vector.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/vector.sml	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/sequence/vector.sml	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -7,4 +7,5 @@
 structure Vector : VECTOR = struct
    structure Common = MkSeqCommonExt (Vector)
    open Common Vector
+   fun iso ? = Pair.map (map, map) ?
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/option.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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,4 +20,9 @@
     * NONE)}; {LESS} if given {(NONE, SOME _)}; for {(SOME _, SOME _)} it
     * uses the provided comparison function.
     *)
+
+   (** == Generic Programming == *)
+
+   val iso : ('a, 'b) Iso.t -> ('a t, 'b t) Iso.t
+   (** Lifts an iso between elements to an iso between options. *)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/product-type.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/product-type.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/product-type.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -66,4 +66,9 @@
    val foldr : ('a * 'y -> 'z) * ('b * 'x -> 'y) -> ('a, 'b) t * 'x -> 'z
 
    val thunk : 'a Thunk.t * 'b Thunk.t -> ('a, 'b) t Thunk.t
+
+   (** == Generic Programming == *)
+
+   val iso : ('a, 'c) Iso.t * ('b, 'd) Iso.t -> (('a, 'b) t, ('c, 'd) t) Iso.t
+   (** Lifts isos between elements to an iso between products. *)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/sum.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/sum.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/data/sum.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -40,4 +40,9 @@
 
    val equal : 'a BinPr.t * 'b BinPr.t -> ('a, 'b) t BinPr.t
    val collate : 'a Cmp.t * 'b Cmp.t -> ('a, 'b) t Cmp.t
+
+   (** == Generic Programming == *)
+
+   val iso : ('a, 'c) Iso.t * ('b, 'd) Iso.t -> (('a, 'b) t, ('c, 'd) t) Iso.t
+   (** Lifts isos between elements to an iso between sums. *)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fn/fn.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -27,6 +27,9 @@
    val id : 'a -> 'a
    (** I-combinator ({id x = x}). *)
 
+   val iso : ('a, 'c) Iso.t * ('b, 'd) Iso.t -> (('a, 'b) t, ('c, 'd) t) Iso.t
+   (** Lifts isos between elements to an iso between arrows. *)
+
    val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c
    (** Uncurrying ({uncurry f (x, y) = f x y}). *)
 

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/iso.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/iso.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/generic/iso.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -30,28 +30,4 @@
 
    val <--> : ('a, 'b) t * ('c, 'a) t -> ('c, 'b) t
    (** Isomorphism composition. *)
-
-   val --> : ('c, 'a) t * ('b, 'd) t -> (('a, 'b) Fn.t, ('c, 'd) Fn.t) t
-   (**
-    * Creates an isomorphism between functions given isomorphisms between
-    * domains and ranges.
-    *)
-
-   val +` : ('a, 'c) t * ('b, 'd) t -> (('a, 'b) Sum.t, ('c, 'd) Sum.t) t
-   (**
-    * Creates an isomorphism between sums given isomorphisms between
-    * elements.
-    *)
-
-   val *` : ('a, 'c) t * ('b, 'd) t -> (('a, 'b) Product.t, ('c, 'd) Product.t) t
-   (**
-    * Creates an isomorphism between products given isomorphisms between
-    * elements.
-    *)
-
-   val pair : ('a, 'c) t * ('b, 'd) t -> ('a * 'b, 'c * 'd) t
-   (**
-    * Creates an isomorphism between pairs given isomorphisms between
-    * elements.
-    *)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/list.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -164,4 +164,9 @@
     * equivalence class specified by {eq}.  It preserves the ordering of
     * the elements in {xs}.
     *)
+
+   (** == Generic Programming == *)
+
+   val iso : ('a, 'b) Iso.t -> ('a t, 'b t) Iso.t
+   (** Lifts an iso between elements to an iso between lists. *)
 end

Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/vector.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/vector.sig	2007-07-29 20:31:20 UTC (rev 5805)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/sequence/vector.sig	2007-07-30 03:10:52 UTC (rev 5806)
@@ -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.
@@ -36,4 +36,9 @@
     * An isomorphism between vectors and lists.  It is always equivalent
     * to {(toList, fromList)}.
     *)
+
+   (** == Generic Programming == *)
+
+   val iso : ('a, 'b) Iso.t -> ('a t, 'b t) Iso.t
+   (** Lifts an iso between elements to an iso between vectors. *)
 end




More information about the MLton-commit mailing list