pax_global_header00006660000000000000000000000064134633646070014526gustar00rootroot0000000000000052 comment=94c316340e2dc7cf65afcd67acb815cc415360a9 gen-0.5.2/000077500000000000000000000000001346336460700123035ustar00rootroot00000000000000gen-0.5.2/.gitignore000066400000000000000000000002501346336460700142700ustar00rootroot00000000000000.*.swp .*.swo _build *.native *.byte .session TAGS *.docdir *.log setup.data qtest .merlin *.install # BuckleScript node_modules lib/bs lib/ocaml *.bs.js bs-gen-*.tgz gen-0.5.2/.header000066400000000000000000000001241346336460700135310ustar00rootroot00000000000000(* This file is free software, part of gen. See file "license" for more details. *) gen-0.5.2/.ocamlinit000066400000000000000000000000541346336460700142620ustar00rootroot00000000000000#directory "_build/src";; #load "gen.cma";; gen-0.5.2/.ocp-indent000066400000000000000000000000171346336460700143420ustar00rootroot00000000000000match_clause=4 gen-0.5.2/CHANGELOG.md000066400000000000000000000045351346336460700141230ustar00rootroot00000000000000# Changelog # 0.5.2 - explicitly support BuckleScript, and publish to npm as bs-gen - transition to updated dune (jbuilder), and opam 2.0 # 0.5.1 - refactor to use match-with-exception from OCaml 4.02 - transition to jbuilder # 0.5 - fix small problem with safe-string - move to safe-string, for compatibility with 4.06.0 - add optimize() flag to `_tags` - rename parameter of `int_range` from `by` to `step` - add `?(by=1)` to `int_range` # 0.4 - update `GenLabels` with missing functions - add `Gen.peek_n` - add `Gen.peek` - add first draft of `GenM`, an overlay for iterating over monadic values. this module is experimental as of now. - cleanup: * more tests * move all tests to gen.ml using qtest * merge benchmarks into a single file * add ocp-indent file, update header, reindent files * move code to src/ # 0.3 - add `Gen.return` - fix overflow in `Gen.flat_map`; add regression test - opam: depend on ocamlbuild - add functions `Gen.{lines,unlines}` - add `Gen.Restart.of_gen` as a convenient alias to `persistent_lazy` - add `Gen.IO.{with_lines, write_lines}` - update benchmarks to use Benchmark.Tree # 0.2.4 - `GenLabels` module - `fold_while` function - `fold_map` implementation, deprecating `scan` - updated doc to make clear that combinators consume their generator argument - add missing @since; expose infix operators # 0.2.3 - updated .mli to replace "enum" with "gen" - `Gen.persistent_lazy` now exposes caching parameters related to `GenMList.of_gen_lazy` - give control over buffering in `GenMList.of_gen_lazy` - move some code to new modules GenClone and GenMList - add lwt and async style infix map operators - Gen.IO - `to_string`, `of_string`, `to_buffer` - opam file - add `permutations_heap` for array-based permutations; add a corresponding benchmark to compare - license file # 0.2.2 - do not depend on qtest - better combinatorics (`permutations`, `power_set`, `combinations`) -` Gen.{permutations,power_set,combinations}` - `Gen.unfold_scan` - put Gen.S into a new module, `Gen_intf` - `Gen.persistent_lazy` implemented - .merlin files ## 0.2.1 - added many tests using Qtest; fixed 2 bugs - simpler and more efficient unrolled list - unrolled list for Gen.persistent (much better on big generators) ## 0.2 - changed `camlCase` to `this_case` - `take_nth` combinator note: `git log --no-merges previous_version..HEAD --pretty=%s` gen-0.5.2/LICENSE000066400000000000000000000024061346336460700133120ustar00rootroot00000000000000Copyright (c) 2012, Simon Cruanes All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. gen-0.5.2/Makefile000066400000000000000000000011361346336460700137440ustar00rootroot00000000000000 all: build test build: @dune build @install test: @dune runtest --no-buffer --force clean: @dune clean doc: @dune build @doc VERSION=$(shell awk '/^version:/ {print $$2}' gen.opam) update_next_tag: @echo "update version to $(VERSION)..." find -name '*.ml' -or -name '*.mli' | xargs sed -i "s/NEXT_VERSION/$(VERSION)/g" find -name '*.ml' -or -name '*.mli' | xargs sed -i "s/NEXT_RELEASE/$(VERSION)/g" watch: while find src/ bench/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \ echo "============ at `date` ==========" ; \ make ; \ done .PHONY: update_next_tag release gen-0.5.2/README.md000066400000000000000000000032641346336460700135670ustar00rootroot00000000000000# Gen Iterators for OCaml, both restartable and consumable. The implementation keeps a good balance between simplicity and performance. The library is extensively tested using `qtest`. If you find a bug, please report! The documentation can be found [here](http://c-cube.github.io/gen/) the main module is [Gen](https://github.com/c-cube/gen/blob/master/src/gen.mli) and should suffice for 95% of use cases. [Changelog](https://github.com/c-cube/gen/blob/master/CHANGELOG.md) ## Native install Installation in a native OCaml project, via [opam](https://opam.ocaml.org/): ```sh $ opam install gen ``` or, manually, by building the library and running `make install`. Opam is recommended, for it keeps the library up-to-date. ## BuckleScript install Installation in JavaScript, via [BuckleScript](https://bucklescript.github.io/bucklescript/Manual.html), in an [npm](https://npmjs.com/) project: 1. Install this package: ```sh $ npm install bs-gen ``` 2. Manually add `bs-gen` to your `bsconfig.json`'s `bs-dependencies`: ```json "bs-dependencies": [ ... "bs-gen" ], ``` ## Use You can either build and install the library (see "Build"), or just copy files to your own project. The last solution has the benefits that you don't have additional dependencies nor build complications (and it may enable more inlining). If you have comments, requests, or bugfixes, please share them! :-) ## Build There are no dependencies except for `dune` for building. This should work with `OCaml>=4.02` ```sh $ make ``` To build and run tests (requires `oUnit` and `qtest`): ```sh $ opam install oUnit qtest $ make test ``` ## License This code is free, under the BSD license. gen-0.5.2/bench/000077500000000000000000000000001346336460700133625ustar00rootroot00000000000000gen-0.5.2/bench/.merlin000066400000000000000000000000511346336460700146450ustar00rootroot00000000000000S . B ../_build/bench/ REC PKG benchmark gen-0.5.2/bench/run_benchs.ml000066400000000000000000000221271346336460700160460ustar00rootroot00000000000000 module B = Benchmark (* benchmark the "persistent" function *) module Persistent = struct let _sum g = Gen.Restart.fold (+) 0 g module MList = struct type 'a t = 'a node option ref and 'a node = { content : 'a; mutable prev : 'a node; mutable next : 'a node; } let create () = ref None let is_empty d = match !d with | None -> true | Some _ -> false let push_back d x = match !d with | None -> let rec elt = { content = x; prev = elt; next = elt; } in d := Some elt | Some first -> let elt = { content = x; next=first; prev=first.prev; } in first.prev.next <- elt; first.prev <- elt (* conversion to gen *) let to_gen d = fun () -> match !d with | None -> (fun () -> None) | Some first -> let cur = ref first in (* current element of the list *) let stop = ref false in (* are we done yet? *) fun () -> if !stop then None else begin let x = (!cur).content in cur := (!cur).next; (if !cur == first then stop := true); (* EOG, we made a full cycle *) Some x end end (** Store content of the generator in an enum *) let persistent_mlist gen = let l = MList.create () in Gen.iter (MList.push_back l) gen; MList.to_gen l let bench_mlist n = let g = persistent_mlist Gen.(1 -- n) in ignore (_sum g) (** {6 Unrolled mutable list} *) module UnrolledList = struct type 'a node = | Nil | Partial of 'a array * int | Cons of 'a array * 'a node ref let of_gen gen = let start = ref Nil in let chunk_size = ref 16 in let rec fill prev cur = match cur, gen() with | Partial (a,n), None -> prev := Cons (Array.sub a 0 n, ref Nil); () (* done *) | _, None -> prev := cur; () (* done *) | Nil, Some x -> let n = !chunk_size in if n < 4096 then chunk_size := 2 * !chunk_size; fill prev (Partial (Array.make n x, 1)) | Partial (a, n), Some x -> assert (n < Array.length a); a.(n) <- x; if n+1 = Array.length a then begin let r = ref Nil in prev := Cons(a, r); fill r Nil end else fill prev (Partial (a, n+1)) | Cons _, _ -> assert false in fill start !start ; !start let to_gen l () = let cur = ref l in let i = ref 0 in let rec next() = match !cur with | Nil -> None | Cons (a,l') -> if !i = Array.length a then begin cur := !l'; i := 0; next() end else begin let y = a.(!i) in incr i; Some y end | Partial _ -> assert false in next end (** Store content of the generator in an enum *) let persistent_unrolled gen = let l = UnrolledList.of_gen gen in UnrolledList.to_gen l let bench_unrolled n = let g = persistent_unrolled Gen.(1 -- n) in ignore (_sum g) let bench_naive n = let l = Gen.to_rev_list Gen.(1 -- n) in let g = Gen.Restart.of_list (List.rev l) in ignore (_sum g) let bench_current n = let g = Gen.persistent Gen.(1 -- n) in ignore (_sum g) let bench_current_lazy n = let g = Gen.persistent_lazy Gen.(1 -- n) in ignore (_sum g) let bench_current_lazy_no_cache n = let g = Gen.persistent_lazy ~max_chunk_size:16 ~caching:false Gen.(1 -- n) in ignore (_sum g) let () = let open B.Tree in let bench_n n = B.throughputN 2 ~repeat:3 [ "mlist", bench_mlist, n ; "naive", bench_naive, n ; "unrolled", bench_unrolled, n ; "current", bench_current, n ; "current_lazy", bench_current_lazy, n ; "current_lazy_no_cache", bench_current_lazy_no_cache, n ] in let app_int f n = string_of_int n @> lazy (f n) in let app_ints f l = B.Tree.concat (List.map (app_int f) l) in B.Tree.register ( "persistent" @>> app_ints bench_n [100; 1_000; 10_000; 100_000] ) end (* benchmark the "permutation" function *) module Perm = struct module PermState = struct type 'a state = | Done | Base (* bottom machine, yield [] *) | Insert of 'a insert_state and 'a insert_state = { x : 'a; mutable l : 'a list; mutable n : int; (* idx for insertion *) len : int; (* len of [l] *) sub : 'a t; } and 'a t = { mutable st : 'a state; } end let permutations_rec g = let open PermState in (* make a machine for n elements. Invariant: n=len(l) *) let rec make_machine n l = match l with | [] -> assert (n=0); {st=Base} | x :: tail -> let sub = make_machine (n-1) tail in let st = match next sub () with | None -> Done | Some l -> Insert {x;n=0;l;len=n;sub} in {st;} (* next element of the machine *) and next m () = match m.st with | Done -> None | Base -> m.st <- Done; Some [] | Insert ({x;len;n;l;sub} as state) -> if n=len then match next sub () with | None -> m.st <- Done; None | Some l -> state.l <- l; state.n <- 0; next m () else ( state.n <- state.n + 1; Some (insert x n l) ) and insert x n l = match n, l with | 0, _ -> x::l | _, [] -> assert false | _, y::tail -> y :: insert x (n-1) tail in let l = Gen.fold (fun acc x->x::acc) [] g in next (make_machine (List.length l) l) (* Credits to Bernardo Freitas Paulo da Costa for [permutations_heap]! B.R.Heap's algorithm for permutations, cf http://en.wikipedia.org/wiki/Heap%27s_algorithm. Continuation-based recursive formula, model for the state manipulations below: {[ let rec heap_perm k a n = match n with | 0 -> k a | n -> for i = 0 to n-1 do heap_perm k a (n-1); let j = (if n mod 2 = 1 then 0 else i) in let t = a.(j) in a.(j) <- a.(n-1); a.(n-1) <- t done ]} *) (* The state of the permutation machine, containing - the array [a] we're permuting, in the "current permutation"; - the level of recursion [n]: we can permute elements with index < [n] - the stack of values of indices to permute [i] in the list [is] The permutation stops when we have no more elements in the stack [is]. *) module HeapPermState = struct type 'a state = { elts : 'a array; mutable n : int; mutable is : int list; } end let permutations_heap g = let open HeapPermState in let l = Gen.fold (fun acc x->x::acc) [] g in let a = Array.of_list l in let rec next st () = match st.n with | 0 -> begin match st.is with | [] | _::[] -> assert false | 0::i::is' -> (* "Pop state" before returning next element *) st.is <- (i+1)::is'; st.n <- 1; Some (Array.copy a) | _::_::_ -> assert false end | n -> match st.is with | [] -> None | i::is' when i = n -> (* Pop state at end of loop *) st.is <- is'; st.n <- n+1; begin match st.is with | [] -> None (* last loop *) | i::is' -> let j = (if st.n mod 2 = 1 then 0 else i) in let tmp = st.elts.(j) in st.elts.(j) <- st.elts.(n); st.elts.(n) <- tmp; st.is <- (i+1)::is'; next st () end | _::_ -> (* Recurse down and start new loop *) st.n <- n-1; st.is <- 0 :: st.is; next st () in let n = Array.length a in if n = 0 then Gen.empty else next {elts = a; n=n; is=[0]} (* take [len] permutations of [1..n] *) let bench_it n len = Printf.printf "\ntake %d permutations out of [1...%d]\n" len n; let run perm () = let open Gen in perm (1--n) |> take len |> iter (fun _ -> ()) in let res = Benchmark.throughputN 2 [ "perm_rec", run permutations_rec, () ; "perm_heap", run permutations_heap, () ; "current", run Gen.permutations, () ] in Benchmark.tabulate res let bench_n len n = let run perm () = let open Gen in perm (1--n) |> take len |> iter (fun _ -> ()) in B.throughputN 2 ~repeat:3 [ "perm_rec", run permutations_rec, () ; "perm_heap", run permutations_heap, () ; "current", run Gen.permutations, () ] let () = let open B.Tree in let app_int f n = string_of_int n @> lazy (f n) in let app_ints f l = B.Tree.concat (List.map (app_int f) l) in B.Tree.register ( "perm" @>>> [ "len=100" @>> app_ints (bench_n 100) [5; 100; 1_000] ; "len=50_000" @>> app_ints (bench_n 50_000) [100; 1_000] ]) end let () = try B.Tree.run_global () with Arg.Help msg -> print_endline msg gen-0.5.2/bsconfig.json000066400000000000000000000005611346336460700147720ustar00rootroot00000000000000{ "name": "bs-gen", "version": "0.5.2", "sources": [ { "dir": "src", "files": [ "gen.ml", "gen_intf.ml", "genM.ml", "genM_intf.ml", "genMList.ml", "genClone.ml" ] } ], "namespace": false, "package-specs": { "module": "commonjs", "in-source": true }, "suffix": ".bs.js" } gen-0.5.2/dune-project000066400000000000000000000000201346336460700146150ustar00rootroot00000000000000(lang dune 1.1) gen-0.5.2/gen.opam000066400000000000000000000012661346336460700137370ustar00rootroot00000000000000opam-version: "2.0" maintainer: "simon.cruanes.2007@m4x.org" synopsis: "Iterators for OCaml, both restartable and consumable" author: [ "Simon Cruanes" "ELLIOTTCABLE" ] name: "gen" version: "0.5.2" build: [ ["dune" "build" "@install" "-p" name] ["dune" "runtest" "-p" name] {with-test} ["dune" "build" "@doc" "-p" name] {with-doc} ] depends: [ "dune" {build} "base-bytes" "odoc" {with-doc} "qtest" {with-test} "qcheck" {with-test} "qtest" {with-test} ] tags: [ "gen" "iterator" "iter" "fold" ] homepage: "https://github.com/c-cube/gen/" doc: "https://c-cube.github.io/gen/" bug-reports: "https://github.com/c-cube/gen/issues" dev-repo: "git+https://github.com/c-cube/gen.git" gen-0.5.2/package-lock.json000066400000000000000000000005051346336460700155170ustar00rootroot00000000000000{ "name": "bs-gen", "version": "0.5.2", "lockfileVersion": 1, "requires": true, "dependencies": { "bs-platform": { "version": "4.0.3", "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-4.0.3.tgz", "integrity": "sha1-RRDByRXMWxabVxflwK2lLT+Z/5g=", "dev": true } } } gen-0.5.2/package.json000066400000000000000000000016231346336460700145730ustar00rootroot00000000000000{ "name": "bs-gen", "version": "0.5.2", "description": "Simple, efficient iterators for OCaml", "main": "src/gen.bs.js", "scripts": { "prepare": "npm run clean && bsb -make-world", "clean": "bsb -clean-world", "test": "echo \"Error: no test specified\" && exit 1" }, "keywords": [ "BuckleScript", "ReasonML", "OCaml", "generator", "tool", "coro", "coroutine", "async", "iterator" ], "repository": { "type": "git", "url": "git+https://github.com/c-cube/gen.git" }, "contributors": [ "Simon Cruanes ", "ELLIOTTCABLE " ], "license": "BSD-2-Clause", "bugs": { "url": "https://github.com/c-cube/gen/issues" }, "homepage": "http://cedeela.fr/~simon/software/gen", "devDependencies": { "bs-platform": "^4.0.3" }, "peerDependencies": { "bs-platform": ">=4.0.0" } } gen-0.5.2/src/000077500000000000000000000000001346336460700130725ustar00rootroot00000000000000gen-0.5.2/src/dune000066400000000000000000000007071346336460700137540ustar00rootroot00000000000000(rule (targets flambda.flags) (deps (file mkflags.ml)) (mode fallback) (action (run ocaml ./mkflags.ml)) ) (library (name gen) (public_name gen) (wrapped false) (modules Gen GenLabels GenM GenClone GenMList GenM_intf Gen_intf GenLabels_intf) (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -nolabels) (ocamlopt_flags :standard (:include flambda.flags)) (libraries bytes) (inline_tests (backend qtest.lib)) ) gen-0.5.2/src/gen.ml000066400000000000000000001437261346336460700142120ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Restartable generators} *) (** {2 Global type declarations} *) type 'a t = unit -> 'a option type 'a gen = 'a t module type S = Gen_intf.S (*$inject [@@@ocaml.warning "-26"] let pint i = string_of_int i let pilist l = let b = Buffer.create 15 in let fmt = Format.formatter_of_buffer b in Format.fprintf fmt "%a@?" (Gen.pp Format.pp_print_int) (Gen.of_list l); Buffer.contents b let pi2list l = let b = Buffer.create 15 in let fmt = Format.formatter_of_buffer b in Format.fprintf fmt "%a@?" (Gen.pp (fun fmt (a,b) -> Format.fprintf fmt "%d,%d" a b)) (Gen.of_list l); Buffer.contents b let pstrlist l = let b = Buffer.create 15 in let fmt = Format.formatter_of_buffer b in Format.fprintf fmt "%a@?" (Gen.pp Format.pp_print_string) (Gen.of_list l); Buffer.contents b *) (** {2 Transient generators} *) let empty () = None (*$T empty empty |> to_list = [] *) let singleton x = let first = ref true in fun () -> if !first then (first := false; Some x) else None (*$T singleton singleton 1 |> to_list = [1] singleton "foo" |> to_list = ["foo"] *) (*$R let gen = Gen.singleton 42 in OUnit.assert_equal (Some 42) (Gen.get gen); OUnit.assert_equal None (Gen.get gen); let gen = Gen.singleton 42 in OUnit.assert_equal 1 (Gen.length gen); *) let return = singleton let repeat x () = Some x (*$T repeat repeat 42 |> take 3 |> to_list = [42; 42; 42] *) let repeatedly f () = Some (f ()) (*$T repeatedly repeatedly (let r = ref 0 in fun () -> incr r; !r) \ |> take 5 |> to_list = [1;2;3;4;5] *) let iterate x f = let cur = ref x in fun () -> let x = !cur in cur := f !cur; Some x (*$T iterate iterate 0 ((+)1) |> take 5 |> to_list = [0;1;2;3;4] *) let next gen = gen () let get gen = gen () let get_exn gen = match gen () with | Some x -> x | None -> raise (Invalid_argument "Gen.get_exn") (*$R get_exn let g = of_list [1;2;3] in assert_equal 1 (get_exn g); assert_equal 2 (get_exn g); assert_equal 3 (get_exn g); assert_raises (Invalid_argument "Gen.get_exn") (fun () -> get_exn g) *) let junk gen = ignore (gen ()) let rec fold f acc gen = match gen () with | None -> acc | Some x -> fold f (f acc x) gen (*$Q (Q.list Q.small_int) (fun l -> \ of_list l |> fold (fun l x->x::l) [] = List.rev l) *) let reduce f g = let acc = match g () with | None -> raise (Invalid_argument "reduce") | Some x -> x in fold f acc g (* Dual of {!fold}, with a deconstructing operation *) let unfold f acc = let acc = ref acc in fun () -> match f !acc with | None -> None | Some (x, acc') -> acc := acc'; Some x (*$T unfold unfold (fun (prev,cur) -> Some (prev, (cur,prev+cur))) (0,1) \ |> take 7 |> to_list = [0; 1; 1; 2; 3; 5; 8] *) let init ?(limit=max_int) f = let r = ref 0 in fun () -> if !r >= limit then None else let x = f !r in let _ = incr r in Some x (*$T init init ~limit:5 (fun i->i) |> to_list = [0;1;2;3;4] *) let rec iter f gen = match gen() with | None -> () | Some x -> f x; iter f gen (*$R iter let e = Restart.(1 -- 10) in OUnit.assert_equal ~printer:pint 10 (Restart.length e); OUnit.assert_equal [1;2] Restart.(to_list (1 -- 2)); OUnit.assert_equal [1;2;3;4;5] (Restart.to_list (Restart.take 5 e)); *) let iteri f gen = let rec iteri i = match gen() with | None -> () | Some x -> f i x; iteri (i+1) in iteri 0 let is_empty gen = match gen () with | None -> true | Some _ -> false (*$T is_empty empty not (is_empty (singleton 2)) *) let length gen = fold (fun acc _ -> acc + 1) 0 gen (*$Q (Q.list Q.small_int) (fun l -> \ of_list l |> length = List.length l) *) (* useful state *) module RunState = struct type 'a t = | Init | Run of 'a | Stop end let scan f acc g = let open RunState in let state = ref Init in fun () -> match !state with | Init -> state := Run acc; Some acc | Stop -> None | Run acc -> match g() with | None -> state := Stop; None | Some x -> let acc' = f acc x in state := Run acc'; Some acc' (*$T scan scan (fun acc x -> x+1::acc) [] (1--5) |> to_list \ = [[]; [2]; [3;2]; [4;3;2]; [5;4;3;2]; [6;5;4;3;2]] *) let unfold_scan f acc g = let open RunState in let state = ref (Run acc) in fun () -> match !state with | Init -> assert false | Stop -> None | Run acc -> match g() with | None -> state := Stop; None | Some x -> let acc', y = f acc x in state := Run acc'; Some y (*$T unfold_scan unfold_scan (fun acc x -> x+acc,acc) 0 (1--5) |> to_list \ = [0; 1; 3; 6; 10] *) (** {3 Lazy} *) let map f gen = let stop = ref false in fun () -> if !stop then None else match gen() with | None -> stop:= true; None | Some x -> Some (f x) (*$Q map (Q.list Q.small_int) (fun l -> \ let f x = x*2 in \ of_list l |> map f |> to_list = List.map f l) *) (*$R let e = 1 -- 10 in let e' = e >>| string_of_int in OUnit.assert_equal ~printer:pstrlist ["9"; "10"] (Gen.to_list (Gen.drop 8 e')); *) let mapi f = let cnt = ref 0 in let cnt_map x = let i = !cnt in cnt := i + 1; f i x in map cnt_map (*$Q mapi (Q.list Q.small_int) (fun l -> \ let len = List.length l in \ let f i x = i+x+1 in \ of_list l |> mapi f |> to_list |> fun l' -> List.fold_left (+) 0 l'= \ len*(len+1)/2 + List.fold_left (+) 0 l) *) let fold_map f s gen = map (let state = ref s in fun x -> state := f (!state) x; !state) gen (*$T fold_map (+) 0 (1--3) |> to_list = [1;3;6] *) let append gen1 gen2 = let first = ref true in fun () -> if !first then match gen1() with | (Some _) as x -> x | None -> first:=false; gen2() else gen2() (*$Q (Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \ append (of_list l1) (of_list l2) |> to_list = l1 @ l2) *) (*$R let e = Gen.append (1 -- 5) (6 -- 10) in OUnit.assert_equal [10;9;8;7;6;5;4;3;2;1] (Gen.to_rev_list e); *) let flatten next_gen = let open RunState in let state = ref Init in (* get next element *) let rec next () = match !state with | Init -> get_next_gen() | Run gen -> begin match gen () with | None -> get_next_gen () | (Some _) as x -> x end | Stop -> None and get_next_gen() = match next_gen() with | None -> state := Stop; None | Some gen -> state := Run gen; next() in next let flat_map f next_elem = let open RunState in let state = ref Init in let rec next() = match !state with | Init -> get_next_gen() | Run gen -> begin match gen () with | None -> get_next_gen () | (Some _) as x -> x end | Stop -> None and get_next_gen() = match next_elem() with | None -> state:=Stop; None | Some x -> state := Run (f x); next() | exception e -> state := Stop; raise e in next (*$Q flat_map (Q.list Q.small_int) (fun l -> \ let f x = of_list [x;x*2] in \ eq (map f (of_list l) |> flatten) (flat_map f (of_list l))) *) (*$T flat_map (fun x -> if x mod 1_500_000=0 then singleton x else empty) (1 -- 6_000_000) \ |> to_list = [1_500_000; 3_000_000; 4_500_000; 6_000_000] *) (*$R let e = 1 -- 3 in let e' = e >>= (fun x -> x -- (x+1)) in OUnit.assert_equal [1;2;2;3;3;4] (Gen.to_list e'); *) let mem ?(eq=(=)) x gen = let rec mem eq x gen = match gen() with | Some y -> eq x y || mem eq x gen | None -> false in mem eq x gen let take n gen = assert (n >= 0); let count = ref 0 in (* how many yielded elements *) fun () -> if !count = n || !count = ~-1 then None else match gen() with | None -> count := ~-1; None (* indicate stop *) | (Some _) as x -> incr count; x (*$Q (Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \ of_list l |> take n |> length = Pervasives.min n (List.length l)) *) (* call [gen] at most [n] times, and stop *) let rec __drop n gen = if n = 0 then () else match gen() with | Some _ -> __drop (n-1) gen | None -> () let drop n gen = assert (n >= 0); let dropped = ref false in fun () -> if !dropped then gen() else begin (* drop [n] elements and yield the next element *) dropped := true; __drop n gen; gen() end (*$Q (Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \ let g1,g2 = take n (of_list l), drop n (of_list l) in \ append g1 g2 |> to_list = l) *) let nth n gen = assert (n>=0); __drop n gen; match gen () with | None -> raise Not_found | Some x -> x (*$= nth & ~printer:string_of_int 4 (nth 4 (0--10)) 8 (nth 8 (0--10)) *) (*$T (try ignore (nth 11 (1--10)); false with Not_found -> true) *) let take_nth n gen = assert (n>=1); let i = ref n in let rec next() = match gen() with | None -> None | (Some _) as res when !i = n -> i:=1; res | Some _ -> incr i; next() in next let filter p gen = let rec next () = (* wrap exception into option, for next to be tailrec *) match gen() with | None -> None | (Some x) as res -> if p x then res (* yield element *) else next () (* discard element *) in next (*$T filter (fun x ->x mod 2 = 0) (1--10) |> to_list = [2;4;6;8;10] *) let take_while p gen = let stop = ref false in fun () -> if !stop then None else match gen() with | (Some x) as res -> if p x then res else (stop := true; None) | None -> stop:=true; None (*$T take_while (fun x ->x<10) (1--1000) |> eq (1--9) *) let fold_while f s gen = let state = ref s in let rec consume gen = match gen() with | None -> () | Some x -> let acc, cont = f !state x in state := acc; match cont with | `Stop -> () | `Continue -> consume gen in consume gen; !state (*$T fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 \ (of_list [true;true;false;true]) = 2 *) module DropWhileState = struct type t = | Stop | Drop | Yield end (* state machine starts at Drop: Drop: - If next element doesn't satisfy predicate, goto yield - if no more elements, goto stop Yield: - if there is a next element, yield it - if no more elements, goto stop Stop: just return None *) let drop_while p gen = let open DropWhileState in let state = ref Drop in let rec next () = match !state with | Stop -> None | Drop -> begin match gen () with | None -> state := Stop; None | (Some x) as res -> if p x then next() else (state:=Yield; res) end | Yield -> begin match gen () with | None -> state := Stop; None | Some _ as res -> res end in next (*$T drop_while (fun x-> x<10) (1--20) |> eq (10--20) *) let filter_map f gen = (* tailrec *) let rec next () = match gen() with | None -> None | Some x -> match f x with | None -> next() | (Some _) as res -> res in next (*$T filter_map (fun x-> if x mod 2 = 0 then Some (string_of_int x) else None) (1--10) \ |> to_list = List.map string_of_int [2;4;6;8;10] *) (*$R let f x = if x mod 2 = 0 then Some (string_of_int x) else None in let e = Gen.filter_map f (1 -- 10) in OUnit.assert_equal ["2"; "4"; "6"; "8"; "10"] (Gen.to_list e); *) let zip_index gen = let r = ref ~-1 in fun () -> match gen() with | None -> None | Some x -> incr r; Some (!r, x) (*$T zip_index (1--5) |> to_list = [0,1; 1,2; 2,3; 3,4; 4,5] *) let unzip gen = let stop = ref false in let q1 = Queue.create () in let q2 = Queue.create () in let next_left () = if Queue.is_empty q1 then if !stop then None else match gen() with | Some (x,y) -> Queue.push y q2; Some x | None -> stop := true; None else Some (Queue.pop q1) in let next_right () = if Queue.is_empty q2 then if !stop then None else match gen() with | Some (x,y) -> Queue.push x q1; Some y | None -> stop := true; None else Some (Queue.pop q2) in next_left, next_right (*$T unzip (of_list [1,2;3,4]) |> (fun (x,y)-> to_list x, to_list y) \ = ([1;3], [2;4]) *) (*$Q (Q.list (Q.pair Q.small_int Q.small_int)) (fun l -> \ of_list l |> unzip |> (fun (x,y) -> to_list x,to_list y) = \ List.split l) *) (* [partition p l] returns the elements that satisfy [p], and the elements that do not satisfy [p] *) let partition p gen = let qtrue = Queue.create () in let qfalse = Queue.create () in let stop = ref false in let rec nexttrue () = if Queue.is_empty qtrue then if !stop then None else match gen() with | (Some x) as res -> if p x then res else (Queue.push x qfalse; nexttrue()) | None -> stop:=true; None else Some (Queue.pop qtrue) and nextfalse() = if Queue.is_empty qfalse then if !stop then None else match gen() with | (Some x) as res -> if p x then (Queue.push x qtrue; nextfalse()) else res | None -> stop:= true; None else Some (Queue.pop qfalse) in nexttrue, nextfalse (*$T partition (fun x -> x mod 2 = 0) (1--10) |> \ (fun (x,y)->to_list x, to_list y) = ([2;4;6;8;10], [1;3;5;7;9]) *) let rec for_all p gen = match gen() with | None -> true | Some x -> p x && for_all p gen let rec exists p gen = match gen() with | None -> false | Some x -> p x || exists p gen let min ?(lt=fun x y -> x < y) gen = let first = match gen () with | Some x -> x | None -> raise (Invalid_argument "min") in fold (fun min x -> if lt x min then x else min) first gen (*$T min (of_list [1;4;6;0;11; -2]) = ~-2 (try ignore (min empty); false with Invalid_argument _ -> true) *) let max ?(lt=fun x y -> x < y) gen = let first = match gen () with | Some x -> x | None -> raise (Invalid_argument "max") in fold (fun max x -> if lt max x then x else max) first gen (*$T max (of_list [1;4;6;0;11; -2]) = 11 (try ignore (max empty); false with Invalid_argument _ -> true) *) let eq ?(eq=(=)) gen1 gen2 = let rec check () = match gen1(), gen2() with | None, None -> true | Some x1, Some x2 when eq x1 x2 -> check () | _ -> false in check () (*$Q (Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \ eq (of_list l1)(of_list l2) = (l1 = l2)) *) let lexico ?(cmp=Pervasives.compare) gen1 gen2 = let rec lexico () = match gen1(), gen2() with | None, None -> 0 | Some x1, Some x2 -> let c = cmp x1 x2 in if c <> 0 then c else lexico () | Some _, None -> 1 | None, Some _ -> -1 in lexico () let compare ?cmp gen1 gen2 = lexico ?cmp gen1 gen2 (*$Q (Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \ let sign x = if x < 0 then -1 else if x=0 then 0 else 1 in \ sign (compare (of_list l1)(of_list l2)) = sign (Pervasives.compare l1 l2)) *) let rec find p e = match e () with | None -> None | Some x when p x -> Some x | Some _ -> find p e (*$T find (fun x -> x>=5) (1--10) = Some 5 find (fun x -> x>5) (1--4) = None *) let sum e = let rec sum acc = match e() with | None -> acc | Some x -> sum (x+acc) in sum 0 (*$T sum (1--10) = 55 *) (** {2 Multiple Iterators} *) let map2 f e1 e2 = fun () -> match e1(), e2() with | Some x, Some y -> Some (f x y) | _ -> None (*$T map2 (+) (1--5) (1--4) |> eq (of_list [2;4;6;8]) map2 (+) (1--5) (repeat 0) |> eq (1--5) *) let rec iter2 f e1 e2 = match e1(), e2() with | Some x, Some y -> f x y; iter2 f e1 e2 | _ -> () (*$T iter2 let r = ref 0 in iter2 (fun _ _ -> incr r) (1--10) (4--6); !r = 3 *) let rec fold2 f acc e1 e2 = match e1(), e2() with | Some x, Some y -> fold2 f (f acc x y) e1 e2 | _ -> acc let rec for_all2 p e1 e2 = match e1(), e2() with | Some x, Some y -> p x y && for_all2 p e1 e2 | _ -> true let rec exists2 p e1 e2 = match e1(), e2() with | Some x, Some y -> p x y || exists2 p e1 e2 | _ -> false let zip_with f a b = let stop = ref false in fun () -> if !stop then None else match a(), b() with | Some xa, Some xb -> Some (f xa xb) | _ -> stop:=true; None let zip a b = zip_with (fun x y -> x,y) a b (*$Q (Q.list Q.small_int) (fun l -> \ zip_with (fun x y->x,y) (of_list l) (of_list l) \ |> unzip |> fst |> to_list = l) *) (*$R let e = Gen.zip_with (+) (Gen.repeat 1) (4--7) in OUnit.assert_equal [5;6;7;8] (Gen.to_list e); *) (** {3 Complex combinators} *) module MergeState = struct type 'a t = { gens : 'a gen Queue.t; mutable state : my_state; } and my_state = | NewGen (* obtain a new generator and push it in queue *) | YieldAndNew (* yield element from queue, then behave like NewGen *) | Yield (* just yield elements from queue *) | Stop (* no more elements *) end (* state machine starts at NewGen: NewGen: use next_gen to push a new gen into the queue Yield: while the queue is not empty: pop gen g from it if g is empty continue else: pop element x from g push g at back of queue yield x YieldAndNew: mix of Yield and NewGen. if next_gen is exhausted, goto Yield; if queue is empty, goto NewGen Stop: do nothing *) let merge next_gen = let open MergeState in let state = {gens = Queue.create(); state=NewGen;}in (* recursive function to get next element *) let rec next () = match state.state with | Stop -> None | Yield -> (* only yield from generators in state.gens *) if Queue.is_empty state.gens then (state.state <- Stop; None) else let gen = Queue.pop state.gens in begin match gen () with | None -> next() | (Some _) as res -> Queue.push gen state.gens; (* put gen back in queue *) res end | NewGen -> begin match next_gen() with | None -> state.state <- Yield; (* exhausted *) next() | Some gen -> Queue.push gen state.gens; state.state <- YieldAndNew; next() end | YieldAndNew -> (* yield element from queue, then get a new generator *) if Queue.is_empty state.gens then (state.state <- NewGen; next()) else let gen = Queue.pop state.gens in begin match gen () with | None -> state.state <- NewGen; next() | (Some _) as res -> Queue.push gen state.gens; state.state <- NewGen; res end in next (*$T merge (of_list [of_list [1;3;5]; of_list [2;4;6]; of_list [7;8;9]]) \ |> to_list |> List.sort Pervasives.compare = [1;2;3;4;5;6;7;8;9] *) (*$R let e = of_list [1--3; 4--6; 7--9] in let e' = merge e in OUnit.assert_equal [1;2;3;4;5;6;7;8;9] (to_list e' |> List.sort Pervasives.compare); *) let intersection ?(cmp=Pervasives.compare) gen1 gen2 = let x1 = ref (gen1 ()) in let x2 = ref (gen2 ()) in let rec next () = match !x1, !x2 with | Some y1, Some y2 -> let c = cmp y1 y2 in if c = 0 (* equal elements, yield! *) then (x1 := gen1(); x2 := gen2(); Some y1) else if c < 0 (* drop y1 *) then (x1 := gen1 (); next ()) else (* drop y2 *) (x2 := gen2(); next ()) | _ -> None in next (*$T intersection (of_list [1;1;2;3;4;8]) (of_list [1;2;4;5;6;7;8;9]) \ |> to_list = [1;2;4;8] *) let sorted_merge ?(cmp=Pervasives.compare) gen1 gen2 = let x1 = ref (gen1 ()) in let x2 = ref (gen2 ()) in fun () -> match !x1, !x2 with | None, None -> None | (Some y1)as r1, ((Some y2) as r2) -> if cmp y1 y2 <= 0 then (x1 := gen1 (); r1) else (x2 := gen2 (); r2) | (Some _)as r, None -> x1 := gen1 (); r | None, ((Some _)as r) -> x2 := gen2 (); r (*$T sorted_merge (of_list [1;2;2;3;5;10;100]) (of_list [2;4;5;6;11]) \ |> to_list = [1;2;2;2;3;4;5;5;6;10;11;100] *) (*$R [Gen.of_list [1;3;5]; Gen.of_list [0;1;1;3;4;6;10]; Gen.of_list [2;2;11]] |> Gen.sorted_merge_n ?cmp:None |> Gen.to_list |> OUnit.assert_equal ~printer:pilist [0;1;1;1;2;2;3;3;4;5;6;10;11] *) (** {4 Mutable heap (taken from heap.ml to avoid dependencies)} *) module Heap = struct type 'a t = { mutable tree : 'a tree; cmp : 'a -> 'a -> int; } (** A pairing tree heap with the given comparison function *) and 'a tree = | Empty | Node of 'a * 'a tree * 'a tree let empty ~cmp = { tree = Empty; cmp; } let is_empty h = match h.tree with | Empty -> true | Node _ -> false let rec union ~cmp t1 t2 = match t1, t2 with | Empty, _ -> t2 | _, Empty -> t1 | Node (x1, l1, r1), Node (x2, l2, r2) -> if cmp x1 x2 <= 0 then Node (x1, union ~cmp t2 r1, l1) else Node (x2, union ~cmp t1 r2, l2) let insert h x = h.tree <- union ~cmp:h.cmp (Node (x, Empty, Empty)) h.tree let pop h = match h.tree with | Empty -> raise Not_found | Node (x, l, r) -> h.tree <- union ~cmp:h.cmp l r; x end let sorted_merge_n ?(cmp=Pervasives.compare) l = (* make a heap of (value, generator) *) let cmp (v1,_) (v2,_) = cmp v1 v2 in let heap = Heap.empty ~cmp in (* add initial values *) List.iter (fun gen' -> match gen'() with | Some x -> Heap.insert heap (x, gen') | None -> ()) l; fun () -> if Heap.is_empty heap then None else begin let x, gen = Heap.pop heap in match gen() with | Some y -> Heap.insert heap (y, gen); (* insert next value *) Some x | None -> Some x (* gen empty, drop it *) end (*$T sorted_merge_n [of_list [1;2;2;3;5;10;100]; of_list [2;4;5;6;11]; (6--10)] \ |> to_list = [1;2;2;2;3;4;5;5;6;6;7;8;9;10;10;11;100] *) let round_robin ?(n=2) gen = (* array of queues, together with their index *) let qs = Array.init n (fun _ -> Queue.create ()) in let cur = ref 0 in (* get next element for the i-th queue *) let rec next i = let q = qs.(i) in if Queue.is_empty q then update_to_i i (* consume generator *) else Some(Queue.pop q) (* consume [gen] until some element for [i]-th generator is available. *) and update_to_i i = match gen() with | None -> None | Some x -> let j = !cur in cur := (j+1) mod n; (* move cursor to next generator *) let q = qs.(j) in if j = i then begin assert (Queue.is_empty q); Some x (* return the element *) end else begin Queue.push x q; update_to_i i (* continue consuming [gen] *) end in (* generators *) let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in Array.to_list l (*$T round_robin ~n:3 (1--12) |> List.map to_list = \ [[1;4;7;10]; [2;5;8;11]; [3;6;9;12]] *) (*$R let e = Restart.round_robin ~n:2 Restart.(1--10) in match e with | [a;b] -> OUnit.assert_equal [1;3;5;7;9] (Gen.to_list a); OUnit.assert_equal [2;4;6;8;10] (Gen.to_list b) | _ -> OUnit.assert_failure "wrong list lenght" *) (*$R let e = Restart.round_robin ~n:3 Restart.(1 -- 999) in let l = List.map Gen.length e in OUnit.assert_equal [333;333;333] l; *) (* Duplicate the enum into [n] generators (default 2). The generators share the same underlying instance of the enum, so the optimal case is when they are consumed evenly *) let tee ?(n=2) gen = (* array of queues, together with their index *) let qs = Array.init n (fun _ -> Queue.create ()) in let finished = ref false in (* is [gen] exhausted? *) (* get next element for the i-th queue *) let rec next i = if Queue.is_empty qs.(i) then if !finished then None else get_next i (* consume generator *) else Queue.pop qs.(i) (* consume one more element *) and get_next i = match gen() with | Some _ as res -> for j = 0 to n-1 do if j <> i then Queue.push res qs.(j) done; res | None -> finished := true; None in (* generators *) let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in Array.to_list l (*$T tee ~n:3 (1--12) |> List.map to_list = \ [to_list (1--12); to_list (1--12); to_list (1--12)] *) module InterleaveState = struct type 'a t = | Only of 'a gen | Both of 'a gen * 'a gen * bool ref | Stop end (* Yield elements from a and b alternatively *) let interleave gen_a gen_b = let open InterleaveState in let state = ref (Both (gen_a, gen_b, ref true)) in let rec next() = match !state with | Stop -> None | Only g -> begin match g() with | None -> state := Stop; None | (Some _) as res -> res end | Both (g1, g2, r) -> match (if !r then g1() else g2()) with | None -> state := if !r then Only g2 else Only g1; next() | (Some _) as res -> r := not !r; (* swap *) res in next (*$T interleave (repeat 0) (1--5) |> take 10 |> to_list = \ [0;1;0;2;0;3;0;4;0;5] *) (*$R let e1 = Gen.of_list [1;3;5;7;9] in let e2 = Gen.of_list [2;4;6;8;10] in let e = Gen.interleave e1 e2 in OUnit.assert_equal [1;2;3;4;5;6;7;8;9;10] (Gen.to_list e); *) module IntersperseState = struct type 'a t = | Start | YieldElem of 'a option | YieldSep of 'a option (* next val *) | Stop end (* Put [x] between elements of [enum] *) let intersperse x gen = let open IntersperseState in let state = ref Start in let rec next() = match !state with | Stop -> None | YieldElem res -> begin match gen() with | None -> state := Stop | Some _ as res' -> state := YieldSep res' end; res | YieldSep res -> state := YieldElem res; Some x | Start -> match gen() with | None -> state := Stop; None | Some _ as res -> state := YieldElem res; next() in next (*$T intersperse 0 (1--5) |> to_list = [1;0;2;0;3;0;4;0;5] *) (*$R let e = 1 -- 5 in let e' = Gen.intersperse 0 e in OUnit.assert_equal [1;0;2;0;3;0;4;0;5] (Gen.to_list e'); *) (* Cartesian product *) let product gena genb = let all_a = ref [] in let all_b = ref [] in (* cur: current state, i.e., what we have to do next. Can be stop, getLeft/getRight (to obtain next element from first/second generator), or prodLeft/prodRIght to compute the product of an element with a list of already met elements *) let cur = ref `GetLeft in let rec next () = match !cur with | `Stop -> None | `GetLeft -> begin match gena() with | None -> cur := `GetRightOrStop | Some a -> all_a := a :: !all_a; cur := `ProdLeft (a, !all_b) end; next () | `GetRight | `GetRightOrStop -> (* TODO: test *) begin match genb() with | None when !cur = `GetRightOrStop -> cur := `Stop | None -> cur := `GetLeft | Some b -> all_b := b::!all_b; cur := `ProdRight (b, !all_a) end; next () | `ProdLeft (_, []) -> cur := `GetRight; next() | `ProdLeft (x, y::l) -> cur := `ProdLeft (x, l); Some (x, y) | `ProdRight (_, []) -> cur := `GetLeft; next() | `ProdRight (y, x::l) -> cur := `ProdRight (y, l); Some (x, y) in next (*$T product (1--3) (of_list ["a"; "b"]) |> to_list \ |> List.sort Pervasives.compare = \ [1, "a"; 1, "b"; 2, "a"; 2, "b"; 3, "a"; 3, "b"] *) (*$R let printer = pi2list in let e = Gen.product (1--3) (4--5) in OUnit.assert_equal ~printer [1,4; 1,5; 2,4; 2,5; 3,4; 3,5] (List.sort Pervasives.compare (Gen.to_list e)); *) (* Group equal consecutive elements together. *) let group ?(eq=(=)) gen = match gen() with | None -> fun () -> None | Some x -> let cur = ref [x] in let rec next () = (* try to get an element *) let next_x = if !cur = [] then None else gen() in match next_x, !cur with | None, [] -> None | None, l -> cur := []; (* stop *) Some l | Some x, y::_ when eq x y -> cur := x::!cur; next () (* same group *) | Some x, l -> cur := [x]; Some l in next (*$T group (of_list [0;0;0;1;0;2;2;3;4;5;5;5;5;10]) |> to_list = \ [[0;0;0];[1];[0];[2;2];[3];[4];[5;5;5;5];[10]] *) let uniq ?(eq=(=)) gen = let open RunState in let state = ref Init in let rec next() = match !state with | Stop -> None | Init -> begin match gen() with | None -> state:= Stop; None | (Some x) as res -> state := Run x; res end | Run x -> begin match gen() with | None -> state:= Stop; None | (Some y) as res -> if eq x y then next() (* ignore duplicate *) else (state := Run y; res) end in next (*$T uniq (of_list [0;0;0;1;0;2;2;3;4;5;5;5;5;10]) |> to_list = \ [0;1;0;2;3;4;5;10] *) let sort ?(cmp=Pervasives.compare) gen = (* build heap *) let h = Heap.empty ~cmp in iter (Heap.insert h) gen; fun () -> if Heap.is_empty h then None else Some (Heap.pop h) (*$T sort (of_list [0;0;0;1;0;2;2;3;4;5;5;5;-42;5;10]) |> to_list = \ [-42;0;0;0;0;1;2;2;3;4;5;5;5;5;10] *) (* NOTE: using a set is not really possible, because once we have built the set there is no simple way to iterate on it *) let sort_uniq ?(cmp=Pervasives.compare) gen = uniq ~eq:(fun x y -> cmp x y = 0) (sort ~cmp gen) (*$T sort_uniq (of_list [0;0;0;1;0;2;2;3;4;5;42;5;5;42;5;10]) |> to_list = \ [0;1;2;3;4;5;10;42] *) let chunks n e = let rec next () = match e() with | None -> None | Some x -> let a = Array.make n x in fill a 1 and fill a i = (* fill the array. [i]: current index to fill *) if i = n then Some a else match e() with | None -> Some (Array.sub a 0 i) (* last array is not full *) | Some x -> a.(i) <- x; fill a (i+1) in next (*$T chunks 25 (0--100) |> map Array.to_list |> to_list = \ List.map to_list [(0--24); (25--49);(50--74);(75--99);(100--100)] *) (*$Q Q.(list int) (fun l -> \ of_list l |> chunks 25 |> flat_map of_array |> to_list = l) *) (* state of the permutation machine. One machine manages one element [x], and depends on a deeper machine [g] that generates permutations of the list minus this element (down to the empty list). The machine can do two things: - insert the element in the current list of [g], at any position - obtain the next list of [g] *) (* TODO: check https://en.wikipedia.org/wiki/Heap's_algorithm , might be better *) module PermState = struct type 'a state = | Done | Base (* bottom machine, yield [] *) | Insert of 'a insert_state and 'a insert_state = { x : 'a; mutable l : 'a list; mutable n : int; (* idx for insertion *) len : int; (* len of [l] *) sub : 'a t; } and 'a t = { mutable st : 'a state; } end let permutations g = let open PermState in (* make a machine for n elements. Invariant: n=len(l) *) let rec make_machine n l = match l with | [] -> assert (n=0); {st=Base} | x :: tail -> let sub = make_machine (n-1) tail in let st = match next sub () with | None -> Done | Some l -> Insert {x;n=0;l;len=n;sub} in {st;} (* next element of the machine *) and next m () = match m.st with | Done -> None | Base -> m.st <- Done; Some [] | Insert ({x;len;n;l;sub} as state) -> if n=len then match next sub () with | None -> m.st <- Done; None | Some l -> state.l <- l; state.n <- 0; next m () else ( state.n <- state.n + 1; Some (insert x n l) ) and insert x n l = match n, l with | 0, _ -> x::l | _, [] -> assert false | _, y::tail -> y :: insert x (n-1) tail in let l = fold (fun acc x->x::acc) [] g in next (make_machine (List.length l) l) (*$T permutations permutations (1--3) |> to_list |> List.sort Pervasives.compare = \ [[1;2;3]; [1;3;2]; [2;1;3]; [2;3;1]; [3;1;2]; [3;2;1]] permutations empty |> to_list = [[]] permutations (singleton 1) |> to_list = [[1]] *) (* Credits to Bernardo Freitas Paulo da Costa for [permutations_heap]! B.R.Heap's algorithm for permutations, cf http://en.wikipedia.org/wiki/Heap%27s_algorithm. Continuation-based recursive formula, model for the state manipulations below: {[ let rec heap_perm k a n = match n with | 0 -> k a | n -> for i = 0 to n-1 do heap_perm k a (n-1); let j = (if n mod 2 = 1 then 0 else i) in let t = a.(j) in a.(j) <- a.(n-1); a.(n-1) <- t done ]} *) (* The state of the permutation machine, containing - the array [a] we're permuting, in the "current permutation"; - the level of recursion [n]: we can permute elements with index < [n] - the stack of values of indices to permute [i] in the list [is] The permutation stops when we have no more elements in the stack [is]. *) module HeapPermState = struct type 'a state = { elts : 'a array; mutable n : int; mutable is : int list; } end let permutations_heap g = let open HeapPermState in let l = fold (fun acc x->x::acc) [] g in let a = Array.of_list l in let rec next st () = match st.n with | 0 -> begin match st.is with | [] | _::[] -> assert false | 0::i::is' -> (* "Pop state" before returning next element *) st.is <- (i+1)::is'; st.n <- 1; Some (Array.copy a) | _::_::_ -> assert false end | n -> match st.is with | [] -> None | i::is' when i = n -> (* Pop state at end of loop *) st.is <- is'; st.n <- n+1; begin match st.is with | [] -> None (* last loop *) | i::is' -> let j = (if st.n mod 2 = 1 then 0 else i) in let tmp = st.elts.(j) in st.elts.(j) <- st.elts.(n); st.elts.(n) <- tmp; st.is <- (i+1)::is'; next st () end | _::_ -> (* Recurse down and start new loop *) st.n <- n-1; st.is <- 0 :: st.is; next st () in let n = Array.length a in if n = 0 then empty else next {elts = a; n=n; is=[0]} (*$T permutations_heap permutations_heap (1--3) |> to_list |> List.sort Pervasives.compare = \ [[|1;2;3|]; [|1;3;2|]; [|2;1;3|]; [|2;3;1|]; [|3;1;2|]; [|3;2;1|]] permutations_heap empty |> to_list = [] permutations_heap (singleton 1) |> to_list = [[|1|]] *) module CombState = struct type 'a state = | Done | Base | Add of 'a * 'a t * 'a t (* add x at beginning of first; then switch to second *) | Follow of 'a t (* just forward *) and 'a t = { mutable st : 'a state } end let combinations n g = let open CombState in assert (n >= 0); let rec make_state n l = match n, l with | 0, _ -> {st=Base} | _, [] -> {st=Done} | _, x::tail -> let m1 = make_state (n-1) tail in let m2 = make_state n tail in {st=Add(x,m1,m2)} and next m () = match m.st with | Done -> None | Base -> m.st <- Done; Some [] | Follow m -> begin match next m () with | None -> m.st <- Done; None | Some _ as res -> res end | Add (x, m1, m2) -> match next m1 () with | None -> m.st <- Follow m2; next m () | Some l -> Some (x::l) in let l = fold (fun acc x->x::acc) [] g in next (make_state n l) (*$T combinations 2 (1--4) |> map (List.sort Pervasives.compare) \ |> to_list |> List.sort Pervasives.compare = \ [[1;2]; [1;3]; [1;4]; [2;3]; [2;4]; [3;4]] combinations 0 (1--4) |> to_list = [[]] combinations 1 (singleton 1) |> to_list = [[1]] *) module PowerSetState = struct type 'a state = | Done | Base | Add of 'a * 'a t (* add x before any result of m *) | AddTo of 'a list * 'a * 'a t (* yield x::list, then back to Add(x,m) *) and 'a t = { mutable st : 'a state } end let power_set g = let open PowerSetState in let rec make_state l = match l with | [] -> {st=Base} | x::tail -> let m = make_state tail in {st=Add(x,m)} and next m () = match m.st with | Done -> None | Base -> m.st <- Done; Some [] | Add (x,m') -> begin match next m' () with | None -> m.st <- Done; None | Some l as res -> m.st <- AddTo(l,x,m'); res end | AddTo (l, x, m') -> m.st <- Add (x,m'); Some (x::l) in let l = fold (fun acc x->x::acc) [] g in next (make_state l) (*$T power_set (1--3) |> map (List.sort Pervasives.compare) \ |> to_list |> List.sort Pervasives.compare = \ [[]; [1]; [1;2]; [1;2;3]; [1;3]; [2]; [2;3]; [3]] power_set empty |> to_list = [[]] power_set (singleton 1) |> map (List.sort Pervasives.compare) \ |> to_list |> List.sort Pervasives.compare = [[]; [1]] *) (** {3 Conversion} *) let of_list l = let l = ref l in fun () -> match !l with | [] -> None | x::l' -> l := l'; Some x let to_rev_list gen = fold (fun acc x -> x :: acc) [] gen (*$Q (Q.list Q.small_int) (fun l -> \ to_rev_list (of_list l) = List.rev l) *) let to_list gen = List.rev (to_rev_list gen) let to_array gen = let l = to_rev_list gen in match l with | [] -> [| |] | _ -> let a = Array.of_list l in let n = Array.length a in (* reverse array *) for i = 0 to (n-1) / 2 do let tmp = a.(i) in a.(i) <- a.(n-i-1); a.(n-i-1) <- tmp done; a let of_array ?(start=0) ?len a = let len = match len with | None -> Array.length a - start | Some n -> assert (n + start < Array.length a); n in let i = ref start in fun () -> if !i >= start + len then None else (let x = a.(!i) in incr i; Some x) (*$Q (Q.array Q.small_int) (fun a -> \ of_array a |> to_array = a) *) let of_string ?(start=0) ?len s = let len = match len with | None -> String.length s - start | Some n -> assert (n + start < String.length s); n in let i = ref start in fun () -> if !i >= start + len then None else (let x = s.[!i] in incr i; Some x) let to_buffer buf g = iter (Buffer.add_char buf) g let to_string s = let buf = Buffer.create 16 in to_buffer buf s; Buffer.contents buf let rand_int i = repeatedly (fun () -> Random.int i) let int_range ?(step=1) i j = if step = 0 then raise (Invalid_argument "Gen.int_range"); let (>) = if step > 0 then (>) else (<) in let r = ref i in fun () -> let x = !r in if x > j then None else begin r := !r + step; Some x end (*$= & ~printer:Q.Print.(list int) [1;2;3;4] (int_range 1 4 |> to_list) [4;3;2;1] (int_range ~step:~-1 4 1 |> to_list) [6;4;2] (int_range 6 1 ~step:~-2 |> to_list) [] (int_range 4 1 |> to_list) *) let lines g = let buf = Buffer.create 32 in let stop = ref false in let rec next() = if !stop then None else match g() with | None -> stop := true; (* only return a non-empty line *) if Buffer.length buf =0 then None else Some (Buffer.contents buf) | Some '\n' -> let s = Buffer.contents buf in Buffer.clear buf; Some s | Some c -> Buffer.add_char buf c; next () in next (*$= & ~printer:Q.Print.(list string) ["abc"; "de"; ""] (lines (of_string "abc\nde\n\n") |> to_list) *) let unlines g = let st = ref `Next in fun () -> match !st with | `Stop -> None | `Next -> begin match g() with | None -> st := `Stop; None | Some "" -> Some '\n' (* empty line *) | Some s -> st := `Consume (s, 1); Some s.[0] end | `Consume (s, i) when i=String.length s -> st := `Next; Some '\n' | `Consume (s, i) -> st := `Consume (s, i+1); Some s.[i] (*$Q Q.printable_string (fun s -> \ of_string s |> lines |> unlines |> to_string |> String.trim = String.trim s) *) let pp ?(start="") ?(stop="") ?(sep=",") ?(horizontal=false) pp_elem formatter gen = (if horizontal then Format.pp_open_hbox formatter () else Format.pp_open_hvbox formatter 0); Format.pp_print_string formatter start; let rec next is_first = match gen() with | Some x -> if not is_first then begin Format.pp_print_string formatter sep; Format.pp_print_space formatter (); pp_elem formatter x end else pp_elem formatter x; next false | None -> () in next true; Format.pp_print_string formatter stop; Format.pp_close_box formatter () module Infix = struct let (--) = int_range ~step:1 let (>>=) x f = flat_map f x let (>>|) x f = map f x let (>|=) x f = map f x end include Infix module Restart = struct type 'a t = unit -> 'a gen type 'a restartable = 'a t let lift f e = f (e ()) let lift2 f e1 e2 = f (e1 ()) (e2 ()) let empty () = empty let singleton x () = singleton x let return = singleton let iterate x f () = iterate x f let repeat x () = repeat x let unfold f acc () = unfold f acc let init ?limit f () = init ?limit f let cycle enum = assert (not (is_empty (enum ()))); fun () -> let gen = ref (enum ()) in (* start cycle *) let rec next () = match (!gen) () with | (Some _) as res -> res | None -> gen := enum(); next() in next let is_empty e = is_empty (e ()) let fold f acc e = fold f acc (e ()) let reduce f e = reduce f (e ()) let scan f acc e () = scan f acc (e ()) let unfold_scan f acc e () = unfold_scan f acc (e()) let iter f e = iter f (e ()) let iteri f e = iteri f (e ()) let length e = length (e ()) let map f e () = map f (e ()) let mapi f e () = mapi f (e ()) let fold_map f s e () = fold_map f s (e ()) let append e1 e2 () = append (e1 ()) (e2 ()) let flatten e () = flatten (e ()) let flat_map f e () = flat_map f (e ()) let mem ?eq x e = mem ?eq x (e ()) let take n e () = take n (e ()) let drop n e () = drop n (e ()) let nth n e = nth n (e ()) let take_nth n e () = take_nth n (e ()) let filter p e () = filter p (e ()) let take_while p e () = take_while p (e ()) let fold_while f s e = fold_while f s (e ()) let drop_while p e () = drop_while p (e ()) let filter_map f e () = filter_map f (e ()) let zip_with f e1 e2 () = zip_with f (e1 ()) (e2 ()) let zip e1 e2 () = zip (e1 ()) (e2 ()) let zip_index e () = zip_index (e ()) let unzip e = map fst e, map snd e let partition p e = filter p e, filter (fun x -> not (p x)) e let for_all p e = for_all p (e ()) let exists p e = exists p (e ()) let for_all2 p e1 e2 = for_all2 p (e1 ()) (e2 ()) let exists2 p e1 e2 = exists2 p (e1 ()) (e2 ()) let map2 f e1 e2 () = map2 f (e1()) (e2()) let iter2 f e1 e2 = iter2 f (e1()) (e2()) let fold2 f acc e1 e2 = fold2 f acc (e1()) (e2()) let min ?lt e = min ?lt (e ()) let max ?lt e = max ?lt (e ()) let ___eq = eq let eq ?eq e1 e2 = ___eq ?eq (e1 ()) (e2 ()) let lexico ?cmp e1 e2 = lexico ?cmp (e1 ()) (e2 ()) let compare ?cmp e1 e2 = compare ?cmp (e1 ()) (e2 ()) let sum e = sum (e()) let find f e = find f (e()) let merge e () = merge (e ()) let intersection ?cmp e1 e2 () = intersection ?cmp (e1 ()) (e2 ()) let sorted_merge ?cmp e1 e2 () = sorted_merge ?cmp (e1 ()) (e2 ()) let sorted_merge_n ?cmp l () = sorted_merge_n ?cmp (List.map (fun g -> g()) l) let tee ?n e = tee ?n (e ()) let round_robin ?n e = round_robin ?n (e ()) let interleave e1 e2 () = interleave (e1 ()) (e2 ()) let intersperse x e () = intersperse x (e ()) let product e1 e2 () = product (e1 ()) (e2 ()) let group ?eq e () = group ?eq (e ()) let uniq ?eq e () = uniq ?eq (e ()) let sort ?(cmp=Pervasives.compare) enum = fun () -> sort ~cmp (enum ()) let sort_uniq ?(cmp=Pervasives.compare) e = let e' = sort ~cmp e in uniq ~eq:(fun x y -> cmp x y = 0) e' let chunks n e () = chunks n (e()) let permutations g () = permutations (g ()) let permutations_heap g () = permutations_heap (g ()) let combinations n g () = combinations n (g()) let power_set g () = power_set (g()) let of_list l () = of_list l let to_rev_list e = to_rev_list (e ()) let to_list e = to_list (e ()) let to_array e = to_array (e ()) let of_array ?start ?len a () = of_array ?start ?len a let of_string ?start ?len s () = of_string ?start ?len s let to_string s = to_string (s ()) let to_buffer buf s = to_buffer buf (s ()) let rand_int i () = rand_int i let int_range ?step i j () = int_range ?step i j let lines g () = lines (g()) let unlines g () = unlines (g()) module Infix = struct let (--) = int_range ~step:1 let (>>=) x f = flat_map f x let (>>|) x f = map f x let (>|=) x f = map f x end include Infix let pp ?start ?stop ?sep ?horizontal pp_elem fmt e = pp ?start ?stop ?sep ?horizontal pp_elem fmt (e ()) let of_gen ?caching ?max_chunk_size g = let cached = ref None in fun () -> match !cached with | Some mlist -> GenMList.to_gen mlist | None -> let mlist = GenMList.of_gen_lazy ?caching ?max_chunk_size g in cached := Some mlist; GenMList.to_gen mlist end (** {2 Generator functions} *) let start g = g () (** Store content of the generator in an enum *) let persistent gen = let l = GenMList.of_gen gen in fun () -> GenMList.to_gen l (*$T let g = 1--10 in let g' = persistent g in \ Restart.to_list g' = Restart.to_list g' let g = 1--10 in let g' = persistent g in \ Restart.to_list g' = [1;2;3;4;5;6;7;8;9;10] *) (*$R let i = ref 0 in let gen () = let j = !i in if j > 5 then None else (incr i; Some j) in let e = Gen.persistent gen in OUnit.assert_equal [0;1;2;3;4;5] (Restart.to_list e); OUnit.assert_equal [0;1;2;3;4;5] (Restart.to_list e); OUnit.assert_equal [0;1;2;3;4;5] (Restart.to_list e); *) let persistent_lazy ?caching ?max_chunk_size gen = let l = GenMList.of_gen_lazy ?caching ?max_chunk_size gen in fun () -> GenMList.to_gen l (*$T let g = 1--1_000_000_000 in let g' = persistent_lazy g in \ (g' () |> take 100 |> to_list = (1--100 |> to_list)) && \ (g' () |> take 200 |> to_list = (1--200 |> to_list)) *) let peek g = let state = ref `Start in let rec next() = match !state with | `Stop -> None | `At x -> begin match g() with | None -> state := `Stop; Some (x,None) | Some y as res -> state := `At y; Some (x, res) end | `Start -> begin match g() with | None -> state := `Stop; None | Some x -> state := `At x; next() end in next (*$= & ~printer:Q.Print.(list (pair int (option int))) [] (peek (of_list []) |> to_list) [1, Some 2; 2, Some 3; 3, Some 4; 4, None] (peek (1 -- 4) |> to_list) *) (*$Q Q.(list int) (fun l -> \ l = [] || (of_list l |> peek |> filter_map snd |> to_list = List.tl l)) *) let queue_to_array_ q = if Queue.is_empty q then [||] else ( let x = Queue.peek q in let a = Array.make (Queue.length q) x in let i = ref 0 in Queue.iter (fun x -> a.(!i) <- x; incr i) q; a ) let peek_n n g = if n<1 then invalid_arg "peek_n"; let state = ref `Start in let q = Queue.create() in let rec next () = match !state with | `Start -> fill n; state := if Queue.is_empty q then `Stop else `Continue; next () | `Continue -> assert (not (Queue.is_empty q)); let x = Queue.pop q in fill 1; state := if Queue.is_empty q then `Stop else `Continue; Some (x, queue_to_array_ q) | `Stop -> None (* add [n] elements to [f] if possible *) and fill i = assert (i + Queue.length q <= n); if i>0 then match g() with | None -> () | Some x -> Queue.push x q; fill (i-1) in next (*$= & ~printer:Q.Print.(list (pair int (array int))) [] (peek_n 1 (of_list []) |> to_list) [1, [|2;3|]; 2, [|3;4|]; 3, [|4|]; 4, [||]] (peek_n 2 (1 -- 4) |> to_list) [1, [|2;3;4|]; 2, [|3;4;5|]; 3, [|4;5|]; 4, [|5|]; 5,[||]] \ (peek_n 3 (1 -- 5) |> to_list) *) (*$QR Q.(list small_int) (fun l -> let l' = of_list l |> peek_n 10 |> filter_map (fun (_,a) -> if a=[||] then None else Some a.(0)) |> to_list in l = [] || l' = List.tl l) *) (** {2 Basic IO} *) module IO = struct let with_file_in ?(mode=0o644) ?(flags=[]) filename f = let ic = open_in_gen flags mode filename in try let x = f ic in close_in_noerr ic; x with e -> close_in_noerr ic; raise e let with_in ?mode ?flags filename f = with_file_in ?mode ?flags filename (fun ic -> let next() = try Some (input_char ic) with End_of_file -> None in f next ) let with_lines ?mode ?flags filename f = with_file_in ?mode ?flags filename (fun ic -> let next() = try Some (input_line ic) with End_of_file -> None in f next ) let with_file_out ?(mode=0o644) ?(flags=[Open_creat;Open_wronly]) filename f = let oc = open_out_gen flags mode filename in try let x = f oc in close_out oc; x with e -> close_out_noerr oc; raise e let write_str ?mode ?flags ?(sep="") filename g = with_file_out ?mode ?flags filename (fun oc -> iteri (fun i s -> if i>0 then output_string oc sep; output_string oc s ) g ) let write ?mode ?flags filename g = with_file_out ?mode ?flags filename (fun oc -> iter (fun c -> output_char oc c) g ) let write_lines ?mode ?flags filename g = with_file_out ?mode ?flags filename (fun oc -> iter (fun s -> output_string oc s; output_char oc '\n') g ) end gen-0.5.2/src/gen.mli000066400000000000000000000120101346336460700143400ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Generators} Values of type ['a Gen.t] represent a possibly infinite sequence of values of type 'a. One can only iterate once on the sequence, as it is consumed by iteration/deconstruction/access. [None] is returned when the generator is exhausted. The submodule {!Restart} provides utilities to work with {b restartable generators}, that is, functions [unit -> 'a Gen.t] that allow to build as many generators from the same source as needed. *) (** {2 Global type declarations} *) type 'a t = unit -> 'a option (** A generator may be called several times, yielding the next value each time. It returns [None] when no elements remain *) type 'a gen = 'a t module type S = Gen_intf.S (** {2 Transient generators} *) val get : 'a t -> 'a option (** Get the next value *) val next : 'a t -> 'a option (** Synonym for {!get} *) val get_exn : 'a t -> 'a (** Get the next value, or fails @raise Invalid_argument if no element remains *) val junk : 'a t -> unit (** Drop the next value, discarding it. *) val repeatedly : (unit -> 'a) -> 'a t (** Call the same function an infinite number of times (useful for instance if the function is a random generator). *) include S with type 'a t := 'a gen (** Operations on {b transient} generators *) (** {2 Restartable generators} A {i restartable generator} is a function that produces copies of the same generator, on demand. It has the type [unit -> 'a gen] and it is assumed that every generated returned by the function behaves the same (that is, that it traverses the same sequence of elements). *) module Restart : sig type 'a t = unit -> 'a gen type 'a restartable = 'a t include S with type 'a t := 'a restartable val cycle : 'a t -> 'a t (** Cycle through the enum, endlessly. The enum must not be empty. *) val lift : ('a gen -> 'b) -> 'a t -> 'b val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c val of_gen : ?caching:bool -> ?max_chunk_size:int -> 'a gen -> 'a t (** Use {!persistent_lazy} to convert a one-shot generator into a restartable one. See {!GenMList.of_gen_lazy} for more details on parameters. @since 0.4 *) end (** {2 Utils} *) val persistent : 'a t -> 'a Restart.t (** Store content of the transient generator in memory, to be able to iterate on it several times later. If possible, consider using combinators from {!Restart} directly instead. *) val persistent_lazy : ?caching:bool -> ?max_chunk_size:int -> 'a t -> 'a Restart.t (** Same as {!persistent}, but consumes the generator on demand (by chunks). This allows to make a restartable generator out of an ephemeral one, without paying a big cost upfront (nor even consuming it fully). Optional parameters: see {!GenMList.of_gen_lazy}. @since 0.2.2 *) val peek : 'a t -> ('a * 'a option) t (** [peek g] transforms the generator [g] into a generator of [x, Some next] if [x] was followed by [next] in [g], or [x, None] if [x] was the last element of [g] @since 0.4 *) val peek_n : int -> 'a t -> ('a * 'a array) t (** [peek_n n g] iterates on [g], returning along with each element the array of the (at most) [n] elements that follow it immediately @raise Invalid_argument if the int is [< 1] @since 0.4 *) val start : 'a Restart.t -> 'a t (** Create a new transient generator. [start gen] is the same as [gen ()] but is included for readability. *) (** {2 Basic IO} Very basic interface to manipulate files as sequence of chunks/lines. @since 0.2.3 *) module IO : sig val with_in : ?mode:int -> ?flags:open_flag list -> string -> (char t -> 'a) -> 'a (** [with_in filename f] opens [filename] and calls [f g], where [g] is a generator of characters from the file. The generator is only valid within the scope in which [f] is called. *) val with_lines : ?mode:int -> ?flags:open_flag list -> string -> (string t -> 'a) -> 'a (** [with_lines filename f] opens file [filename] and calls [f g], where [g] is a generator that iterates on the lines from the file. Do not use the generator outside of the scope of [f] @since 0.4 *) val write_str : ?mode:int -> ?flags:open_flag list -> ?sep:string -> string -> string t -> unit (** [write_to filename g] writes all strings from [g] into the given file. It takes care of opening and closing the file. Does not add [sep] after the last string. @param mode default [0o644] @param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. @param sep separator between each string (e.g. newline) *) val write : ?mode:int -> ?flags:open_flag list -> string -> char t -> unit (** Same as {!write_str} but with individual characters *) val write_lines : ?mode:int -> ?flags:open_flag list -> string -> string t -> unit (** [write_lines file g] is similar to [write_str file g ~sep:"\n"] but also adds ['\n'] at the end of the file @since 0.4 *) end gen-0.5.2/src/gen.odocl000066400000000000000000000002331346336460700146630ustar00rootroot00000000000000# OASIS_START # DO NOT EDIT (digest: bd697a51498f01cda75ad40b61e3c47d) Gen GenLabels GenClone GenMList Gen_intf GenLabels_intf GenM GenM_intf # OASIS_STOP gen-0.5.2/src/genClone.ml000066400000000000000000000044241346336460700151620ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Clonable Generators} *) type 'a gen = unit -> 'a option class virtual ['a] t = object method virtual gen : 'a gen (** Generator of values tied to this copy *) method virtual clone : 'a t (** Clone the internal state *) end (** A generator that can be cloned as many times as required. *) type 'a clonable = 'a t (** Alias to {!'a t} *) (** {2 Prepend method} *) type 'a prependable = < gen : 'a gen; clone : 'a prependable; prepend : 'a -> unit (** Add value at front position *) > (* helper function for {!to_prependable} *) let rec to_prependable c = let g = c#gen in let st = ref `Fwd in (* state: forward *) let next () = match !st with | `Fwd -> g() | `Yield [] -> assert false | `Yield [x] -> st := `Fwd; Some x | `Yield (x::l) -> st := `Yield l; Some x in object method gen = next method clone = to_prependable (c#clone) method prepend x = st := match !st with | `Fwd -> `Yield [x] | `Yield l -> `Yield (x::l) end (** {2 Misc} *) let rec map f c = let g = c#gen in let next () = match g() with | None -> None | Some x -> Some (f x) in object method gen = next method clone = map f c#clone end (** {2 Basic IO} *) module IO = struct let with_in ?(mode=0o644) ?(flags=[]) filename f = let ic = open_in_gen flags mode filename in let timestamp = ref 0 in (* make a generator at offset [i] *) let rec make i : _ clonable = let state = ref `Not_started in let rec next() = match !state with | `Not_started -> (* initialize by restoring state *) seek_in ic i; incr timestamp; state := `Started !timestamp; next() | `Started t -> (* check whether another iterator was used more recently *) if t < !timestamp then failwith "invalidated iterator"; try Some (input_char ic) with End_of_file -> None in object method clone = let i = pos_in ic in make i method gen = next end in try let x = f (make 0) in close_in_noerr ic; x with e -> close_in_noerr ic; raise e end gen-0.5.2/src/genClone.mli000066400000000000000000000040261346336460700153310ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Clonable Generators} Utils to save the internal state of a generator, and restart from this state. This will and should not work on {i any} iterator, but for some of them (e.g. reading from a file, see {!IO}) it makes a lot of sense. @since 0.2.3 *) type 'a gen = unit -> 'a option type 'a t = < gen : 'a gen; (** Generator of values tied to this copy *) clone : 'a t; (** Clone the internal state *) > (** A generator that can be cloned as many times as required. *) type 'a clonable = 'a t (** Alias to {!'a t} *) (** {2 Prepend method} *) type 'a prependable = < gen : 'a gen; clone : 'a prependable; prepend : 'a -> unit (** Add value at front position *) > val to_prependable : 'a t -> 'a prependable (** {2 Misc} *) val map : ('a -> 'b) -> 'a t -> 'b t (** {2 Low-level Persistency} Example: {[ let g = 1 -- 1000 ;; val g : int t = let c = g |> MList.of_gen_lazy |> MList.to_clonable;; val c : int clonable = c#next |> take 500 |> to_list;; - : int list = [1; 2; 3; .....; 500] let c' = c#clone ;; val c' : int clonable = c |> to_list;; - : int list = [501; 502; ....; 1000] c'#gen |> to_list;; (* c consumed, but not c' *) - : int list = [501; 502; ....; 1000] c#gen |> to_list;; - : int list = [] ]}*) (** {2 IO} *) module IO : sig val with_in : ?mode:int -> ?flags:open_flag list -> string -> (char t -> 'a) -> 'a (** [read filename f] opens [filename] and calls [f g], where [g] is a clonable generator of characters from the file. It can be cloned by calling [g#save] (which saves the position in the file), and used with [g#next]. Distinct clones of [g] shouldn't be used at the same time (otherwise [Failure _] will be raised). Both the generator and save points are only valid within the scope in which [f] is called. *) end gen-0.5.2/src/genLabels.ml000066400000000000000000000000141346336460700153130ustar00rootroot00000000000000include Gen gen-0.5.2/src/genLabels.mli000066400000000000000000000101201346336460700154630ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Generators} Label version of {!Gen} @since 0.2.4 *) (** {2 Global type declarations} *) type 'a t = unit -> 'a option (** A generator may be called several times, yielding the next value each time. It returns [None] when no elements remain *) type 'a gen = 'a t module type S = GenLabels_intf.S (** {2 Transient generators} *) val get : 'a t -> 'a option (** Get the next value *) val next : 'a t -> 'a option (** Synonym for {!get} *) val get_exn : 'a t -> 'a (** Get the next value, or fails @raise Invalid_argument if no element remains *) val junk : 'a t -> unit (** Drop the next value, discarding it. *) val repeatedly : (unit -> 'a) -> 'a t (** Call the same function an infinite number of times (useful for instance if the function is a random generator). *) include S with type 'a t := 'a gen (** Operations on {b transient} generators *) (** {2 Restartable generators} *) module Restart : sig type 'a t = unit -> 'a gen type 'a restartable = 'a t include S with type 'a t := 'a restartable val cycle : 'a t -> 'a t (** Cycle through the enum, endlessly. The enum must not be empty. *) val lift : ('a gen -> 'b) -> 'a t -> 'b val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c end (** {2 Utils} *) val persistent : 'a t -> 'a Restart.t (** Store content of the transient generator in memory, to be able to iterate on it several times later. If possible, consider using combinators from {!Restart} directly instead. *) val persistent_lazy : ?caching:bool -> ?max_chunk_size:int -> 'a t -> 'a Restart.t (** Same as {!persistent}, but consumes the generator on demand (by chunks). This allows to make a restartable generator out of an ephemeral one, without paying a big cost upfront (nor even consuming it fully). Optional parameters: see {!GenMList.of_gen_lazy}. @since 0.2.2 *) val peek : 'a t -> ('a * 'a option) t (** [peek g] transforms the generator [g] into a generator of [x, Some next] if [x] was followed by [next] in [g], or [x, None] if [x] was the last element of [g] @since 0.4 *) val peek_n : n:int -> 'a t -> ('a * 'a array) t (** [peek_n ~n g] iterates on [g], returning along with each element the array of the (at most) [n] elements that follow it immediately @raise Invalid_argument if the int is [< 1] @since 0.4 *) val start : 'a Restart.t -> 'a t (** Create a new transient generator. [start gen] is the same as [gen ()] but is included for readability. *) (** {2 Basic IO} Very basic interface to manipulate files as sequence of chunks/lines. *) module IO : sig val with_in : ?mode:int -> ?flags:open_flag list -> file:string -> (char t -> 'a) -> 'a (** [with_in ~file f] opens [file] and calls [f g], where [g] is a generator of characters from the file. The generator is only valid within the scope in which [f] is called. *) val with_lines : ?mode:int -> ?flags:open_flag list -> file:string -> (string t -> 'a) -> 'a (** [with_lines ~file f] opens file [file] and calls [f g], where [g] is a generator that iterates on the lines from the file. Do not use the generator outside of the scope of [f] @since 0.4 *) val write_str : ?mode:int -> ?flags:open_flag list -> ?sep:string -> file:string -> string t -> unit (** [write_to ~file g] writes all strings from [g] into the given file. It takes care of opening and closing the file. Does not add [sep] after the last string. @param mode default [0o644] @param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. @param sep separator between each string (e.g. newline) *) val write : ?mode:int -> ?flags:open_flag list -> file:string -> char t -> unit (** Same as {!write_str} but with individual characters *) val write_lines : ?mode:int -> ?flags:open_flag list -> file:string -> string t -> unit (** [write_lines ~file g] is similar to [write_str file g ~sep:"\n"] but also adds ['\n'] at the end of the file @since 0.4 *) end gen-0.5.2/src/genLabels_intf.ml000066400000000000000000000316121346336460700163430ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Common signature for transient and restartable generators} The signature {!S} abstracts on a type ['a t], where the [t] can be the type of transient or restartable generators. Some functions specify explicitely that they use ['a gen] (transient generators). *) type 'a gen = unit -> 'a option module type S = sig type 'a t val empty : 'a t (** Empty generator, with no elements *) val singleton : 'a -> 'a t (** One-element generator *) val return : 'a -> 'a t (** Alias to {!singleton} @since 0.3 *) val repeat : 'a -> 'a t (** Repeat same element endlessly *) val iterate : 'a -> ('a -> 'a) -> 'a t (** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *) val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t (** Dual of {!fold}, with a deconstructing operation. It keeps on unfolding the ['b] value into a new ['b], and a ['a] which is yielded, until [None] is returned. *) val init : ?limit:int -> (int -> 'a) -> 'a t (** Calls the function, starting from 0, on increasing indices. If [limit] is provided and is a positive int, iteration will stop at the limit (excluded). For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *) (** {2 Basic combinators} {b Note}: those combinators, applied to generators (not restartable generators) {i consume} their argument. Sometimes they consume it lazily, sometimes eagerly, but in any case once [f gen] has been called (with [f] a combinator), [gen] shouldn't be used anymore. *) val is_empty : _ t -> bool (** Check whether the gen is empty. Pops an element, if any *) val fold : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b (** Fold on the generator, tail-recursively. Consumes the generator. *) val reduce : f:('a -> 'a -> 'a) -> 'a t -> 'a (** Fold on non-empty sequences. Consumes the generator. @raise Invalid_argument on an empty gen *) val scan : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b t (** Like {!fold}, but keeping successive values of the accumulator. Consumes the generator. *) val unfold_scan : ('b -> 'a -> 'b * 'c) -> 'b -> 'a t -> 'c t (** A mix of {!unfold} and {!scan}. The current state is combined with the current element to produce a new state, and an output value of type 'c. @since 0.2.2 *) val iter : f:('a -> unit) -> 'a t -> unit (** Iterate on the gen, consumes it. *) val iteri : f:(int -> 'a -> unit) -> 'a t -> unit (** Iterate on elements with their index in the gen, from 0, consuming it. *) val length : _ t -> int (** Length of an gen (linear time), consuming it *) val map : f:('a -> 'b) -> 'a t -> 'b t (** Lazy map. No iteration is performed now, the function will be called when the result is traversed. *) val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t (** Lazy map with indexing starting from 0. No iteration is performed now, the function will be called when the result is traversed. @since 0.5 *) val fold_map : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b t (** Lazy fold and map. No iteration is performed now, the function will be called when the result is traversed. The result is an iterator over the successive states of the fold. @since 0.2.4 *) val append : 'a t -> 'a t -> 'a t (** Append the two gens; the result contains the elements of the first, then the elements of the second gen. *) val flatten : 'a gen t -> 'a t (** Flatten the generator of generators *) val flat_map : f:('a -> 'b gen) -> 'a t -> 'b t (** Monadic bind; each element is transformed to a sub-gen which is then iterated on, before the next element is processed, and so on. *) val mem : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> bool (** Is the given element, member of the gen? *) val take : int -> 'a t -> 'a t (** Take at most n elements *) val drop : int -> 'a t -> 'a t (** Drop n elements *) val nth : int -> 'a t -> 'a (** n-th element, or Not_found @raise Not_found if the generator contains less than [n] arguments *) val take_nth : int -> 'a t -> 'a t (** [take_nth n g] returns every element of [g] whose index is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list] will return [1;3;5;7;9] *) val filter : f:('a -> bool) -> 'a t -> 'a t (** Filter out elements that do not satisfy the predicate. *) val take_while : f:('a -> bool) -> 'a t -> 'a t (** Take elements while they satisfy the predicate. The initial generator itself is not to be used anymore after this. *) val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> 'a (** Fold elements until (['a, `Stop]) is indicated by the accumulator. @since 0.2.4 *) val drop_while : f:('a -> bool) -> 'a t -> 'a t (** Drop elements while they satisfy the predicate. The initial generator itself should not be used anymore, only the result of [drop_while]. *) val filter_map : f:('a -> 'b option) -> 'a t -> 'b t (** Maps some elements to 'b, drop the other ones *) val zip_index : 'a t -> (int * 'a) t (** Zip elements with their index in the gen *) val unzip : ('a * 'b) t -> 'a t * 'b t (** Unzip into two sequences, splitting each pair *) val partition : f:('a -> bool) -> 'a t -> 'a t * 'a t (** [partition p l] returns the elements that satisfy [p], and the elements that do not satisfy [p] *) val for_all : f:('a -> bool) -> 'a t -> bool (** Is the predicate true for all elements? *) val exists : f:('a -> bool) -> 'a t -> bool (** Is the predicate true for at least one element? *) val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a (** Minimum element, according to the given comparison function. @raise Invalid_argument if the generator is empty *) val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a (** Maximum element, see {!min} @raise Invalid_argument if the generator is empty *) val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** Equality of generators. *) val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int (** Lexicographic comparison of generators. If a generator is a prefix of the other one, it is considered smaller. *) val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int (** Synonym for {! lexico} *) val find : f:('a -> bool) -> 'a t -> 'a option (** [find p e] returns the first element of [e] to satisfy [p], or None. *) val sum : int t -> int (** Sum of all elements *) (** {2 Multiple iterators} *) val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** Map on the two sequences. Stops once one of them is exhausted.*) val iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit (** Iterate on the two sequences. Stops once one of them is exhausted.*) val fold2 : f:('acc -> 'a -> 'b -> 'acc) -> init:'acc -> 'a t -> 'b t -> 'acc (** Fold the common prefix of the two iterators *) val for_all2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool (** Succeeds if all pairs of elements satisfy the predicate. Ignores elements of an iterator if the other runs dry. *) val exists2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool (** Succeeds if some pair of elements satisfy the predicate. Ignores elements of an iterator if the other runs dry. *) val zip_with : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** Combine common part of the gens (stops when one is exhausted) *) val zip : 'a t -> 'b t -> ('a * 'b) t (** Zip together the common part of the gens *) (** {2 Complex combinators} *) val merge : 'a gen t -> 'a t (** Pick elements fairly in each sub-generator. The merge of gens [e1, e2, ... ] picks elements in [e1], [e2], in [e3], [e1], [e2] .... Once a generator is empty, it is skipped; when they are all empty, and none remains in the input, their merge is also empty. For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *) val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t (** Intersection of two sorted sequences. Only elements that occur in both inputs appear in the output *) val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t (** Merge two sorted sequences into a sorted sequence *) val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t (** Sorted merge of multiple sorted sequences *) val tee : ?n:int -> 'a t -> 'a gen list (** Duplicate the gen into [n] generators (default 2). The generators share the same underlying instance of the gen, so the optimal case is when they are consumed evenly *) val round_robin : ?n:int -> 'a t -> 'a gen list (** Split the gen into [n] generators in a fair way. Elements with [index = k mod n] with go to the k-th gen. [n] default value is 2. *) val interleave : 'a t -> 'a t -> 'a t (** [interleave a b] yields an element of [a], then an element of [b], and so on. When a generator is exhausted, this behaves like the other generator. *) val intersperse : 'a -> 'a t -> 'a t (** Put the separator element between all elements of the given gen *) val product : 'a t -> 'b t -> ('a * 'b) t (** Cartesian product, in no predictable order. Works even if some of the arguments are infinite. *) val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t (** Group equal consecutive elements together. *) val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t (** Remove consecutive duplicate elements. Basically this is like [fun e -> map List.hd (group e)]. *) val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t (** Sort according to the given comparison function. The gen must be finite. *) val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t (** Sort and remove duplicates. The gen must be finite. *) val chunks : int -> 'a t -> 'a array t (** [chunks n e] returns a generator of arrays of length [n], composed of successive elements of [e]. The last array may be smaller than [n] *) val permutations : 'a t -> 'a list t (** Permutations of the gen. @since 0.2.2 *) val permutations_heap : 'a t -> 'a array t (** Permutations of the gen, using Heap's algorithm. @since 0.2.3 *) val combinations : int -> 'a t -> 'a list t (** Combinations of given length. The ordering of the elements within each combination is unspecified. Example (ignoring ordering): [combinations 2 (1--3) |> to_list = [[1;2]; [1;3]; [2;3]]] @since 0.2.2 *) val power_set : 'a t -> 'a list t (** All subsets of the gen (in no particular order). The ordering of the elements within each subset is unspecified. @since 0.2.2 *) (** {2 Basic conversion functions} *) val of_list : 'a list -> 'a t (** Enumerate elements of the list *) val to_list : 'a t -> 'a list (** non tail-call trasnformation to list, in the same order *) val to_rev_list : 'a t -> 'a list (** Tail call conversion to list, in reverse order (more efficient) *) val to_array : 'a t -> 'a array (** Convert the gen to an array (not very efficient) *) val of_array : ?start:int -> ?len:int -> 'a array -> 'a t (** Iterate on (a slice of) the given array *) val of_string : ?start:int -> ?len:int -> string -> char t (** Iterate on bytes of the string *) val to_string : char t -> string (** Convert into a string *) val to_buffer : Buffer.t -> char t -> unit (** Consumes the iterator and writes to the buffer *) val rand_int : int -> int t (** Random ints in the given range. *) val int_range : ?step:int -> int -> int -> int t (** [int_range ~step a b] generates integers between [a] and [b], included, with steps of length [step] (1 if omitted). [a] is assumed to be smaller than [b]. [step] must not be null, but it can be negative for decreasing integers. *) val lines : char t -> string t (** Group together chars belonging to the same line @since 0.3 *) val unlines : string t -> char t (** Explode lines into their chars, adding a ['\n'] after each one @since 0.3 *) module Infix : sig val (--) : int -> int -> int t (** Synonym for {! int_range ~by:1} *) val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t (** Monadic bind operator *) val (>>|) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) end val (--) : int -> int -> int t (** Synonym for {! int_range ~by:1} *) val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t (** Monadic bind operator *) val (>>|) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit (** Pretty print the content of the generator on a formatter. *) end gen-0.5.2/src/genM.ml000066400000000000000000000032661346336460700143210ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Monadic Interface} *) module type MONAD = GenM_intf.MONAD module Make(M : MONAD) = struct module M = M let (>>=) = M.(>>=) let (>|=) = M.(>|=) type +'a t = unit -> 'a option M.t let return x = let first = ref true in fun () -> if !first then ( first := false; M.return (Some x) ) else M.return None let sequence_m g () = match g() with | None -> M.return None | Some act -> act >|= fun x -> Some x let map f g () = g() >|= function | None -> None | Some x -> Some (f x) let flat_map f g = let rec next f g () = g() >>= function | None -> M.return None (* done *) | Some x -> let cur = f x in map_from f g cur () and map_from f g cur () = let res = cur() in res >>= function | None -> next f g () | Some _ -> res in next f g let rec fold f acc g = g() >>= function | None -> M.return acc | Some x -> let acc = f acc x in fold f acc g let rec fold_m f acc g = g() >>= function | None -> M.return acc | Some x -> f acc x >>= fun acc -> fold_m f acc g let rec iter f g = g() >>= function | None -> M.return () | Some x -> f x; iter f g let rec iter_s f g = g() >>= function | None -> M.return () | Some x -> f x >>= fun () -> iter_s f g let rec iter_p f g = g() >>= function | None -> M.return () | Some x -> let _ = f x in iter_p f g module Infix = struct let (>|=) x f = map f x let (>>=) x f = flat_map f x end include Infix end gen-0.5.2/src/genM.mli000066400000000000000000000003761346336460700144710ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Monadic Interface} {b status: experimental} @since 0.4 *) module type MONAD = GenM_intf.MONAD module Make(M : MONAD) : GenM_intf.S with module M = M gen-0.5.2/src/genMList.ml000066400000000000000000000066501346336460700151550ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Efficient Mutable Lists} *) type 'a gen = unit -> 'a option type 'a clonable = < gen : 'a gen; (** Generator of values tied to this copy *) clone : 'a clonable; (** Clone the internal state *) > type 'a node = | Nil | Cons of 'a array * int ref * 'a node ref | Cons1 of 'a * 'a node ref | Suspend of 'a gen type 'a t = { start : 'a node ref; (* first node. *) mutable chunk_size : int; max_chunk_size : int; } let _make ~max_chunk_size gen = { start = ref (Suspend gen); chunk_size = 8; max_chunk_size; } let _make_no_buffer gen = { start = ref (Suspend gen); chunk_size = 1; max_chunk_size = 1; } (* increment the size of chunks *) let _incr_chunk_size mlist = if mlist.chunk_size < mlist.max_chunk_size then mlist.chunk_size <- 2 * mlist.chunk_size (* read one chunk of input; return the corresponding node. will potentially change [mlist.chunk_size]. *) let _read_chunk mlist gen = match gen() with | None -> Nil (* done *) | Some x when mlist.max_chunk_size = 1 -> let tail = ref (Suspend gen) in let node = Cons1 (x, tail) in node | Some x -> (* new list node *) let r = ref 1 in let a = Array.make mlist.chunk_size x in let tail = ref (Suspend gen) in let stop = ref false in let node = Cons (a, r, tail) in (* read the rest of the chunk *) while not !stop && !r < mlist.chunk_size do match gen() with | None -> tail := Nil; stop := true | Some x -> a.(!r) <- x; incr r; done; _incr_chunk_size mlist; node (* eager construction *) let of_gen gen = let mlist = _make ~max_chunk_size:4096 gen in let rec _fill prev = match _read_chunk mlist gen with | Nil -> prev := Nil | Suspend _ -> assert false | Cons1 (_, prev') as node -> prev := node; _fill prev' | Cons (_, _, prev') as node -> prev := node; _fill prev' in _fill mlist.start; mlist (* lazy construction *) let of_gen_lazy ?(max_chunk_size=2048) ?(caching=true) gen = if caching then let max_chunk_size = max max_chunk_size 2 in _make ~max_chunk_size gen else _make_no_buffer gen let to_gen l = let cur = ref l.start in let i = ref 0 in let rec next() = match ! !cur with | Nil -> None | Cons1 (x, l') -> cur := l'; Some x | Cons (a,n,l') -> if !i = !n then begin cur := l'; i := 0; next() end else begin let y = a.(!i) in incr i; Some y end | Suspend gen -> let node = _read_chunk l gen in !cur := node; next() in next let to_clonable l : 'a clonable = let rec make node i = let cur = ref node and i = ref i in let rec next() = match ! !cur with | Nil -> None | Cons (a,n,l') -> if !i = !n then begin cur := l'; i := 0; next() end else begin let y = a.(!i) in i := !i+1; Some y end | Cons1 (x, l') -> cur := l'; Some x | Suspend gen -> let node = _read_chunk l gen in (!cur) := node; next() in object method gen = next method clone = make !cur !i end in make l.start 0 gen-0.5.2/src/genMList.mli000066400000000000000000000034751346336460700153300ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Efficient Mutable Lists} Unrolled lists, append-only, used for storing the content of a generator. Example: {[ let g = 1 -- 1000 ;; val g : int t = let c = g |> MList.of_gen_lazy |> MList.to_clonable;; val c : int clonable = c#next |> take 500 |> to_list;; - : int list = [1; 2; 3; .....; 500] let c' = c#clone ;; val c' : int clonable = c |> to_list;; - : int list = [501; 502; ....; 1000] c'#gen |> to_list;; (* c consumed, but not c' *) - : int list = [501; 502; ....; 1000] c#gen |> to_list;; - : int list = [] ]} @since 0.2.3 *) type 'a gen = unit -> 'a option type 'a clonable = < gen : 'a gen; (** Generator of values tied to this copy *) clone : 'a clonable; (** Clone the internal state *) > type 'a t (** An internal append-only storage of elements of type 'a, produced from a generator *) val of_gen : 'a gen -> 'a t (** [of_gen g] consumes [g] to build a mlist *) val of_gen_lazy : ?max_chunk_size:int -> ?caching:bool -> 'a gen -> 'a t (** [of_gen_lazy g] makes a mlist that will read from [g] as required, until [g] is exhausted. Do not use [g] directly after this, or some elements will be absent from the mlist! @param caching if true or absent, values are read from the generator by chunks of increasing size. If false, values are read one by one. @param max_chunk_size if provided and [caching = true], sets the (maximal) size of the internal chunks *) val to_gen : 'a t -> 'a gen (** Iterate on the mlist. This function can be called many times without any problem, the mlist isn't consumable! *) val to_clonable : 'a t -> 'a clonable gen-0.5.2/src/genM_intf.ml000066400000000000000000000022761346336460700153410ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) type 'a gen = unit -> 'a option module type MONAD = sig type +'a t val return : 'a -> 'a t val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (>|=) : 'a t -> ('a -> 'b) -> 'b t end module type S = sig module M : MONAD type +'a t = unit -> 'a option M.t (** A value of type ['a t] is an iterator over values of type ['a] that live in the monad [M.t]. For instance, if [M] is [Lwt], accessing each element might require some IO operation (reading a file, etc.) *) val return : 'a -> 'a t val sequence_m : 'a M.t gen -> 'a t (** From a generator of actions, return an effectful generator *) val map : ('a -> 'b) -> 'a t -> 'b t val flat_map : ('a -> 'b t) -> 'a t -> 'b t val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a M.t val fold_m : ('a -> 'b -> 'a M.t) -> 'a -> 'b t -> 'a M.t val iter : ('a -> unit) -> 'a t -> unit M.t val iter_s : ('a -> unit M.t) -> 'a t -> unit M.t val iter_p : ('a -> unit M.t) -> 'a t -> unit M.t module Infix : sig val (>>=) : 'a t -> ('a -> 'b t) -> 'b t val (>|=) : 'a t -> ('a -> 'b) -> 'b t end include module type of Infix end gen-0.5.2/src/gen_intf.ml000066400000000000000000000316771346336460700152330ustar00rootroot00000000000000 (* This file is free software, part of gen. See file "license" for more details. *) (** {1 Common signature for transient and restartable generators} The signature {!S} abstracts on a type ['a t], where the [t] can be the type of transient or restartable generators. Some functions specify explicitely that they use ['a gen] (transient generators). *) type 'a gen = unit -> 'a option module type S = sig type 'a t val empty : 'a t (** Empty generator, with no elements *) val singleton : 'a -> 'a t (** One-element generator *) val return : 'a -> 'a t (** Alias to {!singleton} @since 0.3 *) val repeat : 'a -> 'a t (** Repeat same element endlessly *) val iterate : 'a -> ('a -> 'a) -> 'a t (** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *) val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t (** Dual of {!fold}, with a deconstructing operation. It keeps on unfolding the ['b] value into a new ['b], and a ['a] which is yielded, until [None] is returned. *) val init : ?limit:int -> (int -> 'a) -> 'a t (** Calls the function, starting from 0, on increasing indices. If [limit] is provided and is a positive int, iteration will stop at the limit (excluded). For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *) (** {2 Basic combinators} {b Note}: those combinators, applied to generators (not restartable generators) {i consume} their argument. Sometimes they consume it lazily, sometimes eagerly, but in any case once [f gen] has been called (with [f] a combinator), [gen] shouldn't be used anymore. *) val is_empty : _ t -> bool (** Check whether the gen is empty. Pops an element, if any *) val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b (** Fold on the generator, tail-recursively. Consumes the generator. *) val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a (** Fold on non-empty sequences. Consumes the generator. @raise Invalid_argument on an empty gen *) val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t (** Like {!fold}, but keeping successive values of the accumulator. Consumes the generator. *) val unfold_scan : ('b -> 'a -> 'b * 'c) -> 'b -> 'a t -> 'c t (** A mix of {!unfold} and {!scan}. The current state is combined with the current element to produce a new state, and an output value of type 'c. @since 0.2.2 *) val iter : ('a -> unit) -> 'a t -> unit (** Iterate on the gen, consumes it. *) val iteri : (int -> 'a -> unit) -> 'a t -> unit (** Iterate on elements with their index in the gen, from 0, consuming it. *) val length : _ t -> int (** Length of an gen (linear time), consuming it *) val map : ('a -> 'b) -> 'a t -> 'b t (** Lazy map. No iteration is performed now, the function will be called when the result is traversed. *) val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t (** Lazy map with indexing starting from 0. No iteration is performed now, the function will be called when the result is traversed. @since 0.5 *) val fold_map : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t (** Lazy fold and map. No iteration is performed now, the function will be called when the result is traversed. The result is an iterator over the successive states of the fold. @since 0.2.4 *) val append : 'a t -> 'a t -> 'a t (** Append the two gens; the result contains the elements of the first, then the elements of the second gen. *) val flatten : 'a gen t -> 'a t (** Flatten the generator of generators *) val flat_map : ('a -> 'b gen) -> 'a t -> 'b t (** Monadic bind; each element is transformed to a sub-gen which is then iterated on, before the next element is processed, and so on. *) val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool (** Is the given element, member of the gen? *) val take : int -> 'a t -> 'a t (** Take at most n elements *) val drop : int -> 'a t -> 'a t (** Drop n elements *) val nth : int -> 'a t -> 'a (** n-th element, or Not_found @raise Not_found if the generator contains less than [n] arguments *) val take_nth : int -> 'a t -> 'a t (** [take_nth n g] returns every element of [g] whose index is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list] will return [1;3;5;7;9] *) val filter : ('a -> bool) -> 'a t -> 'a t (** Filter out elements that do not satisfy the predicate. *) val take_while : ('a -> bool) -> 'a t -> 'a t (** Take elements while they satisfy the predicate. The initial generator itself is not to be used anymore after this. *) val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a (** Fold elements until (['a, `Stop]) is indicated by the accumulator. @since 0.2.4 *) val drop_while : ('a -> bool) -> 'a t -> 'a t (** Drop elements while they satisfy the predicate. The initial generator itself should not be used anymore, only the result of [drop_while]. *) val filter_map : ('a -> 'b option) -> 'a t -> 'b t (** Maps some elements to 'b, drop the other ones *) val zip_index : 'a t -> (int * 'a) t (** Zip elements with their index in the gen *) val unzip : ('a * 'b) t -> 'a t * 'b t (** Unzip into two sequences, splitting each pair *) val partition : ('a -> bool) -> 'a t -> 'a t * 'a t (** [partition p l] returns the elements that satisfy [p], and the elements that do not satisfy [p] *) val for_all : ('a -> bool) -> 'a t -> bool (** Is the predicate true for all elements? *) val exists : ('a -> bool) -> 'a t -> bool (** Is the predicate true for at least one element? *) val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a (** Minimum element, according to the given comparison function. @raise Invalid_argument if the generator is empty *) val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a (** Maximum element, see {!min} @raise Invalid_argument if the generator is empty *) val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool (** Equality of generators. *) val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int (** Lexicographic comparison of generators. If a generator is a prefix of the other one, it is considered smaller. *) val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int (** Synonym for {! lexico} *) val find : ('a -> bool) -> 'a t -> 'a option (** [find p e] returns the first element of [e] to satisfy [p], or None. *) val sum : int t -> int (** Sum of all elements *) (** {2 Multiple iterators} *) val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** Map on the two sequences. Stops once one of them is exhausted.*) val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit (** Iterate on the two sequences. Stops once one of them is exhausted.*) val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc (** Fold the common prefix of the two iterators *) val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool (** Succeeds if all pairs of elements satisfy the predicate. Ignores elements of an iterator if the other runs dry. *) val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool (** Succeeds if some pair of elements satisfy the predicate. Ignores elements of an iterator if the other runs dry. *) val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t (** Combine common part of the gens (stops when one is exhausted) *) val zip : 'a t -> 'b t -> ('a * 'b) t (** Zip together the common part of the gens *) (** {2 Complex combinators} *) val merge : 'a gen t -> 'a t (** Pick elements fairly in each sub-generator. The merge of gens [e1, e2, ... ] picks elements in [e1], [e2], in [e3], [e1], [e2] .... Once a generator is empty, it is skipped; when they are all empty, and none remains in the input, their merge is also empty. For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *) val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t (** Intersection of two sorted sequences. Only elements that occur in both inputs appear in the output *) val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t (** Merge two sorted sequences into a sorted sequence *) val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t (** Sorted merge of multiple sorted sequences *) val tee : ?n:int -> 'a t -> 'a gen list (** Duplicate the gen into [n] generators (default 2). The generators share the same underlying instance of the gen, so the optimal case is when they are consumed evenly *) val round_robin : ?n:int -> 'a t -> 'a gen list (** Split the gen into [n] generators in a fair way. Elements with [index = k mod n] with go to the k-th gen. [n] default value is 2. *) val interleave : 'a t -> 'a t -> 'a t (** [interleave a b] yields an element of [a], then an element of [b], and so on. When a generator is exhausted, this behaves like the other generator. *) val intersperse : 'a -> 'a t -> 'a t (** Put the separator element between all elements of the given gen *) val product : 'a t -> 'b t -> ('a * 'b) t (** Cartesian product, in no predictable order. Works even if some of the arguments are infinite. *) val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t (** Group equal consecutive elements together. *) val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t (** Remove consecutive duplicate elements. Basically this is like [fun e -> map List.hd (group e)]. *) val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t (** Sort according to the given comparison function. The gen must be finite. *) val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t (** Sort and remove duplicates. The gen must be finite. *) val chunks : int -> 'a t -> 'a array t (** [chunks n e] returns a generator of arrays of length [n], composed of successive elements of [e]. The last array may be smaller than [n] *) val permutations : 'a t -> 'a list t (** Permutations of the gen. @since 0.2.2 *) val permutations_heap : 'a t -> 'a array t (** Permutations of the gen, using Heap's algorithm. @since 0.2.3 *) val combinations : int -> 'a t -> 'a list t (** Combinations of given length. The ordering of the elements within each combination is unspecified. Example (ignoring ordering): [combinations 2 (1--3) |> to_list = [[1;2]; [1;3]; [2;3]]] @since 0.2.2 *) val power_set : 'a t -> 'a list t (** All subsets of the gen (in no particular order). The ordering of the elements within each subset is unspecified. @since 0.2.2 *) (** {2 Basic conversion functions} *) val of_list : 'a list -> 'a t (** Enumerate elements of the list *) val to_list : 'a t -> 'a list (** non tail-call trasnformation to list, in the same order *) val to_rev_list : 'a t -> 'a list (** Tail call conversion to list, in reverse order (more efficient) *) val to_array : 'a t -> 'a array (** Convert the gen to an array (not very efficient) *) val of_array : ?start:int -> ?len:int -> 'a array -> 'a t (** Iterate on (a slice of) the given array *) val of_string : ?start:int -> ?len:int -> string -> char t (** Iterate on bytes of the string *) val to_string : char t -> string (** Convert into a string *) val to_buffer : Buffer.t -> char t -> unit (** Consumes the iterator and writes to the buffer *) val rand_int : int -> int t (** Random ints in the given range. *) val int_range : ?step:int -> int -> int -> int t (** [int_range ~step a b] generates integers between [a] and [b], included, with steps of length [step] (1 if omitted). [a] is assumed to be smaller than [b], otherwise the result will be empty. @raise Invalid_argument if [step=0] @param step step between two numbers; must not be zero, but it can be negative for decreasing ranges (@since 0.5). *) val lines : char t -> string t (** Group together chars belonging to the same line @since 0.3 *) val unlines : string t -> char t (** Explode lines into their chars, adding a ['\n'] after each one @since 0.3 *) module Infix : sig val (--) : int -> int -> int t (** Synonym for {! int_range ~by:1} *) val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t (** Monadic bind operator *) val (>>|) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) end val (--) : int -> int -> int t (** Synonym for {! int_range ~by:1} *) val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t (** Monadic bind operator *) val (>>|) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) val (>|=) : 'a t -> ('a -> 'b) -> 'b t (** Infix map operator @since 0.2.3 *) val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool -> (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit (** Pretty print the content of the generator on a formatter. *) end gen-0.5.2/src/mkflags.ml000066400000000000000000000006431346336460700150530ustar00rootroot00000000000000 let () = let major, minor = Scanf.sscanf Sys.ocaml_version "%u.%u" (fun major minor -> major, minor) in let after_4_3 = (major, minor) >= (4, 3) in let flags_file = open_out "flambda.flags" in if after_4_3 then ( output_string flags_file "(-O3 -unbox-closures -unbox-closures-factor 20 -color always)\n"; ) else ( output_string flags_file "()\n"; ); close_out flags_file