[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