[MLton-commit] r6957

[Vesa Karvonen]

Added support for (labelled) args via FRU.

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

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-19 20:16:39 UTC (rev 6956)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/detail/fold/fru.sml	2008-10-19 23:00:33 UTC (rev 6957)
@@ -1,4 +1,5 @@
 (* Copyright (C) 2007 SSH Communications Security, Helsinki, Finland
+ * Copyright (C) 2008 Vesa Karvonen
  *
  * This code is released under the MLton license, a BSD-style license.
  * See the LICENSE file or http://mlton.org/License for details.
@@ -8,6 +9,9 @@
    datatype ('rec, 'upds) t' = IN of 'rec UnOp.t * 'upds
    type ('rec, 'upds, 'data) t =
         (('rec, 'upds) t', ('rec, 'upds) t', 'data UnOp.t) Fold.t
+   type ('value, 'rec) upd = 'value -> 'rec UnOp.t
+   type ('args, 'upds, 'result) args =
+        (('args, 'upds) t', ('args, 'upds) t', 'result) Fold.t
 
    local
       open StaticSum
@@ -27,10 +31,10 @@
    in
       fun A ? =
           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)))) ?
+           (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 =
           Fold.post (fn f => fn ~ => updData iso o f ~) make
@@ -38,6 +42,15 @@
       fun fru ? =
           fruData Iso.id ?
 
+      fun args ? =
+          Fold.post
+           (fn mkU => fn iso1 => fn iso2 => fn default => fn f =>
+               Fold.post
+                (fn u => f (u default))
+                (updData Iso.id (mkU iso1 iso2)))
+           make
+           ?
+
       fun U s v =
           Fold.mapSt (fn IN (f, u) => IN (s u v o f, u))
    end

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-19 20:16:39 UTC (rev 6956)
+++ mltonlib/trunk/com/ssh/extended-basis/unstable/public/fold/fru.sig	2008-10-19 23:00:33 UTC (rev 6957)
@@ -14,6 +14,9 @@
    type ('rec, 'upds) t'
    type ('rec, 'upds, 'data) t =
         (('rec, 'upds) t', ('rec, 'upds) t', 'data UnOp.t) Fold.t
+   type ('value, 'rec) upd = 'value -> 'rec UnOp.t
+   type ('args, 'upds, 'result) args =
+        (('args, 'upds) t', ('args, 'upds) t', 'result) Fold.t
 
    val fru :
        (((('a -> Unit.t) * 'b UnOp.t, 'c, 'd, 'e, 'c) StaticSum.t,
@@ -34,6 +37,14 @@
          (('rec, 'upds, 'data) t, 't) CPS.t) Fold.t,
         'u) CPS.t
 
+   val args :
+       (((('a -> Unit.t) * ('b -> 'b), 'c, 'd, 'e, 'c) StaticSum.t,
+         ('f, 'f, 'g, 'g,
+          (('h -> 'i -> 'j) -> 'k) * ('h -> 'l -> 'm)) StaticSum.t,
+         ('i -> 'l) * ('m -> 'j) -> 'n * ('k -> 'o) -> 'p -> ('p -> 'q) ->
+         ((('r, 'o) t', ('p, 's) t', 'q) Fold.t, 't) CPS.t) Fold.t,
+        'u) CPS.t
+
    val A :
        ((('a * 'b, 'c UnOp.t * ('d -> 'e -> 'd),
           (('f -> 'g) -> 'h) * ('i -> 'j -> 'k),
@@ -47,6 +58,6 @@
    val U :
        ('upds -> 'val -> 'rec UnOp.t) ->
        'val ->
-       (('rec, 'upds, 'data) t,
-        ('rec, 'upds, 'data) t, 'k) Fold.s
+       ((('rec, 'upds) t', ('rec, 'upds) t', 'result) Fold.t,
+        (('rec, 'upds) t', ('rec, 'upds) t', 'result) Fold.t, 'k) Fold.s
 end