[MLton] sequences of products
Vesa Karvonen
vesa.karvonen@cs.helsinki.fi
Mon, 19 Sep 2005 19:17:35 +0300
Quoting Stephen Weeks <sweeks@sweeks.com>:
> The idea is to representat a product as its destructor function. That
> is, represent the product of types t1, t2, ..., tn as the type
>
> (t1 -> t2 -> ... -> tn -> 'a) -> 'a
That's an interesting idea. I'll have to take a closer look when I have
more time.
[...]
> This representation of products has a couple of advantages over &.
> First, it supports products of length 1.
I'm not sure what you mean here. The ListProduct module that I have in my
utility library allows you to operate on one or more lists at a time. For
example,
local
open ListProduct
in
val [1,2,3] = map (fn x => x) L[1,2,3] $
end
should work as expected (unless I made a typo). The implementation isn't
too complex either (see tha values noneMake and someMake below).
The simpler version I published earlier should also allow you to operate on
just one list at a time (unless I made a mistake).
> Second, there is a simple associative operator for appending two
> products. If f represents t1, t2, ..., tn and g represents u1, u2, ...,
> um, then g o f represents t1, t2, ..., tn, u1, u2, ..., um. Furthermore,
> append has a natural unit, namely, the identity function.
I agree that these properties are not as easily available using the
ListProduct approach, but I'm not sure how useful it is to be able to pass
products (of streams) around as first class entities. The point of the
ListProduct module is to make it convenient to perform ad hoc operations
on products of lists. The function that you pass to a ListProduct iterator
usually performs some ad hoc operation that considers all the elements of
the product.
Now that I think about, this reminds me of an experimental Loop module I
wrote after Anton van Straaten compared my Iter module to the Common Lisp
loop macro. The Loop module uses "iterators" (or sequences) of the type
type ('a, 's) iter = {get: 's -> ('a * 's) option, state: 's}
The streams you are using might be a viable alternative, but I haven't yet
investigated the possiblity. The Loop module provides several operations
intended to simulate features of the Common Lisp loop macro (and others).
Here is a simple example from the unit tests
["a1", "b2", "c3"] =
collect ((inList ["a", "b", "c"] && up 1)
by (fn s & i =>
s ^ Int.toString i))
Here the && combinator creates a "parallel" product iterator (unlike the
cartesian product combinator of the Iter module). The up combinator
creates an iterator of increasing integers. I haven't yet considered ways
to avoid having to use infix declarations in the Loop module (I wrote it
before the Fold revolution).
> The currying is not so concise in SML. One could use a function
> declaration instead of an anonymous function, but for many situations
> anonymous functions are handy.
Yes. Avoiding currying and the inconvenience of nested pairs was the idea
behind the product type.
> So, I think it's useful to have a family of curry functions C<n> so that
> one can do
>
> p (Cn (fn (x1, x2, ..., xn) => e))
Using infix &, the above would be written as
p (fn x1 & x2 & ... & xn => e)
which is slightly more concise and you are relieved from the task of
explictly counting the number of elements.
> The code below implements this idea, with the added bonus that it
> supports all kinds of sequences (arrays, lists, strings, vectors), not
> just lists.
That is a good idea. After reading about this, I added the same capability
to the ListProduct module of my utility lib. I should probably rename the
module (maybe SeqProduct).
Here is how you could translate the examples to use the ListProduct module
from my utility library:
> val () = foreach (P L l $, pi)
val () = app pi L l $
> val () = foreach (P L l A a $, C2 (fn (i, r) => (pi i; pr r)))
val () = app (fn i & r => (pi i; pr r)) L l A a $
> map (P A a L l S s V v $, C4 id)
map p2t4 A a L l S s V v $
where
val p2t4 = fn v1 & v2 & v3 & v4 => (v1, v2, v3, v4)
> val () = print (concat (rev ("\n" :: (fold (P S s V v $, [], C3 (fn (c, s, ac) => str c :: s :: ac))))))
val () = print (concat (rev ("\n" :: (foldl (fn c & s & ac => str c :: s :: ac) [] S s V v $))))
Below is a copy-paste of just the signature and structure of the current
ListProduct module library without other modules from my utility lib. You
can't compile it directly, but I'll write a few clarifying comments below.
(Simple copy paste of all the required modules from my utility lib would
be about 3 times longer and it would take some time to trim it down to
just the relevant parts. I intend to publish parts of my utility library
in the future (hopefully within a month). I can prepare a snapshot earlier
if anyone wants it.)
(** Functions for manipulating products of list (as well as arrays,
* strings, and vectors). This module can be seen as a generalization of
* the Basis Library module {ListPair}.
*
* The functions {appEq}, {foldlEq}, {foldrEq}, {mapEq}, and {zipEq} raise
* {UnequalLengths} if the lists are not all of equal length. The function
* {allEq} returns {false} if the lists are not all the same length.
* Except for {zipEq}, which has no side-effects, it is not specified
* whether any side-effects are performed before the exception is raised,
* and the equations illustrating the semantics are to be taken modulo
* side-effects. If side-effects must not be performed before raising the
* exception, then you should use {zipEq} and an appropriate function from
* the {List} module.
*)
signature LIST_PRODUCT =
sig
exception UnequalLengths
type ('ep, 'sp, 'e, 's, 'epe, 'sps) list_product_st
(* Below I make use of a couple of type abbreviations:
* 'a predicate = 'a -> bool
* 'a effect = 'a -> unit
* 'a uop = 'a -> 'a
*)
val makeCombiner : {full: 'a -> 'b, hd: 'b -> 'c, null: 'b predicate, tl: 'b uop}
-> ('d, 'e, 'c, 'b, 'f, 'g) list_product_st * 'h -> 'a
-> (('f, 'g, 'i, 'j, ('f, 'i) product, ('g, 'j) product) list_product_st * 'h -> 'k) -> 'k
(** Makes a new combiner. *)
val A : ('a, 'b, 'c, 'c ArraySlice.slice, 'd, 'e) list_product_st * 'f -> 'c array
-> (('d, 'e, 'g, 'h, ('d, 'g) product, ('e, 'h) product) list_product_st * 'f -> 'i) -> 'i
(** Array combiner. *)
val L : ('a, 'b, 'c, 'c list, 'd, 'e) list_product_st * 'f -> 'c list
-> (('d, 'e, 'g, 'h, ('d, 'g) product, ('e, 'h) product) list_product_st * 'f -> 'i) -> 'i
(** List combiner. *)
val S : ('a, 'b, char, Substring.substring, 'c, 'd) list_product_st * 'e -> string
-> (('c, 'd, 'f, 'g, ('c, 'f) product, ('d, 'g) product) list_product_st * 'e -> 'h) -> 'h
(** String combiner. *)
val V : ('a, 'b, 'c, 'c VectorSlice.slice, 'd, 'e) list_product_st * 'f -> 'c vector
-> (('d, 'e, 'g, 'h, ('d, 'g) product, ('e, 'h) product) list_product_st * 'f -> 'i) -> 'i
(** Vector combiner. *)
val all : 'a predicate
-> ((unit, unit, 'b, 'c, 'b, 'c) list_product_st
* ('a, 'd, 'e, 'f, 'g, 'h) list_product_st predicate -> 'i) -> 'i
(** {all p L vs1 ... L vsN $ = List.all p (zip L vs1 ... L vsN $)} *)
val allEq : 'a predicate
-> ((unit, unit, 'b, 'c, 'b, 'c) list_product_st
* ('a, 'd, 'e, 'f, 'g, 'h) list_product_st predicate -> 'i) -> 'i
(** {allEq p L vs1 ... L vsN $ = try (fn () => zipEq L vs1 ... L vsN $, List.all p, const false)} *)
val app : 'a effect
-> ((unit, unit, 'b, 'c, 'b, 'c) list_product_st
* ('a, 'd, 'e, 'f, 'g, 'h) list_product_st effect -> 'i) -> 'i
(** {app e L vs1 ... L vsN $ = List.app e (zip L vs1 ... L vsN $)} *)
val appEq : 'a effect
-> ((unit, unit, 'b, 'c, 'b, 'c) list_product_st
* ('a, 'd, 'e, 'f, 'g, 'h) list_product_st effect -> 'i) -> 'i
(** {appEq e L vs1 ... L vsN $ = List.app e (zipEq L vs1 ... L vsN $)} *)
val exists : 'a predicate
-> ((unit, unit, 'b, 'c, 'b, 'c) list_product_st *
('a, 'd, 'e, 'f, 'g, 'h) list_product_st predicate -> 'i) -> 'i
(** {exists p L vs1 ... L vsN $ = List.exists p (zip L vs1 ... L vsN $)} *)
val foldl : ('a * 'b -> 'b) -> 'b
-> ((unit, unit, 'c, 'd, 'c, 'd) list_product_st *
(('a, 'e, 'f, 'g, 'h, 'i) list_product_st -> 'b) -> 'j) -> 'j
(** {foldl f r L vs1 ... L vsN $ = List.foldl f r (zip L vs1 ... L vsN $)} *)
val foldlEq : ('a * 'b -> 'b) -> 'b
-> ((unit, unit, 'c, 'd, 'c, 'd) list_product_st
* (('a, 'e, 'f, 'g, 'h, 'i) list_product_st -> 'b) -> 'j) -> 'j
(** {foldlEq f r L vs1 ... L vsN $ = List.foldl f r (zipEq L vs1 ... L vsN $)} *)
val foldr : ('a * 'b -> 'b) -> 'b
-> ((unit, unit, 'c, 'd, 'c, 'd) list_product_st
* (('a, 'e, 'f, 'g, 'h, 'i) list_product_st -> 'b) -> 'j) -> 'j
(** {foldlr f r L vs1 ... L vsN $ = List.foldr f r (zip L vs1 ... L vsN $)} *)
val foldrEq : ('a * 'b -> 'b) -> 'b
-> ((unit, unit, 'c, 'd, 'c, 'd) list_product_st
* (('a, 'e, 'f, 'g, 'h, 'i) list_product_st -> 'b) -> 'j) -> 'j
(** {foldlrEq f r L vs1 ... L vsN $ = List.foldr f r (zipEq L vs1 ... L vsN $)} *)
val map : ('a -> 'b)
-> ((unit, unit, 'c, 'd, 'c, 'd) list_product_st
* (('a, 'e, 'f, 'g, 'h, 'i) list_product_st -> 'b list) -> 'j) -> 'j
(** {map f L vs1 ... L vsN $ = List.map f (zip L vs1 ... L vsN $)} *)
val mapEq : ('a -> 'b)
-> ((unit, unit, 'c, 'd, 'c, 'd) list_product_st
* (('a, 'e, 'f, 'g, 'h, 'i) list_product_st -> 'b list) -> 'j) -> 'j
(** {mapEq f L vs1 ... L vsN $ = List.map f (zipEq L vs1 ... L vsN $)} *)
val zip : ((unit, unit, 'a, 'b, 'a, 'b) list_product_st
* (('c, 'd, 'e, 'f, 'g, 'h) list_product_st -> 'c list) -> 'i) -> 'i
(** Converts a product of lists into a list of products. Excess
* elements are ignored. For example, {
* zip L[1, 2, 3] L[true, false] L["a", "b", "c"] $ =
* [1 & true & "a", 2 & false & "b"] } .
*)
val zipEq : ((unit, unit, 'a, 'b, 'a, 'b) list_product_st
* (('c, 'd, 'e, 'f, 'g, 'h) list_product_st -> 'c list) -> 'i) -> 'i
(** Converts a product of equal length lists into a list of
* products. Raises {UnequalLengths} if the lists are not all of
* equal length.
*)
end
structure ListProduct :> LIST_PRODUCT =
struct
exception UnequalLengths = ListPair.UnequalLengths
datatype ('ep, 'sp, 'e, 's, 'epe, 'sps) list_product_st =
T of {allNull: 'sp predicate,
existsNull: 'sp predicate,
hd: 'sp -> 'ep,
ls: 'sp,
tl: 'sp uop} *
{allNull: ('sp predicate, 's predicate) product -> 'sps predicate,
existsNull: ('sp predicate, 's predicate) product -> 'sps predicate,
hd: ('sp -> 'ep, 's -> 'e) product -> 'sps -> 'epe,
ls: ('sp, 's) product -> 'sps,
tl: ('sp uop, 's uop) product -> 'sps uop}
local
local
open Product
in
val noneMake = {allNull = snd, existsNull = snd, hd = snd, ls = snd, tl = snd}
val someMake = {allNull = all, existsNull = exists, hd = map, ls = id, tl = map}
(* The functions {snd} (projection), {all}, {exists}, and
* {map} come from the {Product} module. {all}, {exists}, and
* {map} are higher-order functions used to build functions on
* products. I'm using one "make" function for each element of
* the product, because is straightforward and avoids problems
* with lack of first-class polymorphism.
*)
end
fun listFn f =
Fold.fold (T ({allNull = thunk true, (* thunk x = fn () => x *)
existsNull = thunk true,
hd = thunk (),
ls = (),
tl = thunk ()},
noneMake),
f)
fun all' kf p (T ({allNull, existsNull, hd, ls, tl}, _)) =
let
fun lp ls =
if existsNull ls then
if allNull ls then
true
else
kf ()
else
p (hd ls) andalso lp (tl ls)
in
lp ls
end
fun foldl' kf f i (T ({allNull, existsNull, hd, ls, tl}, _)) =
let
fun lp (r, ls) =
if existsNull ls then
if allNull ls then
r
else
kf r
else
lp (f (hd ls, r), tl ls)
in
lp (i, ls)
end
fun rev' kf t =
foldl' kf op:: [] t
in
fun makeCombiner {full, null, hd, tl} =
Fold.step1 (fn (l, T (t, m)) =>
T ({allNull = #allNull m (#allNull t & null),
existsNull = #existsNull m (#existsNull t & null),
hd = #hd m (#hd t & hd),
ls = #ls m (#ls t & full l),
tl = #tl m (#tl t & tl)},
someMake))
fun A $ = makeCombiner
let open ArraySlice in
{full = full,
null = isEmpty,
hd = #1 o valOf o getItem,
tl = #2 o valOf o getItem}
end $
fun L $ = makeCombiner {full = id, null = null, hd = hd, tl = tl} $
fun S $ = makeCombiner
let open Substring in
{full = full,
null = isEmpty,
hd = #1 o valOf o getc,
tl = #2 o valOf o getc}
end $
fun V $ = makeCombiner
let open VectorSlice in
{full = full,
null = isEmpty,
hd = #1 o valOf o getItem,
tl = #2 o valOf o getItem}
end $
fun all p = listFn (all' (const true) p)
fun allEq p = listFn (all' (const false) p)
fun app f = listFn (foldl' id (f o Pair.fst) ())
fun appEq f = listFn (foldl' (fail UnequalLengths) (f o Pair.fst) ())
fun exists p = listFn (not o all' (const true) (not o p))
fun foldl f i = listFn (foldl' id f i)
fun foldlEq f i = listFn (foldl' (fail UnequalLengths) f i)
fun foldr f i = listFn (List.foldl f i o rev' id)
fun foldrEq f i = listFn (List.foldl f i o rev' (fail UnequalLengths))
fun map f = listFn (rev o foldl' id (op:: o Pair.map (f, id)) [])
fun mapEq f = listFn (rev o foldl' (fail UnequalLengths) (op:: o Pair.map (f, id)) [])
fun zip $ = map id $
fun zipEq $ = mapEq id $
end
end