[MLton-commit] r6956
Vesa Karvonen
vesak at mlton.org
Sun Oct 19 13:16:48 PDT 2008
Changed to use StaticSum.
----------------------------------------------------------------------
U mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fold/fru.sml
U mltonlib/trunk/com/ssh/extended-basis/unstable/public/fold/fru.sig
----------------------------------------------------------------------
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fold/fru.sml
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fold/fru.sml 2008-10-18 18:03:26 UTC (rev 6955)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fold/fru.sml 2008-10-19 20:16:39 UTC (rev 6956)
@@ -10,15 +10,15 @@
(('rec, 'upds) t', ('rec, 'upds) t', 'data UnOp.t) Fold.t
local
+ open StaticSum
datatype product = datatype Product.product
- datatype sum = datatype Sum.sum
infix &
fun fin (m, u) iso (_, p2r) =
p2r (m (Fn.map iso o u))
fun make ? =
- Fold.NSZ.wrap {none = fin, some = fin, zero = (Fn.const (), Fn.id)} ?
+ Fold.wrap (StaticSum.inL (Fn.const (), Fn.id), fin o out) ?
fun out (IN ?) = ?
@@ -26,13 +26,13 @@
Fold.wrap (IN (Fn.id, u), Fn.map iso o Pair.fst o out)
in
fun A ? =
- Fold.NSZ.mapSt
- {none = Pair.map (Fn.const Fn.id, Fn.const Fn.const),
- some = Pair.map (fn m => fn p => m (p o INL) & (p o INR),
- fn u => fn INL p => (fn l & r => u p l & r)
- | INR v => (fn l & _ => l & v))} ?
+ Fold.mapSt
+ (inR o sum (Pair.map (Fn.const Fn.id, Fn.const Fn.const),
+ Pair.map (fn m => fn p => m (p o inL) & (p o inR),
+ fn u => sum (fn p => fn l & r => u p l & r,
+ fn v => fn l & _ => l & v)))) ?
- fun fruData (iso : ('data, 'rec) Iso.t) =
+ fun fruData iso =
Fold.post (fn f => fn ~ => updData iso o f ~) make
fun fru ? =
Modified: mltonlib/trunk/com/ssh/extended-basis/unstable/public/fold/fru.sig
===================================================================
--- mltonlib/trunk/com/ssh/extended-basis/unstable/public/fold/fru.sig 2008-10-18 18:03:26 UTC (rev 6955)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fold/fru.sig 2008-10-19 20:16:39 UTC (rev 6956)
@@ -16,44 +16,33 @@
(('rec, 'upds) t', ('rec, 'upds) t', 'data UnOp.t) Fold.t
val fru :
- (((('a -> unit) * 'b UnOp.t, 'c, 'd, 'e, 'f, 'c, 'd) Fold.NSZ.t',
- ('g,
- (('h -> 'i UnOp.t) -> 'j) * ('h -> 'k UnOp.t),
- ('i, 'k) Iso.t -> ('l, 'j) Iso.t -> 'l,
- (('m -> 'n UnOp.t) -> 'o) * ('m -> 'p UnOp.t),
- ('n, 'p) Iso.t -> ('q, 'o) Iso.t -> 'q,
- 'g,
- 'r -> 's -> 'upds) Fold.NSZ.t',
- 'r -> 's ->
- (('rec, 'upds, 'rec) t, 'v) CPS.t) Fold.t,
- 'w) CPS.t
+ (((('a -> Unit.t) * 'b UnOp.t, 'c, 'd, 'e, 'c) StaticSum.t,
+ ('f, 'f, 'g, 'g,
+ (('h -> 'rec UnOp.t) -> 'prod_upds) *
+ ('h -> 'prod UnOp.t)) StaticSum.t,
+ ('rec, 'prod) Iso.t -> ('upds, 'prod_upds) Iso.t ->
+ (('rec, 'upds, 'rec) t, 's) CPS.t) Fold.t,
+ 't) CPS.t
val fruData :
('data, 'rec) Iso.t ->
- (((('c -> unit) * 'd UnOp.t, 'e, 'f, 'g, 'h, 'e, 'f) Fold.NSZ.t',
- ('i,
- (('j -> 'k UnOp.t) -> 'l) * ('j -> 'm UnOp.t),
- ('k, 'm) Iso.t -> ('n, 'l) Iso.t -> 'n,
- (('o -> 'p UnOp.t) -> 'q) * ('o -> 'r UnOp.t),
- ('p, 'r) Iso.t -> ('s, 'q) Iso.t -> 's,
- 'i,
- 't -> 'u -> 'upds) Fold.NSZ.t',
- 't -> 'u ->
- (('rec, 'upds, 'data) t, 'w) CPS.t) Fold.t,
- 'x) CPS.t
+ (((('c -> Unit.t) * 'd UnOp.t, 'e, 'f, 'g, 'e) StaticSum.t,
+ ('h, 'h, 'i, 'i,
+ (('j -> 'rec UnOp.t) -> 'prod_upds) *
+ ('j -> 'prod UnOp.t)) StaticSum.t,
+ ('rec, 'prod) Iso.t -> ('upds, 'prod_upds) Iso.t ->
+ (('rec, 'upds, 'data) t, 't) CPS.t) Fold.t,
+ 'u) CPS.t
val A :
- ((('a,
- 'b * 'c,
- 'd UnOp.t * ('e -> 'f -> 'e),
- (('g -> 'h) -> 'i) * ('j -> 'k UnOp.t),
- ((('g, 'l) Sum.t -> 'h) -> ('i, 'l -> 'h) Product.t) *
- (('j, 'm) Sum.t -> ('k, 'm) Product.t UnOp.t),
- 'a,
- 'n) Fold.NSZ.t',
- 'o,
- 'p) Fold.t,
- (('n, 'q, 'r, 's, 't, 's, 't) Fold.NSZ.t', 'o, 'p) Fold.t, 'u) Fold.s
+ ((('a * 'b, 'c UnOp.t * ('d -> 'e -> 'd),
+ (('f -> 'g) -> 'h) * ('i -> 'j -> 'k),
+ ((('f, 'l, 'm, 'l, 'l) StaticSum.t -> 'g) ->
+ ('h, 'm -> 'g) Product.t) *
+ (('i, ('j, 'n) Product.t -> ('k, 'n) Product.t,
+ 'o, ('p, 'q) Product.t -> ('p, 'o) Product.t,
+ 'r) StaticSum.t -> 'r), 's) StaticSum.t, 't, 'u) Fold.t,
+ (('v, 'w, 's, 'x, 'x) StaticSum.t, 't, 'u) Fold.t, 'y) Fold.s
val U :
('upds -> 'val -> 'rec UnOp.t) ->
More information about the MLton-commit
mailing list