[MLton-commit] r6460

Vesa Karvonen vesak at mlton.org
Wed Mar 5 19:17:58 PST 2008


Made naming more systematic (roughly descend -> transform and contexts ->
holes) and added some functionality (fold and reduce).  Minor
implementation tweaks.

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

U   mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml
U   mltonlib/trunk/com/ssh/generic/unstable/public/value/uniplate.sig

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

Modified: mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml	2008-03-05 18:08:58 UTC (rev 6459)
+++ mltonlib/trunk/com/ssh/generic/unstable/detail/value/uniplate.sml	2008-03-06 03:17:56 UTC (rev 6460)
@@ -81,35 +81,45 @@
                      fn xs => #1 (ko ((r, newMap ()), map to xs, x))))
 
    fun children t = #1 o uniplate' t
-   fun holes t =
+
+   fun holesC t =
        (fn (k, c) => let
               fun lp hs ys =
-               fn []    => hs
+               fn []    => rev hs
                 | x::xs =>
                   lp ((x, fn x => c (List.revAppend (ys, x::xs)))::hs) (x::ys) xs
            in
               lp [] [] k
            end) o
        uniplate' t
-   fun contexts t x = let
+   fun holesU t x = let
       fun lp (x, f, ys) =
           foldl (fn ((x, c), ys) => lp (x, f o c, ys))
                 ((x, f)::ys)
-                (holes t x)
+                (holesC t x)
    in
       rev (lp (x, id, []))
    end
-   fun para t f x = f x (map (para t f) (children t x))
-   fun descend t f = (fn (k, c) => c (map f k)) o uniplate' t
-   fun transform t f x = f (descend t (transform t f) x)
-   fun rewrite t f =
-       transform t (fn x => case f x of NONE => x | SOME x => rewrite t f x)
-   fun universe t x = let
-      fun lp (x, ys) = foldl lp (x::ys) (children t x)
+
+   fun foldC t f s = foldl f s o children t
+   fun foldU t f s x = foldC t (fn (x, s) => foldU t f s x) (f (x, s)) x
+
+   local
+      fun mk fold t zero op + one = fold t (fn (x, sum) => one x + sum) zero
    in
-      rev (lp (x, []))
+      fun reduceC ? = mk foldC ?
+      fun reduceU ? = mk foldU ?
    end
 
