simon/iter
1
0
Fork 0
mirror of https://github.com/c-cube/iter.git synced 2025-12-06 11:15:32 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge branch 'master' into stable for 0.9; oasis setup

Browse source
This commit is contained in:
Simon Cruanes 2016-12-26 01:23:30 +01:00
commit c63104506c
14 changed files with 4900 additions and 4632 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
.merlin
View file

@ -1,9 +1,10 @@
S .
S src
S bench/
S tests/
B _build
B _build/src
B _build/tests/
B _build/bench/
PKG oUnit
PKG oUnit qcheck
PKG benchmark
FLAG -safe-string
FLG -safe-string
FLG -w +a -w -4 -w -44

8
Makefile
View file

@ -94,4 +94,10 @@ release:
@read
opam publish submit $(NAME_VERSION)
.PHONY: benchs tests examples update_next_tag push_doc push_stable
watch:
while find src/ -print0 | xargs -0 inotifywait -e delete_self -e modify ; do \
echo "============ at `date` ==========" ; \
make all; \
done
.PHONY: benchs tests examples update_next_tag push_doc push_stable watch

197
README.adoc Normal file
View file

@ -0,0 +1,197 @@
= Sequence
:toc: macro
:source-highlighter: pygments
Simple sequence abstract datatype, intended to iterate efficiently
on collections while performing some transformations.
Common operations supported by Sequence include
`filter`, `map`, `take`, `drop`, `append`, `flat_map`, etc.
Sequence is not designed to be as general-purpose or flexible as, say,
Batteries' `'a Enum.t`. Rather, it aims at providing a very simple and efficient
way of iterating on a finite number of values, only allocating (most of the time)
one intermediate closure to do so. For instance, iterating on keys, or values,
of a `Hashtbl.t`, without creating a list.
== Documentation
There is only one important type, `'a Sequence.t`, and lots of functions built
around this type.
To get an overview of sequence, its origins and why it was created,
you can start with http://cedeela.fr/~simon/talks/sequence.pdf[the slides of a talk]
I (@c-cube) made at some OCaml meeting.
See https://c-cube.github.io/sequence/api/[the online API]
for more details on the set of available functions.
== Build
1. via opam `opam install sequence`
2. manually (need OCaml >= 3.12): `make all install`
If you have https://github.com/vincent-hugot/iTeML[qtest] installed,
you can build and run tests with
----
$ ./configure --enable-tests
$ make test
----
If you have https://github.com/Chris00/ocaml-benchmark[benchmarks] installed,
you can build and run benchmarks with
----
$ make benchs
$ ./benchs.native
----
To see how to use the library, check the `examples` directory.
`tests.ml` has a few examples of how to convert basic data structures into
sequences, and conversely.
== Short Tutorial
=== Transferring Data
Conversion between n container types
would take n² functions. In practice, for a given collection
we can at best hope for `to_list` and `of_list`.
With sequence, if the source structure provides a
`iter` function (or a `to_seq` wrapper), it becomes:
[source,OCaml]
----
# let q = Queue.create();;
# Sequence.( 1 -- 10 |> to_queue q);;
- : unit = ()
# Sequence.of_queue q |> Sequence.to_list ;;
- : int list = [1; 2; 3; 4; 5; 6; 7; 8; 9; 10]
# let s = Stack.create();;
# Sequence.(of_queue q |> to_stack s);;
- : unit = ()
# Sequence.of_stack s |> Sequence.to_list ;;
- : int list = [10; 9; 8; 7; 6; 5; 4; 3; 2; 1]
----
Note how the list of elements is reversed when we transfer them
from the queue to the stack.
Another example is extracting the list of values of
a hashtable (in an undefined order that depends on the
underlying hash function):
[source,OCaml]
----
# let h = Hashtbl.create 16;;
# for i = 0 to 10 do
Hashtbl.add h i (string_of_int i)
done;;
- : unit = ()
# Hashtbl.length h;;
- : int = 11
(* now to get the values *)
# Sequence.of_t
# Sequence.of_hashtbl h |> Sequence.map snd |> Sequence.to_list;;
- : string list = ["6"; "2"; "8"; "7"; "3"; "5"; "4"; "9"; "0"; "10"; "1"]
----
=== Replacing `for` loops
The `for` loop is a bit limited, and lacks compositionality.
Instead, it can be more convenient and readable to
use `Sequence.(--) : int -> int -> int Sequence.t`.
[source,OCaml]
----
# Sequence.(1 -- 10_000_000 |> fold (+) 0);;
- : int = 50000005000000
# let p x = x mod 5 = 0 in
Sequence.(1 -- 5_000
|> filter p
|> map (fun x -> x * x)
|> fold (+) 0
);;
- : int = 8345837500
----
NOTE: with **flambda** under sufficiently strong
optimization flags, such compositions of operators
will be compiled to an actual loop with no overhead!
=== Iterating on sub-trees
A small λ-calculus AST, and some operations on it.
[source,OCaml]
----
# type term =
| Var of string
| App of term * term
| Lambda of term ;;
# let rec subterms : term -> term Sequence.t =
fun t ->
let open Sequence.Infix in
Sequence.cons t
(match t with
| Var _ -> Sequence.empty
| Lambda u -> subterms u
| App (a,b) ->
Sequence.append (subterms a) (subterms b))
;;
(* Now we can define many other functions easily! *)
# let vars t =
Sequence.filter_map
(function Var s -> Some s | _ -> None)
(subterms t) ;;
val vars : term -> string sequence = <fun >
# let size t = Sequence.length (subterms t) ;;
val size : term -> int = <fun >
# let vars_list l = Sequence.(of_list l |> flat_map vars);;
val vars_list : term list -> string sequence = <fun >
----
=== Permutations
Makes it easy to write backtracking code (a non-deterministic
function returning several `'a`
will just return a `'a Sequence.t`).
Here, we generate all permutations of a list by
enumerating the ways we can insert an element in a list.
[source,OCaml]
----
# module S = Sequence ;;
# let rec insert x l = match l with
| [] -> S.return [x]
| y :: tl ->
S.append
S.(insert x tl >|= fun tl' -> y :: tl')
(S.return (x :: l)) ;;
# let rec permute l = match l with
| [] -> S.return []
| x :: tl -> permute tl >>= insert x ;;
# permute [1;2;3;4] |> S.take 2 |> S.to_list ;;
- : int list list = [[4; 3; 2; 1]; [4; 3; 1; 2]]
----
=== Advanced example
The module `examples/sexpr.mli` exposes the interface of the S-expression
example library. It requires OCaml>=4.0 to compile, because of the GADT
structure used in the monadic parser combinators part of `examples/sexpr.ml`.
Be careful that this is quite obscure.
== License
Sequence is available under the BSD license.

