├── .github └── workflows │ ├── gh-pages.yml │ └── main.yml ├── .gitignore ├── .header ├── .ocamlinit ├── .ocp-indent ├── CHANGELOG.md ├── LICENSE ├── Makefile ├── README.md ├── bench ├── .merlin └── run_benchs.ml ├── bsconfig.json ├── dune-project ├── gen.opam ├── package-lock.json ├── package.json ├── qtest ├── Makefile └── dune └── src ├── dune ├── gen.ml ├── gen.mli ├── gen.odocl ├── genClone.ml ├── genClone.mli ├── genLabels.ml ├── genLabels.mli ├── genLabels_intf.ml ├── genM.ml ├── genM.mli ├── genMList.ml ├── genMList.mli ├── genM_intf.ml ├── gen_intf.ml ├── mkflags.ml └── mkshims.ml /.github/workflows/gh-pages.yml: -------------------------------------------------------------------------------- 1 | name: github pages 2 | 3 | on: 4 | push: 5 | branches: 6 | - master # Set a branch name to trigger deployment 7 | 8 | jobs: 9 | deploy: 10 | name: Deploy doc 11 | runs-on: ubuntu-latest 12 | steps: 13 | - uses: actions/checkout@main 14 | 15 | - name: Use OCaml 16 | uses: ocaml/setup-ocaml@v2 17 | with: 18 | ocaml-compiler: '4.13.x' 19 | 20 | - name: Pin 21 | run: opam pin -n . 22 | 23 | - name: Depext 24 | run: opam depext -yt gen 25 | 26 | - name: Deps 27 | run: opam install -d . --deps-only 28 | 29 | - name: Build 30 | run: opam exec -- dune build @doc 31 | 32 | - name: Deploy 33 | uses: peaceiris/actions-gh-pages@v3 34 | with: 35 | github_token: ${{ secrets.GITHUB_TOKEN }} 36 | publish_dir: ./_build/default/_doc/_html/ 37 | destination_dir: dev 38 | enable_jekyll: true 39 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: build 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | branches: 8 | - master 9 | jobs: 10 | run: 11 | name: Build 12 | strategy: 13 | matrix: 14 | os: 15 | - macos-latest # too slow 16 | - ubuntu-latest 17 | - windows-latest 18 | ocaml-compiler: 19 | - 4.03 20 | - 4.14 21 | runs-on: ${{ matrix.os }} 22 | steps: 23 | - uses: actions/checkout@main 24 | - uses: ocaml/setup-ocaml@v2 25 | with: 26 | ocaml-compiler: ${{ matrix.ocaml-compiler }} 27 | - run: opam pin -n . 28 | - run: opam depext -yt gen 29 | - run: opam install -t . --deps-only 30 | - run: opam exec -- dune build 31 | - run: opam exec -- dune runtest 32 | if: ${{ matrix.os == 'ubuntu-latest'}} 33 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .*.swp 2 | .*.swo 3 | _build 4 | *.native 5 | *.byte 6 | .session 7 | TAGS 8 | *.docdir 9 | *.log 10 | setup.data 11 | qtest 12 | .merlin 13 | *.install 14 | 15 | # BuckleScript 16 | node_modules 17 | lib/bs 18 | lib/ocaml 19 | *.bs.js 20 | bs-gen-*.tgz 21 | -------------------------------------------------------------------------------- /.header: -------------------------------------------------------------------------------- 1 | (* This file is free software, part of gen. See file "license" for more details. *) 2 | -------------------------------------------------------------------------------- /.ocamlinit: -------------------------------------------------------------------------------- 1 | #directory "_build/src";; 2 | #load "gen.cma";; 3 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | match_clause=4 2 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | ## 1.1 4 | 5 | - remove deps on bytes and dune-configurator (@nojb) 6 | 7 | ## 1.0 8 | 9 | - add `{of_seq,to_iter,persistent_to_seq,persistent_lazy_to_seq}` 10 | - depend on seq 11 | - manual use of qtest, remove the qtestlib backend (more robust) 12 | 13 | ## 0.5.3 14 | 15 | - fix npm-package contents to actually include compiled output. (oops!) 16 | 17 | ## 0.5.2 18 | 19 | - explicitly support BuckleScript, and publish to npm as bs-gen 20 | - transition to updated dune (jbuilder), and opam 2.0 21 | 22 | ## 0.5.1 23 | 24 | - refactor to use match-with-exception from OCaml 4.02 25 | - transition to jbuilder 26 | 27 | ## 0.5 28 | 29 | - fix small problem with safe-string 30 | - move to safe-string, for compatibility with 4.06.0 31 | - add optimize() flag to `_tags` 32 | - rename parameter of `int_range` from `by` to `step` 33 | - add `?(by=1)` to `int_range` 34 | 35 | ## 0.4 36 | 37 | - update `GenLabels` with missing functions 38 | - add `Gen.peek_n` 39 | - add `Gen.peek` 40 | - add first draft of `GenM`, an overlay for iterating over monadic values. 41 | this module is experimental as of now. 42 | - cleanup: 43 | * more tests 44 | * move all tests to gen.ml using qtest 45 | * merge benchmarks into a single file 46 | * add ocp-indent file, update header, reindent files 47 | * move code to src/ 48 | 49 | ## 0.3 50 | 51 | - add `Gen.return` 52 | - fix overflow in `Gen.flat_map`; add regression test 53 | - opam: depend on ocamlbuild 54 | - add functions `Gen.{lines,unlines}` 55 | - add `Gen.Restart.of_gen` as a convenient alias to `persistent_lazy` 56 | - add `Gen.IO.{with_lines, write_lines}` 57 | - update benchmarks to use Benchmark.Tree 58 | 59 | ## 0.2.4 60 | 61 | - `GenLabels` module 62 | - `fold_while` function 63 | - `fold_map` implementation, deprecating `scan` 64 | - updated doc to make clear that combinators consume their generator argument 65 | - add missing @since; expose infix operators 66 | 67 | ## 0.2.3 68 | 69 | - updated .mli to replace "enum" with "gen" 70 | - `Gen.persistent_lazy` now exposes caching parameters related to `GenMList.of_gen_lazy` 71 | - give control over buffering in `GenMList.of_gen_lazy` 72 | - move some code to new modules GenClone and GenMList 73 | - add lwt and async style infix map operators 74 | - Gen.IO 75 | - `to_string`, `of_string`, `to_buffer` 76 | - opam file 77 | - add `permutations_heap` for array-based permutations; add a corresponding benchmark to compare 78 | - license file 79 | 80 | ## 0.2.2 81 | 82 | - do not depend on qtest 83 | - better combinatorics (`permutations`, `power_set`, `combinations`) 84 | -` Gen.{permutations,power_set,combinations}` 85 | - `Gen.unfold_scan` 86 | - put Gen.S into a new module, `Gen_intf` 87 | - `Gen.persistent_lazy` implemented 88 | - .merlin files 89 | 90 | ## 0.2.1 91 | 92 | - added many tests using Qtest; fixed 2 bugs 93 | - simpler and more efficient unrolled list 94 | - unrolled list for Gen.persistent (much better on big generators) 95 | 96 | ## 0.2 97 | 98 | - changed `camlCase` to `this_case` 99 | - `take_nth` combinator 100 | 101 | note: `git log --no-merges previous_version..HEAD --pretty=%s` 102 | 103 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2012, Simon Cruanes 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions are met: 6 | 7 | Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. Redistributions in binary 9 | form must reproduce the above copyright notice, this list of conditions and 10 | the following disclaimer in the documentation and/or other materials 11 | provided with the distribution. 12 | 13 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 14 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 15 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 16 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 17 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 18 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 19 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 20 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 21 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 22 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 23 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: build test 3 | 4 | build: 5 | @dune build @install 6 | 7 | test: 8 | @dune runtest --no-buffer --force 9 | 10 | clean: 11 | @dune clean 12 | 13 | doc: 14 | @dune build @doc 15 | 16 | VERSION=$(shell awk '/^version:/ {print $$2}' gen.opam) 17 | 18 | update_next_tag: 19 | @echo "update version to $(VERSION)..." 20 | find -name '*.ml' -or -name '*.mli' | xargs sed -i "s/NEXT_VERSION/$(VERSION)/g" 21 | find -name '*.ml' -or -name '*.mli' | xargs sed -i "s/NEXT_RELEASE/$(VERSION)/g" 22 | 23 | WATCH?=@all 24 | watch: 25 | @dune build $(WATCH) -w 26 | 27 | .PHONY: update_next_tag 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Gen [![build](https://github.com/c-cube/gen/actions/workflows/main.yml/badge.svg)](https://github.com/c-cube/gen/actions/workflows/main.yml) 2 | 3 | Iterators for OCaml, both restartable and consumable. The implementation 4 | keeps a good balance between simplicity and performance. 5 | 6 | The library is extensively tested using `qtest`. If you find a bug, 7 | please report! 8 | 9 | The documentation can be found [here](http://c-cube.github.io/gen/) 10 | the main module is [Gen](https://github.com/c-cube/gen/blob/master/src/gen.mli) 11 | and should suffice for 95% of use cases. 12 | 13 | [Changelog](https://github.com/c-cube/gen/blob/master/CHANGELOG.md) 14 | 15 | ## Native install 16 | 17 | Installation in a native OCaml project, via [opam](https://opam.ocaml.org/): 18 | 19 | ```sh 20 | $ opam install gen 21 | ``` 22 | 23 | or, manually, by building the library and running `make install`. Opam is 24 | recommended, for it keeps the library up-to-date. 25 | 26 | ## BuckleScript install 27 | 28 | Installation in JavaScript, via [BuckleScript](https://bucklescript.github.io/bucklescript/Manual.html), 29 | in an [npm](https://npmjs.com/) project: 30 | 31 | 1. Install this package: 32 | 33 | ```sh 34 | $ npm install bs-gen 35 | ``` 36 | 37 | 2. Manually add `bs-gen` to your `bsconfig.json`'s `bs-dependencies`: 38 | 39 | ```json 40 | "bs-dependencies": [ 41 | ... 42 | "bs-gen" 43 | ], 44 | ``` 45 | 46 | ## Use 47 | 48 | You can either build and install the library (see "Build"), or just copy 49 | files to your own project. The last solution has the benefits that you 50 | don't have additional dependencies nor build complications (and it may enable 51 | more inlining). 52 | 53 | If you have comments, requests, or bugfixes, please share them! :-) 54 | 55 | ## Build 56 | 57 | There are no dependencies except for `dune` for building. This should work with `OCaml>=4.02` 58 | 59 | ```sh 60 | $ make 61 | ``` 62 | 63 | To build and run tests (requires `oUnit` and `qtest`): 64 | 65 | ```sh 66 | $ opam install oUnit qtest 67 | $ make test 68 | ``` 69 | 70 | ## License 71 | 72 | This code is free, under the BSD license. 73 | -------------------------------------------------------------------------------- /bench/.merlin: -------------------------------------------------------------------------------- 1 | S . 2 | B ../_build/bench/ 3 | REC 4 | PKG benchmark 5 | -------------------------------------------------------------------------------- /bench/run_benchs.ml: -------------------------------------------------------------------------------- 1 | 2 | module B = Benchmark 3 | 4 | (* benchmark the "persistent" function *) 5 | module Persistent = struct 6 | let _sum g = 7 | Gen.Restart.fold (+) 0 g 8 | 9 | module MList = struct 10 | type 'a t = 'a node option ref 11 | and 'a node = { 12 | content : 'a; 13 | mutable prev : 'a node; 14 | mutable next : 'a node; 15 | } 16 | 17 | let create () = ref None 18 | 19 | let is_empty d = 20 | match !d with 21 | | None -> true 22 | | Some _ -> false 23 | 24 | let push_back d x = 25 | match !d with 26 | | None -> 27 | let rec elt = { 28 | content = x; prev = elt; next = elt; } in 29 | d := Some elt 30 | | Some first -> 31 | let elt = { content = x; next=first; prev=first.prev; } in 32 | first.prev.next <- elt; 33 | first.prev <- elt 34 | 35 | (* conversion to gen *) 36 | let to_gen d = 37 | fun () -> 38 | match !d with 39 | | None -> (fun () -> None) 40 | | Some first -> 41 | let cur = ref first in (* current element of the list *) 42 | let stop = ref false in (* are we done yet? *) 43 | fun () -> 44 | if !stop then None 45 | else begin 46 | let x = (!cur).content in 47 | cur := (!cur).next; 48 | (if !cur == first then stop := true); (* EOG, we made a full cycle *) 49 | Some x 50 | end 51 | end 52 | 53 | (** Store content of the generator in an enum *) 54 | let persistent_mlist gen = 55 | let l = MList.create () in 56 | Gen.iter (MList.push_back l) gen; 57 | MList.to_gen l 58 | 59 | let bench_mlist n = 60 | let g = persistent_mlist Gen.(1 -- n) in 61 | ignore (_sum g) 62 | 63 | (** {6 Unrolled mutable list} *) 64 | module UnrolledList = struct 65 | type 'a node = 66 | | Nil 67 | | Partial of 'a array * int 68 | | Cons of 'a array * 'a node ref 69 | 70 | let of_gen gen = 71 | let start = ref Nil in 72 | let chunk_size = ref 16 in 73 | let rec fill prev cur = 74 | match cur, gen() with 75 | | Partial (a,n), None -> 76 | prev := Cons (Array.sub a 0 n, ref Nil); () (* done *) 77 | | _, None -> prev := cur; () (* done *) 78 | | Nil, Some x -> 79 | let n = !chunk_size in 80 | if n < 4096 then chunk_size := 2 * !chunk_size; 81 | fill prev (Partial (Array.make n x, 1)) 82 | | Partial (a, n), Some x -> 83 | assert (n < Array.length a); 84 | a.(n) <- x; 85 | if n+1 = Array.length a 86 | then begin 87 | let r = ref Nil in 88 | prev := Cons(a, r); 89 | fill r Nil 90 | end else fill prev (Partial (a, n+1)) 91 | | Cons _, _ -> assert false 92 | in 93 | fill start !start ; 94 | !start 95 | 96 | let to_gen l () = 97 | let cur = ref l in 98 | let i = ref 0 in 99 | let rec next() = match !cur with 100 | | Nil -> None 101 | | Cons (a,l') -> 102 | if !i = Array.length a 103 | then begin 104 | cur := !l'; 105 | i := 0; 106 | next() 107 | end else begin 108 | let y = a.(!i) in 109 | incr i; 110 | Some y 111 | end 112 | | Partial _ -> assert false 113 | in 114 | next 115 | end 116 | 117 | (** Store content of the generator in an enum *) 118 | let persistent_unrolled gen = 119 | let l = UnrolledList.of_gen gen in 120 | UnrolledList.to_gen l 121 | 122 | let bench_unrolled n = 123 | let g = persistent_unrolled Gen.(1 -- n) in 124 | ignore (_sum g) 125 | 126 | let bench_naive n = 127 | let l = Gen.to_rev_list Gen.(1 -- n) in 128 | let g = Gen.Restart.of_list (List.rev l) in 129 | ignore (_sum g) 130 | 131 | let bench_current n = 132 | let g = Gen.persistent Gen.(1 -- n) in 133 | ignore (_sum g) 134 | 135 | let bench_current_lazy n = 136 | let g = Gen.persistent_lazy Gen.(1 -- n) in 137 | ignore (_sum g) 138 | 139 | let bench_current_lazy_no_cache n = 140 | let g = Gen.persistent_lazy ~max_chunk_size:16 ~caching:false Gen.(1 -- n) in 141 | ignore (_sum g) 142 | 143 | let () = 144 | let open B.Tree in 145 | let bench_n n = 146 | B.throughputN 2 ~repeat:3 147 | [ "mlist", bench_mlist, n 148 | ; "naive", bench_naive, n 149 | ; "unrolled", bench_unrolled, n 150 | ; "current", bench_current, n 151 | ; "current_lazy", bench_current_lazy, n 152 | ; "current_lazy_no_cache", bench_current_lazy_no_cache, n 153 | ] 154 | in 155 | let app_int f n = string_of_int n @> lazy (f n) in 156 | let app_ints f l = B.Tree.concat (List.map (app_int f) l) in 157 | B.Tree.register ( 158 | "persistent" @>> 159 | app_ints bench_n [100; 1_000; 10_000; 100_000] 160 | ) 161 | end 162 | 163 | (* benchmark the "permutation" function *) 164 | module Perm = struct 165 | module PermState = struct 166 | type 'a state = 167 | | Done 168 | | Base (* bottom machine, yield [] *) 169 | | Insert of 'a insert_state 170 | and 'a insert_state = { 171 | x : 'a; 172 | mutable l : 'a list; 173 | mutable n : int; (* idx for insertion *) 174 | len : int; (* len of [l] *) 175 | sub : 'a t; 176 | } 177 | and 'a t = { 178 | mutable st : 'a state; 179 | } 180 | end 181 | 182 | let permutations_rec g = 183 | let open PermState in 184 | (* make a machine for n elements. Invariant: n=len(l) *) 185 | let rec make_machine n l = match l with 186 | | [] -> assert (n=0); {st=Base} 187 | | x :: tail -> 188 | let sub = make_machine (n-1) tail in 189 | let st = match next sub () with 190 | | None -> Done 191 | | Some l -> Insert {x;n=0;l;len=n;sub} 192 | in 193 | {st;} 194 | (* next element of the machine *) 195 | and next m () = match m.st with 196 | | Done -> None 197 | | Base -> m.st <- Done; Some [] 198 | | Insert ({x;len;n;l;sub} as state) -> 199 | if n=len 200 | then match next sub () with 201 | | None -> m.st <- Done; None 202 | | Some l -> 203 | state.l <- l; 204 | state.n <- 0; 205 | next m () 206 | else ( 207 | state.n <- state.n + 1; 208 | Some (insert x n l) 209 | ) 210 | and insert x n l = match n, l with 211 | | 0, _ -> x::l 212 | | _, [] -> assert false 213 | | _, y::tail -> y :: insert x (n-1) tail 214 | in 215 | let l = Gen.fold (fun acc x->x::acc) [] g in 216 | next (make_machine (List.length l) l) 217 | 218 | (* 219 | Credits to Bernardo Freitas Paulo da Costa for [permutations_heap]! 220 | 221 | B.R.Heap's algorithm for permutations, 222 | cf http://en.wikipedia.org/wiki/Heap%27s_algorithm. 223 | 224 | Continuation-based recursive formula, model for the state manipulations 225 | below: 226 | {[ 227 | let rec heap_perm k a n = 228 | match n with 229 | | 0 -> k a 230 | | n -> 231 | for i = 0 to n-1 do 232 | heap_perm k a (n-1); 233 | let j = (if n mod 2 = 1 then 0 else i) in 234 | let t = a.(j) in 235 | a.(j) <- a.(n-1); 236 | a.(n-1) <- t 237 | done 238 | ]} 239 | *) 240 | 241 | (* The state of the permutation machine, containing 242 | - the array [a] we're permuting, in the "current permutation"; 243 | - the level of recursion [n]: we can permute elements with index < [n] 244 | - the stack of values of indices to permute [i] in the list [is] 245 | The permutation stops when we have no more elements in the stack [is]. 246 | *) 247 | module HeapPermState = struct 248 | type 'a state = { 249 | elts : 'a array; 250 | mutable n : int; 251 | mutable is : int list; 252 | } 253 | end 254 | 255 | let permutations_heap g = 256 | let open HeapPermState in 257 | let l = Gen.fold (fun acc x->x::acc) [] g in 258 | let a = Array.of_list l in 259 | let rec next st () = match st.n with 260 | | 0 -> 261 | begin match st.is with 262 | | [] | _::[] -> assert false 263 | | 0::i::is' -> (* "Pop state" before returning next element *) 264 | st.is <- (i+1)::is'; 265 | st.n <- 1; 266 | Some (Array.copy a) 267 | | _::_::_ -> assert false 268 | end 269 | | n -> 270 | match st.is with 271 | | [] -> None 272 | | i::is' when i = n -> (* Pop state at end of loop *) 273 | st.is <- is'; 274 | st.n <- n+1; 275 | begin match st.is with 276 | | [] -> None (* last loop *) 277 | | i::is' -> 278 | let j = (if st.n mod 2 = 1 then 0 else i) in 279 | let tmp = st.elts.(j) in 280 | st.elts.(j) <- st.elts.(n); 281 | st.elts.(n) <- tmp; 282 | st.is <- (i+1)::is'; 283 | next st () 284 | end 285 | | _::_ -> (* Recurse down and start new loop *) 286 | st.n <- n-1; 287 | st.is <- 0 :: st.is; 288 | next st () 289 | in 290 | let n = Array.length a in 291 | if n = 0 then Gen.empty 292 | else next {elts = a; n=n; is=[0]} 293 | 294 | (* take [len] permutations of [1..n] *) 295 | let bench_it n len = 296 | Printf.printf "\ntake %d permutations out of [1...%d]\n" len n; 297 | let run perm () = 298 | let open Gen in 299 | perm (1--n) |> take len |> iter (fun _ -> ()) 300 | in 301 | let res = Benchmark.throughputN 2 302 | [ "perm_rec", run permutations_rec, () 303 | ; "perm_heap", run permutations_heap, () 304 | ; "current", run Gen.permutations, () 305 | ] 306 | in 307 | Benchmark.tabulate res 308 | 309 | let bench_n len n = 310 | let run perm () = 311 | let open Gen in 312 | perm (1--n) |> take len |> iter (fun _ -> ()) 313 | in 314 | B.throughputN 2 ~repeat:3 315 | [ "perm_rec", run permutations_rec, () 316 | ; "perm_heap", run permutations_heap, () 317 | ; "current", run Gen.permutations, () 318 | ] 319 | 320 | let () = 321 | let open B.Tree in 322 | let app_int f n = string_of_int n @> lazy (f n) in 323 | let app_ints f l = B.Tree.concat (List.map (app_int f) l) in 324 | B.Tree.register ( 325 | "perm" @>>> 326 | [ "len=100" @>> app_ints (bench_n 100) [5; 100; 1_000] 327 | ; "len=50_000" @>> app_ints (bench_n 50_000) [100; 1_000] 328 | ]) 329 | end 330 | 331 | let () = 332 | try B.Tree.run_global () 333 | with Arg.Help msg -> print_endline msg 334 | -------------------------------------------------------------------------------- /bsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "bs-gen", 3 | "version": "0.5.3", 4 | "sources": [ 5 | { 6 | "dir": "src", 7 | "files": [ 8 | "gen.ml", 9 | "gen_intf.ml", 10 | "genM.ml", 11 | "genM_intf.ml", 12 | "genMList.ml", 13 | "genClone.ml" 14 | ] 15 | } 16 | ], 17 | "namespace": false, 18 | "package-specs": { 19 | "module": "commonjs", 20 | "in-source": true 21 | }, 22 | "suffix": ".bs.js" 23 | } 24 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.1) 2 | -------------------------------------------------------------------------------- /gen.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "simon.cruanes.2007@m4x.org" 3 | synopsis: "Iterators for OCaml, both restartable and consumable" 4 | author: [ "Simon Cruanes" "ELLIOTTCABLE" ] 5 | name: "gen" 6 | version: "1.1" 7 | license: "BSD-2-Clause" 8 | build: [ 9 | ["dune" "build" "@install" "-p" name "-j" jobs] 10 | ["dune" "runtest" "-p" name "-j" jobs] {with-test} 11 | ["dune" "build" "@doc" "-p" name "-j" jobs] {with-doc} 12 | ] 13 | depends: [ 14 | "dune" {>= "1.1"} 15 | "seq" 16 | "odoc" {with-doc} 17 | "qcheck" {with-test} 18 | "qtest" {with-test} 19 | "ounit2" {with-test} 20 | "ocaml" { >= "4.03.0" } 21 | ] 22 | tags: [ "gen" "iterator" "iter" "fold" ] 23 | homepage: "https://github.com/c-cube/gen/" 24 | doc: "https://c-cube.github.io/gen/" 25 | bug-reports: "https://github.com/c-cube/gen/issues" 26 | dev-repo: "git+https://github.com/c-cube/gen.git" 27 | -------------------------------------------------------------------------------- /package-lock.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "bs-gen", 3 | "version": "0.5.3", 4 | "lockfileVersion": 1, 5 | "requires": true, 6 | "dependencies": { 7 | "bs-platform": { 8 | "version": "5.2.1", 9 | "resolved": "https://registry.npmjs.org/bs-platform/-/bs-platform-5.2.1.tgz", 10 | "integrity": "sha512-3ISP+RBC/NYILiJnphCY0W3RTYpQ11JGa2dBBLVug5fpFZ0qtSaL3ZplD8MyjNeXX2bC7xgrWfgBSn8Tc9om7Q==", 11 | "dev": true 12 | } 13 | } 14 | } 15 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "bs-gen", 3 | "version": "0.5.3", 4 | "description": "Simple, efficient iterators for OCaml", 5 | "main": "src/gen.bs.js", 6 | "scripts": { 7 | "prepare": "npm run clean && bsb -make-world", 8 | "clean": "bsb -clean-world", 9 | "test": "echo \"Error: no test specified\" && exit 1" 10 | }, 11 | "files": [ 12 | "bsconfig.json", 13 | "src", 14 | "!**/dune", 15 | "!**/dune-project", 16 | "!**/.merlin" 17 | ], 18 | "keywords": [ 19 | "BuckleScript", 20 | "ReasonML", 21 | "OCaml", 22 | "generator", 23 | "tool", 24 | "coro", 25 | "coroutine", 26 | "async", 27 | "iterator" 28 | ], 29 | "repository": { 30 | "type": "git", 31 | "url": "git+https://github.com/c-cube/gen.git" 32 | }, 33 | "contributors": [ 34 | "Simon Cruanes ", 35 | "ELLIOTTCABLE " 36 | ], 37 | "license": "BSD-2-Clause", 38 | "bugs": { 39 | "url": "https://github.com/c-cube/gen/issues" 40 | }, 41 | "homepage": "http://c-cube.github.io/gen/", 42 | "devDependencies": { 43 | "bs-platform": "^5.2.1" 44 | }, 45 | "peerDependencies": { 46 | "bs-platform": ">=5.0.0" 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /qtest/Makefile: -------------------------------------------------------------------------------- 1 | 2 | QTEST_PREAMBLE=' ' 3 | DONTTEST=../src/mkflags.ml ../src/mkshims.ml 4 | QTESTABLE=$(filter-out $(DONTTEST), \ 5 | $(wildcard ../src/*.ml) \ 6 | $(wildcard ../src/*.mli) \ 7 | ) 8 | 9 | qtest-gen: 10 | @rm run_qtest.ml 2>/dev/null || true 11 | @if which qtest > /dev/null ; then \ 12 | qtest extract -o run_qtest.ml \ 13 | $(QTESTABLE) 2> /dev/null ; \ 14 | else touch run_qtest.ml ; \ 15 | fi 16 | 17 | .PHONY: qtest-gen 18 | -------------------------------------------------------------------------------- /qtest/dune: -------------------------------------------------------------------------------- 1 | 2 | (rule 3 | (targets run_qtest.ml) 4 | (deps Makefile (source_tree ../src)) ; (glob_files ../src/**/*.ml{,i}))) 5 | (mode fallback) 6 | (action (run make qtest-gen))) 7 | 8 | (executable 9 | (name run_qtest) 10 | (flags :standard -warn-error -a+8 -safe-string -w -33) 11 | (libraries gen ounit2 qcheck)) 12 | 13 | (alias 14 | (name runtest) 15 | (deps run_qtest.exe) 16 | (action (run %{deps}))) 17 | 18 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name mkshims) 3 | (modules mkshims)) 4 | 5 | (rule 6 | (targets GenShims_.ml) 7 | (deps ./mkshims.exe) 8 | (action (run ./mkshims.exe))) 9 | 10 | (rule 11 | (targets flambda.flags) 12 | (deps (file mkflags.ml)) 13 | (mode fallback) 14 | (action (run ocaml ./mkflags.ml))) 15 | 16 | (library 17 | (name gen) 18 | (public_name gen) 19 | (wrapped false) 20 | (modules Gen GenLabels GenM GenClone GenMList GenM_intf Gen_intf GenLabels_intf GenShims_) 21 | (flags :standard -warn-error -a+8 -safe-string -nolabels) 22 | (ocamlopt_flags :standard (:include flambda.flags)) 23 | (libraries seq)) 24 | -------------------------------------------------------------------------------- /src/gen.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {2 Global type declarations} *) 5 | 6 | type 'a t = unit -> 'a option 7 | 8 | type 'a gen = 'a t 9 | 10 | module type S = Gen_intf.S 11 | 12 | (*$inject 13 | [@@@ocaml.warning "-26"] 14 | 15 | let pint i = string_of_int i 16 | let pilist l = 17 | let b = Buffer.create 15 in 18 | let fmt = Format.formatter_of_buffer b in 19 | Format.fprintf fmt "%a@?" 20 | (Gen.pp Format.pp_print_int) (Gen.of_list l); 21 | Buffer.contents b 22 | let pi2list l = 23 | let b = Buffer.create 15 in 24 | let fmt = Format.formatter_of_buffer b in 25 | Format.fprintf fmt "%a@?" 26 | (Gen.pp (fun fmt (a,b) -> Format.fprintf fmt "%d,%d" a b)) 27 | (Gen.of_list l); 28 | Buffer.contents b 29 | let pstrlist l = 30 | let b = Buffer.create 15 in 31 | let fmt = Format.formatter_of_buffer b in 32 | Format.fprintf fmt "%a@?" 33 | (Gen.pp Format.pp_print_string) (Gen.of_list l); 34 | Buffer.contents b 35 | 36 | *) 37 | 38 | (** {2 Transient generators} *) 39 | 40 | let empty () = None 41 | 42 | (*$T empty 43 | empty |> to_list = [] 44 | *) 45 | 46 | let singleton x = 47 | let first = ref true in 48 | fun () -> 49 | if !first then (first := false; Some x) else None 50 | 51 | (*$T singleton 52 | singleton 1 |> to_list = [1] 53 | singleton "foo" |> to_list = ["foo"] 54 | *) 55 | 56 | (*$R 57 | let gen = Gen.singleton 42 in 58 | OUnit.assert_equal (Some 42) (Gen.get gen); 59 | OUnit.assert_equal None (Gen.get gen); 60 | let gen = Gen.singleton 42 in 61 | OUnit.assert_equal 1 (Gen.length gen); 62 | *) 63 | 64 | let return = singleton 65 | 66 | let repeat x () = Some x 67 | 68 | (*$T repeat 69 | repeat 42 |> take 3 |> to_list = [42; 42; 42] 70 | *) 71 | 72 | let repeatedly f () = Some (f ()) 73 | 74 | (*$T repeatedly 75 | repeatedly (let r = ref 0 in fun () -> incr r; !r) \ 76 | |> take 5 |> to_list = [1;2;3;4;5] 77 | *) 78 | 79 | let iterate x f = 80 | let cur = ref x in 81 | fun () -> 82 | let x = !cur in 83 | cur := f !cur; 84 | Some x 85 | 86 | (*$T iterate 87 | iterate 0 ((+)1) |> take 5 |> to_list = [0;1;2;3;4] 88 | *) 89 | 90 | let next gen = gen () 91 | 92 | let get gen = gen () 93 | 94 | let get_exn gen = 95 | match gen () with 96 | | Some x -> x 97 | | None -> raise (Invalid_argument "Gen.get_exn") 98 | 99 | (*$R get_exn 100 | let g = of_list [1;2;3] in 101 | assert_equal 1 (get_exn g); 102 | assert_equal 2 (get_exn g); 103 | assert_equal 3 (get_exn g); 104 | assert_raises (Invalid_argument "Gen.get_exn") (fun () -> get_exn g) 105 | *) 106 | 107 | let junk gen = ignore (gen ()) 108 | 109 | let rec fold f acc gen = 110 | match gen () with 111 | | None -> acc 112 | | Some x -> fold f (f acc x) gen 113 | 114 | (*$Q 115 | (Q.list Q.small_int) (fun l -> \ 116 | of_list l |> fold (fun l x->x::l) [] = List.rev l) 117 | *) 118 | 119 | let reduce f g = 120 | let acc = match g () with 121 | | None -> raise (Invalid_argument "reduce") 122 | | Some x -> x 123 | in 124 | fold f acc g 125 | 126 | (* Dual of {!fold}, with a deconstructing operation *) 127 | let unfold f acc = 128 | let acc = ref acc in 129 | fun () -> 130 | match f !acc with 131 | | None -> None 132 | | Some (x, acc') -> 133 | acc := acc'; 134 | Some x 135 | 136 | (*$T unfold 137 | unfold (fun (prev,cur) -> Some (prev, (cur,prev+cur))) (0,1) \ 138 | |> take 7 |> to_list = [0; 1; 1; 2; 3; 5; 8] 139 | *) 140 | 141 | let init ?(limit=max_int) f = 142 | let r = ref 0 in 143 | fun () -> 144 | if !r >= limit 145 | then None 146 | else 147 | let x = f !r in 148 | let _ = incr r in 149 | Some x 150 | 151 | (*$T init 152 | init ~limit:5 (fun i->i) |> to_list = [0;1;2;3;4] 153 | *) 154 | 155 | let rec iter f gen = 156 | match gen() with 157 | | None -> () 158 | | Some x -> f x; iter f gen 159 | 160 | (*$R iter 161 | let e = Restart.(1 -- 10) in 162 | OUnit.assert_equal ~printer:pint 10 (Restart.length e); 163 | OUnit.assert_equal [1;2] Restart.(to_list (1 -- 2)); 164 | OUnit.assert_equal [1;2;3;4;5] (Restart.to_list (Restart.take 5 e)); 165 | *) 166 | 167 | let iteri f gen = 168 | let rec iteri i = match gen() with 169 | | None -> () 170 | | Some x -> f i x; iteri (i+1) 171 | in 172 | iteri 0 173 | 174 | let is_empty gen = match gen () with 175 | | None -> true 176 | | Some _ -> false 177 | 178 | (*$T 179 | is_empty empty 180 | not (is_empty (singleton 2)) 181 | *) 182 | 183 | let length gen = 184 | fold (fun acc _ -> acc + 1) 0 gen 185 | 186 | (*$Q 187 | (Q.list Q.small_int) (fun l -> \ 188 | of_list l |> length = List.length l) 189 | *) 190 | 191 | (* useful state *) 192 | module RunState = struct 193 | type 'a t = 194 | | Init 195 | | Run of 'a 196 | | Stop 197 | end 198 | 199 | let scan f acc g = 200 | let open RunState in 201 | let state = ref Init in 202 | fun () -> 203 | match !state with 204 | | Init -> 205 | state := Run acc; 206 | Some acc 207 | | Stop -> None 208 | | Run acc -> 209 | match g() with 210 | | None -> state := Stop; None 211 | | Some x -> 212 | let acc' = f acc x in 213 | state := Run acc'; 214 | Some acc' 215 | 216 | (*$T scan 217 | scan (fun acc x -> x+1::acc) [] (1--5) |> to_list \ 218 | = [[]; [2]; [3;2]; [4;3;2]; [5;4;3;2]; [6;5;4;3;2]] 219 | *) 220 | 221 | let unfold_scan f acc g = 222 | let open RunState in 223 | let state = ref (Run acc) in 224 | fun () -> 225 | match !state with 226 | | Init -> assert false 227 | | Stop -> None 228 | | Run acc -> 229 | match g() with 230 | | None -> state := Stop; None 231 | | Some x -> 232 | let acc', y = f acc x in 233 | state := Run acc'; 234 | Some y 235 | 236 | (*$T unfold_scan 237 | unfold_scan (fun acc x -> x+acc,acc) 0 (1--5) |> to_list \ 238 | = [0; 1; 3; 6; 10] 239 | *) 240 | 241 | (** {3 Lazy} *) 242 | 243 | let map f gen = 244 | let stop = ref false in 245 | fun () -> 246 | if !stop then None 247 | else match gen() with 248 | | None -> stop:= true; None 249 | | Some x -> Some (f x) 250 | 251 | (*$Q map 252 | (Q.list Q.small_int) (fun l -> \ 253 | let f x = x*2 in \ 254 | of_list l |> map f |> to_list = List.map f l) 255 | *) 256 | 257 | (*$R 258 | let e = 1 -- 10 in 259 | let e' = e >>| string_of_int in 260 | OUnit.assert_equal ~printer:pstrlist ["9"; "10"] (Gen.to_list (Gen.drop 8 e')); 261 | *) 262 | 263 | let mapi f = 264 | let cnt = ref 0 in 265 | let cnt_map x = 266 | let i = !cnt in cnt := i + 1; f i x in 267 | map cnt_map 268 | 269 | (*$Q mapi 270 | (Q.list Q.small_int) (fun l -> \ 271 | let len = List.length l in \ 272 | let f i x = i+x+1 in \ 273 | of_list l |> mapi f |> to_list |> fun l' -> List.fold_left (+) 0 l'= \ 274 | len*(len+1)/2 + List.fold_left (+) 0 l) 275 | *) 276 | 277 | let fold_map f s gen = 278 | map (let state = ref s in fun x -> state := f (!state) x; !state) gen 279 | 280 | (*$T 281 | fold_map (+) 0 (1--3) |> to_list = [1;3;6] 282 | *) 283 | 284 | let append gen1 gen2 = 285 | let first = ref true in 286 | fun () -> 287 | if !first 288 | then match gen1() with 289 | | (Some _) as x -> x 290 | | None -> first:=false; gen2() 291 | else gen2() 292 | 293 | (*$Q 294 | (Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \ 295 | append (of_list l1) (of_list l2) |> to_list = l1 @ l2) 296 | *) 297 | 298 | (*$R 299 | let e = Gen.append (1 -- 5) (6 -- 10) in 300 | OUnit.assert_equal [10;9;8;7;6;5;4;3;2;1] (Gen.to_rev_list e); 301 | *) 302 | 303 | let flatten next_gen = 304 | let open RunState in 305 | let state = ref Init in 306 | (* get next element *) 307 | let rec next () = 308 | match !state with 309 | | Init -> get_next_gen() 310 | | Run gen -> 311 | begin match gen () with 312 | | None -> get_next_gen () 313 | | (Some _) as x -> x 314 | end 315 | | Stop -> None 316 | and get_next_gen() = match next_gen() with 317 | | None -> state := Stop; None 318 | | Some gen -> state := Run gen; next() 319 | in 320 | next 321 | 322 | let flat_map f next_elem = 323 | let open RunState in 324 | let state = ref Init in 325 | let rec next() = 326 | match !state with 327 | | Init -> get_next_gen() 328 | | Run gen -> 329 | begin match gen () with 330 | | None -> get_next_gen () 331 | | (Some _) as x -> x 332 | end 333 | | Stop -> None 334 | and get_next_gen() = match next_elem() with 335 | | None -> state:=Stop; None 336 | | Some x -> state := Run (f x); next() 337 | | exception e -> state := Stop; raise e 338 | in 339 | next 340 | 341 | (*$Q flat_map 342 | (Q.list Q.small_int) (fun l -> \ 343 | let f x = of_list [x;x*2] in \ 344 | eq (map f (of_list l) |> flatten) (flat_map f (of_list l))) 345 | *) 346 | 347 | (*$T 348 | flat_map (fun x -> if x mod 1_500_000=0 then singleton x else empty) (1 -- 6_000_000) \ 349 | |> to_list = [1_500_000; 3_000_000; 4_500_000; 6_000_000] 350 | *) 351 | 352 | (*$R 353 | let e = 1 -- 3 in 354 | let e' = e >>= (fun x -> x -- (x+1)) in 355 | OUnit.assert_equal [1;2;2;3;3;4] (Gen.to_list e'); 356 | *) 357 | 358 | let mem ?(eq=(=)) x gen = 359 | let rec mem eq x gen = 360 | match gen() with 361 | | Some y -> eq x y || mem eq x gen 362 | | None -> false 363 | in mem eq x gen 364 | 365 | let take n gen = 366 | assert (n >= 0); 367 | let count = ref 0 in (* how many yielded elements *) 368 | fun () -> 369 | if !count = n || !count = ~-1 370 | then None 371 | else match gen() with 372 | | None -> count := ~-1; None (* indicate stop *) 373 | | (Some _) as x -> incr count; x 374 | 375 | (*$Q 376 | (Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \ 377 | of_list l |> take n |> length = GenShims_.Stdlib.min n (List.length l)) 378 | *) 379 | 380 | (* call [gen] at most [n] times, and stop *) 381 | let rec __drop n gen = 382 | if n = 0 then () 383 | else match gen() with 384 | | Some _ -> __drop (n-1) gen 385 | | None -> () 386 | 387 | let drop n gen = 388 | assert (n >= 0); 389 | let dropped = ref false in 390 | fun () -> 391 | if !dropped 392 | then gen() 393 | else begin 394 | (* drop [n] elements and yield the next element *) 395 | dropped := true; 396 | __drop n gen; 397 | gen() 398 | end 399 | 400 | (*$Q 401 | (Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \ 402 | let g1,g2 = take n (of_list l), drop n (of_list l) in \ 403 | append g1 g2 |> to_list = l) 404 | *) 405 | 406 | let nth n gen = 407 | assert (n>=0); 408 | __drop n gen; 409 | match gen () with 410 | | None -> raise Not_found 411 | | Some x -> x 412 | 413 | (*$= nth & ~printer:string_of_int 414 | 4 (nth 4 (0--10)) 415 | 8 (nth 8 (0--10)) 416 | *) 417 | 418 | (*$T 419 | (try ignore (nth 11 (1--10)); false with Not_found -> true) 420 | *) 421 | 422 | let take_nth n gen = 423 | assert (n>=1); 424 | let i = ref n in 425 | let rec next() = 426 | match gen() with 427 | | None -> None 428 | | (Some _) as res when !i = n -> i:=1; res 429 | | Some _ -> incr i; next() 430 | in next 431 | 432 | let filter p gen = 433 | let rec next () = 434 | (* wrap exception into option, for next to be tailrec *) 435 | match gen() with 436 | | None -> None 437 | | (Some x) as res -> 438 | if p x 439 | then res (* yield element *) 440 | else next () (* discard element *) 441 | in next 442 | 443 | (*$T 444 | filter (fun x ->x mod 2 = 0) (1--10) |> to_list = [2;4;6;8;10] 445 | *) 446 | 447 | let take_while p gen = 448 | let stop = ref false in 449 | fun () -> 450 | if !stop 451 | then None 452 | else match gen() with 453 | | (Some x) as res -> 454 | if p x then res else (stop := true; None) 455 | | None -> stop:=true; None 456 | 457 | (*$T 458 | take_while (fun x ->x<10) (1--1000) |> eq (1--9) 459 | *) 460 | 461 | let fold_while f s gen = 462 | let state = ref s in 463 | let rec consume gen = match gen() with 464 | | None -> () 465 | | Some x -> 466 | let acc, cont = f !state x in 467 | state := acc; 468 | match cont with 469 | | `Stop -> () 470 | | `Continue -> consume gen 471 | in 472 | consume gen; 473 | !state 474 | 475 | (*$T 476 | fold_while (fun acc b -> if b then acc+1, `Continue else acc, `Stop) 0 \ 477 | (of_list [true;true;false;true]) = 2 478 | *) 479 | 480 | module DropWhileState = struct 481 | type t = 482 | | Stop 483 | | Drop 484 | | Yield 485 | end 486 | 487 | (* state machine starts at Drop: 488 | Drop: 489 | - If next element doesn't satisfy predicate, goto yield 490 | - if no more elements, goto stop 491 | Yield: 492 | - if there is a next element, yield it 493 | - if no more elements, goto stop 494 | Stop: just return None 495 | *) 496 | let drop_while p gen = 497 | let open DropWhileState in 498 | let state = ref Drop in 499 | let rec next () = 500 | match !state with 501 | | Stop -> None 502 | | Drop -> 503 | begin match gen () with 504 | | None -> state := Stop; None 505 | | (Some x) as res -> 506 | if p x then next() else (state:=Yield; res) 507 | end 508 | | Yield -> 509 | begin match gen () with 510 | | None -> state := Stop; None 511 | | Some _ as res -> res 512 | end 513 | in next 514 | 515 | (*$T 516 | drop_while (fun x-> x<10) (1--20) |> eq (10--20) 517 | *) 518 | 519 | let filter_map f gen = 520 | (* tailrec *) 521 | let rec next () = 522 | match gen() with 523 | | None -> None 524 | | Some x -> 525 | match f x with 526 | | None -> next() 527 | | (Some _) as res -> res 528 | in next 529 | 530 | (*$T 531 | filter_map (fun x-> if x mod 2 = 0 then Some (string_of_int x) else None) (1--10) \ 532 | |> to_list = List.map string_of_int [2;4;6;8;10] 533 | *) 534 | 535 | (*$R 536 | let f x = if x mod 2 = 0 then Some (string_of_int x) else None in 537 | let e = Gen.filter_map f (1 -- 10) in 538 | OUnit.assert_equal ["2"; "4"; "6"; "8"; "10"] (Gen.to_list e); 539 | *) 540 | 541 | let zip_index gen = 542 | let r = ref ~-1 in 543 | fun () -> 544 | match gen() with 545 | | None -> None 546 | | Some x -> 547 | incr r; 548 | Some (!r, x) 549 | 550 | (*$T 551 | zip_index (1--5) |> to_list = [0,1; 1,2; 2,3; 3,4; 4,5] 552 | *) 553 | 554 | let unzip gen = 555 | let stop = ref false in 556 | let q1 = Queue.create () in 557 | let q2 = Queue.create () in 558 | let next_left () = 559 | if Queue.is_empty q1 560 | then if !stop then None 561 | else match gen() with 562 | | Some (x,y) -> 563 | Queue.push y q2; 564 | Some x 565 | | None -> stop := true; None 566 | else Some (Queue.pop q1) 567 | in 568 | let next_right () = 569 | if Queue.is_empty q2 570 | then if !stop then None 571 | else match gen() with 572 | | Some (x,y) -> 573 | Queue.push x q1; 574 | Some y 575 | | None -> stop := true; None 576 | else Some (Queue.pop q2) 577 | in 578 | next_left, next_right 579 | 580 | (*$T 581 | unzip (of_list [1,2;3,4]) |> (fun (x,y)-> to_list x, to_list y) \ 582 | = ([1;3], [2;4]) 583 | *) 584 | 585 | (*$Q 586 | (Q.list (Q.pair Q.small_int Q.small_int)) (fun l -> \ 587 | of_list l |> unzip |> (fun (x,y) -> to_list x,to_list y) = \ 588 | List.split l) 589 | *) 590 | 591 | (* [partition p l] returns the elements that satisfy [p], 592 | and the elements that do not satisfy [p] *) 593 | let partition p gen = 594 | let qtrue = Queue.create () in 595 | let qfalse = Queue.create () in 596 | let stop = ref false in 597 | let rec nexttrue () = 598 | if Queue.is_empty qtrue 599 | then if !stop then None 600 | else match gen() with 601 | | (Some x) as res -> 602 | if p x then res else (Queue.push x qfalse; nexttrue()) 603 | | None -> stop:=true; None 604 | else Some (Queue.pop qtrue) 605 | and nextfalse() = 606 | if Queue.is_empty qfalse 607 | then if !stop then None 608 | else match gen() with 609 | | (Some x) as res -> 610 | if p x then (Queue.push x qtrue; nextfalse()) else res 611 | | None -> stop:= true; None 612 | else Some (Queue.pop qfalse) 613 | in 614 | nexttrue, nextfalse 615 | 616 | (*$T 617 | partition (fun x -> x mod 2 = 0) (1--10) |> \ 618 | (fun (x,y)->to_list x, to_list y) = ([2;4;6;8;10], [1;3;5;7;9]) 619 | *) 620 | 621 | let rec for_all p gen = 622 | match gen() with 623 | | None -> true 624 | | Some x -> p x && for_all p gen 625 | 626 | let rec exists p gen = 627 | match gen() with 628 | | None -> false 629 | | Some x -> p x || exists p gen 630 | 631 | let min ?(lt=fun x y -> x < y) gen = 632 | let first = match gen () with 633 | | Some x -> x 634 | | None -> raise (Invalid_argument "min") 635 | in 636 | fold (fun min x -> if lt x min then x else min) first gen 637 | 638 | (*$T 639 | min (of_list [1;4;6;0;11; -2]) = ~-2 640 | (try ignore (min empty); false with Invalid_argument _ -> true) 641 | *) 642 | 643 | let max ?(lt=fun x y -> x < y) gen = 644 | let first = match gen () with 645 | | Some x -> x 646 | | None -> raise (Invalid_argument "max") 647 | in 648 | fold (fun max x -> if lt max x then x else max) first gen 649 | 650 | (*$T 651 | max (of_list [1;4;6;0;11; -2]) = 11 652 | (try ignore (max empty); false with Invalid_argument _ -> true) 653 | *) 654 | 655 | let eq ?(eq=(=)) gen1 gen2 = 656 | let rec check () = 657 | match gen1(), gen2() with 658 | | None, None -> true 659 | | Some x1, Some x2 when eq x1 x2 -> check () 660 | | _ -> false 661 | in 662 | check () 663 | 664 | (*$Q 665 | (Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \ 666 | eq (of_list l1)(of_list l2) = (l1 = l2)) 667 | *) 668 | 669 | let lexico ?(cmp=GenShims_.Stdlib.compare) gen1 gen2 = 670 | let rec lexico () = 671 | match gen1(), gen2() with 672 | | None, None -> 0 673 | | Some x1, Some x2 -> 674 | let c = cmp x1 x2 in 675 | if c <> 0 then c else lexico () 676 | | Some _, None -> 1 677 | | None, Some _ -> -1 678 | in lexico () 679 | 680 | let compare ?cmp gen1 gen2 = lexico ?cmp gen1 gen2 681 | 682 | (*$Q 683 | (Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \ 684 | let sign x = if x < 0 then -1 else if x=0 then 0 else 1 in \ 685 | sign (compare (of_list l1)(of_list l2)) = sign (GenShims_.Stdlib.compare l1 l2)) 686 | *) 687 | 688 | let rec find p e = match e () with 689 | | None -> None 690 | | Some x when p x -> Some x 691 | | Some _ -> find p e 692 | 693 | (*$T 694 | find (fun x -> x>=5) (1--10) = Some 5 695 | find (fun x -> x>5) (1--4) = None 696 | *) 697 | 698 | let sum e = 699 | let rec sum acc = match e() with 700 | | None -> acc 701 | | Some x -> sum (x+acc) 702 | in sum 0 703 | 704 | (*$T 705 | sum (1--10) = 55 706 | *) 707 | 708 | (** {2 Multiple Iterators} *) 709 | 710 | let map2 f e1 e2 = 711 | fun () -> match e1(), e2() with 712 | | Some x, Some y -> Some (f x y) 713 | | _ -> None 714 | 715 | (*$T 716 | map2 (+) (1--5) (1--4) |> eq (of_list [2;4;6;8]) 717 | map2 (+) (1--5) (repeat 0) |> eq (1--5) 718 | *) 719 | 720 | let rec iter2 f e1 e2 = 721 | match e1(), e2() with 722 | | Some x, Some y -> f x y; iter2 f e1 e2 723 | | _ -> () 724 | 725 | (*$T iter2 726 | let r = ref 0 in iter2 (fun _ _ -> incr r) (1--10) (4--6); !r = 3 727 | *) 728 | 729 | let rec fold2 f acc e1 e2 = 730 | match e1(), e2() with 731 | | Some x, Some y -> fold2 f (f acc x y) e1 e2 732 | | _ -> acc 733 | 734 | let rec for_all2 p e1 e2 = 735 | match e1(), e2() with 736 | | Some x, Some y -> p x y && for_all2 p e1 e2 737 | | _ -> true 738 | 739 | let rec exists2 p e1 e2 = 740 | match e1(), e2() with 741 | | Some x, Some y -> p x y || exists2 p e1 e2 742 | | _ -> false 743 | 744 | let zip_with f a b = 745 | let stop = ref false in 746 | fun () -> 747 | if !stop then None 748 | else match a(), b() with 749 | | Some xa, Some xb -> Some (f xa xb) 750 | | _ -> stop:=true; None 751 | 752 | let zip a b = zip_with (fun x y -> x,y) a b 753 | 754 | (*$Q 755 | (Q.list Q.small_int) (fun l -> \ 756 | zip_with (fun x y->x,y) (of_list l) (of_list l) \ 757 | |> unzip |> fst |> to_list = l) 758 | *) 759 | 760 | (*$R 761 | let e = Gen.zip_with (+) (Gen.repeat 1) (4--7) in 762 | OUnit.assert_equal [5;6;7;8] (Gen.to_list e); 763 | *) 764 | 765 | (** {3 Complex combinators} *) 766 | 767 | module MergeState = struct 768 | type 'a t = { 769 | gens : 'a gen Queue.t; 770 | mutable state : my_state; 771 | } 772 | 773 | and my_state = 774 | | NewGen (* obtain a new generator and push it in queue *) 775 | | YieldAndNew (* yield element from queue, then behave like NewGen *) 776 | | Yield (* just yield elements from queue *) 777 | | Stop (* no more elements *) 778 | end 779 | 780 | (* state machine starts at NewGen: 781 | NewGen: use next_gen to push a new gen into the queue 782 | Yield: 783 | while the queue is not empty: 784 | pop gen g from it 785 | if g is empty continue 786 | else: 787 | pop element x from g 788 | push g at back of queue 789 | yield x 790 | YieldAndNew: mix of Yield and NewGen. 791 | if next_gen is exhausted, goto Yield; 792 | if queue is empty, goto NewGen 793 | Stop: do nothing 794 | *) 795 | let merge next_gen = 796 | let open MergeState in 797 | let state = {gens = Queue.create(); state=NewGen;}in 798 | (* recursive function to get next element *) 799 | let rec next () = 800 | match state.state with 801 | | Stop -> None 802 | | Yield -> (* only yield from generators in state.gens *) 803 | if Queue.is_empty state.gens 804 | then (state.state <- Stop; None) 805 | else 806 | let gen = Queue.pop state.gens in 807 | begin match gen () with 808 | | None -> next() 809 | | (Some _) as res -> 810 | Queue.push gen state.gens; (* put gen back in queue *) 811 | res 812 | end 813 | | NewGen -> 814 | begin match next_gen() with 815 | | None -> 816 | state.state <- Yield; (* exhausted *) 817 | next() 818 | | Some gen -> 819 | Queue.push gen state.gens; 820 | state.state <- YieldAndNew; 821 | next() 822 | end 823 | | YieldAndNew -> (* yield element from queue, then get a new generator *) 824 | if Queue.is_empty state.gens 825 | then (state.state <- NewGen; next()) 826 | else 827 | let gen = Queue.pop state.gens in 828 | begin match gen () with 829 | | None -> state.state <- NewGen; next() 830 | | (Some _) as res -> 831 | Queue.push gen state.gens; 832 | state.state <- NewGen; 833 | res 834 | end 835 | in next 836 | 837 | (*$T 838 | merge (of_list [of_list [1;3;5]; of_list [2;4;6]; of_list [7;8;9]]) \ 839 | |> to_list |> List.sort GenShims_.Stdlib.compare = [1;2;3;4;5;6;7;8;9] 840 | *) 841 | 842 | (*$R 843 | let e = of_list [1--3; 4--6; 7--9] in 844 | let e' = merge e in 845 | OUnit.assert_equal [1;2;3;4;5;6;7;8;9] 846 | (to_list e' |> List.sort GenShims_.Stdlib.compare); 847 | *) 848 | 849 | let intersection ?(cmp=GenShims_.Stdlib.compare) gen1 gen2 = 850 | let x1 = ref (gen1 ()) in 851 | let x2 = ref (gen2 ()) in 852 | let rec next () = 853 | match !x1, !x2 with 854 | | Some y1, Some y2 -> 855 | let c = cmp y1 y2 in 856 | if c = 0 (* equal elements, yield! *) 857 | then (x1 := gen1(); x2 := gen2(); Some y1) 858 | else if c < 0 (* drop y1 *) 859 | then (x1 := gen1 (); next ()) 860 | else (* drop y2 *) 861 | (x2 := gen2(); next ()) 862 | | _ -> None 863 | in next 864 | 865 | (*$T 866 | intersection (of_list [1;1;2;3;4;8]) (of_list [1;2;4;5;6;7;8;9]) \ 867 | |> to_list = [1;2;4;8] 868 | *) 869 | 870 | let sorted_merge ?(cmp=GenShims_.Stdlib.compare) gen1 gen2 = 871 | let x1 = ref (gen1 ()) in 872 | let x2 = ref (gen2 ()) in 873 | fun () -> 874 | match !x1, !x2 with 875 | | None, None -> None 876 | | (Some y1)as r1, ((Some y2) as r2) -> 877 | if cmp y1 y2 <= 0 878 | then (x1 := gen1 (); r1) 879 | else (x2 := gen2 (); r2) 880 | | (Some _)as r, None -> 881 | x1 := gen1 (); 882 | r 883 | | None, ((Some _)as r) -> 884 | x2 := gen2 (); 885 | r 886 | 887 | (*$T 888 | sorted_merge (of_list [1;2;2;3;5;10;100]) (of_list [2;4;5;6;11]) \ 889 | |> to_list = [1;2;2;2;3;4;5;5;6;10;11;100] 890 | *) 891 | 892 | (*$R 893 | [Gen.of_list [1;3;5]; Gen.of_list [0;1;1;3;4;6;10]; Gen.of_list [2;2;11]] 894 | |> Gen.sorted_merge_n ?cmp:None 895 | |> Gen.to_list 896 | |> OUnit.assert_equal ~printer:pilist [0;1;1;1;2;2;3;3;4;5;6;10;11] 897 | *) 898 | 899 | (** {4 Mutable heap (taken from heap.ml to avoid dependencies)} *) 900 | module Heap = struct 901 | type 'a t = { 902 | mutable tree : 'a tree; 903 | cmp : 'a -> 'a -> int; 904 | } (** A pairing tree heap with the given comparison function *) 905 | 906 | and 'a tree = 907 | | Empty 908 | | Node of 'a * 'a tree * 'a tree 909 | 910 | let empty ~cmp = { 911 | tree = Empty; 912 | cmp; 913 | } 914 | 915 | let is_empty h = 916 | match h.tree with 917 | | Empty -> true 918 | | Node _ -> false 919 | 920 | let rec union ~cmp t1 t2 = match t1, t2 with 921 | | Empty, _ -> t2 922 | | _, Empty -> t1 923 | | Node (x1, l1, r1), Node (x2, l2, r2) -> 924 | if cmp x1 x2 <= 0 925 | then Node (x1, union ~cmp t2 r1, l1) 926 | else Node (x2, union ~cmp t1 r2, l2) 927 | 928 | let insert h x = 929 | h.tree <- union ~cmp:h.cmp (Node (x, Empty, Empty)) h.tree 930 | 931 | let pop h = match h.tree with 932 | | Empty -> raise Not_found 933 | | Node (x, l, r) -> 934 | h.tree <- union ~cmp:h.cmp l r; 935 | x 936 | end 937 | 938 | let sorted_merge_n ?(cmp=GenShims_.Stdlib.compare) l = 939 | (* make a heap of (value, generator) *) 940 | let cmp (v1,_) (v2,_) = cmp v1 v2 in 941 | let heap = Heap.empty ~cmp in 942 | (* add initial values *) 943 | List.iter 944 | (fun gen' -> match gen'() with 945 | | Some x -> Heap.insert heap (x, gen') 946 | | None -> ()) 947 | l; 948 | fun () -> 949 | if Heap.is_empty heap then None 950 | else begin 951 | let x, gen = Heap.pop heap in 952 | match gen() with 953 | | Some y -> 954 | Heap.insert heap (y, gen); (* insert next value *) 955 | Some x 956 | | None -> Some x (* gen empty, drop it *) 957 | end 958 | 959 | (*$T 960 | sorted_merge_n [of_list [1;2;2;3;5;10;100]; of_list [2;4;5;6;11]; (6--10)] \ 961 | |> to_list = [1;2;2;2;3;4;5;5;6;6;7;8;9;10;10;11;100] 962 | *) 963 | 964 | let round_robin ?(n=2) gen = 965 | (* array of queues, together with their index *) 966 | let qs = Array.init n (fun _ -> Queue.create ()) in 967 | let cur = ref 0 in 968 | (* get next element for the i-th queue *) 969 | let rec next i = 970 | let q = qs.(i) in 971 | if Queue.is_empty q 972 | then update_to_i i (* consume generator *) 973 | else Some(Queue.pop q) 974 | (* consume [gen] until some element for [i]-th generator is 975 | available. *) 976 | and update_to_i i = 977 | match gen() with 978 | | None -> None 979 | | Some x -> 980 | let j = !cur in 981 | cur := (j+1) mod n; (* move cursor to next generator *) 982 | let q = qs.(j) in 983 | if j = i 984 | then begin 985 | assert (Queue.is_empty q); 986 | Some x (* return the element *) 987 | end else begin 988 | Queue.push x q; 989 | update_to_i i (* continue consuming [gen] *) 990 | end 991 | in 992 | (* generators *) 993 | let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in 994 | Array.to_list l 995 | 996 | (*$T 997 | round_robin ~n:3 (1--12) |> List.map to_list = \ 998 | [[1;4;7;10]; [2;5;8;11]; [3;6;9;12]] 999 | *) 1000 | 1001 | (*$R 1002 | let e = Restart.round_robin ~n:2 Restart.(1--10) in 1003 | match e with 1004 | | [a;b] -> 1005 | OUnit.assert_equal [1;3;5;7;9] (Gen.to_list a); 1006 | OUnit.assert_equal [2;4;6;8;10] (Gen.to_list b) 1007 | | _ -> OUnit.assert_failure "wrong list length" 1008 | *) 1009 | 1010 | (*$R 1011 | let e = Restart.round_robin ~n:3 Restart.(1 -- 999) in 1012 | let l = List.map Gen.length e in 1013 | OUnit.assert_equal [333;333;333] l; 1014 | *) 1015 | 1016 | (* Duplicate the enum into [n] generators (default 2). The generators 1017 | share the same underlying instance of the enum, so the optimal case is 1018 | when they are consumed evenly *) 1019 | let tee ?(n=2) gen = 1020 | (* array of queues, together with their index *) 1021 | let qs = Array.init n (fun _ -> Queue.create ()) in 1022 | let finished = ref false in (* is [gen] exhausted? *) 1023 | (* get next element for the i-th queue *) 1024 | let rec next i = 1025 | if Queue.is_empty qs.(i) 1026 | then 1027 | if !finished then None 1028 | else get_next i (* consume generator *) 1029 | else Queue.pop qs.(i) 1030 | (* consume one more element *) 1031 | and get_next i = match gen() with 1032 | | Some _ as res -> 1033 | for j = 0 to n-1 do 1034 | if j <> i then Queue.push res qs.(j) 1035 | done; 1036 | res 1037 | | None -> finished := true; None 1038 | in 1039 | (* generators *) 1040 | let l = Array.mapi (fun i _ -> (fun () -> next i)) qs in 1041 | Array.to_list l 1042 | 1043 | (*$T 1044 | tee ~n:3 (1--12) |> List.map to_list = \ 1045 | [to_list (1--12); to_list (1--12); to_list (1--12)] 1046 | *) 1047 | 1048 | 1049 | module InterleaveState = struct 1050 | type 'a t = 1051 | | Only of 'a gen 1052 | | Both of 'a gen * 'a gen * bool ref 1053 | | Stop 1054 | end 1055 | 1056 | (* Yield elements from a and b alternatively *) 1057 | let interleave gen_a gen_b = 1058 | let open InterleaveState in 1059 | let state = ref (Both (gen_a, gen_b, ref true)) in 1060 | let rec next() = match !state with 1061 | | Stop -> None 1062 | | Only g -> 1063 | begin match g() with 1064 | | None -> state := Stop; None 1065 | | (Some _) as res -> res 1066 | end 1067 | | Both (g1, g2, r) -> 1068 | match (if !r then g1() else g2()) with 1069 | | None -> 1070 | state := if !r then Only g2 else Only g1; 1071 | next() 1072 | | (Some _) as res -> 1073 | r := not !r; (* swap *) 1074 | res 1075 | in next 1076 | 1077 | (*$T 1078 | interleave (repeat 0) (1--5) |> take 10 |> to_list = \ 1079 | [0;1;0;2;0;3;0;4;0;5] 1080 | *) 1081 | 1082 | (*$R 1083 | let e1 = Gen.of_list [1;3;5;7;9] in 1084 | let e2 = Gen.of_list [2;4;6;8;10] in 1085 | let e = Gen.interleave e1 e2 in 1086 | OUnit.assert_equal [1;2;3;4;5;6;7;8;9;10] (Gen.to_list e); 1087 | *) 1088 | 1089 | module IntersperseState = struct 1090 | type 'a t = 1091 | | Start 1092 | | YieldElem of 'a option 1093 | | YieldSep of 'a option (* next val *) 1094 | | Stop 1095 | end 1096 | 1097 | (* Put [x] between elements of [enum] *) 1098 | let intersperse x gen = 1099 | let open IntersperseState in 1100 | let state = ref Start in 1101 | let rec next() = match !state with 1102 | | Stop -> None 1103 | | YieldElem res -> 1104 | begin match gen() with 1105 | | None -> state := Stop 1106 | | Some _ as res' -> state := YieldSep res' 1107 | end; 1108 | res 1109 | | YieldSep res -> 1110 | state := YieldElem res; 1111 | Some x 1112 | | Start -> 1113 | match gen() with 1114 | | None -> state := Stop; None 1115 | | Some _ as res -> state := YieldElem res; next() 1116 | in next 1117 | 1118 | (*$T 1119 | intersperse 0 (1--5) |> to_list = [1;0;2;0;3;0;4;0;5] 1120 | *) 1121 | 1122 | (*$R 1123 | let e = 1 -- 5 in 1124 | let e' = Gen.intersperse 0 e in 1125 | OUnit.assert_equal [1;0;2;0;3;0;4;0;5] (Gen.to_list e'); 1126 | *) 1127 | 1128 | (* Cartesian product *) 1129 | let product gena genb = 1130 | let all_a = ref [] in 1131 | let all_b = ref [] in 1132 | (* cur: current state, i.e., what we have to do next. Can be stop, 1133 | getLeft/getRight (to obtain next element from first/second generator), 1134 | or prodLeft/prodRIght to compute the product of an element with a list 1135 | of already met elements *) 1136 | let cur = ref `GetLeft in 1137 | let rec next () = 1138 | match !cur with 1139 | | `Stop -> None 1140 | | `GetLeft -> 1141 | begin match gena() with 1142 | | None -> cur := `GetRightOrStop 1143 | | Some a -> all_a := a :: !all_a; cur := `ProdLeft (a, !all_b) 1144 | end; 1145 | next () 1146 | | `GetRight | `GetRightOrStop -> (* TODO: test *) 1147 | begin match genb() with 1148 | | None when !cur = `GetRightOrStop -> cur := `Stop 1149 | | None -> cur := `GetLeft 1150 | | Some b -> all_b := b::!all_b; cur := `ProdRight (b, !all_a) 1151 | end; 1152 | next () 1153 | | `ProdLeft (_, []) -> 1154 | cur := `GetRight; 1155 | next() 1156 | | `ProdLeft (x, y::l) -> 1157 | cur := `ProdLeft (x, l); 1158 | Some (x, y) 1159 | | `ProdRight (_, []) -> 1160 | cur := `GetLeft; 1161 | next() 1162 | | `ProdRight (y, x::l) -> 1163 | cur := `ProdRight (y, l); 1164 | Some (x, y) 1165 | in 1166 | next 1167 | 1168 | (*$T 1169 | product (1--3) (of_list ["a"; "b"]) |> to_list \ 1170 | |> List.sort GenShims_.Stdlib.compare = \ 1171 | [1, "a"; 1, "b"; 2, "a"; 2, "b"; 3, "a"; 3, "b"] 1172 | *) 1173 | 1174 | (*$R 1175 | let printer = pi2list in 1176 | let e = Gen.product (1--3) (4--5) in 1177 | OUnit.assert_equal ~printer [1,4; 1,5; 2,4; 2,5; 3,4; 3,5] 1178 | (List.sort GenShims_.Stdlib.compare (Gen.to_list e)); 1179 | *) 1180 | 1181 | (* Group equal consecutive elements together. *) 1182 | let group ?(eq=(=)) gen = 1183 | match gen() with 1184 | | None -> fun () -> None 1185 | | Some x -> 1186 | let cur = ref [x] in 1187 | let rec next () = 1188 | (* try to get an element *) 1189 | let next_x = if !cur = [] then None else gen() in 1190 | match next_x, !cur with 1191 | | None, [] -> None 1192 | | None, l -> 1193 | cur := []; (* stop *) 1194 | Some l 1195 | | Some x, y::_ when eq x y -> 1196 | cur := x::!cur; 1197 | next () (* same group *) 1198 | | Some x, l -> 1199 | cur := [x]; 1200 | Some l 1201 | in next 1202 | 1203 | (*$T 1204 | group (of_list [0;0;0;1;0;2;2;3;4;5;5;5;5;10]) |> to_list = \ 1205 | [[0;0;0];[1];[0];[2;2];[3];[4];[5;5;5;5];[10]] 1206 | *) 1207 | 1208 | let uniq ?(eq=(=)) gen = 1209 | let open RunState in 1210 | let state = ref Init in 1211 | let rec next() = match !state with 1212 | | Stop -> None 1213 | | Init -> 1214 | begin match gen() with 1215 | | None -> state:= Stop; None 1216 | | (Some x) as res -> state := Run x; res 1217 | end 1218 | | Run x -> 1219 | begin match gen() with 1220 | | None -> state:= Stop; None 1221 | | (Some y) as res -> 1222 | if eq x y 1223 | then next() (* ignore duplicate *) 1224 | else (state := Run y; res) 1225 | end 1226 | in next 1227 | 1228 | (*$T 1229 | uniq (of_list [0;0;0;1;0;2;2;3;4;5;5;5;5;10]) |> to_list = \ 1230 | [0;1;0;2;3;4;5;10] 1231 | *) 1232 | 1233 | let sort ?(cmp=GenShims_.Stdlib.compare) gen = 1234 | (* build heap *) 1235 | let h = Heap.empty ~cmp in 1236 | iter (Heap.insert h) gen; 1237 | fun () -> 1238 | if Heap.is_empty h 1239 | then None 1240 | else Some (Heap.pop h) 1241 | (*$T 1242 | sort (of_list [0;0;0;1;0;2;2;3;4;5;5;5;-42;5;10]) |> to_list = \ 1243 | [-42;0;0;0;0;1;2;2;3;4;5;5;5;5;10] 1244 | *) 1245 | 1246 | 1247 | (* NOTE: using a set is not really possible, because once we have built the 1248 | set there is no simple way to iterate on it *) 1249 | let sort_uniq ?(cmp=GenShims_.Stdlib.compare) gen = 1250 | uniq ~eq:(fun x y -> cmp x y = 0) (sort ~cmp gen) 1251 | 1252 | (*$T 1253 | sort_uniq (of_list [0;0;0;1;0;2;2;3;4;5;42;5;5;42;5;10]) |> to_list = \ 1254 | [0;1;2;3;4;5;10;42] 1255 | *) 1256 | 1257 | let chunks n e = 1258 | let rec next () = 1259 | match e() with 1260 | | None -> None 1261 | | Some x -> 1262 | let a = Array.make n x in 1263 | fill a 1 1264 | 1265 | and fill a i = 1266 | (* fill the array. [i]: current index to fill *) 1267 | if i = n 1268 | then Some a 1269 | else match e() with 1270 | | None -> Some (Array.sub a 0 i) (* last array is not full *) 1271 | | Some x -> 1272 | a.(i) <- x; 1273 | fill a (i+1) 1274 | in 1275 | next 1276 | 1277 | (*$T 1278 | chunks 25 (0--100) |> map Array.to_list |> to_list = \ 1279 | List.map to_list [(0--24); (25--49);(50--74);(75--99);(100--100)] 1280 | *) 1281 | 1282 | (*$Q 1283 | Q.(list int) (fun l -> \ 1284 | of_list l |> chunks 25 |> flat_map of_array |> to_list = l) 1285 | *) 1286 | 1287 | (* state of the permutation machine. One machine manages one element [x], 1288 | and depends on a deeper machine [g] that generates permutations of the 1289 | list minus this element (down to the empty list). 1290 | The machine can do two things: 1291 | - insert the element in the current list of [g], at any position 1292 | - obtain the next list of [g] 1293 | *) 1294 | 1295 | (* TODO: check https://en.wikipedia.org/wiki/Heap's_algorithm , might be better *) 1296 | 1297 | module PermState = struct 1298 | type 'a state = 1299 | | Done 1300 | | Base (* bottom machine, yield [] *) 1301 | | Insert of 'a insert_state 1302 | and 'a insert_state = { 1303 | x : 'a; 1304 | mutable l : 'a list; 1305 | mutable n : int; (* idx for insertion *) 1306 | len : int; (* len of [l] *) 1307 | sub : 'a t; 1308 | } 1309 | and 'a t = { 1310 | mutable st : 'a state; 1311 | } 1312 | end 1313 | 1314 | let permutations g = 1315 | let open PermState in 1316 | (* make a machine for n elements. Invariant: n=len(l) *) 1317 | let rec make_machine n l = match l with 1318 | | [] -> assert (n=0); {st=Base} 1319 | | x :: tail -> 1320 | let sub = make_machine (n-1) tail in 1321 | let st = match next sub () with 1322 | | None -> Done 1323 | | Some l -> Insert {x;n=0;l;len=n;sub} 1324 | in 1325 | {st;} 1326 | (* next element of the machine *) 1327 | and next m () = match m.st with 1328 | | Done -> None 1329 | | Base -> m.st <- Done; Some [] 1330 | | Insert ({x;len;n;l;sub} as state) -> 1331 | if n=len 1332 | then match next sub () with 1333 | | None -> m.st <- Done; None 1334 | | Some l -> 1335 | state.l <- l; 1336 | state.n <- 0; 1337 | next m () 1338 | else ( 1339 | state.n <- state.n + 1; 1340 | Some (insert x n l) 1341 | ) 1342 | and insert x n l = match n, l with 1343 | | 0, _ -> x::l 1344 | | _, [] -> assert false 1345 | | _, y::tail -> y :: insert x (n-1) tail 1346 | in 1347 | let l = fold (fun acc x->x::acc) [] g in 1348 | next (make_machine (List.length l) l) 1349 | 1350 | (*$T permutations 1351 | permutations (1--3) |> to_list |> List.sort GenShims_.Stdlib.compare = \ 1352 | [[1;2;3]; [1;3;2]; [2;1;3]; [2;3;1]; [3;1;2]; [3;2;1]] 1353 | permutations empty |> to_list = [[]] 1354 | permutations (singleton 1) |> to_list = [[1]] 1355 | *) 1356 | 1357 | 1358 | (* 1359 | Credits to Bernardo Freitas Paulo da Costa for [permutations_heap]! 1360 | 1361 | B.R.Heap's algorithm for permutations, 1362 | cf http://en.wikipedia.org/wiki/Heap%27s_algorithm. 1363 | 1364 | Continuation-based recursive formula, model for the state manipulations 1365 | below: 1366 | {[ 1367 | let rec heap_perm k a n = 1368 | match n with 1369 | | 0 -> k a 1370 | | n -> 1371 | for i = 0 to n-1 do 1372 | heap_perm k a (n-1); 1373 | let j = (if n mod 2 = 1 then 0 else i) in 1374 | let t = a.(j) in 1375 | a.(j) <- a.(n-1); 1376 | a.(n-1) <- t 1377 | done 1378 | ]} 1379 | *) 1380 | 1381 | (* The state of the permutation machine, containing 1382 | - the array [a] we're permuting, in the "current permutation"; 1383 | - the level of recursion [n]: we can permute elements with index < [n] 1384 | - the stack of values of indices to permute [i] in the list [is] 1385 | The permutation stops when we have no more elements in the stack [is]. 1386 | *) 1387 | module HeapPermState = struct 1388 | type 'a state = { 1389 | elts : 'a array; 1390 | mutable n : int; 1391 | mutable is : int list; 1392 | } 1393 | end 1394 | 1395 | let permutations_heap g = 1396 | let open HeapPermState in 1397 | let l = fold (fun acc x->x::acc) [] g in 1398 | let a = Array.of_list l in 1399 | let rec next st () = match st.n with 1400 | | 0 -> 1401 | begin match st.is with 1402 | | [] | _::[] -> assert false 1403 | | 0::i::is' -> (* "Pop state" before returning next element *) 1404 | st.is <- (i+1)::is'; 1405 | st.n <- 1; 1406 | Some (Array.copy a) 1407 | | _::_::_ -> assert false 1408 | end 1409 | | n -> 1410 | match st.is with 1411 | | [] -> None 1412 | | i::is' when i = n -> (* Pop state at end of loop *) 1413 | st.is <- is'; 1414 | st.n <- n+1; 1415 | begin match st.is with 1416 | | [] -> None (* last loop *) 1417 | | i::is' -> 1418 | let j = (if st.n mod 2 = 1 then 0 else i) in 1419 | let tmp = st.elts.(j) in 1420 | st.elts.(j) <- st.elts.(n); 1421 | st.elts.(n) <- tmp; 1422 | st.is <- (i+1)::is'; 1423 | next st () 1424 | end 1425 | | _::_ -> (* Recurse down and start new loop *) 1426 | st.n <- n-1; 1427 | st.is <- 0 :: st.is; 1428 | next st () 1429 | in 1430 | let n = Array.length a in 1431 | if n = 0 then empty 1432 | else next {elts = a; n=n; is=[0]} 1433 | 1434 | (*$T permutations_heap 1435 | permutations_heap (1--3) |> to_list |> List.sort GenShims_.Stdlib.compare = \ 1436 | [[|1;2;3|]; [|1;3;2|]; [|2;1;3|]; [|2;3;1|]; [|3;1;2|]; [|3;2;1|]] 1437 | permutations_heap empty |> to_list = [] 1438 | permutations_heap (singleton 1) |> to_list = [[|1|]] 1439 | *) 1440 | 1441 | module CombState = struct 1442 | type 'a state = 1443 | | Done 1444 | | Base 1445 | | Add of 'a * 'a t * 'a t (* add x at beginning of first; then switch to second *) 1446 | | Follow of 'a t (* just forward *) 1447 | and 'a t = { 1448 | mutable st : 'a state 1449 | } 1450 | end 1451 | 1452 | let combinations n g = 1453 | let open CombState in 1454 | assert (n >= 0); 1455 | let rec make_state n l = match n, l with 1456 | | 0, _ -> {st=Base} 1457 | | _, [] -> {st=Done} 1458 | | _, x::tail -> 1459 | let m1 = make_state (n-1) tail in 1460 | let m2 = make_state n tail in 1461 | {st=Add(x,m1,m2)} 1462 | and next m () = match m.st with 1463 | | Done -> None 1464 | | Base -> m.st <- Done; Some [] 1465 | | Follow m -> 1466 | begin match next m () with 1467 | | None -> m.st <- Done; None 1468 | | Some _ as res -> res 1469 | end 1470 | | Add (x, m1, m2) -> 1471 | match next m1 () with 1472 | | None -> 1473 | m.st <- Follow m2; 1474 | next m () 1475 | | Some l -> Some (x::l) 1476 | in 1477 | let l = fold (fun acc x->x::acc) [] g in 1478 | next (make_state n l) 1479 | 1480 | (*$T 1481 | combinations 2 (1--4) |> map (List.sort GenShims_.Stdlib.compare) \ 1482 | |> to_list |> List.sort GenShims_.Stdlib.compare = \ 1483 | [[1;2]; [1;3]; [1;4]; [2;3]; [2;4]; [3;4]] 1484 | combinations 0 (1--4) |> to_list = [[]] 1485 | combinations 1 (singleton 1) |> to_list = [[1]] 1486 | *) 1487 | 1488 | module PowerSetState = struct 1489 | type 'a state = 1490 | | Done 1491 | | Base 1492 | | Add of 'a * 'a t (* add x before any result of m *) 1493 | | AddTo of 'a list * 'a * 'a t (* yield x::list, then back to Add(x,m) *) 1494 | and 'a t = { 1495 | mutable st : 'a state 1496 | } 1497 | end 1498 | 1499 | let power_set g = 1500 | let open PowerSetState in 1501 | let rec make_state l = match l with 1502 | | [] -> {st=Base} 1503 | | x::tail -> 1504 | let m = make_state tail in 1505 | {st=Add(x,m)} 1506 | and next m () = match m.st with 1507 | | Done -> None 1508 | | Base -> m.st <- Done; Some [] 1509 | | Add (x,m') -> 1510 | begin match next m' () with 1511 | | None -> m.st <- Done; None 1512 | | Some l as res -> m.st <- AddTo(l,x,m'); res 1513 | end 1514 | | AddTo (l, x, m') -> 1515 | m.st <- Add (x,m'); 1516 | Some (x::l) 1517 | in 1518 | let l = fold (fun acc x->x::acc) [] g in 1519 | next (make_state l) 1520 | 1521 | (*$T 1522 | power_set (1--3) |> map (List.sort GenShims_.Stdlib.compare) \ 1523 | |> to_list |> List.sort GenShims_.Stdlib.compare = \ 1524 | [[]; [1]; [1;2]; [1;2;3]; [1;3]; [2]; [2;3]; [3]] 1525 | power_set empty |> to_list = [[]] 1526 | power_set (singleton 1) |> map (List.sort GenShims_.Stdlib.compare) \ 1527 | |> to_list |> List.sort GenShims_.Stdlib.compare = [[]; [1]] 1528 | *) 1529 | 1530 | (** {3 Conversion} *) 1531 | 1532 | let of_list l = 1533 | let l = ref l in 1534 | fun () -> 1535 | match !l with 1536 | | [] -> None 1537 | | x::l' -> l := l'; Some x 1538 | 1539 | let to_rev_list gen = 1540 | fold (fun acc x -> x :: acc) [] gen 1541 | 1542 | (*$Q 1543 | (Q.list Q.small_int) (fun l -> \ 1544 | to_rev_list (of_list l) = List.rev l) 1545 | *) 1546 | 1547 | let to_list gen = List.rev (to_rev_list gen) 1548 | 1549 | let to_array gen = 1550 | let l = to_rev_list gen in 1551 | match l with 1552 | | [] -> [| |] 1553 | | _ -> 1554 | let a = Array.of_list l in 1555 | let n = Array.length a in 1556 | (* reverse array *) 1557 | for i = 0 to (n-1) / 2 do 1558 | let tmp = a.(i) in 1559 | a.(i) <- a.(n-i-1); 1560 | a.(n-i-1) <- tmp 1561 | done; 1562 | a 1563 | 1564 | let of_array ?(start=0) ?len a = 1565 | let len = match len with 1566 | | None -> Array.length a - start 1567 | | Some n -> assert (n + start < Array.length a); n in 1568 | let i = ref start in 1569 | fun () -> 1570 | if !i >= start + len 1571 | then None 1572 | else (let x = a.(!i) in incr i; Some x) 1573 | 1574 | (*$Q 1575 | (Q.array Q.small_int) (fun a -> \ 1576 | of_array a |> to_array = a) 1577 | *) 1578 | 1579 | let of_string ?(start=0) ?len s = 1580 | let len = match len with 1581 | | None -> String.length s - start 1582 | | Some n -> assert (n + start < String.length s); n in 1583 | let i = ref start in 1584 | fun () -> 1585 | if !i >= start + len 1586 | then None 1587 | else (let x = s.[!i] in incr i; Some x) 1588 | 1589 | let to_buffer buf g = 1590 | iter (Buffer.add_char buf) g 1591 | 1592 | let to_string s = 1593 | let buf = Buffer.create 16 in 1594 | to_buffer buf s; 1595 | Buffer.contents buf 1596 | 1597 | let of_seq seq : _ t = 1598 | let seq = ref seq in 1599 | fun () -> 1600 | match !seq () with 1601 | | Seq.Nil -> None 1602 | | Seq.Cons (x,tl) -> 1603 | seq := tl; 1604 | Some x 1605 | 1606 | let rand_int i = 1607 | repeatedly (fun () -> Random.int i) 1608 | 1609 | let int_range ?(step=1) i j = 1610 | if step = 0 then raise (Invalid_argument "Gen.int_range"); 1611 | let (>) = if step > 0 then (>) else (<) in 1612 | let r = ref i in 1613 | fun () -> 1614 | let x = !r in 1615 | if x > j then None 1616 | else begin 1617 | r := !r + step; 1618 | Some x 1619 | end 1620 | 1621 | (*$= & ~printer:Q.Print.(list int) 1622 | [1;2;3;4] (int_range 1 4 |> to_list) 1623 | [4;3;2;1] (int_range ~step:~-1 4 1 |> to_list) 1624 | [6;4;2] (int_range 6 1 ~step:~-2 |> to_list) 1625 | [] (int_range 4 1 |> to_list) 1626 | *) 1627 | 1628 | let lines g = 1629 | let buf = Buffer.create 32 in 1630 | let stop = ref false in 1631 | let rec next() = 1632 | if !stop then None 1633 | else match g() with 1634 | | None -> stop := true; 1635 | (* only return a non-empty line *) 1636 | if Buffer.length buf =0 then None else Some (Buffer.contents buf) 1637 | | Some '\n' -> 1638 | let s = Buffer.contents buf in 1639 | Buffer.clear buf; 1640 | Some s 1641 | | Some c -> Buffer.add_char buf c; next () 1642 | in 1643 | next 1644 | 1645 | (*$= & ~printer:Q.Print.(list string) 1646 | ["abc"; "de"; ""] (lines (of_string "abc\nde\n\n") |> to_list) 1647 | *) 1648 | 1649 | let unlines g = 1650 | let st = ref `Next in 1651 | fun () -> match !st with 1652 | | `Stop -> None 1653 | | `Next -> 1654 | begin match g() with 1655 | | None -> st := `Stop; None 1656 | | Some "" -> Some '\n' (* empty line *) 1657 | | Some s -> st := `Consume (s, 1); Some s.[0] 1658 | end 1659 | | `Consume (s, i) when i=String.length s -> 1660 | st := `Next; 1661 | Some '\n' 1662 | | `Consume (s, i) -> 1663 | st := `Consume (s, i+1); Some s.[i] 1664 | 1665 | (*$Q 1666 | Q.printable_string (fun s -> \ 1667 | of_string s |> lines |> unlines |> to_string |> String.trim = String.trim s) 1668 | *) 1669 | 1670 | let pp ?(start="") ?(stop="") ?(sep=",") ?(horizontal=false) pp_elem formatter gen = 1671 | (if horizontal 1672 | then Format.pp_open_hbox formatter () 1673 | else Format.pp_open_hvbox formatter 0); 1674 | Format.pp_print_string formatter start; 1675 | let rec next is_first = 1676 | match gen() with 1677 | | Some x -> 1678 | if not is_first 1679 | then begin 1680 | Format.pp_print_string formatter sep; 1681 | Format.pp_print_space formatter (); 1682 | pp_elem formatter x 1683 | end else pp_elem formatter x; 1684 | next false 1685 | | None -> () 1686 | in 1687 | next true; 1688 | Format.pp_print_string formatter stop; 1689 | Format.pp_close_box formatter () 1690 | 1691 | module Infix = struct 1692 | let (--) = int_range ~step:1 1693 | 1694 | let (>>=) x f = flat_map f x 1695 | let (>>|) x f = map f x 1696 | let (>|=) x f = map f x 1697 | end 1698 | 1699 | include Infix 1700 | 1701 | module Restart = struct 1702 | type 'a t = unit -> 'a gen 1703 | 1704 | type 'a restartable = 'a t 1705 | 1706 | let lift f e = f (e ()) 1707 | let lift2 f e1 e2 = f (e1 ()) (e2 ()) 1708 | 1709 | let empty () = empty 1710 | 1711 | let singleton x () = singleton x 1712 | 1713 | let return = singleton 1714 | 1715 | let iterate x f () = iterate x f 1716 | 1717 | let repeat x () = repeat x 1718 | 1719 | let unfold f acc () = unfold f acc 1720 | 1721 | let init ?limit f () = init ?limit f 1722 | 1723 | let cycle enum = 1724 | assert (not (is_empty (enum ()))); 1725 | fun () -> 1726 | let gen = ref (enum ()) in (* start cycle *) 1727 | let rec next () = 1728 | match (!gen) () with 1729 | | (Some _) as res -> res 1730 | | None -> gen := enum(); next() 1731 | in next 1732 | 1733 | let is_empty e = is_empty (e ()) 1734 | 1735 | let fold f acc e = fold f acc (e ()) 1736 | 1737 | let reduce f e = reduce f (e ()) 1738 | 1739 | let scan f acc e () = scan f acc (e ()) 1740 | 1741 | let unfold_scan f acc e () = unfold_scan f acc (e()) 1742 | 1743 | let iter f e = iter f (e ()) 1744 | 1745 | let iteri f e = iteri f (e ()) 1746 | 1747 | let length e = length (e ()) 1748 | 1749 | let map f e () = map f (e ()) 1750 | 1751 | let mapi f e () = mapi f (e ()) 1752 | 1753 | let fold_map f s e () = fold_map f s (e ()) 1754 | 1755 | let append e1 e2 () = append (e1 ()) (e2 ()) 1756 | 1757 | let flatten e () = flatten (e ()) 1758 | 1759 | let flat_map f e () = flat_map f (e ()) 1760 | 1761 | let mem ?eq x e = mem ?eq x (e ()) 1762 | 1763 | let take n e () = take n (e ()) 1764 | 1765 | let drop n e () = drop n (e ()) 1766 | 1767 | let nth n e = nth n (e ()) 1768 | 1769 | let take_nth n e () = take_nth n (e ()) 1770 | 1771 | let filter p e () = filter p (e ()) 1772 | 1773 | let take_while p e () = take_while p (e ()) 1774 | 1775 | let fold_while f s e = fold_while f s (e ()) 1776 | 1777 | let drop_while p e () = drop_while p (e ()) 1778 | 1779 | let filter_map f e () = filter_map f (e ()) 1780 | 1781 | let zip_with f e1 e2 () = zip_with f (e1 ()) (e2 ()) 1782 | 1783 | let zip e1 e2 () = zip (e1 ()) (e2 ()) 1784 | 1785 | let zip_index e () = zip_index (e ()) 1786 | 1787 | let unzip e = map fst e, map snd e 1788 | 1789 | let partition p e = 1790 | filter p e, filter (fun x -> not (p x)) e 1791 | 1792 | let for_all p e = 1793 | for_all p (e ()) 1794 | 1795 | let exists p e = 1796 | exists p (e ()) 1797 | 1798 | let for_all2 p e1 e2 = 1799 | for_all2 p (e1 ()) (e2 ()) 1800 | 1801 | let exists2 p e1 e2 = 1802 | exists2 p (e1 ()) (e2 ()) 1803 | 1804 | let map2 f e1 e2 () = 1805 | map2 f (e1()) (e2()) 1806 | 1807 | let iter2 f e1 e2 = 1808 | iter2 f (e1()) (e2()) 1809 | 1810 | let fold2 f acc e1 e2 = 1811 | fold2 f acc (e1()) (e2()) 1812 | 1813 | let min ?lt e = min ?lt (e ()) 1814 | 1815 | let max ?lt e = max ?lt (e ()) 1816 | 1817 | let ___eq = eq 1818 | let eq ?eq e1 e2 = ___eq ?eq (e1 ()) (e2 ()) 1819 | 1820 | let lexico ?cmp e1 e2 = lexico ?cmp (e1 ()) (e2 ()) 1821 | 1822 | let compare ?cmp e1 e2 = compare ?cmp (e1 ()) (e2 ()) 1823 | 1824 | let sum e = sum (e()) 1825 | 1826 | let find f e = find f (e()) 1827 | 1828 | let merge e () = merge (e ()) 1829 | 1830 | let intersection ?cmp e1 e2 () = 1831 | intersection ?cmp (e1 ()) (e2 ()) 1832 | 1833 | let sorted_merge ?cmp e1 e2 () = 1834 | sorted_merge ?cmp (e1 ()) (e2 ()) 1835 | 1836 | let sorted_merge_n ?cmp l () = 1837 | sorted_merge_n ?cmp (List.map (fun g -> g()) l) 1838 | 1839 | let tee ?n e = tee ?n (e ()) 1840 | 1841 | let round_robin ?n e = round_robin ?n (e ()) 1842 | 1843 | let interleave e1 e2 () = interleave (e1 ()) (e2 ()) 1844 | 1845 | let intersperse x e () = intersperse x (e ()) 1846 | 1847 | let product e1 e2 () = product (e1 ()) (e2 ()) 1848 | 1849 | let group ?eq e () = group ?eq (e ()) 1850 | 1851 | let uniq ?eq e () = uniq ?eq (e ()) 1852 | 1853 | let sort ?(cmp=GenShims_.Stdlib.compare) enum = 1854 | fun () -> sort ~cmp (enum ()) 1855 | 1856 | let sort_uniq ?(cmp=GenShims_.Stdlib.compare) e = 1857 | let e' = sort ~cmp e in 1858 | uniq ~eq:(fun x y -> cmp x y = 0) e' 1859 | 1860 | let chunks n e () = chunks n (e()) 1861 | 1862 | let permutations g () = permutations (g ()) 1863 | 1864 | let permutations_heap g () = permutations_heap (g ()) 1865 | 1866 | let combinations n g () = combinations n (g()) 1867 | 1868 | let power_set g () = power_set (g()) 1869 | 1870 | let of_list l () = of_list l 1871 | 1872 | let to_rev_list e = to_rev_list (e ()) 1873 | 1874 | let to_list e = to_list (e ()) 1875 | 1876 | let to_array e = to_array (e ()) 1877 | 1878 | let of_array ?start ?len a () = of_array ?start ?len a 1879 | 1880 | let of_string ?start ?len s () = of_string ?start ?len s 1881 | 1882 | let to_string s = to_string (s ()) 1883 | 1884 | let to_buffer buf s = to_buffer buf (s ()) 1885 | 1886 | let to_iter s yield = iter yield s 1887 | 1888 | let rand_int i () = rand_int i 1889 | 1890 | let int_range ?step i j () = int_range ?step i j 1891 | 1892 | let lines g () = lines (g()) 1893 | let unlines g () = unlines (g()) 1894 | 1895 | module Infix = struct 1896 | let (--) = int_range ~step:1 1897 | 1898 | let (>>=) x f = flat_map f x 1899 | let (>>|) x f = map f x 1900 | let (>|=) x f = map f x 1901 | end 1902 | 1903 | include Infix 1904 | 1905 | let pp ?start ?stop ?sep ?horizontal pp_elem fmt e = 1906 | pp ?start ?stop ?sep ?horizontal pp_elem fmt (e ()) 1907 | 1908 | let of_gen ?caching ?max_chunk_size g = 1909 | let cached = ref None in 1910 | fun () -> 1911 | match !cached with 1912 | | Some mlist -> GenMList.to_gen mlist 1913 | | None -> 1914 | let mlist = GenMList.of_gen_lazy ?max_chunk_size ?caching g in 1915 | cached := Some mlist; 1916 | GenMList.to_gen mlist 1917 | 1918 | let of_seq seq : _ t = 1919 | fun () -> of_seq seq 1920 | end 1921 | 1922 | (** {2 Generator functions} *) 1923 | 1924 | let start g = g () 1925 | 1926 | (** Store content of the generator in an enum *) 1927 | let persistent gen = 1928 | let l = GenMList.of_gen gen in 1929 | fun () -> GenMList.to_gen l 1930 | 1931 | (*$inject 1932 | let rec seq_take i seq () = 1933 | if i=0 then Seq.Nil 1934 | else match seq() with 1935 | | Seq.Nil -> Seq.Nil 1936 | | Seq.Cons (x,tl) -> Seq.Cons (x, seq_take (i-1) tl) 1937 | 1938 | let seq_to_list seq = 1939 | let rec aux acc s = match s() with 1940 | | Seq.Nil -> List.rev acc 1941 | | Seq.Cons (x,tl) -> aux (x::acc) tl 1942 | in 1943 | aux [] seq 1944 | *) 1945 | 1946 | (*$T 1947 | let g = 1--10 in let g' = persistent g in \ 1948 | Restart.to_list g' = Restart.to_list g' 1949 | let g = 1--10 in let g' = persistent g in \ 1950 | Restart.to_list g' = [1;2;3;4;5;6;7;8;9;10] 1951 | *) 1952 | 1953 | let persistent_to_seq gen : _ Seq.t = 1954 | let l = GenMList.of_gen gen in 1955 | GenMList.to_seq l 1956 | 1957 | (*$T 1958 | let g = 1--100_000 in \ 1959 | let seq = persistent_to_seq g in \ 1960 | (seq |> seq_take 100 |> seq_to_list = (1--100 |> to_list)) && \ 1961 | (seq |> seq_take 200 |> seq_to_list = (1--200 |> to_list)) && \ 1962 | (seq |> seq_take 80_000 |> seq_to_list = (1--80_000 |> to_list)) && \ 1963 | (seq |> seq_take 50_000 |> seq_to_list = (1--50_000 |> to_list)) 1964 | *) 1965 | 1966 | (*$R 1967 | let i = ref 0 in 1968 | let gen () = 1969 | let j = !i in 1970 | if j > 5 then None else (incr i; Some j) 1971 | in 1972 | let e = Gen.persistent gen in 1973 | OUnit.assert_equal [0;1;2;3;4;5] (Restart.to_list e); 1974 | OUnit.assert_equal [0;1;2;3;4;5] (Restart.to_list e); 1975 | OUnit.assert_equal [0;1;2;3;4;5] (Restart.to_list e); 1976 | *) 1977 | 1978 | let persistent_lazy ?caching ?max_chunk_size gen = 1979 | let l = GenMList.of_gen_lazy ?max_chunk_size ?caching gen in 1980 | fun () -> GenMList.to_gen l 1981 | 1982 | (*$T 1983 | let g = 1--1_000_000_000 in let g' = persistent_lazy g in \ 1984 | (g' () |> take 100 |> to_list = (1--100 |> to_list)) && \ 1985 | (g' () |> take 200 |> to_list = (1--200 |> to_list)) 1986 | *) 1987 | 1988 | let persistent_lazy_to_seq ?caching ?max_chunk_size gen : _ Seq.t = 1989 | let l = GenMList.of_gen_lazy ?max_chunk_size ?caching gen in 1990 | GenMList.to_seq l 1991 | 1992 | (*$T 1993 | let g = 1--1_000_000_000 in \ 1994 | let seq = persistent_lazy_to_seq g in \ 1995 | (seq |> seq_take 100 |> seq_to_list = (1--100 |> to_list)) && \ 1996 | (seq |> seq_take 200 |> seq_to_list = (1--200 |> to_list)) && \ 1997 | (seq |> seq_take 80_000 |> seq_to_list = (1--80_000 |> to_list)) && \ 1998 | (seq |> seq_take 50_000 |> seq_to_list = (1--50_000 |> to_list)) 1999 | *) 2000 | 2001 | let to_iter g yield = iter yield g 2002 | 2003 | let peek g = 2004 | let state = ref `Start in 2005 | let rec next() = match !state with 2006 | | `Stop -> None 2007 | | `At x -> 2008 | begin match g() with 2009 | | None -> state := `Stop; Some (x,None) 2010 | | Some y as res -> state := `At y; Some (x, res) 2011 | end 2012 | | `Start -> 2013 | begin match g() with 2014 | | None -> state := `Stop; None 2015 | | Some x -> state := `At x; next() 2016 | end 2017 | in 2018 | next 2019 | 2020 | (*$= & ~printer:Q.Print.(list (pair int (option int))) 2021 | [] (peek (of_list []) |> to_list) 2022 | [1, Some 2; 2, Some 3; 3, Some 4; 4, None] (peek (1 -- 4) |> to_list) 2023 | *) 2024 | 2025 | (*$Q 2026 | Q.(list int) (fun l -> \ 2027 | l = [] || (of_list l |> peek |> filter_map snd |> to_list = List.tl l)) 2028 | *) 2029 | 2030 | let queue_to_array_ q = 2031 | if Queue.is_empty q then [||] 2032 | else ( 2033 | let x = Queue.peek q in 2034 | let a = Array.make (Queue.length q) x in 2035 | let i = ref 0 in 2036 | Queue.iter (fun x -> a.(!i) <- x; incr i) q; 2037 | a 2038 | ) 2039 | 2040 | let peek_n n g = 2041 | if n<1 then invalid_arg "peek_n"; 2042 | let state = ref `Start in 2043 | let q = Queue.create() in 2044 | let rec next () = match !state with 2045 | | `Start -> 2046 | fill n; 2047 | state := if Queue.is_empty q then `Stop else `Continue; 2048 | next () 2049 | | `Continue -> 2050 | assert (not (Queue.is_empty q)); 2051 | let x = Queue.pop q in 2052 | fill 1; 2053 | state := if Queue.is_empty q then `Stop else `Continue; 2054 | Some (x, queue_to_array_ q) 2055 | | `Stop -> None 2056 | (* add [n] elements to [f] if possible *) 2057 | and fill i = 2058 | assert (i + Queue.length q <= n); 2059 | if i>0 then match g() with 2060 | | None -> () 2061 | | Some x -> 2062 | Queue.push x q; 2063 | fill (i-1) 2064 | in 2065 | next 2066 | 2067 | (*$= & ~printer:Q.Print.(list (pair int (array int))) 2068 | [] (peek_n 1 (of_list []) |> to_list) 2069 | [1, [|2;3|]; 2, [|3;4|]; 3, [|4|]; 4, [||]] (peek_n 2 (1 -- 4) |> to_list) 2070 | [1, [|2;3;4|]; 2, [|3;4;5|]; 3, [|4;5|]; 4, [|5|]; 5,[||]] \ 2071 | (peek_n 3 (1 -- 5) |> to_list) 2072 | *) 2073 | 2074 | (*$QR 2075 | Q.(list small_int) 2076 | (fun l -> 2077 | let l' = 2078 | of_list l 2079 | |> peek_n 10 2080 | |> filter_map (fun (_,a) -> if a=[||] then None else Some a.(0)) 2081 | |> to_list 2082 | in 2083 | l = [] || l' = List.tl l) 2084 | *) 2085 | 2086 | (** {2 Basic IO} *) 2087 | 2088 | module IO = struct 2089 | let with_file_in ?(mode=0o644) ?(flags=[]) filename f = 2090 | let ic = open_in_gen flags mode filename in 2091 | try 2092 | let x = f ic in 2093 | close_in_noerr ic; 2094 | x 2095 | with e -> 2096 | close_in_noerr ic; 2097 | raise e 2098 | 2099 | let with_in ?mode ?flags filename f = 2100 | with_file_in ?mode ?flags filename 2101 | (fun ic -> 2102 | let next() = 2103 | try Some (input_char ic) 2104 | with End_of_file -> None 2105 | in 2106 | f next 2107 | ) 2108 | 2109 | let with_lines ?mode ?flags filename f = 2110 | with_file_in ?mode ?flags filename 2111 | (fun ic -> 2112 | let next() = 2113 | try Some (input_line ic) 2114 | with End_of_file -> None 2115 | in 2116 | f next 2117 | ) 2118 | 2119 | let with_file_out ?(mode=0o644) ?(flags=[Open_creat;Open_wronly]) filename f = 2120 | let oc = open_out_gen flags mode filename in 2121 | try 2122 | let x = f oc in 2123 | close_out oc; 2124 | x 2125 | with e -> 2126 | close_out_noerr oc; 2127 | raise e 2128 | 2129 | let write_str ?mode ?flags ?(sep="") filename g = 2130 | with_file_out ?mode ?flags filename 2131 | (fun oc -> 2132 | iteri 2133 | (fun i s -> 2134 | if i>0 then output_string oc sep; 2135 | output_string oc s 2136 | ) g 2137 | ) 2138 | 2139 | let write ?mode ?flags filename g = 2140 | with_file_out ?mode ?flags filename 2141 | (fun oc -> 2142 | iter (fun c -> output_char oc c) g 2143 | ) 2144 | 2145 | let write_lines ?mode ?flags filename g = 2146 | with_file_out ?mode ?flags filename 2147 | (fun oc -> 2148 | iter (fun s -> output_string oc s; output_char oc '\n') g 2149 | ) 2150 | end 2151 | -------------------------------------------------------------------------------- /src/gen.mli: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Generators} 5 | 6 | Values of type ['a Gen.t] represent a possibly infinite sequence of values 7 | of type 'a. One can only iterate once on the sequence, as it is consumed 8 | by iteration/deconstruction/access. [None] is returned when the generator 9 | is exhausted. 10 | 11 | The submodule {!Restart} provides utilities to work with 12 | {b restartable generators}, that is, functions [unit -> 'a Gen.t] that 13 | allow to build as many generators from the same source as needed. 14 | *) 15 | 16 | (** {2 Global type declarations} *) 17 | 18 | type 'a t = unit -> 'a option 19 | (** A generator may be called several times, yielding the next value 20 | each time. It returns [None] when no elements remain *) 21 | 22 | type 'a gen = 'a t 23 | 24 | module type S = Gen_intf.S 25 | 26 | (** {2 Transient generators} *) 27 | 28 | val get : 'a t -> 'a option 29 | (** Get the next value *) 30 | 31 | val next : 'a t -> 'a option 32 | (** Synonym for {!get} *) 33 | 34 | val get_exn : 'a t -> 'a 35 | (** Get the next value, or fails 36 | @raise Invalid_argument if no element remains *) 37 | 38 | val junk : 'a t -> unit 39 | (** Drop the next value, discarding it. *) 40 | 41 | val repeatedly : (unit -> 'a) -> 'a t 42 | (** Call the same function an infinite number of times (useful for instance 43 | if the function is a random generator). *) 44 | 45 | include S with type 'a t := 'a gen 46 | (** Operations on {b transient} generators *) 47 | 48 | (** {2 Restartable generators} 49 | 50 | A {i restartable generator} is a function that produces copies of the 51 | same generator, on demand. It has the type [unit -> 'a gen] and it is 52 | assumed that every generated returned by the function behaves the same 53 | (that is, that it traverses the same sequence of elements). *) 54 | 55 | module Restart : sig 56 | type 'a t = unit -> 'a gen 57 | 58 | type 'a restartable = 'a t 59 | 60 | include S with type 'a t := 'a restartable 61 | 62 | val cycle : 'a t -> 'a t 63 | (** Cycle through the enum, endlessly. The enum must not be empty. *) 64 | 65 | val lift : ('a gen -> 'b) -> 'a t -> 'b 66 | 67 | val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c 68 | 69 | val of_gen : 70 | ?caching:bool -> ?max_chunk_size:int -> 71 | 'a gen -> 'a t 72 | (** Use {!persistent_lazy} to convert a one-shot generator into a 73 | restartable one. 74 | See {!GenMList.of_gen_lazy} for more details on parameters. 75 | @since 0.4 *) 76 | end 77 | 78 | (** {2 Utils} *) 79 | 80 | val persistent : 'a t -> 'a Restart.t 81 | (** Store content of the transient generator in memory, to be able to iterate 82 | on it several times later. If possible, consider using combinators 83 | from {!Restart} directly instead. *) 84 | 85 | val persistent_lazy : 86 | ?caching:bool -> ?max_chunk_size:int -> 87 | 'a t -> 'a Restart.t 88 | (** Same as {!persistent}, but consumes the generator on demand (by chunks). 89 | This allows to make a restartable generator out of an ephemeral one, 90 | without paying a big cost upfront (nor even consuming it fully). 91 | Optional parameters: see {!GenMList.of_gen_lazy}. 92 | @since 0.2.2 *) 93 | 94 | val persistent_to_seq : 'a t -> 'a Seq.t 95 | (** Same as {!persistent}, but returns a standard Seq. 96 | @since 1.0 *) 97 | 98 | val persistent_lazy_to_seq : 99 | ?caching:bool -> ?max_chunk_size:int -> 100 | 'a t -> 'a Seq.t 101 | (** Same as {!persistent_lazy}, but returns a standard Seq. 102 | @since 1.0 *) 103 | 104 | val peek : 'a t -> ('a * 'a option) t 105 | (** [peek g] transforms the generator [g] into a generator 106 | of [x, Some next] if [x] was followed by [next] in [g], or [x, None] if [x] 107 | was the last element of [g] 108 | @since 0.4 *) 109 | 110 | val peek_n : int -> 'a t -> ('a * 'a array) t 111 | (** [peek_n n g] iterates on [g], returning along with each element 112 | the array of the (at most) [n] elements that follow it immediately 113 | @raise Invalid_argument if the int is [< 1] 114 | @since 0.4 *) 115 | 116 | val start : 'a Restart.t -> 'a t 117 | (** Create a new transient generator. 118 | [start gen] is the same as [gen ()] but is included for readability. *) 119 | 120 | (** {2 Basic IO} 121 | 122 | Very basic interface to manipulate files as sequence of chunks/lines. 123 | @since 0.2.3 *) 124 | 125 | module IO : sig 126 | val with_in : ?mode:int -> ?flags:open_flag list -> 127 | string -> 128 | (char t -> 'a) -> 'a 129 | (** [with_in filename f] opens [filename] and calls [f g], 130 | where [g] is a generator of characters from the file. 131 | The generator is only valid within 132 | the scope in which [f] is called. *) 133 | 134 | val with_lines : ?mode:int -> ?flags:open_flag list -> 135 | string -> (string t -> 'a) -> 'a 136 | (** [with_lines filename f] opens file [filename] and calls [f g], 137 | where [g] is a generator that iterates on the lines from the file. 138 | Do not use the generator outside of the scope of [f] 139 | @since 0.4 *) 140 | 141 | val write_str : ?mode:int -> ?flags:open_flag list -> ?sep:string -> 142 | string -> string t -> unit 143 | (** [write_to filename g] writes all strings from [g] into the given 144 | file. It takes care of opening and closing the file. Does not 145 | add [sep] after the last string. 146 | @param mode default [0o644] 147 | @param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. 148 | @param sep separator between each string (e.g. newline) *) 149 | 150 | val write : ?mode:int -> ?flags:open_flag list -> 151 | string -> char t -> unit 152 | (** Same as {!write_str} but with individual characters *) 153 | 154 | val write_lines : ?mode:int -> ?flags:open_flag list -> 155 | string -> string t -> unit 156 | (** [write_lines file g] is similar to [write_str file g ~sep:"\n"] but 157 | also adds ['\n'] at the end of the file 158 | @since 0.4 *) 159 | end 160 | -------------------------------------------------------------------------------- /src/gen.odocl: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: bd697a51498f01cda75ad40b61e3c47d) 3 | Gen 4 | GenLabels 5 | GenClone 6 | GenMList 7 | Gen_intf 8 | GenLabels_intf 9 | GenM 10 | GenM_intf 11 | # OASIS_STOP 12 | -------------------------------------------------------------------------------- /src/genClone.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Clonable Generators} *) 5 | 6 | type 'a gen = unit -> 'a option 7 | 8 | class virtual ['a] t = object 9 | method virtual gen : 'a gen (** Generator of values tied to this copy *) 10 | 11 | method virtual clone : 'a t (** Clone the internal state *) 12 | end 13 | (** A generator that can be cloned as many times as required. *) 14 | 15 | type 'a clonable = 'a t 16 | (** Alias to {!'a t} *) 17 | 18 | (** {2 Prepend method} *) 19 | 20 | type 'a prependable = < 21 | gen : 'a gen; 22 | clone : 'a prependable; 23 | prepend : 'a -> unit (** Add value at front position *) 24 | > 25 | 26 | (* helper function for {!to_prependable} *) 27 | let rec to_prependable c = 28 | let g = c#gen in 29 | let st = ref `Fwd in (* state: forward *) 30 | let next () = match !st with 31 | | `Fwd -> g() 32 | | `Yield [] -> assert false 33 | | `Yield [x] -> st := `Fwd; Some x 34 | | `Yield (x::l) -> st := `Yield l; Some x 35 | in 36 | object 37 | method gen = next 38 | method clone = to_prependable (c#clone) 39 | method prepend x = 40 | st := match !st with 41 | | `Fwd -> `Yield [x] 42 | | `Yield l -> `Yield (x::l) 43 | end 44 | 45 | (** {2 Misc} *) 46 | 47 | let rec map f c = 48 | let g = c#gen in 49 | let next () = match g() with 50 | | None -> None 51 | | Some x -> Some (f x) 52 | in 53 | object 54 | method gen = next 55 | method clone = map f c#clone 56 | end 57 | 58 | (** {2 Basic IO} *) 59 | 60 | module IO = struct 61 | let with_in ?(mode=0o644) ?(flags=[]) filename f = 62 | let ic = open_in_gen flags mode filename in 63 | let timestamp = ref 0 in 64 | (* make a generator at offset [i] *) 65 | let rec make i : _ clonable = 66 | let state = ref `Not_started in 67 | let rec next() = 68 | match !state with 69 | | `Not_started -> 70 | (* initialize by restoring state *) 71 | seek_in ic i; 72 | incr timestamp; 73 | state := `Started !timestamp; 74 | next() 75 | | `Started t -> 76 | (* check whether another iterator was used more recently *) 77 | if t < !timestamp then failwith "invalidated iterator"; 78 | try Some (input_char ic) 79 | with End_of_file -> None 80 | in 81 | object 82 | method clone = 83 | let i = pos_in ic in 84 | make i 85 | method gen = next 86 | end 87 | in 88 | try 89 | let x = f (make 0) in 90 | close_in_noerr ic; 91 | x 92 | with e -> 93 | close_in_noerr ic; 94 | raise e 95 | end 96 | -------------------------------------------------------------------------------- /src/genClone.mli: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Clonable Generators} 5 | 6 | Utils to save the internal state of a generator, and restart from this 7 | state. This will and should not work on {i any} iterator, but for 8 | some of them (e.g. reading from a file, see {!IO}) it makes a lot of sense. 9 | 10 | @since 0.2.3 *) 11 | 12 | type 'a gen = unit -> 'a option 13 | 14 | type 'a t = < 15 | gen : 'a gen; (** Generator of values tied to this copy *) 16 | clone : 'a t; (** Clone the internal state *) 17 | > 18 | (** A generator that can be cloned as many times as required. *) 19 | 20 | type 'a clonable = 'a t 21 | (** Alias to {!'a t} *) 22 | 23 | (** {2 Prepend method} *) 24 | 25 | type 'a prependable = < 26 | gen : 'a gen; 27 | clone : 'a prependable; 28 | prepend : 'a -> unit (** Add value at front position *) 29 | > 30 | 31 | val to_prependable : 'a t -> 'a prependable 32 | 33 | (** {2 Misc} *) 34 | 35 | val map : ('a -> 'b) -> 'a t -> 'b t 36 | 37 | (** {2 Low-level Persistency} 38 | 39 | Example: 40 | {[ 41 | let g = 1 -- 1000 ;; 42 | val g : int t = 43 | 44 | let c = g |> MList.of_gen_lazy |> MList.to_clonable;; 45 | val c : int clonable = 46 | 47 | c#next |> take 500 |> to_list;; 48 | - : int list = [1; 2; 3; .....; 500] 49 | 50 | let c' = c#clone ;; 51 | val c' : int clonable = 52 | 53 | c |> to_list;; 54 | - : int list = [501; 502; ....; 1000] 55 | 56 | c'#gen |> to_list;; (* c consumed, but not c' *) 57 | - : int list = [501; 502; ....; 1000] 58 | 59 | c#gen |> to_list;; 60 | - : int list = [] 61 | ]}*) 62 | 63 | (** {2 IO} *) 64 | 65 | module IO : sig 66 | val with_in : ?mode:int -> ?flags:open_flag list -> 67 | string -> 68 | (char t -> 'a) -> 'a 69 | (** [read filename f] opens [filename] and calls [f g], 70 | where [g] is a clonable generator of characters from the file. 71 | It can be cloned by calling [g#save] (which saves the position 72 | in the file), and used with [g#next]. Distinct clones of [g] shouldn't 73 | be used at the same time (otherwise [Failure _] will be raised). 74 | Both the generator and save points are only valid within 75 | the scope in which [f] is called. *) 76 | 77 | end 78 | -------------------------------------------------------------------------------- /src/genLabels.ml: -------------------------------------------------------------------------------- 1 | include Gen 2 | -------------------------------------------------------------------------------- /src/genLabels.mli: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Generators} 5 | 6 | Label version of {!Gen} 7 | 8 | @since 0.2.4 *) 9 | 10 | (** {2 Global type declarations} *) 11 | 12 | type 'a t = unit -> 'a option 13 | (** A generator may be called several times, yielding the next value 14 | each time. It returns [None] when no elements remain *) 15 | 16 | type 'a gen = 'a t 17 | 18 | module type S = GenLabels_intf.S 19 | 20 | (** {2 Transient generators} *) 21 | 22 | val get : 'a t -> 'a option 23 | (** Get the next value *) 24 | 25 | val next : 'a t -> 'a option 26 | (** Synonym for {!get} *) 27 | 28 | val get_exn : 'a t -> 'a 29 | (** Get the next value, or fails 30 | @raise Invalid_argument if no element remains *) 31 | 32 | val junk : 'a t -> unit 33 | (** Drop the next value, discarding it. *) 34 | 35 | val repeatedly : (unit -> 'a) -> 'a t 36 | (** Call the same function an infinite number of times (useful for instance 37 | if the function is a random generator). *) 38 | 39 | include S with type 'a t := 'a gen 40 | (** Operations on {b transient} generators *) 41 | 42 | (** {2 Restartable generators} *) 43 | 44 | module Restart : sig 45 | type 'a t = unit -> 'a gen 46 | 47 | type 'a restartable = 'a t 48 | 49 | include S with type 'a t := 'a restartable 50 | 51 | val cycle : 'a t -> 'a t 52 | (** Cycle through the enum, endlessly. The enum must not be empty. *) 53 | 54 | val lift : ('a gen -> 'b) -> 'a t -> 'b 55 | 56 | val lift2 : ('a gen -> 'b gen -> 'c) -> 'a t -> 'b t -> 'c 57 | end 58 | 59 | (** {2 Utils} *) 60 | 61 | val persistent : 'a t -> 'a Restart.t 62 | (** Store content of the transient generator in memory, to be able to iterate 63 | on it several times later. If possible, consider using combinators 64 | from {!Restart} directly instead. *) 65 | 66 | val persistent_lazy : ?caching:bool -> ?max_chunk_size:int -> 67 | 'a t -> 'a Restart.t 68 | (** Same as {!persistent}, but consumes the generator on demand (by chunks). 69 | This allows to make a restartable generator out of an ephemeral one, 70 | without paying a big cost upfront (nor even consuming it fully). 71 | Optional parameters: see {!GenMList.of_gen_lazy}. 72 | @since 0.2.2 *) 73 | 74 | val peek : 'a t -> ('a * 'a option) t 75 | (** [peek g] transforms the generator [g] into a generator 76 | of [x, Some next] if [x] was followed by [next] in [g], or [x, None] if [x] 77 | was the last element of [g] 78 | @since 0.4 *) 79 | 80 | val peek_n : n:int -> 'a t -> ('a * 'a array) t 81 | (** [peek_n ~n g] iterates on [g], returning along with each element 82 | the array of the (at most) [n] elements that follow it immediately 83 | @raise Invalid_argument if the int is [< 1] 84 | @since 0.4 *) 85 | 86 | val start : 'a Restart.t -> 'a t 87 | (** Create a new transient generator. 88 | [start gen] is the same as [gen ()] but is included for readability. *) 89 | 90 | (** {2 Basic IO} 91 | 92 | Very basic interface to manipulate files as sequence of chunks/lines. *) 93 | 94 | module IO : sig 95 | val with_in : ?mode:int -> ?flags:open_flag list -> 96 | file:string -> 97 | (char t -> 'a) -> 'a 98 | (** [with_in ~file f] opens [file] and calls [f g], 99 | where [g] is a generator of characters from the file. 100 | The generator is only valid within 101 | the scope in which [f] is called. *) 102 | 103 | val with_lines : ?mode:int -> ?flags:open_flag list -> 104 | file:string -> (string t -> 'a) -> 'a 105 | (** [with_lines ~file f] opens file [file] and calls [f g], 106 | where [g] is a generator that iterates on the lines from the file. 107 | Do not use the generator outside of the scope of [f] 108 | @since 0.4 *) 109 | 110 | val write_str : ?mode:int -> ?flags:open_flag list -> ?sep:string -> 111 | file:string -> string t -> unit 112 | (** [write_to ~file g] writes all strings from [g] into the given 113 | file. It takes care of opening and closing the file. Does not 114 | add [sep] after the last string. 115 | @param mode default [0o644] 116 | @param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. 117 | @param sep separator between each string (e.g. newline) *) 118 | 119 | val write : ?mode:int -> ?flags:open_flag list -> 120 | file:string -> char t -> unit 121 | (** Same as {!write_str} but with individual characters *) 122 | 123 | val write_lines : ?mode:int -> ?flags:open_flag list -> 124 | file:string -> string t -> unit 125 | (** [write_lines ~file g] is similar to [write_str file g ~sep:"\n"] but 126 | also adds ['\n'] at the end of the file 127 | @since 0.4 *) 128 | end 129 | -------------------------------------------------------------------------------- /src/genLabels_intf.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Common signature for transient and restartable generators} 5 | 6 | The signature {!S} abstracts on a type ['a t], where the [t] can be 7 | the type of transient or restartable generators. Some functions specify 8 | explicitly that they use ['a gen] (transient generators). *) 9 | 10 | type 'a gen = unit -> 'a option 11 | type 'a iter = ('a -> unit) -> unit 12 | 13 | module type S = sig 14 | type 'a t 15 | 16 | val empty : 'a t 17 | (** Empty generator, with no elements *) 18 | 19 | val singleton : 'a -> 'a t 20 | (** One-element generator *) 21 | 22 | val return : 'a -> 'a t 23 | (** Alias to {!singleton} 24 | @since 0.3 *) 25 | 26 | val repeat : 'a -> 'a t 27 | (** Repeat same element endlessly *) 28 | 29 | val iterate : 'a -> ('a -> 'a) -> 'a t 30 | (** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *) 31 | 32 | val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t 33 | (** Dual of {!fold}, with a deconstructing operation. It keeps on 34 | unfolding the ['b] value into a new ['b], and a ['a] which is yielded, 35 | until [None] is returned. *) 36 | 37 | val init : ?limit:int -> (int -> 'a) -> 'a t 38 | (** Calls the function, starting from 0, on increasing indices. 39 | If [limit] is provided and is a positive int, iteration will 40 | stop at the limit (excluded). 41 | For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *) 42 | 43 | (** {2 Basic combinators} 44 | 45 | {b Note}: those combinators, applied to generators (not restartable 46 | generators) {i consume} their argument. Sometimes they consume it lazily, 47 | sometimes eagerly, but in any case once [f gen] has been called (with [f] a 48 | combinator), [gen] shouldn't be used anymore. *) 49 | 50 | val is_empty : _ t -> bool 51 | (** Check whether the gen is empty. Pops an element, if any *) 52 | 53 | val fold : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b 54 | (** Fold on the generator, tail-recursively. Consumes the generator. *) 55 | 56 | val reduce : f:('a -> 'a -> 'a) -> 'a t -> 'a 57 | (** Fold on non-empty sequences. Consumes the generator. 58 | @raise Invalid_argument on an empty gen *) 59 | 60 | val scan : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b t 61 | (** Like {!fold}, but keeping successive values of the accumulator. 62 | Consumes the generator. *) 63 | 64 | val unfold_scan : ('b -> 'a -> 'b * 'c) -> 'b -> 'a t -> 'c t 65 | (** A mix of {!unfold} and {!scan}. The current state is combined with 66 | the current element to produce a new state, and an output value 67 | of type 'c. 68 | @since 0.2.2 *) 69 | 70 | val iter : f:('a -> unit) -> 'a t -> unit 71 | (** Iterate on the gen, consumes it. *) 72 | 73 | val iteri : f:(int -> 'a -> unit) -> 'a t -> unit 74 | (** Iterate on elements with their index in the gen, from 0, consuming it. *) 75 | 76 | val length : _ t -> int 77 | (** Length of an gen (linear time), consuming it *) 78 | 79 | val map : f:('a -> 'b) -> 'a t -> 'b t 80 | (** Lazy map. No iteration is performed now, the function will be called 81 | when the result is traversed. *) 82 | 83 | val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t 84 | (** Lazy map with indexing starting from 0. No iteration is performed now, 85 | the function will be called when the result is traversed. 86 | @since 0.5 *) 87 | 88 | val fold_map : f:('b -> 'a -> 'b) -> init:'b -> 'a t -> 'b t 89 | (** Lazy fold and map. No iteration is performed now, the function will be 90 | called when the result is traversed. The result is 91 | an iterator over the successive states of the fold. 92 | @since 0.2.4 *) 93 | 94 | val append : 'a t -> 'a t -> 'a t 95 | (** Append the two gens; the result contains the elements of the first, 96 | then the elements of the second gen. *) 97 | 98 | val flatten : 'a gen t -> 'a t 99 | (** Flatten the generator of generators *) 100 | 101 | val flat_map : f:('a -> 'b gen) -> 'a t -> 'b t 102 | (** Monadic bind; each element is transformed to a sub-gen 103 | which is then iterated on, before the next element is processed, 104 | and so on. *) 105 | 106 | val mem : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> bool 107 | (** Is the given element, member of the gen? *) 108 | 109 | val take : int -> 'a t -> 'a t 110 | (** Take at most n elements *) 111 | 112 | val drop : int -> 'a t -> 'a t 113 | (** Drop n elements *) 114 | 115 | val nth : int -> 'a t -> 'a 116 | (** n-th element, or Not_found 117 | @raise Not_found if the generator contains less than [n] arguments *) 118 | 119 | val take_nth : int -> 'a t -> 'a t 120 | (** [take_nth n g] returns every element of [g] whose index 121 | is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list] 122 | will return [1;3;5;7;9] *) 123 | 124 | val filter : f:('a -> bool) -> 'a t -> 'a t 125 | (** Filter out elements that do not satisfy the predicate. *) 126 | 127 | val take_while : f:('a -> bool) -> 'a t -> 'a t 128 | (** Take elements while they satisfy the predicate. The initial generator 129 | itself is not to be used anymore after this. *) 130 | 131 | val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> 'a 132 | (** Fold elements until (['a, `Stop]) is indicated by the accumulator. 133 | @since 0.2.4 *) 134 | 135 | val drop_while : f:('a -> bool) -> 'a t -> 'a t 136 | (** Drop elements while they satisfy the predicate. The initial generator 137 | itself should not be used anymore, only the result of [drop_while]. *) 138 | 139 | val filter_map : f:('a -> 'b option) -> 'a t -> 'b t 140 | (** Maps some elements to 'b, drop the other ones *) 141 | 142 | val zip_index : 'a t -> (int * 'a) t 143 | (** Zip elements with their index in the gen *) 144 | 145 | val unzip : ('a * 'b) t -> 'a t * 'b t 146 | (** Unzip into two sequences, splitting each pair *) 147 | 148 | val partition : f:('a -> bool) -> 'a t -> 'a t * 'a t 149 | (** [partition p l] returns the elements that satisfy [p], 150 | and the elements that do not satisfy [p] *) 151 | 152 | val for_all : f:('a -> bool) -> 'a t -> bool 153 | (** Is the predicate true for all elements? *) 154 | 155 | val exists : f:('a -> bool) -> 'a t -> bool 156 | (** Is the predicate true for at least one element? *) 157 | 158 | val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a 159 | (** Minimum element, according to the given comparison function. 160 | @raise Invalid_argument if the generator is empty *) 161 | 162 | val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a 163 | (** Maximum element, see {!min} 164 | @raise Invalid_argument if the generator is empty *) 165 | 166 | val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool 167 | (** Equality of generators. *) 168 | 169 | val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int 170 | (** Lexicographic comparison of generators. If a generator is a prefix 171 | of the other one, it is considered smaller. *) 172 | 173 | val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int 174 | (** Synonym for {! lexico} *) 175 | 176 | val find : f:('a -> bool) -> 'a t -> 'a option 177 | (** [find p e] returns the first element of [e] to satisfy [p], 178 | or None. *) 179 | 180 | val sum : int t -> int 181 | (** Sum of all elements *) 182 | 183 | (** {2 Multiple iterators} *) 184 | 185 | val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 186 | (** Map on the two sequences. Stops once one of them is exhausted.*) 187 | 188 | val iter2 : f:('a -> 'b -> unit) -> 'a t -> 'b t -> unit 189 | (** Iterate on the two sequences. Stops once one of them is exhausted.*) 190 | 191 | val fold2 : f:('acc -> 'a -> 'b -> 'acc) -> init:'acc -> 'a t -> 'b t -> 'acc 192 | (** Fold the common prefix of the two iterators *) 193 | 194 | val for_all2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool 195 | (** Succeeds if all pairs of elements satisfy the predicate. 196 | Ignores elements of an iterator if the other runs dry. *) 197 | 198 | val exists2 : f:('a -> 'b -> bool) -> 'a t -> 'b t -> bool 199 | (** Succeeds if some pair of elements satisfy the predicate. 200 | Ignores elements of an iterator if the other runs dry. *) 201 | 202 | val zip_with : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 203 | (** Combine common part of the gens (stops when one is exhausted) *) 204 | 205 | val zip : 'a t -> 'b t -> ('a * 'b) t 206 | (** Zip together the common part of the gens *) 207 | 208 | (** {2 Complex combinators} *) 209 | 210 | val merge : 'a gen t -> 'a t 211 | (** Pick elements fairly in each sub-generator. The merge of gens 212 | [e1, e2, ... ] picks elements in [e1], [e2], 213 | in [e3], [e1], [e2] .... Once a generator is empty, it is skipped; 214 | when they are all empty, and none remains in the input, 215 | their merge is also empty. 216 | For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *) 217 | 218 | val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t 219 | (** Intersection of two sorted sequences. Only elements that occur in both 220 | inputs appear in the output *) 221 | 222 | val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t 223 | (** Merge two sorted sequences into a sorted sequence *) 224 | 225 | val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t 226 | (** Sorted merge of multiple sorted sequences *) 227 | 228 | val tee : ?n:int -> 'a t -> 'a gen list 229 | (** Duplicate the gen into [n] generators (default 2). The generators 230 | share the same underlying instance of the gen, so the optimal case is 231 | when they are consumed evenly *) 232 | 233 | val round_robin : ?n:int -> 'a t -> 'a gen list 234 | (** Split the gen into [n] generators in a fair way. Elements with 235 | [index = k mod n] with go to the k-th gen. [n] default value 236 | is 2. *) 237 | 238 | val interleave : 'a t -> 'a t -> 'a t 239 | (** [interleave a b] yields an element of [a], then an element of [b], 240 | and so on. When a generator is exhausted, this behaves like the 241 | other generator. *) 242 | 243 | val intersperse : 'a -> 'a t -> 'a t 244 | (** Put the separator element between all elements of the given gen *) 245 | 246 | val product : 'a t -> 'b t -> ('a * 'b) t 247 | (** Cartesian product, in no predictable order. Works even if some of the 248 | arguments are infinite. *) 249 | 250 | val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t 251 | (** Group equal consecutive elements together. *) 252 | 253 | val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t 254 | (** Remove consecutive duplicate elements. Basically this is 255 | like [fun e -> map List.hd (group e)]. *) 256 | 257 | val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t 258 | (** Sort according to the given comparison function. The gen must be finite. *) 259 | 260 | val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t 261 | (** Sort and remove duplicates. The gen must be finite. *) 262 | 263 | val chunks : int -> 'a t -> 'a array t 264 | (** [chunks n e] returns a generator of arrays of length [n], composed 265 | of successive elements of [e]. The last array may be smaller 266 | than [n] *) 267 | 268 | val permutations : 'a t -> 'a list t 269 | (** Permutations of the gen. 270 | @since 0.2.2 *) 271 | 272 | val permutations_heap : 'a t -> 'a array t 273 | (** Permutations of the gen, using Heap's algorithm. 274 | @since 0.2.3 *) 275 | 276 | val combinations : int -> 'a t -> 'a list t 277 | (** Combinations of given length. The ordering of the elements within 278 | each combination is unspecified. 279 | Example (ignoring ordering): 280 | [combinations 2 (1--3) |> to_list = [[1;2]; [1;3]; [2;3]]] 281 | @since 0.2.2 *) 282 | 283 | val power_set : 'a t -> 'a list t 284 | (** All subsets of the gen (in no particular order). The ordering of 285 | the elements within each subset is unspecified. 286 | @since 0.2.2 *) 287 | 288 | (** {2 Basic conversion functions} *) 289 | 290 | val of_list : 'a list -> 'a t 291 | (** Enumerate elements of the list *) 292 | 293 | val to_list : 'a t -> 'a list 294 | (** non tail-call trasnformation to list, in the same order *) 295 | 296 | val to_rev_list : 'a t -> 'a list 297 | (** Tail call conversion to list, in reverse order (more efficient) *) 298 | 299 | val to_array : 'a t -> 'a array 300 | (** Convert the gen to an array (not very efficient) *) 301 | 302 | val of_array : ?start:int -> ?len:int -> 'a array -> 'a t 303 | (** Iterate on (a slice of) the given array *) 304 | 305 | val of_string : ?start:int -> ?len:int -> string -> char t 306 | (** Iterate on bytes of the string *) 307 | 308 | val to_string : char t -> string 309 | (** Convert into a string *) 310 | 311 | val to_buffer : Buffer.t -> char t -> unit 312 | (** Consumes the iterator and writes to the buffer *) 313 | 314 | val rand_int : int -> int t 315 | (** Random ints in the given range. *) 316 | 317 | val int_range : ?step:int -> int -> int -> int t 318 | (** [int_range ~step a b] generates integers between [a] and [b], included, 319 | with steps of length [step] (1 if omitted). [a] is assumed to be smaller 320 | than [b]. [step] must not be null, but it can be negative for decreasing 321 | integers. *) 322 | 323 | val lines : char t -> string t 324 | (** Group together chars belonging to the same line 325 | @since 0.3 *) 326 | 327 | val unlines : string t -> char t 328 | (** Explode lines into their chars, adding a ['\n'] after each one 329 | @since 0.3 *) 330 | 331 | module Infix : sig 332 | val (--) : int -> int -> int t 333 | (** Synonym for {! int_range ~by:1} *) 334 | 335 | val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t 336 | (** Monadic bind operator *) 337 | 338 | val (>>|) : 'a t -> ('a -> 'b) -> 'b t 339 | (** Infix map operator 340 | @since 0.2.3 *) 341 | 342 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 343 | (** Infix map operator 344 | @since 0.2.3 *) 345 | end 346 | 347 | val (--) : int -> int -> int t 348 | (** Synonym for {! int_range ~by:1} *) 349 | 350 | val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t 351 | (** Monadic bind operator *) 352 | 353 | val (>>|) : 'a t -> ('a -> 'b) -> 'b t 354 | (** Infix map operator 355 | @since 0.2.3 *) 356 | 357 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 358 | (** Infix map operator 359 | @since 0.2.3 *) 360 | 361 | val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool -> 362 | (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit 363 | (** Pretty print the content of the generator on a formatter. *) 364 | 365 | val of_seq : 'a Seq.t -> 'a t 366 | (** @since 1.0 *) 367 | 368 | val to_iter : 'a t -> 'a iter 369 | (** @since 1.0 *) 370 | end 371 | 372 | -------------------------------------------------------------------------------- /src/genM.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Monadic Interface} *) 5 | 6 | module type MONAD = GenM_intf.MONAD 7 | 8 | module Make(M : MONAD) = struct 9 | module M = M 10 | 11 | let (>>=) = M.(>>=) 12 | let (>|=) = M.(>|=) 13 | 14 | type +'a t = unit -> 'a option M.t 15 | 16 | let return x = 17 | let first = ref true in 18 | fun () -> 19 | if !first then ( 20 | first := false; 21 | M.return (Some x) 22 | ) else M.return None 23 | 24 | let sequence_m g () = match g() with 25 | | None -> M.return None 26 | | Some act -> 27 | act >|= fun x -> Some x 28 | 29 | let map f g () = 30 | g() >|= function 31 | | None -> None 32 | | Some x -> Some (f x) 33 | 34 | let flat_map f g = 35 | let rec next f g () = 36 | g() >>= function 37 | | None -> M.return None (* done *) 38 | | Some x -> 39 | let cur = f x in 40 | map_from f g cur () 41 | and map_from f g cur () = 42 | let res = cur() in 43 | res >>= function 44 | | None -> next f g () 45 | | Some _ -> res 46 | in 47 | next f g 48 | 49 | let rec fold f acc g = 50 | g() >>= function 51 | | None -> M.return acc 52 | | Some x -> 53 | let acc = f acc x in 54 | fold f acc g 55 | 56 | let rec fold_m f acc g = 57 | g() >>= function 58 | | None -> M.return acc 59 | | Some x -> 60 | f acc x >>= fun acc -> fold_m f acc g 61 | 62 | let rec iter f g = 63 | g() >>= function 64 | | None -> M.return () 65 | | Some x -> f x; iter f g 66 | 67 | let rec iter_s f g = 68 | g() >>= function 69 | | None -> M.return () 70 | | Some x -> f x >>= fun () -> iter_s f g 71 | 72 | let rec iter_p f g = 73 | g() >>= function 74 | | None -> M.return () 75 | | Some x -> 76 | let _ = f x in 77 | iter_p f g 78 | 79 | module Infix = struct 80 | let (>|=) x f = map f x 81 | let (>>=) x f = flat_map f x 82 | end 83 | 84 | include Infix 85 | end 86 | -------------------------------------------------------------------------------- /src/genM.mli: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Monadic Interface} 5 | 6 | {b status: experimental} 7 | 8 | @since 0.4 *) 9 | 10 | module type MONAD = GenM_intf.MONAD 11 | 12 | module Make(M : MONAD) : GenM_intf.S with module M = M 13 | -------------------------------------------------------------------------------- /src/genMList.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Efficient Mutable Lists} *) 5 | 6 | type 'a gen = unit -> 'a option 7 | type 'a iter = ('a -> unit) -> unit 8 | type 'a clonable = < 9 | gen : 'a gen; (** Generator of values tied to this copy *) 10 | clone : 'a clonable; (** Clone the internal state *) 11 | > 12 | 13 | type 'a node = 14 | | Nil 15 | | Cons of 'a array * int ref * 'a node ref 16 | | Cons1 of 'a * 'a node ref 17 | | Suspend of 'a gen 18 | 19 | type 'a t = { 20 | start : 'a node ref; (* first node. *) 21 | mutable chunk_size : int; 22 | max_chunk_size : int; 23 | } 24 | 25 | let _make ~max_chunk_size gen = { 26 | start = ref (Suspend gen); 27 | chunk_size = 8; 28 | max_chunk_size; 29 | } 30 | 31 | let _make_no_buffer gen = { 32 | start = ref (Suspend gen); 33 | chunk_size = 1; 34 | max_chunk_size = 1; 35 | } 36 | 37 | (* increment the size of chunks *) 38 | let _incr_chunk_size mlist = 39 | if mlist.chunk_size < mlist.max_chunk_size 40 | then mlist.chunk_size <- 2 * mlist.chunk_size 41 | 42 | (* read one chunk of input; return the corresponding node. 43 | will potentially change [mlist.chunk_size]. *) 44 | let _read_chunk mlist gen = 45 | match gen() with 46 | | None -> Nil (* done *) 47 | | Some x when mlist.max_chunk_size = 1 -> 48 | let tail = ref (Suspend gen) in 49 | let node = Cons1 (x, tail) in 50 | node 51 | | Some x -> 52 | (* new list node *) 53 | let r = ref 1 in 54 | let a = Array.make mlist.chunk_size x in 55 | let tail = ref (Suspend gen) in 56 | let stop = ref false in 57 | let node = Cons (a, r, tail) in 58 | (* read the rest of the chunk *) 59 | while not !stop && !r < mlist.chunk_size do 60 | match gen() with 61 | | None -> 62 | tail := Nil; 63 | stop := true 64 | | Some x -> 65 | a.(!r) <- x; 66 | incr r; 67 | done; 68 | _incr_chunk_size mlist; 69 | node 70 | 71 | (* eager construction *) 72 | let of_gen gen = 73 | let mlist = _make ~max_chunk_size:4096 gen in 74 | let rec _fill prev = match _read_chunk mlist gen with 75 | | Nil -> prev := Nil 76 | | Suspend _ -> assert false 77 | | Cons1 (_, prev') as node -> 78 | prev := node; 79 | _fill prev' 80 | | Cons (_, _, prev') as node -> 81 | prev := node; 82 | _fill prev' 83 | in 84 | _fill mlist.start; 85 | mlist 86 | 87 | (* lazy construction *) 88 | let of_gen_lazy ?(max_chunk_size=2048) ?(caching=true) gen = 89 | if caching 90 | then 91 | let max_chunk_size = max max_chunk_size 2 in 92 | _make ~max_chunk_size gen 93 | else _make_no_buffer gen 94 | 95 | let to_gen l = 96 | let cur = ref l.start in 97 | let i = ref 0 in 98 | let rec next() = match ! !cur with 99 | | Nil -> None 100 | | Cons1 (x, l') -> 101 | cur := l'; 102 | Some x 103 | | Cons (a,n,l') -> 104 | if !i = !n 105 | then begin 106 | cur := l'; 107 | i := 0; 108 | next() 109 | end else begin 110 | let y = a.(!i) in 111 | incr i; 112 | Some y 113 | end 114 | | Suspend gen -> 115 | let node = _read_chunk l gen in 116 | !cur := node; 117 | next() 118 | in 119 | next 120 | 121 | let to_seq l0 : _ Seq.t = 122 | let rec next l i ()= 123 | match !l with 124 | | Nil -> Seq.Nil 125 | | Cons1 (x, l') -> 126 | Seq.Cons (x, next l' i) 127 | | Cons (a,n,l') -> 128 | if i = !n then ( 129 | next l' 0 () 130 | ) else ( 131 | let y = a.(i) in 132 | Seq.Cons (y, next l (i+1)) 133 | ) 134 | | Suspend gen -> 135 | let node = _read_chunk l0 gen in 136 | l := node; (* modify previous pointer *) 137 | next l i () 138 | in 139 | next l0.start 0 140 | 141 | let to_clonable l : 'a clonable = 142 | let rec make node i = 143 | let cur = ref node and i = ref i in 144 | let rec next() = match ! !cur with 145 | | Nil -> None 146 | | Cons (a,n,l') -> 147 | if !i = !n 148 | then begin 149 | cur := l'; 150 | i := 0; 151 | next() 152 | end else begin 153 | let y = a.(!i) in 154 | i := !i+1; 155 | Some y 156 | end 157 | | Cons1 (x, l') -> 158 | cur := l'; 159 | Some x 160 | | Suspend gen -> 161 | let node = _read_chunk l gen in 162 | (!cur) := node; 163 | next() 164 | in 165 | object 166 | method gen = next 167 | method clone = make !cur !i 168 | end 169 | in 170 | make l.start 0 171 | 172 | 173 | -------------------------------------------------------------------------------- /src/genMList.mli: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Efficient Mutable Lists} 5 | 6 | Unrolled lists, append-only, used for storing the content of a generator. 7 | 8 | Example: 9 | {[ 10 | let g = 1 -- 1000 ;; 11 | val g : int t = 12 | 13 | let c = g |> MList.of_gen_lazy |> MList.to_clonable;; 14 | val c : int clonable = 15 | 16 | c#next |> take 500 |> to_list;; 17 | - : int list = [1; 2; 3; .....; 500] 18 | 19 | let c' = c#clone ;; 20 | val c' : int clonable = 21 | 22 | c |> to_list;; 23 | - : int list = [501; 502; ....; 1000] 24 | 25 | c'#gen |> to_list;; (* c consumed, but not c' *) 26 | - : int list = [501; 502; ....; 1000] 27 | 28 | c#gen |> to_list;; 29 | - : int list = [] 30 | ]} 31 | 32 | @since 0.2.3 *) 33 | 34 | type 'a gen = unit -> 'a option 35 | type 'a iter = ('a -> unit) -> unit 36 | type 'a clonable = < 37 | gen : 'a gen; (** Generator of values tied to this copy *) 38 | clone : 'a clonable; (** Clone the internal state *) 39 | > 40 | 41 | type 'a t 42 | (** An internal append-only storage of elements of type 'a, produced from 43 | a generator *) 44 | 45 | val of_gen : 'a gen -> 'a t 46 | (** [of_gen g] consumes [g] to build a mlist *) 47 | 48 | val of_gen_lazy : ?max_chunk_size:int -> ?caching:bool -> 'a gen -> 'a t 49 | (** [of_gen_lazy g] makes a mlist that will read from [g] as required, 50 | until [g] is exhausted. Do not use [g] directly after this, or 51 | some elements will be absent from the mlist! 52 | @param caching if true or absent, values are read from the generator 53 | by chunks of increasing size. If false, values are read one by one. 54 | @param max_chunk_size if provided and [caching = true], 55 | sets the (maximal) size of the internal chunks *) 56 | 57 | val to_gen : 'a t -> 'a gen 58 | (** Iterate on the mlist. This function can be called many times without 59 | any problem, the mlist isn't consumable! *) 60 | 61 | val to_seq : 'a t -> 'a Seq.t 62 | (** Iterate on the mlist using the standard functional iterators. 63 | @since 1.0 *) 64 | 65 | val to_clonable : 'a t -> 'a clonable 66 | -------------------------------------------------------------------------------- /src/genM_intf.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | type 'a gen = unit -> 'a option 5 | 6 | module type MONAD = sig 7 | type +'a t 8 | 9 | val return : 'a -> 'a t 10 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 11 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 12 | end 13 | 14 | module type S = sig 15 | module M : MONAD 16 | 17 | type +'a t = unit -> 'a option M.t 18 | (** A value of type ['a t] is an iterator over values of type ['a] 19 | that live in the monad [M.t]. For instance, if [M] is [Lwt], accessing 20 | each element might require some IO operation (reading a file, etc.) *) 21 | 22 | val return : 'a -> 'a t 23 | 24 | val sequence_m : 'a M.t gen -> 'a t 25 | (** From a generator of actions, return an effectful generator *) 26 | 27 | val map : ('a -> 'b) -> 'a t -> 'b t 28 | 29 | val flat_map : ('a -> 'b t) -> 'a t -> 'b t 30 | 31 | val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a M.t 32 | 33 | val fold_m : ('a -> 'b -> 'a M.t) -> 'a -> 'b t -> 'a M.t 34 | 35 | val iter : ('a -> unit) -> 'a t -> unit M.t 36 | 37 | val iter_s : ('a -> unit M.t) -> 'a t -> unit M.t 38 | 39 | val iter_p : ('a -> unit M.t) -> 'a t -> unit M.t 40 | 41 | module Infix : sig 42 | val (>>=) : 'a t -> ('a -> 'b t) -> 'b t 43 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 44 | end 45 | 46 | include module type of Infix 47 | end 48 | -------------------------------------------------------------------------------- /src/gen_intf.ml: -------------------------------------------------------------------------------- 1 | 2 | (* This file is free software, part of gen. See file "license" for more details. *) 3 | 4 | (** {1 Common signature for transient and restartable generators} 5 | 6 | The signature {!S} abstracts on a type ['a t], where the [t] can be 7 | the type of transient or restartable generators. Some functions specify 8 | explicitly that they use ['a gen] (transient generators). *) 9 | 10 | type 'a gen = unit -> 'a option 11 | type 'a iter = ('a -> unit) -> unit 12 | 13 | module type S = sig 14 | type 'a t 15 | 16 | val empty : 'a t 17 | (** Empty generator, with no elements *) 18 | 19 | val singleton : 'a -> 'a t 20 | (** One-element generator *) 21 | 22 | val return : 'a -> 'a t 23 | (** Alias to {!singleton} 24 | @since 0.3 *) 25 | 26 | val repeat : 'a -> 'a t 27 | (** Repeat same element endlessly *) 28 | 29 | val iterate : 'a -> ('a -> 'a) -> 'a t 30 | (** [iterate x f] is [[x; f x; f (f x); f (f (f x)); ...]] *) 31 | 32 | val unfold : ('b -> ('a * 'b) option) -> 'b -> 'a t 33 | (** Dual of {!fold}, with a deconstructing operation. It keeps on 34 | unfolding the ['b] value into a new ['b], and a ['a] which is yielded, 35 | until [None] is returned. *) 36 | 37 | val init : ?limit:int -> (int -> 'a) -> 'a t 38 | (** Calls the function, starting from 0, on increasing indices. 39 | If [limit] is provided and is a positive int, iteration will 40 | stop at the limit (excluded). 41 | For instance [init ~limit:4 id] will yield 0, 1, 2, and 3. *) 42 | 43 | (** {2 Basic combinators} 44 | 45 | {b Note}: those combinators, applied to generators (not restartable 46 | generators) {i consume} their argument. Sometimes they consume it lazily, 47 | sometimes eagerly, but in any case once [f gen] has been called (with [f] a 48 | combinator), [gen] shouldn't be used anymore. *) 49 | 50 | val is_empty : _ t -> bool 51 | (** Check whether the gen is empty. Pops an element, if any *) 52 | 53 | val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b 54 | (** Fold on the generator, tail-recursively. Consumes the generator. *) 55 | 56 | val reduce : ('a -> 'a -> 'a) -> 'a t -> 'a 57 | (** Fold on non-empty sequences. Consumes the generator. 58 | @raise Invalid_argument on an empty gen *) 59 | 60 | val scan : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t 61 | (** Like {!fold}, but keeping successive values of the accumulator. 62 | Consumes the generator. *) 63 | 64 | val unfold_scan : ('b -> 'a -> 'b * 'c) -> 'b -> 'a t -> 'c t 65 | (** A mix of {!unfold} and {!scan}. The current state is combined with 66 | the current element to produce a new state, and an output value 67 | of type 'c. 68 | @since 0.2.2 *) 69 | 70 | val iter : ('a -> unit) -> 'a t -> unit 71 | (** Iterate on the gen, consumes it. *) 72 | 73 | val iteri : (int -> 'a -> unit) -> 'a t -> unit 74 | (** Iterate on elements with their index in the gen, from 0, consuming it. *) 75 | 76 | val length : _ t -> int 77 | (** Length of an gen (linear time), consuming it *) 78 | 79 | val map : ('a -> 'b) -> 'a t -> 'b t 80 | (** Lazy map. No iteration is performed now, the function will be called 81 | when the result is traversed. *) 82 | 83 | val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t 84 | (** Lazy map with indexing starting from 0. No iteration is performed now, 85 | the function will be called when the result is traversed. 86 | @since 0.5 *) 87 | 88 | val fold_map : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b t 89 | (** Lazy fold and map. No iteration is performed now, the function will be 90 | called when the result is traversed. The result is 91 | an iterator over the successive states of the fold. 92 | @since 0.2.4 *) 93 | 94 | val append : 'a t -> 'a t -> 'a t 95 | (** Append the two gens; the result contains the elements of the first, 96 | then the elements of the second gen. *) 97 | 98 | val flatten : 'a gen t -> 'a t 99 | (** Flatten the generator of generators *) 100 | 101 | val flat_map : ('a -> 'b gen) -> 'a t -> 'b t 102 | (** Monadic bind; each element is transformed to a sub-gen 103 | which is then iterated on, before the next element is processed, 104 | and so on. *) 105 | 106 | val mem : ?eq:('a -> 'a -> bool) -> 'a -> 'a t -> bool 107 | (** Is the given element, member of the gen? *) 108 | 109 | val take : int -> 'a t -> 'a t 110 | (** Take at most n elements *) 111 | 112 | val drop : int -> 'a t -> 'a t 113 | (** Drop n elements *) 114 | 115 | val nth : int -> 'a t -> 'a 116 | (** n-th element, or Not_found 117 | @raise Not_found if the generator contains less than [n] arguments *) 118 | 119 | val take_nth : int -> 'a t -> 'a t 120 | (** [take_nth n g] returns every element of [g] whose index 121 | is a multiple of [n]. For instance [take_nth 2 (1--10) |> to_list] 122 | will return [1;3;5;7;9] *) 123 | 124 | val filter : ('a -> bool) -> 'a t -> 'a t 125 | (** Filter out elements that do not satisfy the predicate. *) 126 | 127 | val take_while : ('a -> bool) -> 'a t -> 'a t 128 | (** Take elements while they satisfy the predicate. The initial generator 129 | itself is not to be used anymore after this. *) 130 | 131 | val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a 132 | (** Fold elements until (['a, `Stop]) is indicated by the accumulator. 133 | @since 0.2.4 *) 134 | 135 | val drop_while : ('a -> bool) -> 'a t -> 'a t 136 | (** Drop elements while they satisfy the predicate. The initial generator 137 | itself should not be used anymore, only the result of [drop_while]. *) 138 | 139 | val filter_map : ('a -> 'b option) -> 'a t -> 'b t 140 | (** Maps some elements to 'b, drop the other ones *) 141 | 142 | val zip_index : 'a t -> (int * 'a) t 143 | (** Zip elements with their index in the gen *) 144 | 145 | val unzip : ('a * 'b) t -> 'a t * 'b t 146 | (** Unzip into two sequences, splitting each pair *) 147 | 148 | val partition : ('a -> bool) -> 'a t -> 'a t * 'a t 149 | (** [partition p l] returns the elements that satisfy [p], 150 | and the elements that do not satisfy [p] *) 151 | 152 | val for_all : ('a -> bool) -> 'a t -> bool 153 | (** Is the predicate true for all elements? *) 154 | 155 | val exists : ('a -> bool) -> 'a t -> bool 156 | (** Is the predicate true for at least one element? *) 157 | 158 | val min : ?lt:('a -> 'a -> bool) -> 'a t -> 'a 159 | (** Minimum element, according to the given comparison function. 160 | @raise Invalid_argument if the generator is empty *) 161 | 162 | val max : ?lt:('a -> 'a -> bool) -> 'a t -> 'a 163 | (** Maximum element, see {!min} 164 | @raise Invalid_argument if the generator is empty *) 165 | 166 | val eq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t -> bool 167 | (** Equality of generators. *) 168 | 169 | val lexico : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int 170 | (** Lexicographic comparison of generators. If a generator is a prefix 171 | of the other one, it is considered smaller. *) 172 | 173 | val compare : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> int 174 | (** Synonym for {! lexico} *) 175 | 176 | val find : ('a -> bool) -> 'a t -> 'a option 177 | (** [find p e] returns the first element of [e] to satisfy [p], 178 | or None. *) 179 | 180 | val sum : int t -> int 181 | (** Sum of all elements *) 182 | 183 | (** {2 Multiple iterators} *) 184 | 185 | val map2 : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 186 | (** Map on the two sequences. Stops once one of them is exhausted.*) 187 | 188 | val iter2 : ('a -> 'b -> unit) -> 'a t -> 'b t -> unit 189 | (** Iterate on the two sequences. Stops once one of them is exhausted.*) 190 | 191 | val fold2 : ('acc -> 'a -> 'b -> 'acc) -> 'acc -> 'a t -> 'b t -> 'acc 192 | (** Fold the common prefix of the two iterators *) 193 | 194 | val for_all2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool 195 | (** Succeeds if all pairs of elements satisfy the predicate. 196 | Ignores elements of an iterator if the other runs dry. *) 197 | 198 | val exists2 : ('a -> 'b -> bool) -> 'a t -> 'b t -> bool 199 | (** Succeeds if some pair of elements satisfy the predicate. 200 | Ignores elements of an iterator if the other runs dry. *) 201 | 202 | val zip_with : ('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t 203 | (** Combine common part of the gens (stops when one is exhausted) *) 204 | 205 | val zip : 'a t -> 'b t -> ('a * 'b) t 206 | (** Zip together the common part of the gens *) 207 | 208 | (** {2 Complex combinators} *) 209 | 210 | val merge : 'a gen t -> 'a t 211 | (** Pick elements fairly in each sub-generator. The merge of gens 212 | [e1, e2, ... ] picks elements in [e1], [e2], 213 | in [e3], [e1], [e2] .... Once a generator is empty, it is skipped; 214 | when they are all empty, and none remains in the input, 215 | their merge is also empty. 216 | For instance, [merge [1;3;5] [2;4;6]] will be, in disorder, [1;2;3;4;5;6]. *) 217 | 218 | val intersection : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t 219 | (** Intersection of two sorted sequences. Only elements that occur in both 220 | inputs appear in the output *) 221 | 222 | val sorted_merge : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t -> 'a t 223 | (** Merge two sorted sequences into a sorted sequence *) 224 | 225 | val sorted_merge_n : ?cmp:('a -> 'a -> int) -> 'a t list -> 'a t 226 | (** Sorted merge of multiple sorted sequences *) 227 | 228 | val tee : ?n:int -> 'a t -> 'a gen list 229 | (** Duplicate the gen into [n] generators (default 2). The generators 230 | share the same underlying instance of the gen, so the optimal case is 231 | when they are consumed evenly *) 232 | 233 | val round_robin : ?n:int -> 'a t -> 'a gen list 234 | (** Split the gen into [n] generators in a fair way. Elements with 235 | [index = k mod n] with go to the k-th gen. [n] default value 236 | is 2. *) 237 | 238 | val interleave : 'a t -> 'a t -> 'a t 239 | (** [interleave a b] yields an element of [a], then an element of [b], 240 | and so on. When a generator is exhausted, this behaves like the 241 | other generator. *) 242 | 243 | val intersperse : 'a -> 'a t -> 'a t 244 | (** Put the separator element between all elements of the given gen *) 245 | 246 | val product : 'a t -> 'b t -> ('a * 'b) t 247 | (** Cartesian product, in no predictable order. Works even if some of the 248 | arguments are infinite. *) 249 | 250 | val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t 251 | (** Group equal consecutive elements together. *) 252 | 253 | val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t 254 | (** Remove consecutive duplicate elements. Basically this is 255 | like [fun e -> map List.hd (group e)]. *) 256 | 257 | val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t 258 | (** Sort according to the given comparison function. The gen must be finite. *) 259 | 260 | val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t 261 | (** Sort and remove duplicates. The gen must be finite. *) 262 | 263 | val chunks : int -> 'a t -> 'a array t 264 | (** [chunks n e] returns a generator of arrays of length [n], composed 265 | of successive elements of [e]. The last array may be smaller 266 | than [n] *) 267 | 268 | val permutations : 'a t -> 'a list t 269 | (** Permutations of the gen. 270 | @since 0.2.2 *) 271 | 272 | val permutations_heap : 'a t -> 'a array t 273 | (** Permutations of the gen, using Heap's algorithm. 274 | @since 0.2.3 *) 275 | 276 | val combinations : int -> 'a t -> 'a list t 277 | (** Combinations of given length. The ordering of the elements within 278 | each combination is unspecified. 279 | Example (ignoring ordering): 280 | [combinations 2 (1--3) |> to_list = [[1;2]; [1;3]; [2;3]]] 281 | @since 0.2.2 *) 282 | 283 | val power_set : 'a t -> 'a list t 284 | (** All subsets of the gen (in no particular order). The ordering of 285 | the elements within each subset is unspecified. 286 | @since 0.2.2 *) 287 | 288 | (** {2 Basic conversion functions} *) 289 | 290 | val of_list : 'a list -> 'a t 291 | (** Enumerate elements of the list *) 292 | 293 | val to_list : 'a t -> 'a list 294 | (** non tail-call trasnformation to list, in the same order *) 295 | 296 | val to_rev_list : 'a t -> 'a list 297 | (** Tail call conversion to list, in reverse order (more efficient) *) 298 | 299 | val to_array : 'a t -> 'a array 300 | (** Convert the gen to an array (not very efficient) *) 301 | 302 | val of_array : ?start:int -> ?len:int -> 'a array -> 'a t 303 | (** Iterate on (a slice of) the given array *) 304 | 305 | val of_string : ?start:int -> ?len:int -> string -> char t 306 | (** Iterate on bytes of the string *) 307 | 308 | val to_string : char t -> string 309 | (** Convert into a string *) 310 | 311 | val to_buffer : Buffer.t -> char t -> unit 312 | (** Consumes the iterator and writes to the buffer *) 313 | 314 | val rand_int : int -> int t 315 | (** Random ints in the given range. *) 316 | 317 | val int_range : ?step:int -> int -> int -> int t 318 | (** [int_range ~step a b] generates integers between [a] and [b], included, 319 | with steps of length [step] (1 if omitted). [a] is assumed to be smaller 320 | than [b], otherwise the result will be empty. 321 | @raise Invalid_argument if [step=0] 322 | @param step step between two numbers; must not be zero, 323 | but it can be negative for decreasing ranges (@since 0.5). *) 324 | 325 | val lines : char t -> string t 326 | (** Group together chars belonging to the same line 327 | @since 0.3 *) 328 | 329 | val unlines : string t -> char t 330 | (** Explode lines into their chars, adding a ['\n'] after each one 331 | @since 0.3 *) 332 | 333 | module Infix : sig 334 | val (--) : int -> int -> int t 335 | (** Synonym for {! int_range ~by:1} *) 336 | 337 | val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t 338 | (** Monadic bind operator *) 339 | 340 | val (>>|) : 'a t -> ('a -> 'b) -> 'b t 341 | (** Infix map operator 342 | @since 0.2.3 *) 343 | 344 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 345 | (** Infix map operator 346 | @since 0.2.3 *) 347 | end 348 | 349 | val (--) : int -> int -> int t 350 | (** Synonym for {! int_range ~by:1} *) 351 | 352 | val (>>=) : 'a t -> ('a -> 'b gen) -> 'b t 353 | (** Monadic bind operator *) 354 | 355 | val (>>|) : 'a t -> ('a -> 'b) -> 'b t 356 | (** Infix map operator 357 | @since 0.2.3 *) 358 | 359 | val (>|=) : 'a t -> ('a -> 'b) -> 'b t 360 | (** Infix map operator 361 | @since 0.2.3 *) 362 | 363 | val pp : ?start:string -> ?stop:string -> ?sep:string -> ?horizontal:bool -> 364 | (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a t -> unit 365 | (** Pretty print the content of the generator on a formatter. *) 366 | 367 | val of_seq : 'a Seq.t -> 'a t 368 | (** @since 1.0 *) 369 | 370 | val to_iter : 'a t -> 'a iter 371 | (** @since 1.0 *) 372 | end 373 | 374 | -------------------------------------------------------------------------------- /src/mkflags.ml: -------------------------------------------------------------------------------- 1 | 2 | let () = 3 | let major, minor = 4 | Scanf.sscanf Sys.ocaml_version "%u.%u" 5 | (fun major minor -> major, minor) 6 | in 7 | let after_4_3 = (major, minor) >= (4, 3) in 8 | let flags_file = open_out "flambda.flags" in 9 | if after_4_3 then ( 10 | output_string flags_file "(-O3 -unbox-closures -unbox-closures-factor 20 -color always)\n"; 11 | ) else ( 12 | output_string flags_file "()\n"; 13 | ); 14 | close_out flags_file 15 | -------------------------------------------------------------------------------- /src/mkshims.ml: -------------------------------------------------------------------------------- 1 | let write_file f s = 2 | let out = open_out f in 3 | output_string out s; flush out; close_out out 4 | 5 | let shims_pre_407 = "module Stdlib = Pervasives" 6 | 7 | let shims_post_407 = "module Stdlib = Stdlib" 8 | 9 | let () = 10 | let major, minor = Scanf.sscanf Sys.ocaml_version "%u.%u" (fun maj min -> maj, min) in 11 | write_file "GenShims_.ml" (if (major, minor) >= (4,7) then shims_post_407 else shims_pre_407); 12 | --------------------------------------------------------------------------------