+   fun transformC t f = (fn (k, c) => c (map f k)) o uniplate' t
+   fun transformU t f x = f (transformC t (transformU t f) x)
+
+   fun para t f x = f x (map (para t f) (children t x))
+
+   fun rewrite t f =
+       transformU t (fn x => case f x of NONE => x | SOME x => rewrite t f x)
+   fun universe t = rev o foldU t op :: []
+
    fun uniplate t =
        (fn (children, context) =>
            (children,

Modified: mltonlib/trunk/com/ssh/generic/unstable/public/value/uniplate.sig
===================================================================
--- mltonlib/trunk/com/ssh/generic/unstable/public/value/uniplate.sig	2008-03-05 18:08:58 UTC (rev 6459)
+++ mltonlib/trunk/com/ssh/generic/unstable/public/value/uniplate.sig	2008-03-06 03:17:56 UTC (rev 6460)
@@ -21,6 +21,20 @@
 signature UNIPLATE = sig
    structure UniplateRep : OPEN_REP
 
+   val uniplate : ('a, 'x) UniplateRep.t -> 'a -> 'a List.t * ('a List.t -> 'a)
+   (**
+    * Returns a list of all maximal proper substructures (children) of the
+    * same type contained in the given value and a function, dubbed
+    * context, to replace the substructures.  At immutable contexts, a new
+    * value is built.  At mutable contexts, the objects are mutated.  The
+    * number of elements in the list given to context must be equal to the
+    * number of maximal proper substructure returned.  All functions
+    * specified in the {UNIPLATE} signature can be defined in terms of
+    * {uniplate}.
+    *)
+
+   (** == Queries == *)
+
    val children : ('a, 'x) UniplateRep.t -> 'a -> 'a List.t
    (**
     * Returns all maximal proper substructures of the same type contained
@@ -33,34 +47,37 @@
     * the given value (including it).  This is recursive.
     *)
 
-   val holes : ('a, 'x) UniplateRep.t -> 'a -> ('a * 'a UnOp.t) List.t
+   val holesC : ('a, 'x) UniplateRep.t -> 'a -> ('a * 'a UnOp.t) List.t
    (**
     * Returns a list of all maximal proper substructures of the given
     * value and functions to replace the corresponding substructure in the
     * given value.
     *
-    *> map op </ (holes t x) = children t x
+    *> map op </ (holesC t x) = children t x
     *)
 
-   val contexts : ('a, 'x) UniplateRep.t -> 'a -> ('a * 'a UnOp.t) List.t
+   val holesU : ('a, 'x) UniplateRep.t -> 'a -> ('a * 'a UnOp.t) List.t
    (**
     * Returns a list of all substructures of the given value and functions
     * to replace the corresponding substructure in the given value.
     *
-    *> map op </ (contexts t x) = universe t x
+    *> map op </ (holesU t x) = universe t x
     *)
 
-   val descend : ('a, 'x) UniplateRep.t -> 'a UnOp.t UnOp.t
+   (** == Transforms == *)
+
+   val transformC : ('a, 'x) UniplateRep.t -> 'a UnOp.t UnOp.t
    (**
-    * Replaces each maximal proper substructure {x} by {f x} in the given
-    * value.  This is non-recursive.
+    * Replaces each child {x} of the given value by {f x} in the given
+    * value.
     *)
 
-   val para : ('a, 'x) UniplateRep.t -> ('a -> 'b List.t -> 'b) -> 'a -> 'b
+   val transformU : ('a, 'x) UniplateRep.t -> 'a UnOp.t UnOp.t
    (**
-    * A kind of fold.  {para} can be defined as follows:
+    * Recursive bottom-up transformation.  {transform} can be defined as
+    * follows:
     *
-    *> fun para t f x = f x (map (para t f) (children t x))
+    *> fun transformU t f x = f (transformC t (transformU t f) x)
     *)
 
    val rewrite : ('a, 'x) UniplateRep.t -> ('a -> 'a Option.t) -> 'a UnOp.t
@@ -75,25 +92,46 @@
     *>                            | SOME x => rewrite t f x)
     *)
 
-   val transform : ('a, 'x) UniplateRep.t -> 'a UnOp.t UnOp.t
+   (** == Folds == *)
+
+   val foldC : ('a, 'x) UniplateRep.t -> ('a * 'b -> 'b) -> 'b -> 'a -> 'b
    (**
-    * Recursive bottom-up transformation.  {transform} can be defined as
-    * follows:
+    * Fold over the children.  {foldC} can be defined as follows:
     *
-    *> fun transform t f x = f (descend t (transform t f) x)
+    *> fun foldC f s = foldl f s o children t
     *)
 
-   val uniplate : ('a, 'x) UniplateRep.t -> 'a -> 'a List.t * ('a List.t -> 'a)
+   val foldU : ('a, 'x) UniplateRep.t -> ('a * 'b -> 'b) -> 'b -> 'a -> 'b
    (**
-    * Returns a list of all maximal proper substructures (children) of the
-    * same type contained in the given value and a function, dubbed
-    * context, to replace the substructures.  At immutable contexts, a new
-    * value is built.  At mutable contexts, the objects are mutated.  The
-    * number of elements in the list given to context must be equal to the
-    * number of maximal proper substructure returned.  All functions
-    * specified in the {UNIPLATE} signature can be defined in terms of
-    * {uniplate}.
+    * Fold over the universe.  {foldU} can be defined as follows:
+    *
+    *> fun foldU f s = foldl f s o universe t
     *)
+
+   val reduceC : ('a, 'x) UniplateRep.t -> 'b -> 'b BinOp.t -> ('a -> 'b) UnOp.t
+   (**
+    * Reduce children with a binary operation.  {reduceC} can be defined
+    * as follows:
+    *
+    *> fun reduceC t zero op + one =
+    *>     foldC t (fn (x, sum) => one x + sum) zero
+    *)
+
+   val reduceU : ('a, 'x) UniplateRep.t -> 'b -> 'b BinOp.t -> ('a -> 'b) UnOp.t
+   (**
+    * Reduce universe with a binary operation.  {reduceU} can be defined
+    * as follows:
+    *
+    *> fun reduceU t zero op + one =
+    *>     foldU t (fn (x, sum) => one x + sum) zero
+    *)
+
+   val para : ('a, 'x) UniplateRep.t -> ('a -> 'b List.t -> 'b) -> 'a -> 'b
+   (**
+    * A kind of fold.  {para} can be defined as follows:
+    *
+    *> fun para t f x = f x (map (para t f) (children t x))
+    *)
 end
 
 signature UNIPLATE_CASES = sig




More information about the MLton-commit mailing list