tweak reader2.ml, add Juli8.tgz
authorJim <jim.pryor@nyu.edu>
Sat, 4 Apr 2015 23:24:47 +0000 (19:24 -0400)
committerJim <jim.pryor@nyu.edu>
Sat, 4 Apr 2015 23:24:47 +0000 (19:24 -0400)
code/Juli8-v1.2.tgz [new file with mode: 0644]
code/juli8.ml [deleted file]
code/monad.ml [deleted file]
code/reader2.ml

diff --git a/code/Juli8-v1.2.tgz b/code/Juli8-v1.2.tgz
new file mode 100644 (file)
index 0000000..c3c2f01
Binary files /dev/null and b/code/Juli8-v1.2.tgz differ
diff --git a/code/juli8.ml b/code/juli8.ml
deleted file mode 100644 (file)
index 821a09f..0000000
+++ /dev/null
@@ -1,1523 +0,0 @@
-(* This version from 1 April 2015 *)
-
-module Juli8 = struct
-
-(*
-  module Std = struct
-    include Pervasives
-    module List = List
-  end
-*)
-
-  external ident : 'a -> 'a = "%identity"
-  let const c = (); fun _ -> c
-  (* TODO: include fun x y -> f (g x y)? include flip (%)? *)
-  let (%) f g = (); fun x -> f (g x)
-  let flip f = (); fun x y -> f y x
-  let fix (f : ('a -> 'b) -> ('a -> 'b)) : 'a -> 'b = let rec x y = f x y in x
-
-  (* Haskell's `(op rightval)` = `flip (op) rightval` *)
-  (* Haskell's `f $ xxx $ yyy` == `f @@ xxx @@ yyy` which is properly right-associative.
-     If you `let ($$) = (@@)`, then `f $$ xxx $$ yyy` will be `f (xxx) (yyy)`. *)
-
-  (* `non p` == `not % p` *)
-  let non f = (); fun x -> not (f x)
-  let non2 f = (); fun x y -> not (f x y)
-
-  let pair x y = (x, y)
-  let swap (x, y) = (y, x)
-  let curry f = (); fun x y -> f (x, y)
-  let uncurry f = (); fun (x, y) -> f x y
-  let mapfst f (x, y) = (f x, y)
-  let mapsnd f (x, y) = (x, f y)
-
-  let even x = x land 1 = 0
-  let odd x = x land 1 = 1
-  let sign x = if x < 0 then -1 else if x > 0 then 1 else 0
-  exception Overflow
-  let pred x = if x < 0 then invalid_arg "pred" else if x > 0 then x - 1 else raise Overflow
-  let pred' x = if x < 0 then invalid_arg "pred'" else if x > 0 then x - 1 else 0
-  let sub x y = if x < 0 || y < 0 then invalid_arg "sub" else if x >= y then x - y else raise Overflow
-  let sub' x y = if x < 0 || y < 0 then invalid_arg "sub'" else if x >= y then x - y else 0
-  let mid x y = x land y + ((x lxor y) asr 1)
-  let pow (x : int) (n : int) : int =
-    let rec aux x n =
-      if n = 1 then x
-      else
-        let y = aux x (n asr 1) in
-        y * y * (if n land 1 = 0 then 1 else x) in
-    if n < 0 then invalid_arg "pow"
-    else if n = 0 then 1
-    else aux x n
-
-  let undefined () = failwith "undefined"
-
-  let finally handler f x =
-    let res = (try f x with e -> handler(); raise e) in
-    handler(); res
-
-  (* Haskell's `last $ take n $ iterate s z`, might also call `ntimes` *)
-  let rec iterate (n : int) s z =
-    if n <= 0 then z
-    else iterate (n - 1) s (s z)
-
-  (* Haskell's `head $ dropWhile p $ iterate s z`; or `until (not.p) s z` *)
-  let rec iter_while p s z =
-    if p z then iter_while p s (s z) else z
-
-  (* let forever f x = while true do f x done *)
-  let rec forever f x = ignore(f x); forever f x
-
-  module Option : sig
-    val some : 'a -> 'a option
-    val test : ('a -> bool) -> 'a -> 'a option
-    val is_some : 'a option -> bool
-    val is_none : 'a option -> bool
-    val unsome : exn -> 'a option -> 'a (* Haskell's `fromJust` *)
-    val optcatch : ('a -> 'b) -> 'a -> 'b option
-    val string_of_option : ('a -> string) -> 'a option -> string
-    val list_of_option : 'a option -> 'a list (* Haskell's `maybeToList` *)
-    (* List.opthead is Haskell's `listToMaybe` *)
-    val default : 'a -> 'a option -> 'a (* Haskell's `fromMaybe` *)
-    val mapdefault : 'b -> ('a -> 'b) -> 'a option -> 'b (* Haskell's `maybe` *)
-    (* List.optmap is Haskell's `mapMaybe` *)
-    val length : 'a option -> int
-    val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a option -> bool
-    val map : ('a -> 'b) -> 'a option -> 'b option
-    val map2 : ('a -> 'b -> 'c) -> 'a option -> 'b option -> 'c option
-    val filter : ('a -> bool) -> 'a option -> 'a option
-  end = struct
-    let some x = Some x
-    let test p x = if p x then Some x else None
-    let is_some = function Some _ -> true | _ -> false
-    let is_none = function None -> true | _ -> false
-    let unsome exn = function Some a -> a | None -> raise exn
-    let optcatch f a = try Some (f a) with _ -> None
-    let string_of_option f = function Some a -> "Some " ^ f a | None -> "None"
-    let list_of_option = function Some a -> [a] | None -> []
-    let default def = function Some a -> a | None -> def
-    let mapdefault def f = function Some a -> f a | None -> def
-    let length = function Some _ -> 1 | None -> 0
-    let mem ?(eq=(=)) sought = function Some y -> eq y sought | None -> false
-    let map f = function Some a -> Some (f a) | None -> None
-    let map2 f u v = match u,v with Some x,Some y -> Some (f x y) | _ -> None
-    let filter p = function Some a as orig when p a -> orig | _ -> None
-  end
-
-  let some = Option.some
-  let is_some = Option.is_some
-  let is_none = Option.is_none
-  let unsome = Option.unsome
-  let string_of_option = Option.string_of_option
-  let list_of_option = Option.list_of_option
-
-  module List : sig
-    (*
-       Some functions in this module accept labels: ~short, ~onto:_, ~rev, ~cmp:_, ~eq:_, ~missing:_, ~step:_, ~many, ~len:_.
-       ~short (map2, zip, iter2, fold_left2, fold_right2) means you don't require the lists to be the same length. (NOT provided for for_all2, exists2)
-       ~onto:[] is for efficiency (rev, map, mapi, map2, zip, unmap2, unzip, optmap, optmapi, catmap, catmapi, filter, unfold, mapz).
-       ~rev sometimes (map, optmap, catmap, map2, zip, unmap2, unzip, filter, unfold, mapz) means you don't require the output to correspond to input order, and thus can get more efficient implementation.
-       For sort and is_sorted, ~rev reverses the direction of ~cmp (first match will still come first/be retained if not ~many).
-       ~rev other times (max/minimum, max/minby, take_while, drop_while, split_while, find[x], optfind, index, remove, delete, pick[x], assoc/assq, [opt]modify_assoc/assq, remove_assoc/assq) means find last match rather than first.
-       Find/remove from end: find[x]/optfind/index ~rev, remove/delete ~rev, pick[x] ~rev; also assoc/assq, [opt]modify_assoc/assq, remove_assoc/assq.
-       Find/remove all: filter[x]/indices, remove/delete ~many, partition[x]. (`remove ~many` is `filter (non p)`); also remove_assoc/assq ~many and diff ~many.
-       These have a default ~cmp: max/minimum, max/minby, lexcmp, sort, is_sorted, insert, merge (the latter two assume ordered lists). Other times (mem, index, delete, [is_]unique, is_subset, diff, union, intersect) ~cmp:_ asserts the list is ordered, and ignores any ~eq specification.
-       Functions seeking a specific member/key may specify the ~eq:(=) function (mem, index, delete, indices, assoc, mem_assoc, [opt]modify_assoc, remove_assoc).
-       Other functions using ~eq: group, [is_]unique, is_eqset, is_subset/list, diff, union, intersect, histogram.
-       See also memq, indexq, deleteq, indicesq, assq, mem_assq, [opt]modify_assq, remove_assq.
-       Additionally, modify_assoc/assq accepts an optional ~missing:(fun k -> v) alongside its (fun k v -> v); else it raises Not_found. pairwise accepts optional ~missing:'a to supply a snd for the last element.
-       Additionally, range and range_until accept ~step, and range's second argument can be tagged ~len.
-       Additionally, insert and sort accept an optional ~many to insert/keep items even if they cmp 0 to existing members. is_sorted ~many interprets "sorted" to permit duplicates; and is_subset ~many permits multiplicity of subset to > super. See also remove/delete ~many and remove_assoc/assq ~many and diff ~many.
-       sublists and permutations accept optional ~len, and can also be invoked as ~len:_ ~many to mean with replacement.
-
-       Functions in this module may raise:
-       * Invalid_argument for indices < 0, or length < 0 for make, or ~step:0 for range/_until
-       * Invalid argument when specifying both ~cmp and ~rev to index, delete; or both ~many and ~rev to remove, delete.
-       * Invalid_argument when is_subset without ~cmp or ~many; or when sublists/permutations ~many without ~len
-       * Not_found
-       * Short_list, e.g. head []; map2 f [] [...] without ~short; indices >= length
-       Primed versions of tail, init, take, drop, split: silently accommodate short lists. (Compare pred', sub'.)
-    *)
-
-    (* TODO: cycle n xs *)
-    (* IFFY names: unmap2, mapz, min/maxby, chunk[']/chunk_int/chunk_range, is_eqset, indexq/indicesq/deleteq *)
-
-    val short : unit
-    val many : unit
-    exception Short_list
-    val is_null : 'a list -> bool
-    val length : 'a list -> int
-    val count : ('a -> bool) -> 'a list -> int
-    val cons : 'a -> 'a list -> 'a list
-    val snoc : 'a list -> 'a -> 'a list
-    val singleton : 'a -> 'a list
-    val make : int -> 'a -> 'a list (* Haskell's `replicate` *)
-    val head : 'a list -> 'a
-    val opthead : 'a list -> 'a option
-    val tail : 'a list -> 'a list
-    val tail' : 'a list -> 'a list
-    val uncons : 'a list -> 'a * 'a list
-    val last : 'a list -> 'a
-    val init : 'a list -> 'a list
-    val init' : 'a list -> 'a list
-    val append : 'a list -> 'a list -> 'a list
-    val concat : 'a list list -> 'a list
-    val rev : ?onto:'a list -> 'a list -> 'a list (* Haskell's `reverse` *)
-    val mem : 'a -> ?eq:('a -> 'a -> bool) -> ?cmp:('a -> 'a -> int) -> 'a list -> bool (* Haskell's `elem` *)
-    val map : ('a -> 'b) -> ?rev:'c -> ?onto:'b list -> 'a list -> 'b list
-    val map2 : ('a -> 'b -> 'c) -> ?rev:'d -> ?onto:'c list -> ?short:'e -> 'a list -> 'b list -> 'c list (* Haskell's `zipWith` *)
-    val unmap2 : ('c -> 'a * 'b) -> ?rev:'d -> ?onto:'a list * 'b list -> 'c list -> 'a list * 'b list
-    val zip : ?rev:'d -> ?onto:('a * 'b) list -> ?short:'e -> 'a list -> 'b list -> ('a * 'b) list (* aka `Std.List.combine` or `map2 pair` *)
-    val unzip : ?rev:'d -> ?onto:'b list * 'c list -> ('b * 'c) list -> 'b list * 'c list (* aka `Std.List.split` or `unmap2 ident` *)
-    val mapi : (int -> 'a -> 'b) -> ?onto:'b list -> 'a list -> 'b list
-    val optmap : ('a -> 'b option) -> ?rev:'c -> ?onto:'b list -> 'a list -> 'b list
-    val optmapi : (int -> 'a -> 'b option) -> ?onto:'b list -> 'a list -> 'b list
-    (* `catmap f ~rev [x1,x2,x3]` ==> [x3c..x3a; x2c..x2a; x1c..x1a] *)
-    val catmap : ('a -> 'b list) -> ?rev:'c -> ?onto:'b list -> 'a list -> 'b list (* Haskell's `concatMap` *)
-    val catmapi : (int -> 'a -> 'b list) -> ?onto:'b list -> 'a list -> 'b list
-    val iter : ('a -> unit) -> 'a list -> unit
-    val iteri : (int -> 'a -> unit) -> 'a list -> unit
-    val iter2 : ('a -> 'b -> unit) -> ?short:'c -> 'a list -> 'b list -> unit
-    val fold_left : ('z -> 'a -> 'z) -> 'z -> 'a list -> 'z
-    val fold_left1 : ('a -> 'a -> 'a) -> 'a list -> 'a
-    val fold_left2 : ('z -> 'a -> 'b -> 'z) -> 'z -> ?short:'d -> 'a list -> 'b list -> 'z
-    val fold_right : ('a -> 'z -> 'z) -> 'a list -> 'z -> 'z
-    val fold_right1 : ('a -> 'a -> 'a) -> 'a list -> 'a
-    val fold_right2 : ('a -> 'b -> 'z -> 'z) -> ?short:'d -> 'a list -> 'b list -> 'z -> 'z
-    val for_all : ('a -> bool) -> 'a list -> bool (* Haskell's `all` *)
-    val exists : ('a -> bool) -> 'a list -> bool (* Haskell's `any` *)
-    val for_all2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-    val exists2 : ('a -> 'b -> bool) -> 'a list -> 'b list -> bool
-    val maximum : ?rev:'b -> ?cmp:('a -> 'a -> int) -> 'a list -> 'a
-    val minimum : ?rev:'b -> ?cmp:('a -> 'a -> int) -> 'a list -> 'a
-    (* These compare mapped values, and return index,original,mapped value. *)
-    val maxby : ('a -> 'b) -> ?cmp:('b -> 'b -> int) -> ?rev:'c -> 'a list -> int * 'a * 'b
-    val minby : ('a -> 'b) -> ?cmp:('b -> 'b -> int) -> ?rev:'c -> 'a list -> int * 'a * 'b
-    val sum : int list -> int
-    val product : int list -> int
-    val take : int -> 'a list -> 'a list
-    val take' : int -> 'a list -> 'a list
-    val drop : int -> 'a list -> 'a list (* `tail` is `drop 1` *)
-    val drop' : int -> 'a list -> 'a list
-    val split : int -> 'a list -> 'a list * 'a list
-    val split' : int -> 'a list -> 'a list * 'a list (* Haskell's `splitAt` *)
-    val nth : 'a list -> int -> 'a (* Haskell's `xs !! n` *)
-    val modify : int -> ('a -> 'a) -> 'a list -> 'a list
-    val optmodify : int -> ('a -> 'a option) -> 'a list -> 'a list
-    val catmodify : int -> ('a -> 'a list) -> 'a list -> 'a list
-    val take_while : ('a -> bool) -> ?rev:'b -> 'a list -> 'a list
-    val drop_while : ('a -> bool) -> ?rev:'b -> 'a list -> 'a list
-    (* `split_while p xs` is `(take_while p xs, drop_while p xs)`; but `split_while p ~rev xs` is `(drop_while p ~rev xs, take_while p ~rev xs)` *)
-    val split_while : ('a -> bool) -> ?rev:'b -> 'a list -> 'a list * 'a list (* Haskell's `span` *)
-    val find : ('a -> bool) -> ?rev:'b -> 'a list -> 'a
-    val optfind : ('a -> 'b option) -> ?rev:'c -> 'a list -> 'b
-    val findx : ('a -> bool) -> ?rev:'b -> 'a list -> int * 'a (* fst of this is Haskell's `findIndex`, except that returns Maybe Int *)
-    (* Unlike findx, index accepts ~cmp. *)
-    val index : 'a -> ?rev:'b -> ?eq:('a -> 'a -> bool) -> ?cmp:('a -> 'a -> int) -> 'a list -> int (* Haskell's `elemIndex`, except that returns Maybe Int *)
-    val remove : ('a -> bool) -> ?rev:'b -> ?many:'c -> 'a list -> 'a list
-    val delete : 'a -> ?rev:'b -> ?eq:('a -> 'a -> bool) -> ?cmp:('a -> 'a -> int) -> ?many:'c -> 'a list -> 'a list
-    (* `pick p xs` is `(find p xs, remove p xs)` *)
-    val pick : ('a -> bool) -> ?rev:'b -> 'a list -> 'a * 'a list
-    val pickx : ('a -> bool) -> ?rev:'b -> 'a list -> int * 'a * 'a list
-    val filter : ('a -> bool) -> ?rev:'b -> ?onto:'a list -> 'a list -> 'a list
-    val filterx : ('a -> bool) -> 'a list -> (int * 'a) list (* fst of this is Haskell's `findIndices` *)
-    val indices : 'a -> ?eq:('a -> 'a -> bool) -> 'a list -> int list (* Haskell's `elemIndices` *)
-    (* `partition p xs` is `(filter p xs, filter (non p) xs)` *)
-    val partition : ('a -> bool) -> 'a list -> 'a list * 'a list
-    val partitionx : ('a -> bool) -> 'a list -> (int * 'a) list * (int * 'a) list
-    val assoc : 'a -> ?rev:'c -> ?eq:('a -> 'a -> bool) -> ('a * 'b) list -> 'b (* Haskell's `lookup` *)
-    val mem_assoc : 'a -> ?eq:('a -> 'a -> bool) -> ('a * 'b) list -> bool
-    val modify_assoc : 'a -> ('a -> 'b -> 'b) -> ?missing:('a -> 'b) -> ?rev:'c -> ?eq:('a -> 'a -> bool) -> ('a * 'b) list -> ('a * 'b) list
-    val optmodify_assoc : 'a -> ('a -> 'b option -> 'b option) -> ?rev:'c -> ?eq:('a -> 'a -> bool) -> ('a * 'b) list -> ('a * 'b) list
-    val remove_assoc : 'a -> ?rev:'c -> ?eq:('a -> 'a -> bool) -> ?many:'d -> ('a * 'b) list -> ('a * 'b) list
-    val memq : 'a -> 'a list -> bool
-    val indexq : 'a -> 'a list -> int
-    val deleteq : 'a -> 'a list -> 'a list
-    val indicesq : 'a -> 'a list -> int list
-    val assq : 'a -> ?rev:'c -> ('a * 'b) list -> 'b
-    val mem_assq : 'a -> ('a * 'b) list -> bool
-    val modify_assq : 'a -> ('a -> 'b -> 'b) -> ?missing:('a -> 'b) -> ?rev:'c -> ('a * 'b) list -> ('a * 'b) list
-    val optmodify_assq : 'a -> ('a -> 'b option -> 'b option) -> ?rev:'c -> ('a * 'b) list -> ('a * 'b) list
-    val remove_assq : 'a -> ?rev:'c -> ?many:'d -> ('a * 'b) list -> ('a * 'b) list
-
-    (* Positive n rotates forward; `rotate 1 xs` is `append (last xs) (init xs)` or `unsnoc` *)
-    val rotate : int -> 'a list -> 'a list
-    val unfold : ('z -> ('a * 'z) option) -> ?rev:'c -> ?onto:'a list -> 'z -> 'a list
-    (* ~rev only affects the order of the mapz'd output, not the direction of the folding *)
-    val mapz : ('z -> 'a -> 'z * 'b) -> 'z -> ?rev:'d -> ?onto:'b list -> 'a list -> 'z * 'b list (* Haskell's `mapAccumL` *)
-    val group : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list list (* Haskell's `groupBy` *)
-    (* `cross f xs ys` is `[f x y | x from xs, y from ys]` or `catmap (fun x -> map (f x) ys) xs` *)
-    val cross : ('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list
-    (* `insert` expects a sorted list; use `catmodify` to insert elements before/after a specified index *)
-    val insert : 'a -> ?cmp:('a -> 'a -> int) -> ?many:'b -> 'a list -> 'a list
-    (* Plural version of `nth` *)
-    val select : 'a list -> int list -> 'a list
-    (* `range start ~len` *)
-    val range : ?step:int -> int -> len:int -> int list
-    (* `range_until start excluded_stop`; specify ~step:1 to produce [] when stop < start *)
-    val range_until : ?step:int -> int -> int -> int list
-    val unique : ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> 'a list -> 'a list (* Haskell's `nub` *)
-    val is_unique : ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> 'a list -> bool
-    (* `transpose [xxx, yyy]` ==> [xy, xy, xy] *)
-    val transpose : 'a list list -> 'a list list
-    (* Based on http://www.haskell.org/ghc/docs/latest/html/libraries/base/src/Data-List.html#permutations
-       Permutations with replacement, or enum base xs of 0..pow (length xs) k-1, is Haskell's `replicateM k xs` or `sequence $ replicate k xs`; same as `cross klist (make k xs)` *)
-    val permutations : ?len:int -> ?many:'b -> 'a list -> 'a list list
-    (* `sublists` without ~len or ~many is powerlist/all combinations, preserving order of members, who needn't have been contiguous; is Haskell's `subsequences` or `filterM (const [False, True]) xs`.
-       sublists ~len:k gives combinations of length k; straightforward implementation, found at http://www.polyomino.f2s.com/david/haskell/hs/CombinatoricsGeneration.hs.txt, also http://rosettacode.org/wiki/Combinations#Haskell
-       sublists ~len:k ~many gives the ((length xs+k-1) choose k) many combinations with replacement; based on http://rosettacode.org/wiki/Combinations_with_repetitions#Haskell *)
-    val sublists : ?len:int -> ?many:'b -> 'a list -> 'a list list
-    (* Members of first arg must appear in order in second, though they needn't be contiguous; for sorted lists, is a less-efficient version of `is_subset` without ~many *)
-    val is_sublist : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list -> bool
-    (* `let sup = [1] in is_subset ~many [1;1] sup` is true; omit ~many to require sup to have >= the multiplicity of each member of subset *)
-    val is_subset : ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> ?many:'b -> 'a list -> 'a list -> bool
-    (* Multiset equality, order ignored *)
-    val is_eqset : ?eq:('a -> 'a -> bool) -> 'a list -> 'a list -> bool
-    val lexcmp : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> int
-    (* `diff ~many xs ys` deletes all occurrences of each member of ys *)
-    val diff : ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> ?many:'b -> 'a list -> 'a list -> 'a list
-    (* Each element has its max multiplicity; with second list always as a suffix of the result *)
-    val union : ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
-    (* Each element has its min multiplicity; in order of second list *)
-    val intersect : ?cmp:('a -> 'a -> int) -> ?eq:('a -> 'a -> bool) -> 'a list -> 'a list -> 'a list
-    (* To merge without ~many, use `union ~cmp:compare`. *)
-    val merge : ?cmp:('a -> 'a -> int) -> 'a list -> 'a list -> 'a list
-    (* Stable mergesort, O(n log n) avg and worst, will delete later occurrences of any duplicates, unless invoked with ~many *)
-    val sort : ?cmp:('a -> 'a -> int) -> ?many:'b -> ?rev:'c -> 'a list -> 'a list
-    val is_sorted : ?cmp:('a -> 'a -> int) -> ?many:'b -> ?rev:'c -> 'a list -> bool
-    val string_of_list : ?brackets:bool -> ?sep:string -> ('a -> string) -> 'a list -> string
-    val histogram : ?eq:('a -> 'a -> bool) -> 'a list -> ('a * int) list
-    (* [x1;x2;x3] ==> [(x1,x2);(x2,x3);(x3,missing)] *)
-    val pairwise : ?missing:'a -> 'a list -> ('a * 'a) list
-    (* [xxxx,y,zz] ==> xyzxzxx *)
-    val round_robin : 'a list list -> 'a list
-    (* Break list into int-sized discrete segments; chunk' permits last chunk to be short *)
-    val chunk : int -> 'a list -> 'a list list
-    val chunk' : int -> 'a list -> 'a list list
-    (* How many ways can int be represented as sum of members of xs (permitting them to be re-used)?
-       `chunk_int 6 [1;2;3]` ==> [ [3;3]; [3;2;1]; [3;1;1;1]; ...]
-       These are sometimes called "partitions of N". Based on http://www.polyomino.f2s.com/david/haskell/hs/CombinatoricsGeneration.hs.txt. This is an NP problem. *)
-    val chunk_int : int -> int list -> int list list
-    (* Partitions of the range 0..(k1+k2+k3) into lists of size k1,k2,k3.
-       `chunk_range [2;1;3]` ==> [ [[0;1];[2];[3;4;5]]; ...]
-       Based on http://rosettacode.org/wiki/Ordered_Partitions#Haskell *)
-    val chunk_range : int list -> int list list list
-
-  end = struct
-
-    let short = ()
-    let many = ()
-    exception Short_list
-
-    let is_null = function [] -> true | _ -> false
-
-    let length xs =
-      let rec aux i = function [] -> i | _::xs -> aux (i+1) xs in
-      aux 0 xs
-
-    let count p xs =
-      let rec aux p n = function [] -> n | x::xs when p x -> aux p (n+1) xs | _::xs -> aux p n xs in
-      aux p 0 xs
-
-    let cons x xs = x :: xs
-
-    let singleton x = [x]
-
-    let make n x =
-      let rec aux x xs n = if n = 0 then xs else aux x (x::xs) (n-1) in
-    if n < 0 then invalid_arg "make" else aux x [] n
-
-    let rec rev1 onto = function [] -> onto | x::xs -> rev1 (x::onto) xs
-
-    let rec rev2 onto = function [] -> onto | ys::yss -> rev2 (rev1 onto ys) yss
-
-    let rec rev ?(onto=[]) = function [] -> onto | x::xs -> let onto = x::onto in rev ~onto xs
-
-    let snoc xs x = rev1 [x] (rev1 [] xs)
-
-    let head = function x::_ -> x | [] -> raise Short_list
-
-    let opthead = function x::_ -> Some x | [] -> None
-
-    let tail = function _::xs -> xs | [] -> raise Short_list
-
-    let tail' = function _::xs -> xs | [] -> []
-
-    let uncons = function x::xs -> (x,xs) | [] -> raise Short_list
-
-    let rec last = function [x] -> x | x::xs -> last xs | _ -> raise Short_list
-
-    let init xs = match rev1 [] xs with [] -> raise Short_list | _::xs -> rev1 [] xs
-
-    let init' xs = match rev1 [] xs with [] -> [] | _::xs -> rev1 [] xs
-
-    let append xs = function [] -> xs | onto -> rev1 onto (rev1 [] xs)
-
-    let concat xss = rev2 [] (rev1 [] xss)
-
-    let mem sought ?(eq=(=)) ?cmp xs =
-      let rec aux_all eq sought = function [] -> false | x::xs -> eq x sought || aux_all eq sought xs in
-      let rec aux_sorted cmp sought = function
-      | x::xs -> let res = cmp x sought in if res > 0 then false else res = 0 || aux_sorted cmp sought xs
-      | [] -> false in
-      match cmp with
-      | None -> aux_all eq sought xs
-      | Some cmp -> aux_sorted cmp sought xs
-
-    let rec memq sought = function [] -> false | x::xs -> x == sought || memq sought xs
-
-    let map f ?rev ?(onto=[]) xs =
-      let rec aux f onto = function
-      | [] -> onto
-      | x::xs -> aux f (f x::onto) xs in
-      match rev with
-      | None -> rev1 onto (aux f [] xs)
-      | Some _ -> aux f onto xs
-
-    let map2 f ?rev ?(onto=[]) ?short xs ys =
-      let rec aux f short onto xs ys = match xs, ys with
-      | x::xs, y::ys -> aux f short (f x y::onto) xs ys
-      | [],[] -> onto
-      | _ -> if short then onto else raise Short_list in
-      match rev with
-      | None -> rev1 onto (aux f (Option.is_some short) [] xs ys)
-      | Some _ -> aux f (Option.is_some short) onto xs ys
-
-    let zip ?rev ?(onto=[]) ?short xs ys =
-      let rec aux short onto xs ys = match xs, ys with
-      | x::xs, y::ys -> aux short ((x,y)::onto) xs ys
-      | [],[] -> onto
-      | _ -> if short then onto else raise Short_list in
-      match rev with
-      | None -> rev1 onto (aux (Option.is_some short) [] xs ys)
-      | Some _ -> aux (Option.is_some short) onto xs ys
-
-    let unmap2 f ?rev ?(onto=[],[]) zs =
-      let rec aux f xs ys = function
-      | [] -> xs, ys
-      | z::zs -> let x,y = f z in aux f (x::xs) (y::ys) zs in
-      match rev,onto with
-      | None,(xonto,yonto) -> let xs,ys = aux f [] [] zs in rev1 xonto xs, rev1 yonto ys
-      | Some _,(xonto,yonto) -> aux f xonto yonto zs
-
-    let unzip ?rev ?(onto=[],[]) zs =
-      let rec aux xs ys = function
-      | [] -> xs, ys
-      | (x,y)::zs -> aux (x::xs) (y::ys) zs in
-      match rev,onto with
-      | None,(xonto,yonto) -> let xs,ys = aux [] [] zs in rev1 xonto xs, rev1 yonto ys
-      | Some _,(xonto,yonto) -> aux xonto yonto zs
-
-    let mapi f ?(onto=[]) xs =
-      let rec aux f i onto = function
-      | [] -> onto
-      | x::xs -> aux f (i+1) (f i x::onto) xs in
-      rev1 onto (aux f 0 [] xs)
-
-    let optmap f ?rev ?(onto=[]) xs =
-      let rec aux f onto = function
-      | [] -> onto
-      | x::xs -> aux f (match f x with None -> onto | Some x' -> x'::onto) xs in
-      match rev with
-      | None -> rev1 onto (aux f [] xs)
-      | Some _ -> aux f onto xs
-
-    let optmapi f ?(onto=[]) xs =
-      let rec aux f i onto = function
-      | [] -> onto
-      | x::xs -> aux f (i+1) (match f i x with None -> onto | Some x' -> x'::onto) xs in
-      rev1 onto (aux f 0 [] xs)
-
-    let catmap f ?rev ?(onto=[]) xs =
-      let rec aux f onto = function
-      | [] -> onto
-      | x::xs -> aux f (rev1 [] (f x)::onto) xs in
-      let rec aux_rev f onto = function
-      | [] -> onto
-      | x::xs -> aux_rev f (rev1 onto (f x)) xs in
-      match rev with
-      | None -> rev2 onto (aux f [] xs)
-      | Some _ -> aux_rev f onto xs
-
-    let catmapi f ?(onto=[]) xs =
-      let rec aux f i onto = function
-      | [] -> onto
-      | x::xs -> aux f (i+1) (rev1 [] (f i x)::onto) xs in
-      rev2 onto (aux f 0 [] xs)
-
-    let rec iter f = function [] -> () | x::xs -> f x; iter f xs
-
-    let iteri f xs =
-      let rec aux f i = function [] -> () | x::xs -> f i x; aux f (i+1) xs in
-      aux f 0 xs
-
-    let iter2 f ?short xs ys =
-      let rec aux f short xs ys = match xs, ys with
-      | x::xs, y::ys -> f x y; aux f short xs ys
-      | [],[] -> ()
-      | _ -> if short then () else raise Short_list in
-      aux f (Option.is_some short) xs ys
-
-    let rec fold_left f z = function
-    | [] -> z
-    | x::xs -> fold_left f (f z x) xs
-
-    let fold_left1 f = function
-    | [] -> raise Short_list
-    | x::xs -> fold_left f x xs
-
-    let fold_left2 f z ?short xs ys =
-      let rec aux f short z xs ys = match xs, ys with
-      | [],[] -> z
-      | x::xs,y::ys -> aux f short (f z x y) xs ys
-      | _ -> if short then z else raise Short_list in
-    aux f (Option.is_some short) z xs ys
-
-    let rec fold_right f xs z =
-      let rec aux f z = function
-      | [] -> z
-      | x::xs -> aux f (f x z) xs in
-    aux f z (rev1 [] xs)
-
-    let fold_right1 f xs =
-      let rec aux f z = function
-      | [] -> z
-      | x::xs -> aux f (f x z) xs in
-    match rev1 [] xs with
-    | [] -> raise Short_list
-    | x::xs -> aux f x xs
-
-    let fold_right2 f ?short xs ys z =
-      let rec aux f short z xs ys = match xs, ys with
-      | [],[] -> z
-      | x::xs,y::ys -> aux f short (f x y z) xs ys
-      | _ -> if short then z else raise Short_list in
-    aux f (Option.is_some short) z (rev1 [] xs) (rev1 [] ys)
-
-    let rec for_all p = function [] -> true | x::xs -> p x && for_all p xs
-    let rec exists p = function [] -> false | x::xs -> p x || exists p xs
-
-    let rec for_all2 p xs ys = match xs,ys with [],[] -> true | x::xs,y::ys -> p x y && for_all2 p xs ys | _ -> raise Short_list
-    let rec exists2 p xs ys = match xs,ys with [],[] -> false | x::xs,y::ys -> p x y || exists2 p xs ys | _ -> raise Short_list
-
-    let maximum ?rev ?(cmp=compare) xs =
-      let rec aux select cmp sofar = function
-      | [] -> sofar
-      | x::xs -> let res = cmp x sofar in aux select cmp (if res < 0 then sofar else if res = 0 then select sofar x else x) xs in
-      match rev,xs with
-      | None,(x::xs) -> aux (fun sofar x -> sofar) cmp x xs
-      | Some _,(x::xs) -> aux (fun sofar x -> x) cmp x xs
-      | _ -> raise Short_list
-
-    let minimum ?rev ?(cmp=compare) xs =
-      let rec aux select cmp sofar = function
-      | [] -> sofar
-      | x::xs -> let res = cmp x sofar in aux select cmp (if res > 0 then sofar else if res = 0 then select sofar x else x) xs in
-      match rev,xs with
-      | None,(x::xs) -> aux (fun sofar x -> sofar) cmp x xs
-      | Some _,(x::xs) -> aux (fun sofar x -> x) cmp x xs
-      | _ -> raise Short_list
-
-    (*
-    let maximumx ?rev ?(cmp=compare) xs =
-      let rec aux select cmp i sofar = function
-      | [] -> sofar
-      | x::xs -> let res = cmp x (snd sofar) in aux select cmp (i+1) (if res < 0 then sofar else if res = 0 then select sofar i x else (i,x)) xs in
-      match rev,xs with
-      | None,(x::xs) -> aux (fun sofar i x -> sofar) cmp 1 (0,x) xs
-      | Some _,(x::xs) -> aux (fun sofar i x -> (i,x)) cmp 1 (0,x) xs
-      | _ -> raise Short_list
-
-    let minimumx ?rev ?(cmp=compare) xs =
-      let rec aux select cmp i sofar = function
-      | [] -> sofar
-      | x::xs -> let res = cmp x (snd sofar) in aux select cmp (i+1) (if res > 0 then sofar else if res = 0 then select sofar i x else (i,x)) xs in
-      match rev,xs with
-      | None,(x::xs) -> aux (fun sofar i x -> sofar) cmp 1 (0,x) xs
-      | Some _,(x::xs) -> aux (fun sofar i x -> (i,x)) cmp 1 (0,x) xs
-      | _ -> raise Short_list
-    *)
-
-    let maxby f ?(cmp=compare) ?rev xs =
-      let rec aux f cmp thresh (_,_,fw as prev) i = function
-      | [] -> prev
-      | x::xs -> aux f cmp thresh (let fx = f x in if cmp fx fw > thresh then (i,x,fx) else prev) (i+1) xs in
-      match rev,xs with
-      | _,[] -> raise Short_list
-      | None,x::xs -> aux f cmp 0 (0,x,f x) 1 xs
-      | Some _,x::xs -> aux f cmp (-1) (0,x,f x) 1 xs
-
-    let minby f ?(cmp=compare) ?rev xs =
-      let rec aux f cmp thresh (_,_,fw as prev) i = function
-      | [] -> prev
-      | x::xs -> aux f cmp thresh (let fx = f x in if cmp fx fw < thresh then (i,x,fx) else prev) (i+1) xs in
-      match rev,xs with
-      | _,[] -> raise Short_list
-      | None,x::xs -> aux f cmp 0 (0,x,f x) 1 xs
-      | Some _,x::xs -> aux f cmp (+1) (0,x,f x) 1 xs
-
-    let sum xs = fold_left ( + ) 0 xs
-    let product xs = fold_left ( * ) 1 xs
-
-    let take n xs =
-      let rec aux n ys = function
-        | _ when n = 0 -> rev1 [] ys
-        | [] -> raise Short_list
-        | x::xs -> aux (n-1) (x::ys) xs in
-      if n < 0 then invalid_arg "take" else aux n [] xs
-
-    let take' n xs =
-      let rec aux n ys = function
-        | _ when n = 0 -> rev1 [] ys
-        | [] -> rev1 [] ys
-        | x::xs -> aux (n-1) (x::ys) xs in
-      if n < 0 then invalid_arg "take'" else aux n [] xs
-
-    let drop n xs =
-      let rec aux n = function
-        | xs when n = 0 -> xs
-        | [] -> raise Short_list
-        | _::xs -> aux (n-1) xs in
-      if n < 0 then invalid_arg "drop" else aux n xs
-
-    let drop' n xs =
-      let rec aux n = function
-        | xs when n = 0 -> xs
-        | [] -> []
-        | _::xs -> aux (n-1) xs in
-      if n < 0 then invalid_arg "drop'" else aux n xs
-
-    let split n xs =
-      let rec aux n ys = function
-        | xs when n = 0 -> rev1 [] ys, xs
-        | [] -> raise Short_list
-        | x::xs -> aux (n-1) (x::ys) xs in
-      if n < 0 then invalid_arg "split" else aux n [] xs
-
-    let split' n xs =
-      let rec aux n ys = function
-        | xs when n = 0 -> rev1 [] ys, xs
-        | [] -> rev1 [] ys, []
-        | x::xs -> aux (n-1) (x::ys) xs in
-      if n < 0 then invalid_arg "split'" else aux n [] xs
-
-    let nth xs n =
-      let rec aux n = function
-        | x::xs -> if n = 0 then x else aux (n-1) xs
-        | [] -> raise Short_list in
-      if n < 0 then invalid_arg "nth" else aux n xs
-
-    let modify n f xs =
-      let rec aux n f i ys = function
-      | [] -> raise Short_list
-      | x::xs -> if n = i then rev1 ((f x)::xs) ys else aux n f (i+1) (x::ys) xs in
-      if n < 0 then invalid_arg "modify" else aux n f 0 [] xs
-
-    let optmodify n f xs =
-      let rec aux n f i ys = function
-      | [] -> raise Short_list
-      | x::xs -> if n = i then rev1 (match f x with Some x -> x::xs | None -> xs) ys else aux n f (i+1) (x::ys) xs in
-      if n < 0 then invalid_arg "optmodify" else aux n f 0 [] xs
-
-    let catmodify n f xs =
-      let rec aux n f i ys = function
-      | [] -> raise Short_list
-      | x::xs -> if n = i then rev1 xs (rev1 ys (f x)) else aux n f (i+1) (x::ys) xs in
-      if n < 0 then invalid_arg "optmodify" else aux n f 0 [] xs
-
-    let take_while p ?rev xs =
-      let rec aux_left p ys = function
-        | [] -> xs
-        | x::xs -> if p x then aux_left p (x::ys) xs else rev1 [] ys in
-      let rec aux_right p ys = function
-        | [] -> rev1 [] ys
-        | x::xs -> if p x then aux_right p (x::ys) xs else aux_right p [] xs in
-      match rev with
-      | None -> aux_left p [] xs
-      | Some _ -> aux_right p [] xs
-
-    let drop_while p ?rev xs =
-      let rec aux_left p = function
-        | [] -> []
-        | x::xs as orig -> if p x then aux_left p xs else orig in
-      let rec aux_right p matching yss ys = function
-        | [] -> if matching then rev2 [] yss else xs
-        | x::xs -> if p x = matching then aux_right p matching yss (x::ys) xs
-                   else aux_right p (not matching) (ys::yss) [x] xs in
-      match rev with
-      | None -> aux_left p xs
-      | Some _ -> aux_right p false [] [] xs
-
-    let split_while p ?rev xs =
-      let rec aux_left p ys = function
-        | [] -> xs, []
-        | x::xs as orig -> if p x then aux_left p (x::ys) xs else rev1 [] ys, orig in
-      let rec aux_right p matching yss ys = function
-        | [] -> if matching then rev2 [] yss, rev1 [] ys else xs, []
-        | x::xs -> if p x = matching then aux_right p matching yss (x::ys) xs
-                   else aux_right p (not matching) (ys::yss) [x] xs in
-      match rev with
-      | None -> aux_left p [] xs
-      | Some _ -> aux_right p false [] [] xs
-
-    let find p ?rev xs =
-      let rec aux_left p = function [] -> raise Not_found | x::xs -> if p x then x else aux_left p xs in
-      let rec aux_right p prev = function
-      | [] -> (match prev with None -> raise Not_found | Some x -> x)
-      | x::xs -> aux_right p (if p x then Some x else prev) xs in
-      match rev with
-      | None -> aux_left p xs
-      | Some _ -> aux_right p None xs
-
-    let optfind p ?rev xs =
-      let rec aux_left p = function [] -> raise Not_found | x::xs -> (match p x with Some y -> y | None -> aux_left p xs) in
-      let rec aux_right p prev = function
-      | [] -> (match prev with None -> raise Not_found | Some x -> x)
-      | x::xs -> aux_right p (match p x with Some y -> Some y | None -> prev) xs in
-      match rev with
-      | None -> aux_left p xs
-      | Some _ -> aux_right p None xs
-
-    let findx p ?rev xs =
-      let rec aux_left p i = function [] -> raise Not_found | x::xs -> if p x then (i,x) else aux_left p (i+1) xs in
-      let rec aux_right p i prev = function
-      | [] -> (match prev with None -> raise Not_found | Some (i,x as res) -> res)
-      | x::xs -> aux_right p (i+1) (if p x then Some (i,x) else prev) xs in
-      match rev with
-      | None -> aux_left p 0 xs
-      | Some _ -> aux_right p 0 None xs
-
-    let index sought ?rev ?(eq=(=)) ?cmp xs =
-      let rec aux_left eq sought i = function [] -> raise Not_found | x::xs -> if eq x sought then i else aux_left eq sought (i+1) xs in
-      let rec aux_right eq sought i prev = function [] -> if prev < 0 then raise Not_found else prev | x::xs -> aux_right eq sought (i+1) (if eq x sought then i else prev) xs in
-      let rec aux_sorted cmp sought i = function
-      | x::xs -> let res = cmp x sought in if res > 0 then raise Not_found else if res = 0 then i else aux_sorted cmp sought (i+1) xs
-      | [] -> raise Not_found in
-      match cmp,rev with
-      | None,None -> aux_left eq sought 0 xs
-      | None,Some _ -> aux_right eq sought 0 (-1) xs
-      | Some cmp,None -> aux_sorted cmp sought 0 xs
-      | Some _,Some _ -> invalid_arg "index ~rev conflicts with ~cmp"
-
-    let indexq sought xs =
-      let rec aux sought i = function [] -> raise Not_found | x::xs -> if x == sought then i else aux sought (i+1) xs in
-      aux sought 0 xs
-
-    let remove p ?rev ?many xs =
-      let rec aux_left p ys = function [] -> xs | x::xs -> if p x then rev1 xs ys else aux_left p (x::ys) xs in
-      let rec aux_many p ys = function [] -> rev1 [] ys | x::xs -> aux_many p (if p x then ys else x::ys) xs in
-      let rec aux_right p yss ys = function
-      | [] -> (match yss with [] -> xs | (_::xs)::yss -> rev2 (rev1 [] ys) (xs::yss) | _ -> assert false)
-      | x::xs -> if p x then aux_right p ((x::ys)::yss) [] xs else aux_right p yss (x::ys) xs in
-      match rev,many with
-      | None,None -> aux_left p [] xs
-      | Some _,None -> aux_right p [] [] xs
-      | None,Some _ -> aux_many p [] xs
-      | Some _,Some _ -> invalid_arg "remove ~rev conflicts with ~many"
-
-    let delete sought ?rev ?(eq=(=)) ?cmp ?many xs =
-      let rec aux_left eq sought ys = function [] -> xs | x::xs -> if eq x sought then rev1 xs ys else aux_left eq sought (x::ys) xs in
-      let rec aux_many eq sought ys = function [] -> rev1 [] ys | x::xs -> aux_many eq sought (if eq x sought then ys else x::ys) xs in
-      let rec aux_right eq sought yss ys = function
-      | [] -> (match yss with [] -> xs | (_::xs)::yss -> rev2 (rev1 [] ys) (xs::yss) | _ -> assert false)
-      | x::xs -> if eq x sought then aux_right eq sought ((x::ys)::yss) [] xs else aux_right eq sought yss (x::ys) xs in
-      let rec aux_sorted cmp sought ys = function
-      | [] -> xs
-      (* don't shadow the entry-level `xs` *)
-      | z::zs -> let res = cmp z sought in if res > 0 then xs else if res = 0 then rev1 zs ys else aux_sorted cmp sought (z::ys) zs in
-      let rec aux_msorted cmp sought ys = function
-      | [] -> rev1 [] ys
-      | x::xs as orig -> let res = cmp x sought in if res > 0 then rev1 orig ys else aux_msorted cmp sought (if res = 0 then ys else x::ys) xs in
-      match cmp,rev,many with
-      | None,None,None -> aux_left eq sought [] xs
-      | None,Some _,None -> aux_right eq sought [] [] xs
-      | Some cmp,None,None -> aux_sorted cmp sought [] xs
-      | None,None,Some _ -> aux_many eq sought [] xs
-      | Some cmp,None,Some _ -> aux_msorted cmp sought [] xs
-      | Some _,Some _,None -> invalid_arg "delete ~rev conflicts with ~cmp"
-      | None,Some _,Some _ -> invalid_arg "delete ~rev conflicts with ~many"
-      | Some _,Some _,Some _ -> invalid_arg "delete ~rev conflicts with ~many and ~cmp"
-
-    let deleteq sought xs =
-      let rec aux sought ys = function [] -> xs | x::xs -> if x == sought then rev1 xs ys else aux sought (x::ys) xs in
-      aux sought [] xs
-
-    let pick p ?rev xs =
-      let rec aux_left p ys = function [] -> raise Not_found | x::xs -> if p x then x, rev1 xs ys else aux_left p (x::ys) xs in
-      let rec aux_right p prev yss ys = function
-      | [] -> (match prev, yss with None,_ -> raise Not_found | Some x,(_::xs)::yss -> x, rev2 (rev1 [] ys) (xs::yss) | _ -> assert false)
-      | x::xs -> if p x then aux_right p (Some x) ((x::ys)::yss) [] xs else aux_right p prev yss (x::ys) xs in
-      match rev with
-      | None -> aux_left p [] xs
-      | Some _ -> aux_right p None [] [] xs
-
-    let pickx p ?rev xs =
-      let rec aux_left p i ys = function [] -> raise Not_found | x::xs -> if p x then i, x, rev1 xs ys else aux_left p (i+1) (x::ys) xs in
-      let rec aux_right p i prev yss ys = function
-      | [] -> (match prev, yss with None,_ -> raise Not_found | Some (i,x),(_::xs)::yss -> i, x, rev2 (rev1 [] ys) (xs::yss) | _ -> assert false)
-      | x::xs -> if p x then aux_right p (i+1) (Some (i,x)) ((x::ys)::yss) [] xs else aux_right p (i+1) prev yss (x::ys) xs in
-      match rev with
-      | None -> aux_left p 0 [] xs
-      | Some _ -> aux_right p 0 None [] [] xs
-
-    let filter p ?rev ?(onto=[]) xs =
-      let rec aux p ys = function [] -> ys | x::xs -> aux p (if p x then x::ys else ys) xs in
-      match rev with
-      | None -> rev1 onto (aux p [] xs)
-      | Some _ -> aux p onto xs
-
-    (*
-    val filteri : (int -> 'a -> bool) -> ?onto:'a list -> 'a list -> 'a list
-    let filteri p ?(onto=[]) xs =
-      let rec aux p i ys = function [] -> ys | x::xs -> aux p (i+1) (if p i x then x::ys else ys) xs in
-      rev1 onto (aux p 0 [] xs)
-    *)
-
-    let filterx p xs =
-      let rec aux p i ys = function [] -> ys | x::xs -> aux p (i+1) (if p x then (i,x)::ys else ys) xs in
-      rev1 [] (aux p 0 [] xs)
-
-    let indices sought ?(eq=(=)) xs =
-      let rec aux eq sought i ys = function [] -> ys | x::xs -> aux eq sought (i+1) (if eq x sought then i::ys else ys) xs in
-      rev1 [] (aux eq sought 0 [] xs)
-
-    let indicesq sought xs =
-      let rec aux sought i ys = function [] -> ys | x::xs -> aux sought (i+1) (if x == sought then i::ys else ys) xs in
-      rev1 [] (aux sought 0 [] xs)
-
-    (* remove ~many p, delete ~many x *)
-
-    let partition p xs =
-      let rec aux p ys ns = function
-      | [] -> if ys = [] then [], xs else if ns = [] then xs, [] else rev1 [] ys, rev1 [] ns
-      | x::xs -> if p x then aux p (x::ys) ns xs else aux p ys (x::ns) xs in
-      aux p [] [] xs
-
-    let partitionx p xs =
-      let rec aux p i ys ns = function
-      | [] -> rev1 [] ys, rev1 [] ns
-      | x::xs -> if p x then aux p (i+1) ((i,x)::ys) ns xs else aux p (i+1) ys ((i,x)::ns) xs in
-      aux p 0 [] [] xs
-
-    let assoc sought ?rev ?(eq=(=)) xs =
-      let rec aux_left sought eq = function
-      | [] -> raise Not_found
-      | (k,x)::xs -> if eq k sought then x else aux_left sought eq xs in
-      let rec aux_right sought eq prev = function
-      | [] -> (match prev with None -> raise Not_found | Some x -> x)
-      | (k,x)::xs -> aux_right sought eq (if eq k sought then Some x else prev) xs in
-      match rev with
-      | None -> aux_left sought eq xs
-      | Some _ -> aux_right sought eq None xs
-
-    let rec assq sought ?rev xs =
-      let rec aux_left sought = function
-      | [] -> raise Not_found
-      | (k,x)::xs -> if k == sought then x else assq sought xs in
-      let rec aux_right sought prev = function
-      | [] -> (match prev with None -> raise Not_found | Some x -> x)
-      | (k,x)::xs -> aux_right sought (if k == sought then Some x else prev) xs in
-      match rev with
-      | None -> aux_left sought xs
-      | Some _ -> aux_right sought None xs
-
-    let modify_assoc sought f ?missing ?rev ?(eq=(=)) xs =
-      let rec aux_left sought f eq ys = function
-      | [] -> None
-      | (k,x as kx)::xs -> if eq k sought then Some (rev1 ((k,f k x)::xs) ys) else aux_left sought f eq (kx::ys) xs in
-      let rec aux_right sought f eq yss ys = function
-      | [] -> (match yss with [] -> None | ((k,x)::xs)::yss -> Some (rev2 ((k,f k x)::rev1 [] ys) (xs::yss)) | _ -> assert false)
-      | (k,x as kx)::xs -> if eq k sought then aux_right sought f eq ((kx::ys)::yss) [] xs else aux_right sought f eq yss (kx::ys) xs in
-      match rev,missing with
-      | None,None -> (match aux_left sought f eq [] xs with None -> raise Not_found | Some xs -> xs)
-      | None,Some m -> (match aux_left sought f eq [] xs with None -> (sought,m sought)::xs | Some xs -> xs)
-      | Some _,None -> (match aux_right sought f eq [] [] xs with None -> raise Not_found | Some xs -> xs)
-      | Some _,Some m -> (match aux_right sought f eq [] [] xs with None -> (sought,m sought)::xs | Some xs -> xs)
-
-    let optmodify_assoc sought f ?rev ?(eq=(=)) xs =
-      let rec aux_left sought f eq ys = function
-      | [] -> None
-      | (k,x as kx)::xs -> if eq k sought then Some (rev1 (match f k (Some x) with None -> xs | Some x -> (k,x)::xs) ys) else aux_left sought f eq (kx::ys) xs in
-      let rec aux_right sought f eq yss ys = function
-      | [] -> (match yss with [] -> None | ((k,x)::xs)::yss -> Some (rev2 (match f k (Some x) with None -> rev1 [] ys | Some x -> (k,x)::rev1 [] ys) (xs::yss)) | _ -> assert false)
-      | (k,x as kx)::xs -> if eq k sought then aux_right sought f eq ((kx::ys)::yss) [] xs else aux_right sought f eq yss (kx::ys) xs in
-      match rev with
-      | None -> (match aux_left sought f eq [] xs with None -> (match f sought None with None -> xs | Some x -> (sought,x)::xs) | Some xs -> xs)
-      | Some _ -> (match aux_right sought f eq [] [] xs with None -> (match f sought None with None -> xs | Some x -> (sought,x)::xs) | Some xs -> xs)
-
-    let modify_assq sought f ?missing ?rev xs =
-      let rec aux_left sought f ys = function
-      | [] -> None
-      | (k,x as kx)::xs -> if k == sought then Some (rev1 ((k,f k x)::xs) ys) else aux_left sought f (kx::ys) xs in
-      let rec aux_right sought f yss ys = function
-      | [] -> (match yss with [] -> None | ((k,x)::xs)::yss -> Some (rev2 ((k,f k x)::rev1 [] ys) (xs::yss)) | _ -> assert false)
-      | (k,x as kx)::xs -> if k == sought then aux_right sought f ((kx::ys)::yss) [] xs else aux_right sought f yss (kx::ys) xs in
-      match rev,missing with
-      | None,None -> (match aux_left sought f [] xs with None -> raise Not_found | Some xs -> xs)
-      | None,Some m -> (match aux_left sought f [] xs with None -> (sought,m sought)::xs | Some xs -> xs)
-      | Some _,None -> (match aux_right sought f [] [] xs with None -> raise Not_found | Some xs -> xs)
-      | Some _,Some m -> (match aux_right sought f [] [] xs with None -> (sought,m sought)::xs | Some xs -> xs)
-
-    let optmodify_assq sought f ?rev xs =
-      let rec aux_left sought f ys = function
-      | [] -> None
-      | (k,x as kx)::xs -> if k == sought then Some (rev1 (match f k (Some x) with None -> xs | Some x -> (k,x)::xs) ys) else aux_left sought f (kx::ys) xs in
-      let rec aux_right sought f yss ys = function
-      | [] -> (match yss with [] -> None | ((k,x)::xs)::yss -> Some (rev2 (match f k (Some x) with None -> rev1 [] ys | Some x -> (k,x)::rev1 [] ys) (xs::yss)) | _ -> assert false)
-      | (k,x as kx)::xs -> if k == sought then aux_right sought f ((kx::ys)::yss) [] xs else aux_right sought f yss (kx::ys) xs in
-      match rev with
-      | None -> (match aux_left sought f [] xs with None -> (match f sought None with None -> xs | Some x -> (sought,x)::xs) | Some xs -> xs)
-      | Some _ -> (match aux_right sought f [] [] xs with None -> (match f sought None with None -> xs | Some x -> (sought,x)::xs) | Some xs -> xs)
-
-    let rec mem_assoc sought ?(eq=(=)) = function
-    | [] -> false
-    | (k,_)::xs -> eq k sought || mem_assoc ~eq sought xs
-
-    let rec mem_assq sought = function
-    | [] -> false
-    | (k,_)::xs -> k == sought || mem_assq sought xs
-
-    let remove_assoc sought ?rev ?(eq=(=)) ?many xs =
-      let rec aux_left sought eq ys = function
-      | [] -> xs
-      | (k,_ as kx)::xs -> if eq k sought then rev1 xs ys else aux_left sought eq (kx::ys) xs in
-      let rec aux_many sought eq ys = function
-      | [] -> rev1 [] ys
-      | (k,_ as kx)::xs -> aux_many sought eq (if eq k sought then ys else kx::ys) xs in
-      let rec aux_right sought eq yss ys = function
-      | [] -> (match yss with [] -> xs | (_::xs)::yss -> rev2 (rev1 [] ys) (xs::yss) | _ -> assert false)
-      | (k,_ as kx)::xs -> if eq k sought then aux_right sought eq ((kx::ys)::yss) [] xs else aux_right sought eq yss (kx::ys) xs in
-      match rev,many with
-      | None,None -> aux_left sought eq [] xs
-      | Some _,None -> aux_right sought eq [] [] xs
-      | None,Some _ -> aux_many sought eq [] xs
-      | Some _,Some _ -> invalid_arg "remove_assoc ~rev conflicts with ~many"
-
-    let remove_assq sought ?rev ?many xs =
-      let rec aux_left sought ys = function
-      | [] -> xs
-      | (k,_ as kx)::xs -> if k == sought then rev1 xs ys else aux_left sought (kx::ys) xs in
-      let rec aux_many sought ys = function
-      | [] -> rev1 [] ys
-      | (k,_ as kx)::xs -> aux_many sought (if k == sought then ys else kx::ys) xs in
-      let rec aux_right sought yss ys = function
-      | [] -> (match yss with [] -> xs | (_::xs)::yss -> rev2 (rev1 [] ys) (xs::yss) | _ -> assert false)
-      | (k,_ as kx)::xs -> if k == sought then aux_right sought ((kx::ys)::yss) [] xs else aux_right sought yss (kx::ys) xs in
-      match rev,many with
-      | None,None -> aux_left sought [] xs
-      | Some _,None -> aux_right sought [] [] xs
-      | None,Some _ -> aux_many sought [] xs
-      | Some _,Some _ -> invalid_arg "remove_assq ~rev conflicts with ~many"
-
-    let rotate n xs =
-      let rec aux ys = function
-      | [x] -> x::rev1 [] ys
-      | x::xs -> aux (x::ys) xs
-      | _ -> assert false in
-      if n = 0 || xs = [] then xs
-      else if n = 1 then aux [] xs
-      else
-        let xn = length xs in
-        let n = (xn - n) mod xn in
-        let pre,post = if n > 0 then split n xs else if n < 0 then split (xn+n) xs else [],xs in
-        append post pre
-
-    let unfold f ?rev ?(onto=[]) z =
-      let rec aux f ys z = match f z with None -> ys | Some (y,z) -> aux f (y::ys) z in
-      match rev with
-      | None -> rev1 onto (aux f [] z)
-      | Some _ -> aux f onto z
-
-    let mapz f z ?rev ?(onto=[]) xs =
-      let rec aux f z ys = function [] -> z,ys | x::xs -> let z,y = f z x in aux f z (y::ys) xs in
-      match rev with
-      | None -> let z,ys = aux f z [] xs in z, rev1 onto ys
-      | Some _ -> aux f z onto xs
-
-    (*
-    let group ?(eq=(=)) xs =
-      let rec aux eq = function
-      | [] -> []
-      | x::xs -> let xs,ys = split_while (eq x) xs in (x::xs)::aux eq ys in
-      aux eq xs
-    *)
-
-    let group ?(eq=(=)) xs =
-      let f eq x = function [] -> [[x]] | (y::_ as ys)::yss -> if eq y x then (x::ys)::yss else [x]::ys::yss | _ -> assert false in
-      let rec aux f eq yss = function [] -> yss | x::xs -> aux f eq (f eq x yss) xs in
-      match aux f eq [] xs with [] -> [] | xs -> map ~rev rev xs
-
-    let cross f xs ys =
-      let rec aux f ys = function [] -> ys | x::xs -> aux f (f x::ys) xs in
-      rev2 [] (aux (fun x -> aux (f x) [] ys) [] xs)
-
-    let insert ins ?(cmp=compare) ?many xs =
-      let rec aux_one cmp ins ys = function
-      | [] -> rev1 [ins] ys
-      (* don't shadow the entry-level `xs` *)
-      | z::zs as orig -> let res = cmp z ins in if res < 0 then aux_one cmp ins (z::ys) zs else if res = 0 then xs else rev1 (ins::orig) ys in
-      let rec aux_many cmp ins ys = function
-      | [] -> rev1 [ins] ys
-      | x::xs as orig -> let res = cmp x ins in if res < 0 then aux_many cmp ins (x::ys) xs else rev1 (ins::orig) ys in
-      match many with
-      | None -> aux_one cmp ins [] xs
-      | Some _ -> aux_many cmp ins [] xs
-
-    let select xs is =
-      let rec aux j js i ys = function
-      | [] -> raise Short_list
-      (* don't shadow the entry-level `xs` *)
-      | z::zs as orig -> if j = i then (match js with j::js -> if j >= i then aux j js (if j = i then i else i+1) (z::ys) (if j = i then orig else zs) else aux j js 0 (z::ys) xs | [] -> rev1 [z] ys) else aux j js (i+1) ys zs in
-      match is with
-      | [] -> []
-      | i::is -> aux i is 0 [] xs
-
-    let range ?(step=1) start ~len =
-      let rec aux stop step ys i = if stop i then ys else aux stop step (i::ys) (i+step) in
-      if step = 0 then invalid_arg "range" else aux (if step > 0 then (fun i -> i < start) else (fun i -> i > start)) (-step) [] (start + len*step - step)
-
-    let range_until ?step start stop =
-      let rec aux stop step ys i = if stop i then ys else aux stop step (i::ys) (i+step) in
-      match step with
-      | None -> if stop <= start
-          then aux (fun i -> i > start) (1) [] (let len = (start - stop) in start - len + 1)
-          else aux (fun i -> i < start) (-1) [] (let len = (stop - start) in start + len - 1)
-      | Some x when x < 0 -> if stop >= start then [] else aux (fun i -> i > start) (-x) [] (let len = (stop + x + 1 - start) / x in start + len*x - x)
-      | Some x when x > 0 -> if stop <= start then [] else aux (fun i -> i < start) (-x) [] (let len = (stop + x - 1 - start) / x in start + len*x - x)
-      | _ -> invalid_arg "range_until"
-
-    let unique ?cmp ?(eq=(=)) xs =
-      let rec aux_mem eq x = function [] -> false | y::ys -> eq y x || aux_mem eq x ys in
-      let rec aux_all eq ys = function
-      | [] -> rev1 [] ys
-      | x::xs -> aux_all eq (if aux_mem eq x ys then ys else x::ys) xs in
-      let rec aux_sorted cmp ys y = function
-      | [] -> rev1 [y] ys
-      | x::xs -> if cmp y x = 0 then aux_sorted cmp ys y xs else aux_sorted cmp (y::ys) x xs in
-      match xs,cmp with
-      | [],_ | [_],_ -> xs
-      | x::xs, None -> aux_all eq [x] xs
-      | x::xs, Some cmp -> aux_sorted cmp [] x xs
-
-    let is_unique ?cmp ?(eq=(=)) xs =
-      let rec aux_mem eq sought = function [] -> false | x::xs -> eq x sought || aux_mem eq sought xs in
-      let rec aux_all eq ys = function
-      | [] -> true
-      | x::xs -> not (aux_mem eq x ys) && aux_all eq (x::ys) xs in
-      let rec aux_sorted cmp y = function
-      | [] -> true
-      | x::xs -> cmp y x < 0 && aux_sorted cmp x xs in
-      match xs,cmp with
-      | [],_ | [_],_ -> true
-      | x::xs, None -> aux_all eq [x] xs
-      | x::xs, Some cmp -> aux_sorted cmp x xs
-
-    let rec transpose = function
-      | [] -> []
-      | []::xss -> transpose xss
-      | (x::xs)::xss -> (x :: map head xss) :: transpose (xs :: map tail xss)
-
-    let sublists ?len ?many xs =
-      let rec aux_all = function [] -> [] | (x::xs) -> [x]::fold_left (fun yss ys -> (x::ys)::ys::yss) [] (aux_all xs) in
-      let rec aux_fixed k = function
-      | _  when k = 0 -> [[]]
-      | [] -> [] (* happens if k > length xs *)
-      | x::xs -> map (cons x) (aux_fixed (k-1) xs) ~onto:(aux_fixed k xs) in
-      let rec aux_replacing k = function
-        | _ when k = 0 -> [[]]
-        | [] -> [] (* will only happen if xs was [] to start with *)
-        | x::xs as orig -> map (cons x) (aux_replacing (k-1) orig) ~onto:(aux_replacing k xs) in
-      match len,many with
-      | None,None -> []::aux_all xs
-      | Some k,None -> if k < 0 then invalid_arg "sublists ~len" else aux_fixed k xs
-      | Some k,Some _ -> if k < 0 then invalid_arg "sublists ~len" else aux_replacing k xs
-      | None,Some _ -> invalid_arg "sublists ~many requires ~len"
-
-    let rec permutations ?len ?many xs =
-      let rec interleave' x xs f r = function
-      | [] -> xs, r
-      | y::ys -> let us,zs = interleave' x xs (fun ys -> f(y::ys)) r ys in y::us, f (x::y::us)::zs in
-      let interleave x xs r ys = let _,zs = interleave' x xs ident r ys in zs in
-      let rec aux ys = function
-      | [] -> []
-      | x::xs -> fold_left (interleave x xs) (aux (x::ys) xs) (permutations ys) in
-      let prod yss xs = catmap (fun x -> map (cons x) yss) xs in
-      match len,many with
-      | None,None -> xs::aux [] xs
-      | Some k,None -> if k < 0 then invalid_arg "permutations ~len" else catmap permutations (sublists ~len:k xs)
-      | Some k,Some _ -> if k < 0 then invalid_arg "permuations ~len" else if k = 0 then [] else fold_left prod [[]] (make k xs)
-      | None, Some _ -> invalid_arg "permutations ~many requires ~len"
-
-    let is_sublist ?(eq=(=)) xs ys =
-      let rec aux eq ys xs = match ys,xs with
-      | _,[] -> true
-      | [],_::_ -> false
-      | y::ys',x::xs' -> if eq y x then aux eq ys' xs' else aux eq ys' xs in
-      aux eq ys xs
-
-    let is_subset ?cmp ?(eq=(=)) ?many xs ys =
-      let rec aux_sorted uniq cmp ys xs = match ys,xs with
-      | _,[] -> true
-      | [],_::_ -> false
-      | y::ys',x::xs' -> let res = cmp y x in if res > 0 then false else if res < 0 then aux_sorted uniq cmp ys' xs else aux_sorted uniq cmp (if uniq then ys' else ys) xs' in
-      match cmp,many with
-      | None,Some _ -> for_all (fun x -> mem ~eq x ys) xs
-      | Some cmp,None -> aux_sorted true cmp ys xs
-      | Some cmp,Some _ -> aux_sorted false cmp ys xs
-      | None,None -> invalid_arg "is_subset requires ~cmp and/or ~many"
-
-    let is_eqset ?(eq=(=)) xs ys =
-      let rec aux eq x zs = function [] -> raise Not_found | y::ys -> if eq y x then x, rev1 ys zs else aux eq x (y::zs) ys in
-      try (match fold_left (fun ys x -> let _,ys = aux eq x [] ys in ys) ys xs with [] -> true | _ -> false)
-      with Not_found -> false
-
-    let rec lexcmp ?(cmp=compare) xs ys = match xs, ys with
-    | [],[] -> 0
-    | _,[] -> 1
-    | [],_ -> -1
-    | x::xs,y::ys -> let res = cmp x y in if res < 0 then -1 else if res > 0 then 1 else lexcmp ~cmp xs ys
-
-    let diff ?cmp ?(eq=(=)) ?many xs ys = fold_left (fun xs y -> delete ?cmp ~eq ?many y xs) xs ys
-
-    (*
-    let union ?cmp ?(eq=(=)) xs ys = append xs (fold_left (fun ys x -> delete ?cmp ~eq x ys) ys xs)
-    *)
-
-    let union ?cmp ?(eq=(=)) ys xs = append (fold_left (fun ys x -> delete ?cmp ~eq x ys) ys xs) xs
-
-    let intersect ?cmp ?(eq=(=)) xs ys =
-      let rec aux_all eq ws zs xs ys = match xs,ys with
-      | _,[] -> rev1 [] zs
-      | [],y::ys' -> aux_all eq [] zs (* don't need to reverse ws *) ws ys'
-      | x::xs',y::ys' -> if eq x y then aux_all eq [] (y::zs) (rev1 xs' ws) ys' else aux_all eq (x::ws) zs xs' ys in
-      let rec aux_sorted cmp zs xs ys = match xs,ys with
-      | [],_ | _,[] -> rev1 [] zs
-      | x::xs',y::ys' -> let res = cmp x y in if res < 0 then aux_sorted cmp zs xs' ys else if res > 0 then aux_sorted cmp zs xs ys' else aux_sorted cmp (y::zs) xs' ys' in
-      match cmp with
-      | None -> aux_all eq [] [] xs ys
-      | Some cmp -> aux_sorted cmp [] xs ys
-
-    let merge ?(cmp=compare) xs ys =
-      let rec aux cmp zs xs ys = match xs, ys with
-      | [],ys -> rev1 ys zs
-      | xs,[] -> rev1 xs zs
-      | x'::xs',y'::ys' -> if cmp x' y' <= 0 then aux cmp (x'::zs) xs' ys else aux cmp (y'::zs) xs ys' in
-      aux cmp [] xs ys
-
-    (*
-       "Natural" or "adaptive" bottom-up merge sort, inspired by http://www.drmaciver.com/tag/timsort/.
-    
-       Optimized to exploit existing runs of ascending/descending elements, to consume at most O(log n) levels of its working stack,
-       and to be mostly tail-recursive, while minimizing how often sorted and merged runs need to be reversed.
-       
-       Sort is stable, and has O(n log n) avg and worst-case behavior.
-       (Compare to naive mergesort on random data, also to C-implemented qsort, which isn't stable?)
-    
-       Will delete (later occurrences of) any duplicates, unless invoked with ~many.
-       
-       Copyright (c) 2012, 2015 by Dubiousjim <dubiousjim@gmail.com>.
-       See license at https://github.com/dubiousjim/unspoiled/blob/master/LICENSE
-    *)
-
-    let sort ?(cmp=compare) ?many ?rev xs =
-      let rec merge uniq cmp wasc yy zz ws wn =
-        assert (wasc <> 0); match yy,zz with
-        | us,[] | [],us -> rev1 ws us, wn, -wasc
-        | y::ys,z::zs -> let res = cmp y z in
-            if uniq && res = 0 then (assert (wn<>1); merge uniq cmp wasc ys zz ws (if wn = 0 then 0 else wn - 1))
-            else if (wasc < 0) = (res < 0) then merge uniq cmp wasc ys zz (y::ws) wn else merge uniq cmp wasc yy zs (z::ws) wn in
-      let rec merge1 uniq cmp ys yn yasc zss = match zss with
-        | [] -> None
-        | (z::zs' as zs,zn,zasc)::zss as orig -> (match ys with
-            | [] -> assert false
-            | y::ys' ->
-                (* yn = 0 forces collapse of stack *)
-                if yn > 0 && yn*2 <= zn then None
-                else let wn = if yn > 0 then yn + zn else 0 in
-                if yasc = 0 then (assert (yn <= 1); merge2 uniq cmp zss (merge uniq cmp zasc ys zs [] wn))
-                else let res = cmp y z in
-                let () = assert (yn <> 1) in
-                if uniq && res = 0 then (if yn = 1 then merge2 uniq cmp zss (zs,zn,zasc) else merge1 uniq cmp ys' (if yn = 0 then 0 else yn - 1) yasc orig)
-                else if yasc < 0 && zasc > 0 && res >= 0 then merge2 uniq cmp zss (rev1 zs ys, wn, 1)
-                else if yasc > 0 && zasc < 0 && res < 0 then merge2 uniq cmp zss (rev1 ys zs, wn, 1)
-                else let wasc,ys,zs = if (yasc < 0) = (zasc < 0) then zasc, ys, zs else if zn < yn then yasc, ys, rev1 [] zs else zasc, rev1 [] ys, zs in
-                merge2 uniq cmp zss (merge uniq cmp wasc ys zs [] wn))
-        | _ -> assert false
-      and merge2 uniq cmp zss (ws,wn,wasc) =
-        let more = merge1 uniq cmp ws wn wasc zss in
-        match more with None -> Some ((ws,wn,wasc)::zss) | _ -> more in
-      (* yasc = -1 when a segment of the original list was strictly descending, +1 when it was non-descending, 0 when the segment is only 1 member long *)
-      let rec step uniq cmp xs y ys yn yasc zss =
-        match xs with
-        | (x::xs) ->
-            let res = cmp x y in
-            if uniq && res = 0 then step uniq cmp xs y ys yn yasc zss
-            else if yn = 1 then step uniq cmp xs x (y::ys) 2 (if res < 0 then -1 else 1) zss
-            else (assert (yasc <> 0); if (yasc < 0) = (res < 0) then step uniq cmp xs x (y::ys) (yn+1) yasc zss
-            else step uniq cmp xs x [] 1 0 (match merge1 uniq cmp (y::ys) yn yasc zss with None -> (y::ys,yn,yasc)::zss | Some zss -> zss))
-        | [] -> (* finished stepping through original list, use yn = 0 to force merge1 until completion *)
-            (match merge1 uniq cmp (y::ys) 0 yasc zss with
-            | Some [(ys,0,yasc)] -> if yasc > 0 then rev1 [] ys else ys
-            | None -> if yasc > 0 then rev1 [y] ys else y::ys
-            | _ -> assert false) in
-    match many,rev,xs with
-    | _,_,[] | _,_,[_] -> xs
-    | None,None,x::xs -> step true cmp xs x [] 1 0 []
-    | Some _,None,x::xs -> step false cmp xs x [] 1 0 []
-    | None,Some _,x::xs -> step true (fun x y -> -cmp x y) xs x [] 1 0 []
-    | Some _,Some _,x::xs -> step false (fun x y -> -cmp x y) xs x [] 1 0 []
-
-    let is_sorted ?(cmp=compare) ?many ?rev xs =
-      let rec aux cmp thresh y = function
-      | [] -> true
-      | x::xs -> cmp y x < thresh && aux cmp thresh x xs in
-      match rev,xs with
-      | _,[] | _,[_] -> true
-      | None,x::xs -> aux cmp (match many with None -> 0 | Some _ -> 1) x xs
-      | Some _,x::xs -> aux (fun x y -> -cmp x y) (match many with None -> 0 | Some _ -> 1) x xs
-
-
-    let string_of_list ?(brackets=true) ?(sep=";") f xs =
-      let rec aux sep' = function [] -> if brackets then "]" else "" | x::xs -> sep' ^ f x ^ aux sep xs in
-      (if brackets then "[" else "") ^ aux "" xs
-
-    let histogram ?(eq=(=)) xs = fold_left (fun h x -> modify_assoc x (fun _ n -> n+1) ~missing:(fun _ -> 1) ~eq h) [] xs
-
-    let pairwise ?missing xs =
-      let rec aux missing x = function
-      | [] -> (match missing with None -> [] | Some y -> [(x,y)])
-      | y::ys -> (x,y)::aux missing y ys in
-      match xs with
-      | [] -> []
-      | x::xs -> aux missing x xs
-
-    let rec round_robin xss =
-      let rec aux ws ys = function
-      | [] -> (match ys with [] -> rev1 [] ws | _ -> aux ws [] (rev1 [] ys))
-      | []::xss -> aux ws ys xss
-      | (x::xs)::xss -> aux (x::ws) (xs::ys) xss in
-      match xss with
-      | [] -> raise Short_list
-      | []::xss -> round_robin xss
-      | xss -> aux [] [] xss
-
-    let rec chunk n xs = match split n xs with
-      | ys,[] -> [ys]
-      | ys,zs -> ys::chunk n zs
-
-    let rec chunk' n xs = match split' n xs with
-      | ys,[] -> [ys]
-      | ys,zs -> ys::chunk' n zs
-
-    let chunk_int n xs =
-      let rec aux n = function
-      | _ when n = 0 -> [[]]
-      | [] -> []
-      | x::xs as orig -> if x > n then aux n xs else map ~onto:(aux n xs) (cons x) (aux (n-x) orig) in
-      let xs = sort ~many xs in
-      match sort xs with x::_ as xs when x > 0 && n > 0 -> aux n (rev1 [] xs) | _ -> invalid_arg "chunk_int"
-
-    let chunk_range sizes =
-      let rec combs2 k = function
-      | xs when k = 0 -> [([],xs)]
-      | [] -> []
-      | x::xs -> map (fun (cs,zs) -> x::cs,zs) (combs2 (k-1) xs) ~onto:(map (fun (cs,zs) -> cs,x::zs) (combs2 k xs)) in
-      let rec p xs = function
-      | [] -> [[]]
-      | k::ks -> catmap (fun (cs,zs) -> map (cons cs) (p zs ks)) (combs2 k xs) in
-      if exists (fun x -> x<0) sizes then invalid_arg "chunk_range" else p (range_until 0 (sum sizes)) sizes
-
-  end (* List *)
-  
-  let short = List.short
-  let many = List.many
-  exception Short_list = List.Short_list
-
-  let is_null = List.is_null
-  let length = List.length
-  let cons = List.cons
-  let snoc = List.snoc
-  let singleton = List.singleton
-  let head = List.head
-  let opthead = List.opthead
-  let tail = List.tail
-  let tail' = List.tail'
-  let uncons = List.uncons
-  let append = List.append
-  let concat = List.concat
-  let rev = List.rev
-  let zip = List.zip
-  let unzip = List.unzip
-  let iter = List.iter
-  let iteri = List.iteri
-  let iter2 = List.iter2
-  let fold_left = List.fold_left
-  let fold_left1 = List.fold_left1
-  let fold_left2 = List.fold_left2
-  let fold_right = List.fold_right
-  let fold_right1 = List.fold_right1
-  let fold_right2 = List.fold_right2
-  let for_all = List.for_all
-  let exists = List.exists
-  let for_all2 = List.for_all2
-  let exists2 = List.exists2
-  let sum = List.sum
-  let product = List.product
-  let take = List.take
-  let take' = List.take'
-  let drop = List.drop
-  let drop' = List.drop'
-  let split = List.split
-  let split' = List.split'
-  let nth = List.nth
-
-(*
-  count
-  make
-  last
-  init
-  init'
-    mem
-  map
-  map2
-  unmap2
-  mapi
-  optmap
-  optmapi
-  catmap
-  catmapi
-  maximum
-  minimum
-  maxby
-  minby
-  modify
-  optmodify
-  catmodify
-  take_while
-  drop_while
-  split_while
-  find
-  optfind
-  findx
-    index
-  remove
-    delete
-  pick
-  pickx
-  filter
-  filterx
-  indices
-  partition
-  partitionx
-    assoc
-  mem_assoc
-  modify_assoc
-  optmodify_assoc
-  remove_assoc
-  memq
-  indexq
-  deleteq
-  indicesq
-  assq
-  mem_assq
-  modify_assq
-  optmodify_assq
-  remove_assq
-  rotate
-  unfold
-  mapz
-  group
-    cross
-    insert
-    select
-    range
-    range_until
-    unique
-    is_unique
-  transpose
-  permutations
-  sublists
-    is_sublist
-    is_subset
-    is_eqset
-  lexcmp
-    diff
-    union
-    intersect
-    merge
-  sort
-  is_sorted
-    string_of_list
-    histogram
-  pairwise
-  round_robin
-  chunk
-  chunk'
-  chunk_int
-  chunk_range
-*)
-
-  let factorial n = let rec aux m = function 0 -> m | 1 -> m | n -> aux (n*m) (n-1) in aux 1 n
-
-  (* good to around n = 28; naive version overflows after n = 20 *)
-  let choose n k = let j = max k (n-k) in if j = n then 1 else List.fold_left (/) (List.product (List.range_until n j)) (List.range_until (n-j) 1)
-
-  module Random : sig
-    val init : ?seed:int -> unit -> unit
-    val bool : unit -> bool
-    (* start <= result < stop *)
-    val between : int -> int -> int
-    val nth : 'a list -> 'a
-    val pick : 'a list -> 'a * 'a list
-    (* k dice rolls are `permutation ~len:k ~many [1..6]` *)
-    val permutation : ?len:int -> ?many:'b -> 'a list -> 'a list
-    (* choose k elements from xs, in stable order, ~many with replacment *)
-    val sublist : len:int -> ?many:'b -> 'a list -> 'a list
-  end = struct
-
-    let init ?seed () =
-      match seed with
-      | None -> Std.Random.self_init()
-      | Some n -> Std.Random.init n
-
-    let bool = Std.Random.bool
-
-    let between start stop = Std.Random.int (stop-start) + start
-
-    let nth xs = match List.length xs with
-    | 0 -> invalid_arg "Random.nth"
-    | n -> List.nth xs (between 0 n)
-
-    let pick xs =
-      let rec aux n ws = function
-      | x::xs -> if n = 0 then x, List.rev ~onto:xs ws else aux (n-1) (x::ws) xs
-      | [] -> assert false in
-      match List.length xs with
-      | 0 -> invalid_arg "Random.pick"
-      | n -> aux (between 0 n) [] xs
-
-    let permutation ?len ?many xs =
-      (* a[j],a[n] = x,a[j] *)
-      let array_push a j n x = if j = n then a.(n) <- x else let y = a.(j) in (a.(j) <- x; a.(n) <- y) in
-      (* return,a[j] = a[j],a[n] *)
-      let array_pop a j n = let y = a.(n-1) in if j = n - 1 then y else (let x = a.(j) in a.(j) <- y; x) in
-      let rec aux_all a n = function
-      (* Based on https://en.wikipedia.org/wiki/Fisher-Yates_shuffle#The_.22inside-out.22_algorithm
-         Initialize empty array to shuffled copy of xs *)
-      | [] -> Array.to_list a
-      | x::xs -> let j = between 0 (n+1) in (array_push a j n x; aux_all a (n+1) xs) in
-      let rec aux_fixed k n a ws = function
-      | 0 -> ws
-      | i -> let j = between 0 n in let w = array_pop a j n in aux_fixed k (n-1) a (w::ws) (i-1) in
-    match len,many,xs with
-    | None,_,[] -> []
-    | Some k,_,[] -> if k = 0 then [] else invalid_arg "Random.permutation"
-    | None,None,x::_ -> aux_all (Array.make (List.length xs) x) 0 xs
-    | Some k,None,_ -> if k < 0 then invalid_arg "Random.permutation" else aux_fixed k (List.length xs) (Array.of_list xs) [] k
-    | Some k,Some _,_ -> if k < 0 then invalid_arg "Random.permutation" else iterate k (fun ys -> nth xs::ys) []
-    | None,Some _,_ -> invalid_arg "Random.permutation ~many requires ~len"
-
-    let sublist ~len:k ?many xs =
-      let rec aux_fixed ws n k = function
-      | _ when k = 0 -> List.rev ws
-      | (x::xs) ->
-      (* Explanation of the threshhold: There are n choose k many combinations, yes=(n-1) choose (k-1) headed by element x and no=(n-1) choose k not.
-         So x has yes/(yes+no) chance of occupying initial slot, else it occupies none of the slots. yes/(yes+no) reduces to k/n. *)
-         if between 0 n < k then aux_fixed (x::ws) (n-1) (k-1) xs else aux_fixed ws (n-1) k xs
-      | _ -> assert false in
-      let rec aux_replacing k top ws = function
-      | _ when k = 0 -> List.rev ws
-      | [] -> [] (* will only happen when xs was [] to start with *)
-      | x::xs as orig ->
-      (* Explanation of the threshhold: There are n+k-1 choose k many combinations with replacement, yes=(n+k-2) choose (k-1) headed by element x and no=(n+k-2) choose k not.
-         So x has yes/(yes+no) chance of occupying the initial slot, and also possibly some later slots. This reduces to k/(k+n-1). *)
-         if between 0 (k+top) < k then aux_replacing (k-1) top (x::ws) orig else aux_replacing k (top-1) ws xs in
-      let n = List.length xs in
-      if k < 0 || k > n then invalid_arg "Random.sublist"
-      else match many with
-      | None -> aux_fixed [] n k xs
-      | Some _ -> aux_replacing k (n-1) [] xs
-
-  end (* Random *)
-
-  (* #load "Str.cma";; *)
-  module String : sig
-    type t = string
-    val compare : 'a -> 'a -> int
-    val length : string -> int
-    val take : int -> ?rev:'a -> string -> string
-    val drop : int -> string -> string
-    val sub : string -> int -> len:int -> string
-    val is_prefix : string -> string -> bool
-    val is_suffix : string -> string -> bool
-    val is_infix : string -> string -> bool
-    val find : string -> ?rev:'a -> ?from:int -> string -> int
-    val nth : string -> int -> char
-    val make : int -> char -> string
-    val mem : char -> ?rev:'a -> ?from:int -> string -> bool
-    val index : ?rev:'a -> ?from:int -> char -> string -> int
-    val upper : string -> string
-    val lower : string -> string
-    val int_of_char : char -> int
-    val char_of_int : int -> char
-    (* trim only removes up to 1 leading/trailing occurrence of pat *)
-    val trim : string -> string
-    type pat = string
-    val split : string -> ?n:int -> ?trim:'a -> pat -> string list
-    val join : sep:string -> string list -> string
-    val lines : ?trim:'a -> string -> string list (* as in Haskell, gobbles up to 1 \n per line *)
-    val words : string -> string list
-    val unlines : string list -> string (* as in Haskell, does add a trailing \n *)
-    val unwords : string list -> string (* as in Haskell, no trailing space *)
-  end = struct
-    type t = string
-    let compare = compare
-    let length = Std.String.length
-    let take n ?rev s = match rev with
-    | None -> Str.string_before s n
-    | Some _ -> Str.last_chars s n
-    let drop n s = Str.string_after s n
-    let sub s start ~len = Std.String.sub s start len
-    let is_prefix (sought : string) s = let n = length sought in length s >= n && take n s = sought
-    let is_suffix (sought : string) s = let n = length sought in length s >= n && take n ~rev:() s = sought
-    let is_infix (sought : string) s = length sought <= length s && try Str.(search_forward (regexp_string sought) s 0) >= 0 with Not_found -> false
-    let find (sought : string) ?rev ?from s = match rev,from with
-    | None,None -> Str.(search_forward (regexp_string sought) s 0)
-    | None,Some n -> Str.(search_forward (regexp_string sought) s n)
-    | Some _,Some n -> Str.(search_backward (regexp_string sought) s n)
-    | Some _,None -> let n = length s - length sought in if n < 0 then raise Not_found else Str.(search_backward (regexp_string sought) s n)
-    let nth s n = Std.String.get s n
-    let make n c = Std.String.make n c
-    let mem (sought : char) ?rev ?from s = match rev,from with
-    | None,None -> Std.String.contains s sought
-    | None,Some n -> Std.String.contains_from s n sought
-    | Some _,Some n -> Std.String.rcontains_from s n sought
-    | Some _,None -> invalid_arg "String.mem ~rev requires ~from"
-    let index ?rev ?from (sought : char) s = match rev,from with
-    | None,None -> Std.String.index s sought
-    | Some _,None -> Std.String.rindex s sought
-    | None,Some n -> Std.String.index_from s n sought
-    | Some _,Some n -> Std.String.rindex_from s n sought
-    let upper s = Std.String.uppercase s
-    let lower s = Std.String.lowercase s 
-    let int_of_char (c : char) = Std.Char.code c
-    let char_of_int (n : int) = Std.Char.chr n
-    let trim s = Std.String.trim s
-    type pat = string
-    let split s ?n ?trim pat = match n,trim with
-    | None,Some _ -> Str.(split (regexp pat) s)
-    | Some n,Some _ -> Str.(bounded_split (regexp pat) s n)
-    | None,None -> Str.(split_delim (regexp pat) s)
-    | Some n,None -> Str.(bounded_split_delim (regexp pat) s n)
-    let join ~sep ss = Std.String.concat sep ss
-    let lines ?trim s = split ("\n"^s) ~trim "\n"
-    let words s = split s ~trim "[ \t\n]+"
-    let unlines ss = join "\n" ss ^ "\n"
-    let unwords ss = join " " ss
-  end (* String *)
-
-end (* Juli8 *)
-
-open Juli8
-
-#use "monad.ml"
diff --git a/code/monad.ml b/code/monad.ml
deleted file mode 100644 (file)
index f17d953..0000000
+++ /dev/null
@@ -1,1186 +0,0 @@
-(* This version from 1 April 2015 *)
-
-module Monad = struct
-
-  module type MAPPABLE = sig
-    type 'a t
-    val map : ('a -> 'b) -> 'a t -> 'b t
-    (* mapconst is definable as map % const. For example mapconst 4 [1,2,3] == [4,4,4]. Haskell calls mapconst <$ in Data.Functor and Control.Applicative. They also use $> for flip mapconst, and Control.Monad.void for mapconst (). *)
-  end
-
-  module type APPLICATIVE = sig
-    include MAPPABLE
-    val mid : 'a -> 'a t
-    val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
-    val mapply : ('a -> 'b) t -> 'a t -> 'b t
-    val (>>) : 'a t -> 'b t -> 'b t
-    val (<<) : 'a t -> 'b t -> 'a t
-  end
-
-  module type MONAD = sig
-    include APPLICATIVE
-    type 'a result
-    val run : 'a t -> 'a result
-    val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-    val (>=>) : ('a -> 'b t) -> ('b -> 'c t) -> ('a -> 'c t)
-    val (<=<) : ('b -> 'c t) -> ('a -> 'b t) -> ('a -> 'c t)
-    val join : 'a t t -> 'a t
-    val ignore : 'a t -> unit t
-    val seq : 'a t list -> 'a list t
-    val seq_ignore : unit t list -> unit t
-    val do_when : bool -> unit t -> unit t
-    val do_unless : bool -> unit t -> unit t
-  end
-
-  module type MONADT = sig
-    type 'a ut
-    include MONAD
-    val hoist : 'a ut -> 'a t
-  end
-
-  module type ZERO = sig
-    type 'a t
-    (* mzero is a value of type α that is exemplified by Nothing for the box type Maybe α and by [] for the box type List α. It has the behavior that anything ¢ mzero == mzero == mzero ¢ anything == mzero >>= anything. In Haskell, this notion is called Control.Applicative.empty or Control.Monad.mzero. *)
-    val mzero : 'a t
-    val guard : bool -> unit t
-  end 
-
-  module type MONADZERO = sig
-    include MONAD
-    include ZERO with type 'a t := 'a t
-  end
-
-  module type MONADZEROT = sig
-    include MONADT
-    include ZERO with type 'a t := 'a t
-  end
-    
-  module type MAPPABLE2 = sig
-    type ('a,'d) t
-    val map : ('a -> 'b) -> ('a,'d) t -> ('b,'d) t
-  end
-
-  module type APPLICATIVE2 = sig
-    include MAPPABLE2
-    val mid : 'a -> ('a,'d) t
-    val map2 : ('a -> 'b -> 'c) -> ('a,'d) t -> ('b,'d) t -> ('c,'d) t
-    val mapply : ('a -> 'b,'d) t -> ('a,'d) t -> ('b,'d) t
-    val (>>) : ('a,'d) t -> ('b,'d) t -> ('b,'d) t
-    val (<<) : ('a,'d) t -> ('b,'d) t -> ('a,'d) t
-  end
-
-  module type MONAD2 = sig
-    include APPLICATIVE2
-    type ('a,'d) result
-    val run : ('a,'d) t -> ('a,'d) result
-    val (>>=) : ('a,'d) t -> ('a -> ('b,'d) t) -> ('b,'d) t
-    val (>=>) : ('a -> ('b,'d) t) -> ('b -> ('c,'d) t) -> ('a -> ('c,'d) t)
-    val (<=<) : ('b -> ('c,'d) t) -> ('a -> ('b,'d) t) -> ('a -> ('c,'d) t)
-    val join : (('a,'d) t,'d) t -> ('a,'d) t
-    val ignore : ('a,'d) t -> (unit,'d) t
-    val seq : ('a,'d) t list -> ('a list,'d) t
-    val seq_ignore : (unit,'d) t list -> (unit,'d) t
-    val do_when : bool -> (unit,'d) t -> (unit,'d) t
-    val do_unless : bool -> (unit,'d) t -> (unit,'d) t
-  end
-
-  module type MONAD2T = sig
-    include MONAD2
-    type ('a,'d) ut
-    val hoist : ('a,'d) ut -> ('a,'d) t
-  end
-
-  module type MONADZERO2 = sig
-    include MONAD2
-    val mzero : ('a,'d) t
-    val guard : bool -> (unit,'d) t
-  end
-
-  module type MONADZERO2T = sig
-    include MONADZERO2
-    type ('a,'d) ut
-    val hoist : ('a,'d) ut -> ('a,'d) t
-  end
-
-  module Make = struct
-
-    module type MAP2 = sig
-      type 'a t
-      val mid : 'a -> 'a t
-      val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
-      val map : [`Generate | `Custom of ('a -> 'b) -> 'a t -> 'b t]
-      val mapply : [`Generate | `Custom of ('a -> 'b) t -> 'a t -> 'b t]
-    end
-
-    module type MAPPLY = sig
-      type 'a t
-      val mid : 'a -> 'a t
-      val mapply : ('a -> 'b) t -> 'a t -> 'b t
-      val map : [`Generate | `Custom of ('a -> 'b) -> 'a t -> 'b t]
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t]
-    end
-
-    module type BIND = sig
-      type 'a t
-      type 'a result
-      val run : 'a t -> 'a result
-      val mid : 'a -> 'a t
-      val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-      val map : [`Generate | `Custom of ('a -> 'b) -> 'a t -> 'b t]
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t]
-      val mapply : [`Generate | `Custom of ('a -> 'b) t -> 'a t -> 'b t]
-    end
-
-    module type COMP = sig
-      type 'a t
-      type 'a result
-      val run : 'a t -> 'a result
-      val mid : 'a -> 'a t
-      val (>=>) : ('a -> 'b t) -> ('b -> 'c t) -> ('a -> 'c t)
-      val map : [`Generate | `Custom of ('a -> 'b) -> 'a t -> 'b t]
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t]
-      val mapply : [`Generate | `Custom of ('a -> 'b) t -> 'a t -> 'b t]
-    end
-
-    module type JOIN = sig
-      type 'a t
-      type 'a result
-      val run : 'a t -> 'a result
-      val mid : 'a -> 'a t
-      val join : 'a t t -> 'a t
-      val map : ('a -> 'b) -> 'a t -> 'b t
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t]
-      val mapply : [`Generate | `Custom of ('a -> 'b) t -> 'a t -> 'b t]
-    end
-
-    module type TRANS = sig
-      module U : MONAD
-      type 'a t
-      type 'a result
-      val run : 'a t -> 'a result
-      (* Provide hoist, >>=; LAWS: 1. hoist U.(mid x) == mid x; 2. hoist U.(uu >>= k) == hoist uu >>= fun u -> hoist (k u) *)
-      val hoist : 'a U.t -> 'a t
-      val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-    end
-
-    module type TRANSUZ = sig
-      module U : MONADZERO
-      type 'a t
-      type 'a result
-      val run : 'a t -> 'a result
-      val hoist : 'a U.t -> 'a t
-      val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-    end
-
-    module type TRANSZ = sig
-      module U : MONAD
-      type 'a t
-      type 'a result
-      val run : 'a t -> 'a result
-      val hoist : 'a U.t -> 'a t
-      val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-      val mzero : 'a t
-    end
-
-    module ApplicativeFromBind(B : BIND) : APPLICATIVE with type 'a t = 'a B.t = struct
-      type 'a t = 'a B.t
-      let mid = B.mid
-      let (>>=) = B.(>>=)
-      let map = match B.map with
-      | `Custom map -> map
-      | `Generate -> fun f xx -> xx >>= fun x -> mid (f x)
-      let map2 = match B.map2 with
-      | `Custom map2 -> map2
-      | `Generate -> fun f xx yy -> xx >>= fun x -> yy >>= fun y -> mid (f x y)
-      let mapply = match B.map2 with
-      | `Custom map2 -> fun eta -> map2 ident eta
-      | `Generate -> fun ff xx -> ff >>= fun f -> map f xx
-      let (>>) xx yy = xx >>= fun _ -> yy
-      let (<<) xx yy = mapply (map const xx) yy
-    end
-
-    module ApplicativeFromMap2(B : MAP2) : APPLICATIVE with type 'a t = 'a B.t = struct
-      type 'a t = 'a B.t
-      let mid = B.mid
-      let map2 = B.map2
-      let mapply = match B.mapply with
-      | `Custom mapply -> mapply
-      | `Generate -> fun eta -> map2 ident eta
-      let map = match B.map with
-      | `Custom map -> map
-      | `Generate -> fun f xx -> mapply (mid f) xx
-      let (>>) xx yy = mapply (map (const ident) xx) yy
-      let (<<) xx yy = mapply (map const xx) yy
-    end
-
-    module ApplicativeFromApply(B : MAPPLY) : APPLICATIVE with type 'a t = 'a B.t = struct
-      type 'a t = 'a B.t
-      let mid = B.mid
-      let mapply = B.mapply
-      let map = match B.map with
-      | `Custom map -> map
-      | `Generate -> fun f xx -> mapply (mid f) xx
-      let map2 = match B.map2 with
-      | `Custom map2 -> map2
-      | `Generate -> fun f xx yy -> mapply (map f xx) yy
-      let (>>) xx yy = mapply (map (const ident) xx) yy
-      let (<<) xx yy = mapply (map const xx) yy
-    end
-
-    module MonadFromBind(B : BIND) : MONAD with type 'a t = 'a B.t and type 'a result = 'a B.result = struct
-      let (>>=) = B.(>>=)
-      include ApplicativeFromBind(B)
-      type 'a result = 'a B.result
-      let run = B.run
-      let (>=>) j k = fun a -> j a >>= k
-      let (<=<) k j = fun a -> j a >>= k
-      let join xxx = xxx >>= ident
-      let ignore xx = map (fun _ -> ()) xx
-      (* seq xxs = let f xx zzf = (xx >>=) . flip ((zzf.).(:)) in foldr f (return $) xxs [] *)
-      (* 
-         foldr' f z xs = foldl (\g x z -> g (f x z)) id xs z  -- foldr but evaluating from left?
-         foldl'' f z xs = foldr (\x g z -> g (f z x)) id xs z -- foldl but evaluating from right? these don't work
-         -- with foldr, evaluates left->right; with foldl the reverse
-         seq xxs =
-           let f c xx ret xs = xx >>= ret . c xs in -- careful! isn't fmap (c xs) xx because ret isn't (always) return
-           reverse <$> foldr (f $ flip (:)) return xxs []
-           -- or simply: foldr (f snoc) return xxs []
-      *)
-      let seq =
-        let rec aux xs = function
-        | [] -> mid (List.rev xs)
-        | xx::xxs -> xx >>= fun x -> aux (x::xs) xxs in
-        fun xxs -> aux [] xxs
-      let rec seq_ignore = function
-        | [] -> mid ()
-        | xx::xxs -> xx >>= fun () -> seq_ignore xxs
-      let do_when res xx = if res then xx else mid ()
-      let do_unless res xx = if res then mid () else xx
-    end
-
-    module MonadFromComp(B : COMP) : MONAD with type 'a t = 'a B.t and type 'a result = 'a B.result = struct
-      let (>=>) = B.(>=>)
-      let (<=<) k j = j >=> k
-      let (>>=) xx k = (ident >=> k) xx
-      include ApplicativeFromBind(struct include B let (>>=) = (>>=) end)
-      type 'a result = 'a B.result
-      let run = B.run
-      let join xxx = xxx >>= ident
-      let ignore xx = map (fun _ -> ()) xx
-      let seq =
-        let rec aux xs = function
-        | [] -> mid (List.rev xs)
-        | xx::xxs -> xx >>= fun x -> aux (x::xs) xxs in
-        fun xxs -> aux [] xxs
-      let rec seq_ignore = function
-        | [] -> mid ()
-        | xx::xxs -> xx >>= fun () -> seq_ignore xxs
-      let do_when res xx = if res then xx else mid ()
-      let do_unless res xx = if res then mid () else xx
-    end
-
-    module MonadFromJoin(B : JOIN) : MONAD with type 'a t = 'a B.t and type 'a result = 'a B.result = struct
-      let join = B.join
-      let (>>=) xx k = join (B.map k xx)
-      include ApplicativeFromBind(struct include B let (>>=) = (>>=) let map = `Custom B.map end)
-      type 'a result = 'a B.result
-      let run = B.run
-      let (>=>) j k = fun a -> j a >>= k
-      let (<=<) k j = fun a -> j a >>= k
-      let ignore xx = map (fun _ -> ()) xx
-      let seq =
-        let rec aux xs = function
-        | [] -> mid (List.rev xs)
-        | xx::xxs -> xx >>= fun x -> aux (x::xs) xxs in
-        fun xxs -> aux [] xxs
-      let rec seq_ignore = function
-        | [] -> mid ()
-        | xx::xxs -> xx >>= fun () -> seq_ignore xxs
-      let do_when res xx = if res then xx else mid ()
-      let do_unless res xx = if res then mid () else xx
-    end
-
-    module MonadFromT(B : TRANS) : MONADT with type 'a t = 'a B.t and type 'a result = 'a B.result and type 'a ut := 'a B.U.t = struct
-      include MonadFromBind(struct
-        include B
-        let mid x = hoist U.(mid x)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-      end)
-      let hoist = B.hoist
-    end
-
-    module MonadFromTUZ(B : TRANSUZ) : MONADZEROT with type 'a t = 'a B.t and type 'a result = 'a B.result and type 'a ut := 'a B.U.t = struct
-      let mzero = Obj.magic (B.hoist (B.U.mzero)) (* Obj.magic hack to generate enough polymorphism without having to thunk mzero *)
-      include MonadFromBind(struct
-        include B
-        let (>>=) xx k = xx >>= fun x -> try k x with Match_failure _ -> mzero
-        let mid x = hoist U.(mid x)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-      end)
-      let hoist = B.hoist
-      let guard res = if res then mid () else mzero
-    end
-
-    module MonadFromTZ(B : TRANSZ) : MONADZEROT with type 'a t = 'a B.t and type 'a result = 'a B.result and type 'a ut := 'a B.U.t = struct
-      include MonadFromBind(struct
-        include B
-        let (>>=) xx k = xx >>= fun x -> try k x with Match_failure _ -> mzero
-        let mid x = hoist U.(mid x)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-      end)
-      let hoist = B.hoist
-      let mzero = B.mzero
-      let guard res = if res then mid () else mzero
-    end
-
-    module type BIND2 = sig
-      type ('a,'d) t
-      type ('a,'d) result
-      val run : ('a,'d) t -> ('a,'d) result
-      val mid : 'a -> ('a,'d) t
-      val (>>=) : ('a,'d) t -> ('a -> ('b,'d) t) -> ('b,'d) t
-      val map : [`Generate | `Custom of ('a -> 'b) -> ('a,'d) t -> ('b,'d) t]
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> ('a,'d) t -> ('b,'d) t -> ('c,'d) t]
-      val mapply : [`Generate | `Custom of ('a -> 'b,'d) t -> ('a,'d) t -> ('b,'d) t]
-    end
-
-    module type COMP2 = sig
-      type ('a,'d) t
-      type ('a,'d) result
-      val run : ('a,'d) t -> ('a,'d) result
-      val mid : 'a -> ('a,'d) t
-      val (>=>) : ('a -> ('b,'d) t) -> ('b -> ('c,'d) t) -> ('a -> ('c,'d) t)
-      val map : [`Generate | `Custom of ('a -> 'b) -> ('a,'d) t -> ('b,'d) t]
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> ('a,'d) t -> ('b,'d) t -> ('c,'d) t]
-      val mapply : [`Generate | `Custom of ('a -> 'b,'d) t -> ('a,'d) t -> ('b,'d) t]
-    end
-
-    module type JOIN2 = sig
-      type ('a,'d) t
-      type ('a,'d) result
-      val run : ('a,'d) t -> ('a,'d) result
-      val mid : 'a -> ('a,'d) t
-      val join : (('a,'d) t,'d) t -> ('a,'d) t
-      val map : ('a -> 'b) -> ('a,'d) t -> ('b,'d) t
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> ('a,'d) t -> ('b,'d) t -> ('c,'d) t]
-      val mapply : [`Generate | `Custom of ('a -> 'b,'d) t -> ('a,'d) t -> ('b,'d) t]
-    end
-
-    module type TRANS2 = sig
-      module U : MONAD2
-      type ('a,'d) t
-      type ('a,'d) result
-      val run : ('a,'d) t -> ('a,'d) result
-      val (>>=) : ('a,'d) t -> ('a -> ('b,'d) t) -> ('b,'d) t
-      val hoist : ('a,'d) U.t -> ('a,'d) t
-    end
-
-    module type TRANSUZ2 = sig
-      module U : MONADZERO2
-      type ('a,'d) t
-      type ('a,'d) result
-      val run : ('a,'d) t -> ('a,'d) result
-      val (>>=) : ('a,'d) t -> ('a -> ('b,'d) t) -> ('b,'d) t
-      val hoist : ('a,'d) U.t -> ('a,'d) t
-    end
-
-    module type TRANSZ2 = sig
-      module U : MONAD2
-      type ('a,'d) t
-      type ('a,'d) result
-      val run : ('a,'d) t -> ('a,'d) result
-      val (>>=) : ('a,'d) t -> ('a -> ('b,'d) t) -> ('b,'d) t
-      val hoist : ('a,'d) U.t -> ('a,'d) t
-      val mzero : ('a,'d) t
-    end
-
-    module type MAP22 = sig
-      type ('a,'d) t
-      val mid : 'a -> ('a,'d) t
-      val map2 : ('a -> 'b -> 'c) -> ('a,'d) t -> ('b,'d) t -> ('c,'d) t
-      val map : [`Generate | `Custom of ('a -> 'b) -> ('a,'d) t -> ('b,'d) t]
-      val mapply : [`Generate | `Custom of ('a -> 'b,'d) t -> ('a,'d) t -> ('b,'d) t]
-    end
-
-    module type MAPPLY2 = sig
-      type ('a,'d) t
-      val mid : 'a -> ('a,'d) t
-      val mapply : ('a -> 'b,'d) t -> ('a,'d) t -> ('b,'d) t
-      val map : [`Generate | `Custom of ('a -> 'b) -> ('a,'d) t -> ('b,'d) t]
-      val map2 : [`Generate | `Custom of ('a -> 'b -> 'c) -> ('a,'d) t -> ('b,'d) t -> ('c,'d) t]
-    end
-
-    module Applicative2FromBind(B : BIND2) : APPLICATIVE2 with type ('a,'d) t = ('a,'d) B.t = struct
-      type ('a,'d) t = ('a,'d) B.t
-      let mid = B.mid
-      let (>>=) = B.(>>=)
-      let map = match B.map with
-      | `Custom map -> map
-      | `Generate -> fun f xx -> xx >>= fun x -> mid (f x)
-      let map2 = match B.map2 with
-      | `Custom map2 -> map2
-      | `Generate -> fun f xx yy -> xx >>= fun x -> yy >>= fun y -> mid (f x y)
-      let mapply = match B.map2 with
-      | `Custom map2 -> fun eta -> map2 ident eta
-      | `Generate -> fun ff xx -> ff >>= fun f -> map f xx
-      let (>>) xx yy = xx >>= fun _ -> yy
-      let (<<) xx yy = mapply (map const xx) yy
-    end
-
-    module Applicative2FromMap2(B : MAP22) : APPLICATIVE2 with type ('a,'d) t = ('a,'d) B.t = struct
-      type ('a,'d) t = ('a,'d) B.t
-      let mid = B.mid
-      let map2 = B.map2
-      let mapply = match B.mapply with
-      | `Custom mapply -> mapply
-      | `Generate -> fun eta -> map2 ident eta
-      let map = match B.map with
-      | `Custom map -> map
-      | `Generate -> fun f xx -> mapply (mid f) xx
-      let (>>) xx yy = mapply (map (const ident) xx) yy
-      let (<<) xx yy = mapply (map const xx) yy
-    end
-
-    module Applicative2FromApply(B : MAPPLY2) : APPLICATIVE2 with type ('a,'d) t = ('a,'d) B.t = struct
-      type ('a,'d) t = ('a,'d) B.t
-      let mid = B.mid
-      let mapply = B.mapply
-      let map = match B.map with
-      | `Custom map -> map
-      | `Generate -> fun f xx -> mapply (mid f) xx
-      let map2 = match B.map2 with
-      | `Custom map2 -> map2
-      | `Generate -> fun f xx yy -> mapply (map f xx) yy
-      let (>>) xx yy = mapply (map (const ident) xx) yy
-      let (<<) xx yy = mapply (map const xx) yy
-    end
-
-    module Monad2FromBind(B : BIND2) : MONAD2 with type ('a,'d) t = ('a,'d) B.t and type ('a,'d) result = ('a,'d) B.result = struct
-      let (>>=) = B.(>>=)
-      include Applicative2FromBind(B)
-      type ('a,'d) result = ('a,'d) B.result
-      let run = B.run
-      let (>=>) j k = fun a -> j a >>= k
-      let (<=<) k j = fun a -> j a >>= k
-      let join xxx = xxx >>= ident
-      let ignore xx = map (fun _ -> ()) xx
-      let seq =
-        let rec aux xs = function
-        | [] -> mid (List.rev xs)
-        | xx::xxs -> xx >>= fun x -> aux (x::xs) xxs in
-        fun xxs -> aux [] xxs
-      let rec seq_ignore = function
-        | [] -> mid ()
-        | xx::xxs -> xx >>= fun () -> seq_ignore xxs
-      let do_when res xx = if res then xx else mid ()
-      let do_unless res xx = if res then mid () else xx
-    end
-
-    module Monad2FromComp(B : COMP2) : MONAD2 with type ('a,'d) t = ('a,'d) B.t and type ('a,'d) result = ('a,'d) B.result = struct
-      let (>=>) = B.(>=>)
-      let (<=<) k j = j >=> k
-      let (>>=) xx k = (ident >=> k) xx
-      include Applicative2FromBind(struct include B let (>>=) = (>>=) end)
-      type ('a,'d) result = ('a,'d) B.result
-      let run = B.run
-      let join xxx = xxx >>= ident
-      let ignore xx = map (fun _ -> ()) xx
-      let seq =
-        let rec aux xs = function
-        | [] -> mid (List.rev xs)
-        | xx::xxs -> xx >>= fun x -> aux (x::xs) xxs in
-        fun xxs -> aux [] xxs
-      let rec seq_ignore = function
-        | [] -> mid ()
-        | xx::xxs -> xx >>= fun () -> seq_ignore xxs
-      let do_when res xx = if res then xx else mid ()
-      let do_unless res xx = if res then mid () else xx
-    end
-
-    module Monad2FromJoin(B : JOIN2) : MONAD2 with type ('a,'d) t = ('a,'d) B.t and type ('a,'d) result = ('a,'d) B.result = struct
-      let join = B.join
-      let (>>=) xx k = join (B.map k xx)
-      include Applicative2FromBind(struct include B let (>>=) = (>>=) let map = `Custom B.map end)
-      type ('a,'d) result = ('a,'d) B.result
-      let run = B.run
-      let (>=>) j k = fun a -> j a >>= k
-      let (<=<) k j = fun a -> j a >>= k
-      let ignore xx = map (fun _ -> ()) xx
-      let seq =
-        let rec aux xs = function
-        | [] -> mid (List.rev xs)
-        | xx::xxs -> xx >>= fun x -> aux (x::xs) xxs in
-        fun xxs -> aux [] xxs
-      let rec seq_ignore = function
-        | [] -> mid ()
-        | xx::xxs -> xx >>= fun () -> seq_ignore xxs
-      let do_when res xx = if res then xx else mid ()
-      let do_unless res xx = if res then mid () else xx
-    end
-
-    module Monad2FromT(B : TRANS2) : MONAD2T with type ('a,'d) t = ('a,'d) B.t and type ('a,'d) ut := ('a,'d) B.U.t and type ('a,'d) result = ('a,'d) B.result = struct
-      include Monad2FromBind(struct
-        include B
-        let mid x = hoist U.(mid x)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-      end)
-      let hoist = B.hoist
-    end
-
-    module Monad2FromTUZ(B : TRANSUZ2) : MONADZERO2T with type ('a,'d) t = ('a,'d) B.t and type ('a,'d) ut := ('a,'d) B.U.t and type ('a,'d) result = ('a,'d) B.result = struct
-      include Monad2FromBind(struct
-        include B
-        let mid x = hoist U.(mid x)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-      end)
-      let hoist = B.hoist
-      let mzero = Obj.magic (B.hoist (B.U.mzero)) (* Obj.magic hack to generate enough polymorphism without having to thunk mzero *)
-      let guard res = if res then mid () else mzero
-    end
-
-    module Monad2FromTZ(B : TRANSZ2) : MONADZERO2T with type ('a,'d) t = ('a,'d) B.t and type ('a,'d) ut := ('a,'d) B.U.t and type ('a,'d) result = ('a,'d) B.result = struct
-      include Monad2FromBind(struct
-        include B
-        let mid x = hoist U.(mid x)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-      end)
-      let hoist = B.hoist
-      let mzero = B.mzero
-      let guard res = if res then mid () else mzero
-    end
-
-  end (* Make *)
-
-
-  module type OPTION = sig
-    include MONADZERO with type 'a result = 'a option
-    val test : ('a option -> bool) -> 'a t -> 'a t
-  end
-
-  module type OPTIONT = sig
-    type 'a uresult
-    include MONADT with type 'a result = 'a option uresult
-    val test : ('a option ut -> bool) -> 'a t -> 'a t
-  end
-    
-  module Option = struct
-    include Juli8.Option
-    module type EXTRA = sig
-      type 'a t
-      val test : ('a option (* U.t *) -> bool) -> 'a t -> 'a t
-    end
-    module type EXTRA2 = sig
-      type ('a,'d) t
-      val test : ('a option -> bool) -> ('a,'d) t -> ('a,'d) t
-    end
-    module M : OPTION = struct
-      include Make.MonadFromBind(struct
-        type 'a t = 'a option
-        type 'a result = 'a t let run xx = xx
-        let map = `Custom map let map2 = `Custom map2 let mapply = `Generate
-        let mid = some
-        (* val (>>=) : 'a option -> ('a -> 'b option) -> 'b option *)
-        let (>>=) xx k = match xx with Some x -> (try k x with Match_failure _ -> None) | None -> None
-      end)
-      let mzero = None
-      let guard res : unit t = if res then Some () else None
-      let test p xx = if p xx then xx else None
-    end (* Option.M *)
-    module M2 : sig
-      include MONADZERO2 with type ('a,'d) result = 'a option
-      include EXTRA2 with type ('a,'d) t := ('a,'d) t
-    end = struct
-      include Make.Monad2FromBind(struct
-        type ('a,'d) t = 'a option
-        type ('a,'d) result = ('a,'d) t let run xx = xx
-        let map = `Custom map let map2 = `Custom map2 let mapply = `Generate
-        let mid = some
-        let (>>=) xx k = match xx with Some x -> (try k x with Match_failure _ -> None) | None -> None
-      end)
-      let mzero = None
-      let guard res : (unit,'d) t = if res then Some () else None
-      let test p xx = if p xx then xx else None
-    end (* Option.M2 *)
-    module T(U : MONAD) : OPTIONT with type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      include Make.MonadFromTZ(struct
-        module U = U
-        type 'a t = 'a option U.t
-        type 'a result = 'a option U.result let run xx = U.run xx
-        let hoist uu = U.(uu >>= fun u -> mid (Some u)) 
-        let (>>=) xx k = U.(xx >>= function Some x -> k x | None -> mid None)
-        let mzero = Obj.magic U.(mid None)
-      end)
-      let test p xx = if p xx then xx else U.mid None
-    end (* Option.T *)
-    module T2(U : MONAD2) : sig
-      include MONADZERO2T with type ('a,'d) result = ('a option, 'd) U.result and type ('a,'d) ut := ('a,'d) U.t
-      include EXTRA2 with type ('a,'d) t := ('a,'d) t
-      val test : (('a option,'d) U.t -> bool) -> ('a,'d) t -> ('a,'d) t
-    end = struct
-      include Make.Monad2FromTZ(struct
-        module U = U
-        type ('a,'d) t = ('a option,'d) U.t
-        type ('a,'d) result = ('a option,'d) U.result let run xx = U.run xx
-        let hoist uu = U.(uu >>= fun u -> mid (Some u)) 
-        let (>>=) xx k = U.(xx >>= function Some x -> k x | None -> mid None)
-        let mzero = Obj.magic U.(mid None)
-      end)
-      let test p xx = if p xx then xx else U.mid None
-    end (* Option.T2 *)
-  end (* Option *)
-
-
-  module type LIST = sig
-    include MONADZERO with type 'a result = 'a list
-    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
-    val pick : 'a t -> ('a * 'a t) t (* monadically pick each element *)
-    val test : ('a list -> bool) -> 'a t -> 'a t
-  end
-
-  module type LISTT = sig
-    type 'a uresult
-    include MONADZEROT with type 'a result = 'a list uresult
-    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
-    val pick : 'a t -> ('a * 'a t) t (* monadically pick each element *)
-    val test : ('a list ut -> bool) -> 'a t -> 'a t
-    (*
-        Monadically seq k over box<a>.
-        OptionM.seq (List.map (\a -> OptionM.mid $ a+1) int_list) == (after running)
-        ListOption.distribute (\a -> OptionM.mid $ a+1) int_list == Some [x+1,x+1,...]
-        TreeOption.distribute (\a -> OptionM.mid $ a+1) int_tree: works similarly
-    *)
-    val distribute : ('a -> 'b ut) -> 'a list -> 'b t
-  end
-    
-  module List = struct
-    include Juli8.List
-    module type EXTRA2 = sig
-      type ('a,'d) t
-      val (++) : ('a,'d) t -> ('a,'d) t -> ('a,'d) t
-      val pick : ('a,'d) t -> ('a * ('a,'d) t,'d) t
-      val test : ('a list -> bool) -> ('a,'d) t -> ('a,'d) t
-    end
-    module M : LIST = struct
-      include Make.MonadFromBind(struct
-        type 'a t = 'a list
-        type 'a result = 'a t let run xx = xx
-        let map = `Custom (fun f xs -> map f xs) let map2 = `Custom (fun f xs -> map2 f xs) let mapply = `Generate
-        let mid = singleton
-        let (>>=) xx k = catmap (fun x -> try k x with Match_failure _ -> []) xx
-      end)
-      let mzero = []
-      let guard res : unit t = if res then [()] else []
-      (* (++) has tighter precedence than (>>=) *)
-      let (++) = append
-      let rec pick = function [] -> mzero | x::xs -> mid (x,xs) ++ (pick xs >>= fun (y,ys) -> mid (y, x::ys))
-      let test p xx = if p xx then xx else []
-    end (* List.M *)
-    module M2 : sig
-      include MONADZERO2 with type ('a,'d) result = 'a list
-      include EXTRA2 with type ('a,'d) t := ('a,'d) t
-    end = struct
-      include Make.Monad2FromBind(struct
-        type ('a,'d) t = 'a list
-        type ('a,'d) result = ('a,'d) t let run xx = xx
-        let map = `Custom (fun f xs -> map f xs) let map2 = `Custom (fun f xs -> map2 f xs) let mapply = `Generate
-        let mid = singleton
-        let (>>=) xx k = catmap (fun x -> try k x with Match_failure _ -> []) xx
-      end)
-      let mzero = []
-      let guard res : (unit,'d) t = if res then [()] else []
-      let (++) = append
-      let rec pick = function [] -> mzero | x::xs -> mid (x,xs) ++ (pick xs >>= fun (y,ys) -> mid (y, x::ys))
-      let test p xx = if p xx then xx else []
-    end (* List.M2 *)
-    module T(U : MONAD) : LISTT with type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      let distribute k xs = U.seq (List.map k xs)
-      include Make.MonadFromTZ(struct
-        module U = U
-        type 'a t = 'a list U.t
-        type 'a result = 'a list U.result let run xx = U.run xx
-        let hoist uu = U.(uu >>= fun u -> mid [u]) 
-        let (>>=) xx k = U.(xx >>= fun xs -> distribute k xs >>= fun xss -> mid (concat xss))
-        let mzero = Obj.magic U.(mid [])
-      end)
-      let (++) xx yy = U.(xx >>= fun xs -> yy >>= fun ys -> mid (append xs ys))
-      let rec pick xx = U.(>>=) xx (function [] -> mzero | x::xs -> mid (x, U.(mid xs)) ++ (pick U.(mid xs) >>= fun (y,yy) -> mid (y, U.(yy >>= fun ys -> mid (x::ys)))))
-      let test p xx = if p xx then xx else U.mid []
-    end (* List.T *)
-    module T2(U : MONAD2) : sig
-      include MONADZERO2T with type ('a,'d) result = ('a list,'d) U.result and type ('a,'d) ut := ('a,'d) U.t
-      include EXTRA2 with type ('a,'d) t := ('a,'d) t
-      val test : (('a list,'d) U.t -> bool) -> ('a,'d) t -> ('a,'d) t
-      val distribute : ('a -> ('b,'d) U.t) -> 'a list -> ('b,'d) t
-    end = struct
-      let distribute k xs = U.seq (List.map k xs)
-      include Make.Monad2FromTZ(struct
-        module U = U
-        type ('a,'d) t = ('a list,'d) U.t
-        type ('a,'d) result = ('a list,'d) U.result let run xx = U.run xx
-        let hoist uu = U.(uu >>= fun u -> mid [u]) 
-        let (>>=) xx k = U.(xx >>= fun xs -> distribute k xs >>= fun xss -> mid (concat xss))
-        let mzero = Obj.magic U.(mid [])
-      end)
-      let (++) xx yy = U.(xx >>= fun xs -> yy >>= fun ys -> mid (append xs ys))
-      let rec pick xx = U.(>>=) xx (function [] -> mzero | x::xs -> mid (x, U.(mid xs)) ++ (pick U.(mid xs) >>= fun (y,yy) -> mid (y, U.(yy >>= fun ys -> mid (x::ys)))))
-      let test p xx = if p xx then xx else U.mid []
-    end (* List.T2 *)
-  end (* List *)
-
-
-  (* LTree, unit centers, has natural ++ *)
-  (* ITree, unit leaves, has natural mzero *)
-
-  module type TREE = sig
-    type 'a tree
-    include MONAD with type 'a result = 'a tree
-    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
-  end
-
-  module type TREET = sig
-    type 'a tree
-    type 'a uresult
-    include MONADT with type 'a result = 'a tree uresult
-    val (++) : 'a t -> 'a t -> 'a t (* monadically append *)
-    (*
-        Monadically seq k over box<a>.
-        OptionM.seq (List.map (\a -> OptionM.mid $ a+1) int_list) == (after running)
-        ListOption.distribute (\a -> OptionM.mid $ a+1) int_list == Some [x+1,x+1,...]
-        TreeOption.distribute (\a -> OptionM.mid $ a+1) int_tree: works similarly
-    *)
-    val distribute : ('a -> 'b ut) -> 'a tree -> 'b t
-  end
-
-  module LTree = struct
-    type 'a tree = Leaf of 'a | Branch of 'a tree * 'a tree
-    let branch x y = Branch(x,y)
-    let leaf x = Leaf x
-    let traverse ((++) : 'b -> 'b -> 'b) (k : 'a -> 'b) (xt : 'a tree) : 'b =
-      let rec aux = function
-      | Leaf x -> k x
-      | Branch(l, r) -> (* recursive application of k may delete a branch? *) aux l ++ aux r in
-      aux xt
-    let map (f : 'a -> 'b) (xt : 'a tree) =
-      let rec aux = function
-      | Leaf x -> Leaf (f x)
-      | Branch(l, r) -> Branch(aux l, aux r) in
-      aux xt
-    module M : TREE with type 'a tree := 'a tree = struct
-      include Make.MonadFromBind(struct
-        type 'a t = 'a tree
-        type 'a result = 'a t let run xx = xx
-        let map = `Custom map let map2 = `Generate let mapply = `Generate
-        let mid = leaf
-        let (>>=) xx k = traverse branch k xx
-      end)
-      let (++) xx yy = Branch(xx, yy)
-    end (* Tree.M *)
-    module T(U : MONAD) : TREET with type 'a tree := 'a tree and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      let hoist uu = U.(uu >>= fun u -> mid (Leaf u)) 
-      let distribute k xt = traverse (U.map2 branch) (fun x -> hoist (k x)) xt
-      include Make.MonadFromT(struct
-        module U = U
-        type 'a t = 'a tree U.t
-        type 'a result = 'a tree U.result let run xx = U.run xx
-        let hoist = hoist
-        let join xtt = traverse branch ident xtt
-        let (>>=) xx k = U.(>>=) xx (fun xt -> U.(>>=) (distribute k xt) (fun xtt -> U.mid (join xtt)))
-      end)
-      let (++) xx yy = U.(xx >>= fun xt -> yy >>= fun yt -> mid (Branch(xt,yt)))
-    end (* Tree.T *)
-    module Z(U : MONADZERO) : sig
-      include TREET with type 'a tree := 'a tree and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
-      include ZERO with type 'a t := 'a t
-    end = struct
-      let hoist uu = U.(uu >>= fun u -> mid (Leaf u)) 
-      let distribute k xt = traverse (U.map2 branch) (fun x -> hoist (k x)) xt
-      include Make.MonadFromTUZ(struct
-        module U = U
-        type 'a t = 'a tree U.t
-        type 'a result = 'a tree U.result let run xx = U.run xx
-        let hoist = hoist
-        let join xtt = traverse branch ident xtt
-        let (>>=) xx k = U.(>>=) xx (fun xt -> U.(>>=) (distribute k xt) (fun xtt -> U.mid (join xtt)))
-      end)
-      let (++) xx yy = U.(xx >>= fun xt -> yy >>= fun yt -> mid (Branch(xt,yt)))
-    end (* Tree.Z *)
-  end (* Tree *)
-
-
-  module Identity = struct
-    module M : sig
-      include MONAD with type 'a result = 'a
-    end = struct
-      include Make.MonadFromComp(struct
-        type 'a t = 'a
-        type 'a result = 'a t let run xx = xx
-        let map = `Custom (fun f x -> f x) let map2 = `Custom (fun f x y -> f x y) let mapply = `Custom (fun f x -> f x)
-        let mid = ident
-        let (>=>) j k = fun x -> k (j x)
-      end)
-    end
-  end
-
-
-  module type READER = sig
-    type env
-    include MONAD with type 'a result = env -> 'a
-    val ask : env t
-    val asks : (env -> 'a) -> 'a t
-    val shift : (env -> env) -> 'a t -> 'a t
-  end
-
-  module type READERT = sig
-    type env
-    type 'a uresult
-    include MONADT with type 'a result = env -> 'a uresult
-    val ask : env t
-    val asks : (env -> 'a) -> 'a t
-    val shift : (env -> env) -> 'a t -> 'a t
-  end
-
-  (* must be parameterized on `struct type env = ... end` *)
-  module Reader(E : sig type env end) = struct
-    type env = E.env
-    module M : READER with type env := env = struct
-      include Make.MonadFromBind(struct
-        type 'a t = env -> 'a
-        type 'a result = 'a t let run xx = fun e -> xx e
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-        let mid x = fun e -> x
-        let (>>=) xx k = fun e -> let x = xx e in let xx' = k x in xx' e
-      end)
-      let ask = fun e -> e
-      let asks selector = ask >>= (fun e -> mid (selector e)) (* may fail with Not_found *)
-      let shift modifier xx = fun e -> xx (modifier e)
-    end (* Reader.M *)
-    module T(U : MONAD) : READERT with type env := env and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      include Make.MonadFromT(struct
-        module U = U
-        type 'a t = env -> 'a U.t
-        type 'a result = env -> 'a U.result let run xx = fun e -> U.run (xx e)
-        let hoist uu = fun e -> uu
-        let (>>=) xx k = fun e -> U.(xx e >>= fun x -> k x e)
-      end)
-      let ask = U.mid
-      let asks selector = ask >>= (fun e -> mid (selector e)) (* may fail with Not_found *)
-      let shift modifier xx = fun e -> xx (modifier e)
-    end (* Reader.T *)
-    module Z(U : MONADZERO) : sig
-      include READERT with type env := env and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
-      include ZERO with type 'a t := 'a t
-    end = struct
-      include Make.MonadFromTUZ(struct
-        module U = U
-        type 'a t = env -> 'a U.t
-        type 'a result = env -> 'a U.result let run xx = fun e -> U.run (xx e)
-        let hoist uu = fun e -> uu
-        let (>>=) xx k = fun e -> U.(xx e >>= fun x -> k x e)
-      end)
-      let ask = U.mid
-      let asks selector = ask >>= (fun e -> try mid (selector e) with Not_found -> mzero)
-      let shift modifier xx = fun e -> xx (modifier e)
-    end (* Reader.Z *)
-  end (* Reader *)
-
-
-  module type STATE = sig
-    type store
-    include MONAD with type 'a result = store -> 'a * store
-    val get : store t
-    val gets : (store -> 'a) -> 'a t
-    val put : store -> unit t
-    val modify : (store -> store) -> unit t
-  end
-
-  module type STATET = sig
-    type store
-    type 'a uresult
-    include MONADT with type 'a result = store -> ('a * store) uresult
-    val get : store t
-    val gets : (store -> 'a) -> 'a t
-    val put : store -> unit t
-    val modify : (store -> store) -> unit t
-  end
-
-  (* must be parameterized on `struct type store = ... end` *)
-  module State(S : sig type store end) = struct
-    type store = S.store
-    module M : STATE with type store := store = struct
-      include Make.MonadFromBind(struct
-        type 'a t = store -> 'a * store
-        type 'a result = 'a t let run xx = fun s -> xx s
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-        let mid x = fun s -> x, s
-        let (>>=) xx k = fun s -> let (x,s') = xx s in let xx' = k x in xx' s'
-      end)
-      let get = fun s -> s,s
-      (* `gets viewer` is `map viewer get` *)
-      let gets viewer = fun s -> viewer s, s (* may fail with Not_found *)
-      let put s = fun _ -> (), s
-      let modify modifier = fun s -> (), modifier s
-    end (* State.M *)
-    module T(U : MONAD) : STATET with type store := store and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      include Make.MonadFromT(struct
-        module U = U
-        type 'a t = store -> ('a * store) U.t
-        type 'a result = store -> ('a * store) U.result let run xx = fun s -> U.run (xx s)
-        let hoist uu = fun s -> U.(uu >>= fun u -> mid (u, s))
-        let (>>=) xx k = fun s -> U.(xx s >>= fun (x,s') -> k x s')
-      end)
-      let get = fun s -> U.mid (s,s)
-      let gets viewer = fun s -> U.mid (viewer s, s) (* may fail with Not_found *)
-      let put s = fun _ -> U.mid ((), s)
-      let modify modifier = fun s -> U.mid ((), modifier s)
-    end (* State.T *)
-    module Z(U : MONADZERO) : sig
-      include STATET with type store := store and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
-      include ZERO with type 'a t := 'a t
-    end = struct
-      include Make.MonadFromTUZ(struct
-        module U = U
-        type 'a t = store -> ('a * store) U.t
-        type 'a result = store -> ('a * store) U.result let run xx = fun s -> U.run (xx s)
-        let hoist uu = fun s -> U.(uu >>= fun u -> mid (u, s))
-        let (>>=) xx k = fun s -> U.(xx s >>= fun (x,s') -> k x s')
-      end)
-      let get = fun s -> U.mid (s,s)
-      let gets viewer = fun s -> try U.mid (viewer s, s) with Not_found -> mzero s
-      let put s = fun _ -> U.mid ((), s)
-      let modify modifier = fun s -> U.mid ((), modifier s)
-    end (* State.Z *)
-  end (* State *)
-
-
-  module type REF = sig
-    type ref
-    type value
-    include MONAD with type 'a result = 'a
-    val newref : value -> ref t
-    val deref : ref -> value t
-    val change : ref -> value -> unit t
-  end
-
-  module type REFT = sig
-    type ref
-    type value
-    type 'a uresult
-    include MONADT with type 'a result = 'a uresult
-    val newref : value -> ref t
-    val deref : ref -> value t
-    val change : ref -> value -> unit t
-  end
-
-  (* State with a different interface; must be parameterized on `struct type value = ... end` *)
-  module Ref(V : sig type value end) = struct
-    type ref = int
-    type value = V.value
-    module D = Map.Make(struct type t = ref let compare = compare end)
-    type dict = { next : ref; tree : value D.t }
-    let empty = { next = 0; tree = D.empty }
-    let alloc v d = d.next, { next = succ d.next; tree = D.add d.next v d.tree}
-    let read (k : ref) d = D.find k d.tree
-    let write (k : ref) v d = { next = d.next; tree = D.add k v d.tree }
-    module M : REF with type value := value and type ref := ref = struct
-      include Make.MonadFromBind(struct
-        type 'a t = dict -> 'a * dict
-        type 'a result = 'a let run xx = fst (xx empty)
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-        let mid x = fun s -> x, s
-        let (>>=) xx k = fun s -> let (x,s') = xx s in let xx' = k x in xx' s'
-      end)
-      let newref v = fun s -> alloc v s
-      let deref k = fun s -> read k s, s (* shouldn't fail because k will have an abstract type? and we never GC *)
-      let change k v = fun s -> (), write k v s (* shouldn't allocate because k will have an abstract type *)
-    end (* Ref.M *)
-    module T(U : MONAD) : REFT with type value := value and type ref := ref and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      include Make.MonadFromT(struct
-        module U = U
-        type 'a t = dict -> ('a * dict) U.t
-        type 'a result = 'a U.result let run xx = let uu = U.(xx empty >>= fun (x,s) -> mid x) in U.run uu
-        let hoist uu = fun s -> U.(uu >>= fun u -> mid (u, s))
-        let (>>=) xx k = fun s -> U.(xx s >>= fun (x,s') -> k x s')
-      end)
-      let newref v = fun s -> U.mid (alloc v s)
-      let deref k = fun s -> U.mid (read k s, s)
-      let change k v = fun s -> U.mid ((), write k v s)
-    end (* Ref.T *)
-    module Z(U : MONADZERO) : sig
-      include REFT with type value := value and type ref := ref and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
-      include ZERO with type 'a t := 'a t
-    end = struct
-      include Make.MonadFromTUZ(struct
-        module U = U
-        type 'a t = dict -> ('a * dict) U.t
-        type 'a result = 'a U.result let run xx = let uu = U.(xx empty >>= fun (x,s) -> mid x) in U.run uu
-        let hoist uu = fun s -> U.(uu >>= fun u -> mid (u, s))
-        let (>>=) xx k = fun s -> U.(xx s >>= fun (x,s') -> k x s')
-      end)
-      let newref v = fun s -> U.mid (alloc v s)
-      let deref k = fun s -> U.mid (read k s, s)
-      let change k v = fun s -> U.mid ((), write k v s)
-    end (* Ref.Z *)
-  end (* Ref *)
-
-
-  module type WRITER = sig
-    type log
-    include MONAD with type 'a result = 'a * log
-    val listen : 'a t -> ('a * log) t
-    val listens : (log -> 'b) -> 'a t -> ('a * 'b) t
-    val tell : log -> unit t
-    (* val pass : ('a * (log -> log)) t -> 'a t *)
-    val censor : (log -> log) -> 'a t -> 'a t
-  end
-
-  module type WRITERT = sig
-    type log
-    type 'a uresult
-    include MONADT with type 'a result = ('a * log) uresult
-    val listen : 'a t -> ('a * log) t
-    val listens : (log -> 'b) -> 'a t -> ('a * 'b) t
-    val tell : log -> unit t
-    (* val pass : ('a * (log -> log)) t -> 'a t *)
-    val censor : (log -> log) -> 'a t -> 'a t
-  end
-
-  (* must be parameterized on `struct type log = ... end` *)
-  module Writer(W : sig type log val empty : log val append : log -> log -> log end) = struct
-    type log = W.log
-    module M : WRITER with type log := log = struct
-      include Make.MonadFromBind(struct
-        type 'a t = 'a * log
-        type 'a result = 'a t let run xx = xx
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-        let mid x = x, W.empty
-        let (>>=) (x,w) k = let (y,w') = k x in (y, W.append w w')
-      end)
-      let listen (x,w) = (x,w), w
-      let listens selector xx = listen xx >>= fun (x,w) -> mid (x,selector w) (* filter listen through selector *)
-      let tell entries = (), entries (* add to log *)
-      let pass ((x,c),w) = (x, c w) (* usually use censor *)
-      let censor c xx = pass (xx >>= fun x -> mid (x,c)) (* ==> (x, c w) *)
-    end (* Writer.M *)
-    module T(U : MONAD) : WRITERT with type log := log and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      include Make.MonadFromT(struct
-        module U = U
-        type 'a t = ('a * log) U.t
-        type 'a result = ('a * log) U.result let run xx = U.run xx
-        let hoist uu = U.(uu >>= fun u -> mid (u, W.empty))
-        let (>>=) xx k = U.(xx >>= fun (x,w) -> k x >>= fun (y,w') -> mid (y, W.append w w'))
-      end)
-      let listen xx = U.(xx >>= fun (x,w) -> mid ((x,w),w))
-      let listens selector xx = listen xx >>= fun (x,w) -> mid (x,selector w)
-      let tell entries = U.mid ((), entries)
-      let pass xx = U.(xx >>= fun ((x,c),w) -> mid (x, c w))
-      let censor c xx = pass (xx >>= fun x -> mid (x,c))
-    end (* Writer.T *)
-    module Z(U : MONADZERO) : sig
-      include WRITERT with type log := log and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
-      include ZERO with type 'a t := 'a t
-    end = struct
-      include Make.MonadFromTUZ(struct
-        module U = U
-        type 'a t = ('a * log) U.t
-        type 'a result = ('a * log) U.result let run xx = U.run xx
-        let hoist uu = U.(uu >>= fun u -> mid (u, W.empty))
-        let (>>=) xx k = U.(xx >>= fun (x,w) -> k x >>= fun (y,w') -> mid (y, W.append w w'))
-      end)
-      let listen xx = U.(xx >>= fun (x,w) -> mid ((x,w),w))
-      let listens selector xx = listen xx >>= fun (x,w) -> mid (x,selector w)
-      let tell entries = U.mid ((), entries)
-      let pass xx = U.(xx >>= fun ((x,c),w) -> mid (x, c w))
-      let censor c xx = pass (xx >>= fun x -> mid (x,c))
-    end (* Writer.Z *)
-  end (* Writer *)
-
-
-  module type ERROR = sig
-    type msg
-    type 'a error
-    include MONAD with type 'a result = 'a error
-    val throw : msg -> 'a t
-    val catch : 'a t -> (msg -> 'a t) -> 'a t
-  end
-
-  module type ERRORT = sig
-    type msg
-    type 'a error
-    type 'a uresult
-    include MONADT with type 'a result = 'a uresult (* note the difference from ERROR *)
-    val throw : msg -> 'a t
-    val catch : 'a t -> (msg -> 'a t) -> 'a t
-  end
-
-  (* must be parameterized on `struct type msg = ... end` *)
-  module Error(E : sig type msg exception Exc of msg (* Exc used only by T *) end) = struct
-    type msg = E.msg
-    type 'a error = Error of msg | OK of 'a
-    module M : ERROR with type msg := msg and type 'a error := 'a error = struct
-      include Make.MonadFromBind(struct
-        type 'a t = 'a error
-        type 'a result = 'a t
-        (* note that M.run doesn't raise *)
-        let run xx = xx
-        let map = `Generate let map2 = `Generate let mapply = `Generate
-        let mid x = OK x
-        let (>>=) xx k = match xx with OK x -> k x | Error e -> Error e
-      end)
-      let throw e = Error e
-      let catch xx handler = match xx with OK _ -> xx | Error e -> handler e
-    end (* Error.M *)
-    module T(U : MONAD) : ERRORT with type msg := msg and type 'a error := 'a error and type 'a uresult := 'a U.result and type 'a ut := 'a U.t = struct
-      include Make.MonadFromT(struct
-        module U = U
-        type 'a t = 'a error U.t
-        type 'a result = 'a U.result
-        (* note that T.run does raise *)
-        let run xx = let uu = U.(xx >>= function OK x -> mid x | Error e -> raise (E.Exc e)) in U.run uu
-        let hoist uu = U.(uu >>= fun u -> mid (OK u)) 
-        let (>>=) xx k = U.(xx >>= function OK x -> k x | Error e -> mid (Error e))
-      end)
-      let throw e = U.mid (Error e)
-      let catch xx handler = U.(xx >>= function OK _ as x -> mid x | Error e -> handler e)
-    end (* Error.T *)
-    module Z(U : MONADZERO) : sig
-      include ERRORT with type msg := msg and type 'a error := 'a error and type 'a uresult := 'a U.result and type 'a ut := 'a U.t
-      include ZERO with type 'a t := 'a t
-    end = struct
-      include Make.MonadFromTUZ(struct
-        module U = U
-        type 'a t = 'a error U.t
-        type 'a result = 'a U.result
-        (* we recover from error by using U's mzero; but this discards the error msg *)
-        let run xx = let uu = U.(xx >>= function OK x -> mid x | Error e -> mzero) in U.run uu
-        let hoist uu = U.(uu >>= fun u -> mid (OK u)) 
-        let (>>=) xx k = U.(xx >>= function OK x -> k x | Error e -> mid (Error e))
-      end)
-      let throw e = U.mid (Error e)
-      let catch xx handler = U.(xx >>= function OK _ as x -> mid x | Error e -> handler e)
-    end (* Error.Z *)
-  end (* Error *)
-
-
-  (* predefine some common instances *)
-
-  module Writer1 = Writer(struct type log = string let empty = "" let append s1 s2 = if s2 = "" then s1 else if s1 = "" then s2 else s1 ^ "\n" ^ s2 end)
-
-  module Writer2 = struct
-    include Writer(struct
-      type log = string list
-      let empty = []
-      let append s1 s2 = List.append s2 s1
-    end)
-    (* FIXME these aren't inside M *)
-    let tell_string s = M.tell [s]
-    let tell entries = M.tell (List.rev entries)
-    let run xx = let (x,w) = M.run xx in (x, List.rev w)
-  end
-
-  module Failure = Error(struct type msg = string exception Exc = Failure end)
-
-end (* Monad *)
-
-module Option = Monad.Option
-module List = Monad.List
-
index 10d61e3..bf561aa 100644 (file)
@@ -4,8 +4,8 @@ module rec E : sig
 end = E
 and R : Monad.READER with type env = E.env = struct
   type env = E.env
-  module Made = Monad.Reader(E)
-  include Made.M
+  module R_E = Monad.Reader(E)
+  include = R_E.M
 end
 
 
@@ -33,5 +33,5 @@ let letf ff body = R.(ff >>= fun f -> shift (insert 'f' (E.Fun f)) body)
 (* monadic version of `let x = 2 in let f = \y -> y + x in f 3` *)
 let (expr4 : int R.t) = R.(letx (mid 2) (letf (mid lambda1) (getf >>= fun f -> f (mid 3))))
 
-let res = R.run expr4 env0
+let res = R.run expr4 env0 (* will be 5 *)