[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