57
README.md
View file

@ -1,57 +0,0 @@
Sequence
========
Simple sequence abstract datatype, intended to transfer a finite number of
elements from one data structure to another. Some transformations on sequences,
like `filter`, `map`, `take`, `drop` and `append` can be performed before the
sequence is iterated/folded on.
Sequence is not designed to be as general-purpose or flexible as, say,
Batteries' `Enum.t`. Rather, it aims at providing a very simple and efficient
way of iterating on a finite number of values, only allocating (most of the time)
one intermediate closure to do so. For instance, iterating on keys, or values,
of a `Hashtbl.t`, without creating a list.
Documentation
=============
There is only one type, `'a Sequence.t`, and lots of functions built around
this type.
To get an overview of sequence, its origins and why it was created,
you can start with [the slides of a talk](http://cedeela.fr/~simon/talks/sequence.pdf)
I (c-cube) made at some OCaml meeting.
See [the online API](http://cedeela.fr/~simon/software/sequence/Sequence.html)
for more details on the set of available functions.
Build
=====
1. via opam `opam install sequence`
2. manually (need OCaml >= 3.12): `make all install`
If you have `OUnit` installed, you can build and run tests with
$ make tests
$ ./run_tests.native
If you have `Bench` installed, you can build and run benchmarks with
$ make benchs
$ ./benchs.native
To see how to use the library, check the `examples` directory.
`tests.ml` has a few examples of how to convert basic data structures into
sequences, and conversely.
Examples
========
The module `examples/sexpr.mli` exposes the interface of the S-expression
example library. It requires OCaml>=4.0 to compile, because of the GADT
structure used in the monadic parser combinators part of `examples/sexpr.ml`.
License
=======
Sequence is available under the BSD license.

2
_oasis
View file

@ -1,6 +1,6 @@
OASISFormat: 0.4
Name: sequence
Version: 0.8
Version: 0.9
Homepage: https://github.com/c-cube/sequence
Authors: Simon Cruanes
License: BSD-2-clause

4
bench/benchs.ml
View file

@ -10,10 +10,10 @@ let bench_fold n =
0 -- n |> S.fold (+) 0 |> ignore
let bench_flatmap n =
0 -- n |> S.flatMap (fun i -> i -- (i+5)) |> (fun _ -> ())
0 -- n |> S.flat_map (fun i -> i -- (i+5)) |> (fun _ -> ())
let bench_product n =
S.product (0 -- n) (0 -- n) (fun (i,j) -> ())
S.product (0 -- n) (0 -- n) (fun _ -> ())
let _ =
List.iter

642
myocamlbuild.ml
View file

@ -1,19 +1,12 @@
(* OASIS_START *)
(* DO NOT EDIT (digest: 8cefc2cf375bc79d721299976e7d0715) *)
(* DO NOT EDIT (digest: 25607cca926d807aaffd1aa7d72d57d9) *)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
let ns_ str =
str
let s_ str =
str
let f_ (str: ('a, 'b, 'c, 'd) format4) =
str
let ns_ str = str
let s_ str = str
let f_ (str: ('a, 'b, 'c, 'd) format4) = str
let fn_ fmt1 fmt2 n =
@ -23,10 +16,7 @@ module OASISGettext = struct
fmt2^^""
let init =
[]
let init = []
end
module OASISString = struct
@ -38,7 +28,7 @@ module OASISString = struct
Mostly inspired by extlib and batteries ExtString and BatString libraries.
@author Sylvain Le Gall
*)
*)
let nsplitf str f =
@ -52,19 +42,19 @@ module OASISString = struct
Buffer.clear buf
in
let str_len = String.length str in
for i = 0 to str_len - 1 do
if f str.[i] then
push ()
else
Buffer.add_char buf str.[i]
done;
push ();
List.rev !lst
for i = 0 to str_len - 1 do
if f str.[i] then
push ()
else
Buffer.add_char buf str.[i]
done;
push ();
List.rev !lst
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
separator.
*)
*)
let nsplit str c =
nsplitf str ((=) c)
@ -72,18 +62,18 @@ module OASISString = struct
let find ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
while !str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
what_idx := 0;
incr str_idx
done;
if !what_idx <> String.length what then
raise Not_found
while !str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
!str_idx - !what_idx
what_idx := 0;
incr str_idx
done;
if !what_idx <> String.length what then
raise Not_found
else
!str_idx - !what_idx
let sub_start str len =
@ -106,19 +96,19 @@ module OASISString = struct
let what_idx = ref 0 in
let str_idx = ref offset in
let ok = ref true in
while !ok &&
!str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
ok := false;
incr str_idx
done;
if !what_idx = String.length what then
true
while !ok &&
!str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
false
ok := false;
incr str_idx
done;
if !what_idx = String.length what then
true
else
false
let strip_starts_with ~what str =
@ -132,19 +122,19 @@ module OASISString = struct
let what_idx = ref ((String.length what) - 1) in
let str_idx = ref ((String.length str) - 1) in
let ok = ref true in
while !ok &&
offset <= !str_idx &&
0 <= !what_idx do
if str.[!str_idx] = what.[!what_idx] then
decr what_idx
else
ok := false;
decr str_idx
done;
if !what_idx = -1 then
true
while !ok &&
offset <= !str_idx &&
0 <= !what_idx do
if str.[!str_idx] = what.[!what_idx] then
decr what_idx
else
false
ok := false;
decr str_idx
done;
if !what_idx = -1 then
true
else
false
let strip_ends_with ~what str =
@ -189,19 +179,181 @@ module OASISString = struct
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
module OASISUtils = struct
(* # 22 "src/oasis/OASISUtils.ml" *)
open OASISGettext
module MapExt =
struct
module type S =
sig
include Map.S
val add_list: 'a t -> (key * 'a) list -> 'a t
val of_list: (key * 'a) list -> 'a t
val to_list: 'a t -> (key * 'a) list
end
module Make (Ord: Map.OrderedType) =
struct
include Map.Make(Ord)
let rec add_list t =
function
| (k, v) :: tl -> add_list (add k v t) tl
| [] -> t
let of_list lst = add_list empty lst
let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
end
end
module MapString = MapExt.Make(String)
module SetExt =
struct
module type S =
sig
include Set.S
val add_list: t -> elt list -> t
val of_list: elt list -> t
val to_list: t -> elt list
end
module Make (Ord: Set.OrderedType) =
struct
include Set.Make(Ord)
let rec add_list t =
function
| e :: tl -> add_list (add e t) tl
| [] -> t
let of_list lst = add_list empty lst
let to_list = elements
end
end
module SetString = SetExt.Make(String)
let compare_csl s1 s2 =
String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
module HashStringCsl =
Hashtbl.Make
(struct
type t = string
let equal s1 s2 = (compare_csl s1 s2) = 0
let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
end)
module SetStringCsl =
SetExt.Make
(struct
type t = string
let compare = compare_csl
end)
let varname_of_string ?(hyphen='_') s =
if String.length s = 0 then
begin
invalid_arg "varname_of_string"
end
else
begin
let buf =
OASISString.replace_chars
(fun c ->
if ('a' <= c && c <= 'z')
||
('A' <= c && c <= 'Z')
||
('0' <= c && c <= '9') then
c
else
hyphen)
s;
in
let buf =
(* Start with a _ if digit *)
if '0' <= s.[0] && s.[0] <= '9' then
"_"^buf
else
buf
in
OASISString.lowercase_ascii buf
end
let varname_concat ?(hyphen='_') p s =
let what = String.make 1 hyphen in
let p =
try
OASISString.strip_ends_with ~what p
with Not_found ->
p
in
let s =
try
OASISString.strip_starts_with ~what s
with Not_found ->
s
in
p^what^s
let is_varname str =
str = varname_of_string str
let failwithf fmt = Printf.ksprintf failwith fmt
let rec file_location ?pos1 ?pos2 ?lexbuf () =
match pos1, pos2, lexbuf with
| Some p, None, _ | None, Some p, _ ->
file_location ~pos1:p ~pos2:p ?lexbuf ()
| Some p1, Some p2, _ ->
let open Lexing in
let fn, lineno = p1.pos_fname, p1.pos_lnum in
let c1 = p1.pos_cnum - p1.pos_bol in
let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
| _, _, Some lexbuf ->
file_location
~pos1:(Lexing.lexeme_start_p lexbuf)
~pos2:(Lexing.lexeme_end_p lexbuf)
()
| None, None, None ->
s_ "<position undefined>"
let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
let loc = file_location ?pos1 ?pos2 ?lexbuf () in
Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
open OASISUtils
type test = string
type flag = string
@ -214,7 +366,6 @@ module OASISExpr = struct
| ETest of test * string
type 'a choices = (t * 'a) list
@ -289,7 +440,7 @@ module OASISExpr = struct
end
# 292 "myocamlbuild.ml"
# 443 "myocamlbuild.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
@ -300,132 +451,103 @@ module BaseEnvLight = struct
type t = string MapString.t
let default_filename =
Filename.concat
(Sys.getcwd ())
"setup.data"
let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
let chn =
open_in_bin filename
in
let st =
Stream.of_channel chn
in
let line =
ref 1
in
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lexer;
Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
mp
| _ ->
failwith
(Printf.sprintf
"Malformed data file '%s' line %d"
filename !line)
in
let mp =
read_file MapString.empty
in
close_in chn;
mp
end
else if allow_empty then
begin
let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
let line = ref 1 in
let lexer st =
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
Genlex.make_lexer ["="] st_line
in
let rec read_file lxr mp =
match Stream.npeek 3 lxr with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
read_file lxr (MapString.add nm value mp)
| [] -> mp
| _ ->
failwith
(Printf.sprintf "Malformed data file '%s' line %d" filename !line)
in
match stream with
| Some st -> read_file (lexer st) MapString.empty
| None ->
if Sys.file_exists filename then begin
let chn = open_in_bin filename in
let st = Stream.of_channel chn in
try
let mp = read_file (lexer st) MapString.empty in
close_in chn; mp
with e ->
close_in chn; raise e
end else if allow_empty then begin
MapString.empty
end
else
begin
end else begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let rec var_expand str env =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let buff = Buffer.create ((String.length str) * 2) in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let var_get name env =
var_expand (MapString.find name env) env
let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
let var_get name env = var_expand (MapString.find name env) env
let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
end
# 397 "myocamlbuild.ml"
# 523 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
(** OCamlbuild extension, copied from
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
* https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html
* by N. Pouillard and others
*
* Updated on 2009/02/28
* Updated on 2016-06-02
*
* Modified by Sylvain Le Gall
*)
*)
open Ocamlbuild_plugin
type conf =
{ no_automatic_syntax: bool;
}
(* these functions are not really officially exported *)
let run_and_read =
Ocamlbuild_pack.My_unix.run_and_read
type conf = {no_automatic_syntax: bool}
let blank_sep_strings =
Ocamlbuild_pack.Lexers.blank_sep_strings
let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
let exec_from_conf exec =
let exec =
let env_filename = Pathname.basename BaseEnvLight.default_filename in
let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in
let env = BaseEnvLight.load ~allow_empty:true () in
try
BaseEnvLight.var_get exec env
with Not_found ->
@ -436,7 +558,7 @@ module MyOCamlbuildFindlib = struct
if Sys.os_type = "Win32" then begin
let buff = Buffer.create (String.length str) in
(* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
*)
*)
String.iter
(fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
str;
@ -445,7 +567,8 @@ module MyOCamlbuildFindlib = struct
str
end
in
fix_win32 exec
fix_win32 exec
let split s ch =
let buf = Buffer.create 13 in
@ -454,15 +577,15 @@ module MyOCamlbuildFindlib = struct
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
String.iter
(fun c ->
if c = ch then
flush ()
else
Buffer.add_char buf c)
s;
flush ();
List.rev !x
String.iter
(fun c ->
if c = ch then
flush ()
else
Buffer.add_char buf c)
s;
flush ();
List.rev !x
let split_nl s = split s '\n'
@ -504,85 +627,89 @@ module MyOCamlbuildFindlib = struct
let dispatch conf =
function
| After_options ->
(* By using Before_options one let command line options have an higher
* priority on the contrary using After_options will guarantee to have
* the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
Options.ocamlmktop := ocamlfind & A"ocamlmktop";
Options.ocamlmklib := ocamlfind & A"ocamlmklib"
(* By using Before_options one let command line options have an higher
* priority on the contrary using After_options will guarantee to have
* the higher priority override default commands by ocamlfind ones *)
Options.ocamlc := ocamlfind & A"ocamlc";
Options.ocamlopt := ocamlfind & A"ocamlopt";
Options.ocamldep := ocamlfind & A"ocamldep";
Options.ocamldoc := ocamlfind & A"ocamldoc";
Options.ocamlmktop := ocamlfind & A"ocamlmktop";
Options.ocamlmklib := ocamlfind & A"ocamlmklib"
| After_rules ->
(* When one link an OCaml library/binary/package, one should use
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
(* Avoid warnings for unused tag *)
flag ["tests"] N;
if not (conf.no_automatic_syntax) then begin
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let (args, pargs) =
(* Heuristic to identify syntax extensions: whether they end in
".syntax"; some might not.
*)
if Filename.check_suffix pkg "syntax" ||
List.mem pkg well_known_syntax then
(syn_args @ base_args, syn_args)
else
(base_args, [])
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
(* When one link an OCaml library/binary/package, one should use
* -linkpkg *)
flag ["ocaml"; "link"; "program"] & A"-linkpkg";
(* TODO: Check if this is allowed for OCaml < 3.12.1 *)
flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
end
(find_packages ());
end;
(* For each ocamlfind package one inject the -package option when
* compiling, computing dependencies, generating documentation and
* linking. *)
List.iter
begin fun pkg ->
let base_args = [A"-package"; A pkg] in
(* TODO: consider how to really choose camlp4o or camlp4r. *)
let syn_args = [A"-syntax"; A "camlp4o"] in
let (args, pargs) =
(* Heuristic to identify syntax extensions: whether they end in
".syntax"; some might not.
*)
if not (conf.no_automatic_syntax) &&
(Filename.check_suffix pkg "syntax" ||
List.mem pkg well_known_syntax) then
(syn_args @ base_args, syn_args)
else
(base_args, [])
in
flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
(* Like -package but for extensions syntax. Morover -syntax is useless
* when linking. *)
List.iter begin fun syntax ->
(* TODO: Check if this is allowed for OCaml < 3.12.1 *)
flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
end
(find_packages ());
(* Like -package but for extensions syntax. Morover -syntax is useless
* when linking. *)
List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
S[A"-syntax"; A syntax];
end (find_syntaxes ());
S[A"-syntax"; A syntax];
end (find_syntaxes ());
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
*
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
(* The default "thread" tag is not compatible with ocamlfind.
* Indeed, the default rules add the "threads.cma" or "threads.cmxa"
* options when using this tag. When using the "-linkpkg" option with
* ocamlfind, this module will then be added twice on the command line.
*
* To solve this, one approach is to add the "-thread" option when using
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]);
| _ ->
()
()
end
module MyOCamlbuildBase = struct
@ -594,9 +721,6 @@ module MyOCamlbuildBase = struct
*)
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
@ -607,9 +731,6 @@ module MyOCamlbuildBase = struct
type tag = string
(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
type t =
{
lib_ocaml: (name * dir list * string list) list;
@ -622,9 +743,10 @@ module MyOCamlbuildBase = struct
}
let env_filename =
Pathname.basename
BaseEnvLight.default_filename
(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
let env_filename = Pathname.basename BaseEnvLight.default_filename
let dispatch_combine lst =
@ -643,12 +765,7 @@ module MyOCamlbuildBase = struct
let dispatch t e =
let env =
BaseEnvLight.load
~filename:env_filename
~allow_empty:true
()
in
let env = BaseEnvLight.load ~allow_empty:true () in
match e with
| Before_options ->
let no_trailing_dot s =
@ -712,18 +829,19 @@ module MyOCamlbuildBase = struct
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* When ocaml link something that use the C library, then one
need that file to be up to date.
This holds both for programs and for libraries.
*)
dep ["link"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["link"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
@ -763,7 +881,7 @@ module MyOCamlbuildBase = struct
end
# 766 "myocamlbuild.ml"
# 884 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
{
@ -789,6 +907,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
# 793 "myocamlbuild.ml"
# 911 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;

2
opam
View file

@ -1,6 +1,6 @@
opam-version: "1.2"
name: "sequence"
version: "0.8"
version: "0.9"
author: "Simon Cruanes"
maintainer: "simon.cruanes@inria.fr"
license: "BSD-2-clauses"

7259
setup.ml
View file

File diff suppressed because it is too large Load diff

8
src/META
View file

@ -1,6 +1,6 @@
# OASIS_START
# DO NOT EDIT (digest: 8041ba3970fcecd2b690dc7b78ccae41)
version = "0.7"
# DO NOT EDIT (digest: b247543864e9cc39f327533c7e23c440)
version = "0.9"
description = "Simple sequence (iterator) datatype and combinators"
requires = "bytes"
archive(byte) = "sequence.cma"
@ -9,7 +9,7 @@ archive(native) = "sequence.cmxa"
archive(native, plugin) = "sequence.cmxs"
exists_if = "sequence.cma"
package "invert" (
version = "0.7"
version = "0.9"
description = "Simple sequence (iterator) datatype and combinators"
requires = "sequence delimcc"
archive(byte) = "invert.cma"
@ -20,7 +20,7 @@ package "invert" (
)
package "bigarray" (
version = "0.7"
version = "0.9"
description = "Simple sequence (iterator) datatype and combinators"
requires = "sequence bigarray"
archive(byte) = "bigarray.cma"

98
src/sequence.ml
View file

@ -48,6 +48,17 @@ let repeat x k = while true do k x done
(seq |> take 3 |> to_list);
*)
let init f yield =
let rec aux i =
yield (f i);
aux (i+1)
in
aux 0
(*$=
[0;1;2;3;4] (init (fun x->x) |> take 5 |> to_list)
*)
let rec iterate f x k =
k x;
iterate f (f x) k
@ -94,6 +105,28 @@ let foldi f init seq =
OUnit.assert_equal [1, "world"; 0, "hello"] l;
*)
let fold_map f init seq yield =
let r = ref init in
seq
(fun x ->
let acc', y = f !r x in
r := acc';
yield y)
(*$= & ~printer:Q.Print.(list int)
[0;1;3;5] (0--3 |> fold_map (fun prev x -> x,prev+x) 0 |> to_list)
*)
let fold_filter_map f init seq yield =
let r = ref init in
seq
(fun x ->
let acc', y = f !r x in
r := acc';
match y with
| None -> ()
| Some y' -> yield y')
let map f seq k = seq (fun x -> k (f x))
let mapi f seq k =
@ -133,9 +166,7 @@ let concat s k = s (fun s' -> s' k)
let flatten s = concat s
let flatMap f seq k = seq (fun x -> f x k)
let flat_map = flatMap
let flat_map f seq k = seq (fun x -> f x k)
(*$R
(1 -- 1000)
@ -147,14 +178,12 @@ let flat_map = flatMap
let flat_map_l f seq k =
seq (fun x -> List.iter k (f x))
let fmap f seq k =
let filter_map f seq k =
seq (fun x -> match f x with
| None -> ()
| Some y -> k y
)
let filter_map = fmap
let intersperse elem seq k =
let first = ref true in
seq (fun x -> (if !first then first := false else k elem); k x)
@ -324,6 +353,23 @@ let sort ?(cmp=Pervasives.compare) seq =
|> OUnit.assert_equal [100;99;98;97]
*)
exception Exit_sorted
let sorted ?(cmp=Pervasives.compare) seq =
let prev = ref None in
try
seq (fun x -> match !prev with
| Some y when cmp y x > 0 -> raise Exit_sorted
| _ -> prev := Some x);
true
with Exit_sorted -> false
(*$T
of_list [1;2;3;4] |> sorted
not (of_list [1;2;3;0;4] |> sorted)
sorted empty
*)
let group_succ_by ?(eq=fun x y -> x = y) seq k =
let cur = ref [] in
seq (fun x ->
@ -337,8 +383,6 @@ let group_succ_by ?(eq=fun x y -> x = y) seq k =
(* last list *)
if !cur <> [] then k !cur
let group = group_succ_by
(*$R
[1;2;3;3;2;2;3;4]
|> of_list |> group_succ_by ?eq:None |> to_list
@ -419,6 +463,25 @@ let product outer inner k =
let product2 outer inner k =
outer (fun x -> inner (fun y -> k x y))
let rec diagonal_l l yield = match l with
| [] -> ()
| x::tail ->
List.iter (fun y -> yield (x,y)) tail;
diagonal_l tail yield
(*$=
[0,1; 0,2; 1,2] (diagonal_l [0;1;2] |> to_list)
*)
let diagonal seq =
let l = ref [] in
seq (fun x -> l := x :: !l);
diagonal_l (List.rev !l)
(*$=
[0,1; 0,2; 1,2] (of_list [0;1;2] |> diagonal |> to_list)
*)
let join ~join_row s1 s2 k =
s1 (fun a ->
s2 (fun b ->
@ -613,6 +676,25 @@ let find f seq =
end;
!r
let findi f seq =
let i = ref 0 in
let r = ref None in
begin
try
seq
(fun x -> match f !i x with
| None -> incr i
| Some _ as res -> r := res; raise ExitFind);
with ExitFind -> ()
end;
!r
let find_pred f seq = find (fun x -> if f x then Some x else None) seq
let find_pred_exn f seq = match find_pred f seq with
| Some x -> x
| None -> raise Not_found
let length seq =
let r = ref 0 in
seq (fun _ -> incr r);

55
src/sequence.mli
View file

@ -57,6 +57,10 @@ val singleton : 'a -> 'a t
val doubleton : 'a -> 'a -> 'a t
(** Sequence with exactly two elements *)
val init : (int -> 'a) -> 'a t
(** [init f] is the infinite sequence [f 0; f 1; f 2; …].
@since 0.9 *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] yields [x], then yields from [l].
Same as [append (singleton x) l] *)
@ -103,6 +107,17 @@ val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
(** Fold over elements of the sequence and their index, consuming it *)
val fold_map : ('acc -> 'a -> 'acc * 'b) -> 'acc -> 'a t -> 'b t
(** [fold_map f acc l] is like {!map}, but it carries some state as in
{!fold}. The state is not returned, it is just used to thread some
information to the map function.
@since 0.9 *)
val fold_filter_map : ('acc -> 'a -> 'acc * 'b option) -> 'acc -> 'a t -> 'b t
(** [fold_filter_map f acc l] is a {!fold_map}-like function, but the
function can choose to skip an element by retuning [None].
@since 0.9 *)
val map : ('a -> 'b) -> 'a t -> 'b t
(** Map objects of the sequence into other elements, lazily *)
@ -129,6 +144,20 @@ val find : ('a -> 'b option) -> 'a t -> 'b option
(** Find the first element on which the function doesn't return [None]
@since 0.5 *)
val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
(** Indexed version of {!find}
@since 0.9 *)
val find_pred : ('a -> bool) -> 'a t -> 'a option
(** [find_pred p l] finds the first element of [l] that satisfies [p],
or returns [None] if no element satisfies [p]
@since 0.9 *)
val find_pred_exn : ('a -> bool) -> 'a t -> 'a
(** Unsafe version of {!find_pred}
@raise Not_found if no such element is found
@since 0.9 *)
val length : 'a t -> int
(** How long is the sequence? Forces the sequence. *)
@ -150,23 +179,19 @@ val concat : 'a t t -> 'a t
val flatten : 'a t t -> 'a t
(** Alias for {!concat} *)
val flatMap : ('a -> 'b t) -> 'a t -> 'b t
(** @deprecated use {!flat_map} since 0.6 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Monadic bind. Intuitively, it applies the function to every
element of the initial sequence, and calls {!concat}.
Formerly [flatMap]
@since 0.5 *)
val flat_map_l : ('a -> 'b list) -> 'a t -> 'b t
(** Convenience function combining {!flat_map} and {!of_list}
@since 0.8 *)
val fmap : ('a -> 'b option) -> 'a t -> 'b t
(** @deprecated use {!filter_map} since 0.6 *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
(** Map and only keep non-[None] elements
Formerly [fmap]
@since 0.5 *)
val intersperse : 'a -> 'a t -> 'a t
@ -201,13 +226,13 @@ val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort the sequence and remove duplicates. Eager, same as [sort] *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements.
@deprecated since 0.6 use {!group_succ_by} *)
val sorted : ?cmp:('a -> 'a -> int) -> 'a t -> bool
(** Checks whether the sequence is sorted. Eager, same as {!sort}.
@since 0.9 *)
val group_succ_by : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements.
Synonym to {!group}.
Formerly synonym to [group].
@since 0.6 *)
val group_by : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) ->
@ -226,6 +251,16 @@ val product : 'a t -> 'b t -> ('a * 'b) t
as required (several times), possibly by calling {!persistent} on it
beforehand. *)
val diagonal_l : 'a list -> ('a * 'a) t
(** All pairs of distinct positions of the list. [diagonal l] will
return the sequence of all [List.nth i l, List.nth j l] if [i < j].
@since 0.9 *)
val diagonal : 'a t -> ('a * 'a) t
(** All pairs of distinct positions of the sequence.
Iterates only once on the sequence, which must be finite.
@since 0.9 *)
val product2 : 'a t -> 'b t -> ('a, 'b) t2
(** Binary version of {!product}. Same requirements.
@since 0.5 *)

1116
src/sequenceLabels.ml
View file

File diff suppressed because it is too large Load diff

1
src/sequenceLabels.ml Symbolic link
View file

@ -0,0 +1 @@
sequence.ml

74
src/sequenceLabels.mli
View file

@ -35,6 +35,10 @@ val singleton : 'a -> 'a t
val doubleton : 'a -> 'a -> 'a t
(** Sequence with exactly two elements *)
val init : f:(int -> 'a) -> 'a t
(** [init f] is the infinite sequence [f 0; f 1; f 2; …].
@since 0.9 *)
val cons : 'a -> 'a t -> 'a t
(** [cons x l] yields [x], then yields from [l].
Same as [append (singleton x) l] *)
@ -81,6 +85,17 @@ val fold : f:('a -> 'b -> 'a) -> init:'a -> 'b t -> 'a
val foldi : f:('a -> int -> 'b -> 'a) -> init:'a -> 'b t -> 'a
(** Fold over elements of the sequence and their index, consuming it *)
val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a t -> 'b t
(** [fold_map f acc l] is like {!map}, but it carries some state as in
{!fold}. The state is not returned, it is just used to thread some
information to the map function.
@since 0.9 *)
val fold_filter_map : f:('acc -> 'a -> 'acc * 'b option) -> init:'acc -> 'a t -> 'b t
(** [fold_filter_map f acc l] is a {!fold_map}-like function, but the
function can choose to skip an element by retuning [None].
@since 0.9 *)
val map : f:('a -> 'b) -> 'a t -> 'b t
(** Map objects of the sequence into other elements, lazily *)
@ -105,6 +120,20 @@ val mem : ?eq:('a -> 'a -> bool) -> x:'a -> 'a t -> bool
val find : f:('a -> 'b option) -> 'a t -> 'b option
(** Find the first element on which the function doesn't return [None] *)
val findi : f:(int -> 'a -> 'b option) -> 'a t -> 'b option
(** Indexed version of {!find}
@since 0.9 *)
val find_pred : f:('a -> bool) -> 'a t -> 'a option
(** [find_pred p l] finds the first element of [l] that satisfies [p],
or returns [None] if no element satisfies [p]
@since 0.9 *)
val find_pred_exn : f:('a -> bool) -> 'a t -> 'a
(** Unsafe version of {!find_pred}
@raise Not_found if no such element is found
@since 0.9 *)
val length : 'a t -> int
(** How long is the sequence? Forces the sequence. *)
@ -126,14 +155,12 @@ val concat : 'a t t -> 'a t
val flatten : 'a t t -> 'a t
(** Alias for {!concat} *)
val flatMap : f:('a -> 'b t) -> 'a t -> 'b t
(** @deprecated use {!flat_map} *)
val flat_map : f:('a -> 'b t) -> 'a t -> 'b t
(** Alias to {!flatMap} with a more explicit name *)
val fmap : f:('a -> 'b option) -> 'a t -> 'b t
(** @deprecated use {!filter_map} *)
val flat_map_l : f:('a -> 'b list) -> 'a t -> 'b t
(** Convenience function combining {!flat_map} and {!of_list}
@since 0.9 *)
val filter_map : f:('a -> 'b option) -> 'a t -> 'b t
(** Alias to {!fmap} with a more explicit name *)
@ -170,8 +197,20 @@ val sort : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
val sort_uniq : ?cmp:('a -> 'a -> int) -> 'a t -> 'a t
(** Sort the sequence and remove duplicates. Eager, same as [sort] *)
val group : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements. *)
val sorted : ?cmp:('a -> 'a -> int) -> 'a t -> bool
(** Checks whether the sequence is sorted. Eager, same as {!sort}.
@since 0.9 *)
val group_succ_by : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal consecutive elements.
Formerly synonym to [group].
@since 0.6 *)
val group_by : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) ->
'a t -> 'a list t
(** Group equal elements, disregarding their order of appearance.
The result sequence is traversable as many times as required.
@since 0.6 *)
val uniq : ?eq:('a -> 'a -> bool) -> 'a t -> 'a t
(** Remove consecutive duplicate elements. Basically this is
@ -183,6 +222,16 @@ val product : 'a t -> 'b t -> ('a * 'b) t
as required (several times), possibly by calling {!persistent} on it
beforehand. *)
val diagonal_l : 'a list -> ('a * 'a) t
(** All pairs of distinct positions of the list. [diagonal l] will
return the sequence of all [List.nth i l, List.nth j l] if [i < j].
@since 0.9 *)
val diagonal : 'a t -> ('a * 'a) t
(** All pairs of distinct positions of the sequence.
Iterates only once on the sequence, which must be finite.
@since 0.9 *)
val product2 : 'a t -> 'b t -> ('a, 'b) t2
(** Binary version of {!product}. Same requirements. *)
@ -369,6 +418,17 @@ val int_range_dec : start:int -> stop:int -> int t
(** Iterator on decreasing integers in [stop...start] by steps -1.
See {!(--^)} for an infix version *)
val int_range_by : step:int -> start:int -> stop:int -> int t
(** [int_range_by ~step ~start:i ~stop:j] is the range starting at [i], including [j],
where the difference between successive elements is [step].
use a negative [step] for a decreasing sequence.
@since 0.9
@raise Invalid_argument if [step=0] *)
val bools : bool t
(** Iterates on [true] and [false]
@since 0.9 *)
val of_set : (module Set.S with type elt = 'a and type t = 'b) -> 'b -> 'a t
(** Convert the given set to a sequence. The set module must be provided. *)