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

add ocamlformat; reformat; migrate off qtest

Browse source
This commit is contained in:
Simon Cruanes 2022-10-18 15:30:56 -04:00
parent 688689b18b
commit fc254a5d89
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
27 changed files with 1498 additions and 1322 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
.ocamlformat Normal file
View file

@ -0,0 +1,15 @@
version = 0.24.1
profile=conventional
margin=80
if-then-else=k-r
parens-ite=true
parens-tuple=multi-line-only
sequence-style=terminator
type-decl=compact
break-cases=toplevel
cases-exp-indent=2
field-space=tight-decl
leading-nested-match-parens=true
module-item-spacing=compact
quiet=true
ocaml-version=4.08.0

15
Makefile
View file

@ -13,6 +13,10 @@ clean:
doc:
@dune build @doc
format:
@dune build @fmt --auto-promote
DUNE_OPTS ?= --profile=release
BENCH_TARGETS= benchs.exe bench_persistent_read.exe bench_persistent.exe
benchs:
@ -21,10 +25,17 @@ benchs:
dune exec "src/bench/$$i" ; done
build-benchs:
@dune build $(addprefix src/bench/, $(BENCH_TARGETS))
@dune build $(DUNE_OPTS) $(addprefix src/bench/, $(BENCH_TARGETS))
bench-persistent:
@dune exec $(DUNE_OPTS) src/bench/bench_persistent.exe
bench-persistent-read:
@dune exec $(DUNE_OPTS) src/bench/bench_persistent_read.exe
benchs:
@dune exec $(DUNE_OPTS) src/bench/benchs.exe
examples:
dune build examples/test_sexpr.exe
dune exec examples/test_sexpr.exe
VERSION=$(shell awk '/^version:/ {print $$2}' iter.opam)

16
dune
View file

@ -1,8 +1,8 @@
(alias
(name runtest)
(deps (:dep README.md))
(action (progn
(run ocaml-mdx test %{dep})
(diff? %{dep} %{dep}.corrected))))
(rule
(alias runtest)
(deps
(:dep README.md))
(action
(progn
(run ocaml-mdx test %{dep})
(diff? %{dep} %{dep}.corrected))))

2
dune-project
View file

@ -1,2 +1,2 @@
(lang dune 1.0)
(lang dune 2.0)
(name iter)

12
examples/dune
View file

@ -1,8 +1,6 @@
(executable
(name test_sexpr)
(libraries iter)
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
(ocamlopt_flags :standard -O3 -color always
-unbox-closures -unbox-closures-factor 20)
)
(name test_sexpr)
(libraries iter)
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
(ocamlopt_flags :standard -O3 -color always -unbox-closures
-unbox-closures-factor 20))

207
examples/sexpr.ml
View file

@ -24,18 +24,26 @@ type t =
| Atom of string (** An atom *)
| List of t list (** A list of S-expressions *)
type token = [ `Open | `Close | `Atom of string ]
(** Token that compose a Sexpr once serialized *)
type token = [`Open | `Close | `Atom of string]
(** {2 Traverse an iterator of tokens} *)
(** Iterate on the S-expression, calling the callback with tokens *)
let rec iter f s = match s with
let rec iter f s =
match s with
| Atom a -> f (`Atom a)
| List l -> f `Open; iter_list f l; f `Close
and iter_list f l = match l with
| List l ->
f `Open;
iter_list f l;
f `Close
and iter_list f l =
match l with
| [] -> ()
| x::l' -> iter f x; iter_list f l'
| x :: l' ->
iter f x;
iter_list f l'
(** Traverse. This yields an iterator of tokens *)
let traverse s = Iter.from_iter (fun k -> iter k s)
@ -47,12 +55,18 @@ let traverse s = Iter.from_iter (fun k -> iter k s)
let validate seq =
let depth = ref 0 in
Iter.map
(fun tok -> match tok with
| `Open -> incr depth; tok
| `Close -> if !depth = 0
then raise (Invalid_argument "wrong parenthesing")
else decr depth; tok
| _ -> tok)
(fun tok ->
match tok with
| `Open ->
incr depth;
tok
| `Close ->
if !depth = 0 then
raise (Invalid_argument "wrong parenthesing")
else
decr depth;
tok
| _ -> tok)
seq
(** {2 Text <-> tokens} *)
@ -66,48 +80,55 @@ let lex input =
let rec next c =
match c with
| '(' -> k `Open
| ')' -> flush_word(); k `Close
| ')' ->
flush_word ();
k `Close
| ' ' | '\t' | '\n' -> flush_word ()
| c -> in_word := true; Buffer.add_char buf c
| c ->
in_word := true;
Buffer.add_char buf c
(* finish the previous word token *)
and flush_word () =
if !in_word then begin
if !in_word then (
(* this whitespace follows a word *)
let word = Buffer.contents buf in
Buffer.clear buf;
in_word := false;
k (`Atom word)
end
)
in
Iter.iter next input
in
in
Iter.from_iter seq_fun
(** Build a Sexpr from an iterator of tokens *)
let of_seq seq =
(* called on every token *)
let rec k stack token = match token with
let rec k stack token =
match token with
| `Open -> `Open :: stack
| `Close -> collapse [] stack
| `Atom a -> (`Expr (Atom a)) :: stack
| `Atom a -> `Expr (Atom a) :: stack
(* collapse last list into an `Expr *)
and collapse acc stack = match stack with
| `Open::stack' -> `Expr (List acc) :: stack'
| `Expr a::stack' -> collapse (a :: acc) stack'
| _ -> assert false
and collapse acc stack =
match stack with
| `Open :: stack' -> `Expr (List acc) :: stack'
| `Expr a :: stack' -> collapse (a :: acc) stack'
| _ -> assert false
in
(* iterate, given an empty initial stack *)
let stack = Iter.fold k [] seq in
(* stack should contain exactly one expression *)
match stack with
| [`Expr expr] -> expr
| [ `Expr expr ] -> expr
| [] -> failwith "no Sexpr could be parsed"
| _ -> failwith "too many elements on the stack"
(** {2 Printing} *)
(** Print a token on the given formatter *)
let pp_token formatter token = match token with
let pp_token formatter token =
match token with
| `Open -> Format.fprintf formatter "@[("
| `Close -> Format.fprintf formatter ")@]"
| `Atom s -> Format.pp_print_string formatter s
@ -119,19 +140,28 @@ let pp_tokens formatter tokens =
Iter.iter
(fun token ->
(match token with
| `Open -> (if not !first then Format.fprintf formatter " "); first := true
| `Close -> first := false; last := true
| _ -> if !first then first := false else Format.fprintf formatter " ");
| `Open ->
if not !first then Format.fprintf formatter " ";
first := true
| `Close ->
first := false;
last := true
| _ ->
if !first then
first := false
else
Format.fprintf formatter " ");
pp_token formatter token;
if !last then last := false)
tokens
(** Pretty-print the S-expr. If [indent] is true, the S-expression
is printed with indentation. *)
let pp_sexpr ?(indent=false) formatter s =
if indent
then Format.fprintf formatter "@[<hov 4>%a@]" pp_tokens (traverse s)
else pp_tokens formatter (traverse s)
let pp_sexpr ?(indent = false) formatter s =
if indent then
Format.fprintf formatter "@[<hov 4>%a@]" pp_tokens (traverse s)
else
pp_tokens formatter (traverse s)
(** {2 Serializing} *)
@ -166,65 +196,71 @@ type 'a parser =
exception ParseFailure of string
let (>>=) p f = Bind (p, f)
let (>>) p p' = p >>= fun _ -> p'
let ( >>= ) p f = Bind (p, f)
let ( >> ) p p' = p >>= fun _ -> p'
let return x = Return x
let fail reason = Fail reason
let one f = One f
let skip = One (fun _ -> ())
let lookahead f = Zero f
let left = One (function | `Open -> ()
| _ -> raise (ParseFailure "expected '('"))
let left =
One
(function
| `Open -> ()
| _ -> raise (ParseFailure "expected '('"))
let right = One (function | `Close -> ()
| _ -> raise (ParseFailure "expected ')'"))
let right =
One
(function
| `Close -> ()
| _ -> raise (ParseFailure "expected ')'"))
let pair f g =
f >>= fun x ->
g >>= fun y ->
return (x, y)
g >>= fun y -> return (x, y)
let triple f g h =
f >>= fun x ->
g >>= fun y ->
h >>= fun z ->
return (x, y, z)
h >>= fun z -> return (x, y, z)
(** [(name,p) ^|| p'] behaves as p if the next token is [`Atom name], and
like [p'] otherwise *)
let (^||) (name,p) p' =
lookahead
(fun token -> match token with
| `Atom s when s = name -> skip >> p ()
| _ -> p')
let ( ^|| ) (name, p) p' =
lookahead (fun token ->
match token with
| `Atom s when s = name -> skip >> p ()
| _ -> p')
(** Maps the value returned by the parser *)
let map p f = p >>= fun x -> return (f x)
let p_str = one
(function | `Atom s -> s | _ -> raise (ParseFailure "expected string"))
let p_str =
one (function
| `Atom s -> s
| _ -> raise (ParseFailure "expected string"))
let p_int = one
(function | `Atom s -> (try int_of_string s
with Failure _ -> raise (ParseFailure "expected int"))
| _ -> raise (ParseFailure "expected int"))
let p_int =
one (function
| `Atom s ->
(try int_of_string s
with Failure _ -> raise (ParseFailure "expected int"))
| _ -> raise (ParseFailure "expected int"))
let p_bool = one
(function | `Atom s -> (try bool_of_string s
with Failure _ -> raise (ParseFailure "expected bool"))
| _ -> raise (ParseFailure "expected bool"))
let p_bool =
one (function
| `Atom s ->
(try bool_of_string s
with Failure _ -> raise (ParseFailure "expected bool"))
| _ -> raise (ParseFailure "expected bool"))
let p_float = one
(function | `Atom s -> (try float_of_string s
with Failure _ -> raise (ParseFailure "expected float"))
| _ -> raise (ParseFailure "expected float"))
let p_float =
one (function
| `Atom s ->
(try float_of_string s
with Failure _ -> raise (ParseFailure "expected float"))
| _ -> raise (ParseFailure "expected float"))
let many p =
let rec elements token =
@ -232,15 +268,13 @@ let many p =
| `Close -> return []
| _ ->
p >>= fun x ->
lookahead elements >>= fun l ->
return (x :: l)
lookahead elements >>= fun l -> return (x :: l)
in
left >> lookahead elements >>= fun l -> right >> return l
let many1 p =
p >>= fun x ->
many p >>= fun l ->
return (x::l)
many p >>= fun l -> return (x :: l)
(** parsing state that returns a 'a *)
type 'a state =
@ -251,22 +285,29 @@ type 'a state =
on every parsed value. The callback decides whether to push another
state or whether to continue. *)
let parse_k p tokens k =
let rec state = Push(p, fun x -> match k x with `Stop -> Bottom | `Continue -> state) in
let rec state =
Push
( p,
fun x ->
match k x with
| `Stop -> Bottom
| `Continue -> state )
in
(* Token handler. It also takes the current parser. *)
let rec one_step state token =
match reduce state with
| Bottom -> (* should not happen, unless there are too many tokens *)
| Bottom ->
(* should not happen, unless there are too many tokens *)
raise (ParseFailure "unexpected ')'")
| Push (Return _, _cont) ->
assert false (* should be reduced *)
| Push (Return _, _cont) -> assert false (* should be reduced *)
| Push (Zero f, cont) ->
let p' = f token in
let state' = Push (p', cont) in
one_step state' token (* do not consume token *)
one_step state' token (* do not consume token *)
| Push (One f, cont) ->
let x = f token in
let state' = cont x in
reduce state' (* consume token *)
reduce state' (* consume token *)
(* | Maybe f, _ -> let x = f token in (Obj.magic cont) x *)
| Push (Bind (p', cont'), cont) ->
let cont'' x =
@ -274,10 +315,11 @@ let parse_k p tokens k =
Push (p'', cont)
in
let state' = Push (p', cont'') in
one_step state' token (* do not consume token *)
one_step state' token (* do not consume token *)
| Push (Fail reason, _) -> raise (ParseFailure reason)
(* Reduce parser state *)
and reduce state = match state with
and reduce state =
match state with
| Push (Return x, cont) ->
let state' = cont x in
reduce state'
@ -289,7 +331,9 @@ let parse_k p tokens k =
(** Parse one value *)
let parse p tokens =
let res = ref None in
parse_k p tokens (fun x -> res := Some x; `Stop);
parse_k p tokens (fun x ->
res := Some x;
`Stop);
(* return result *)
match !res with
| None -> raise (ParseFailure "incomplete input")
@ -298,7 +342,8 @@ let parse p tokens =
(** Parse an iterator of values *)
let parse_seq p tokens =
let seq_fun k =
parse_k p tokens (fun x -> k x; `Continue)
parse_k p tokens (fun x ->
k x;
`Continue)
in
Iter.from_iter seq_fun

59
examples/sexpr.mli
View file

@ -20,24 +20,24 @@ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
(* {1 Basic S-expressions, with printing and parsing} *)
(** S-expression *)
type t =
| Atom of string (** An atom *)
| List of t list (** A list of S-expressions *)
(** S-expression *)
type token = [`Open | `Close | `Atom of string]
(** Token that compose a Sexpr once serialized *)
type token = [ `Open | `Close | `Atom of string ]
(** Token that compose a Sexpr once serialized *)
(** {2 Traverse an iterator of tokens} *)
val iter : (token -> unit) -> t -> unit
(** Iterate on the S-expression, calling the callback with tokens *)
(** Iterate on the S-expression, calling the callback with tokens *)
val traverse : t -> token Iter.t
(** Traverse. This yields an iterator of tokens *)
(** Traverse. This yields an iterator of tokens *)
val validate : token Iter.t -> token Iter.t
(** Returns the same iterator of tokens, but during iteration, if
(** Returns the same iterator of tokens, but during iteration, if
the structure of the Sexpr corresponding to the iterator
is wrong (bad parenthesing), Invalid_argument is raised
and iteration is stoped *)
@ -45,30 +45,30 @@ val validate : token Iter.t -> token Iter.t
(** {2 Text <-> tokens} *)
val lex : char Iter.t -> token Iter.t
(** Lex: create an iterator of tokens from the given iterator of chars. *)
(** Lex: create an iterator of tokens from the given iterator of chars. *)
val of_seq : token Iter.t -> t
(** Build a Sexpr from an iterator of tokens, or raise Failure *)
(** Build a Sexpr from an iterator of tokens, or raise Failure *)
(** {2 Printing} *)
val pp_token : Format.formatter -> token -> unit
(** Print a token on the given formatter *)
(** Print a token on the given formatter *)
val pp_tokens : Format.formatter -> token Iter.t -> unit
(** Print an iterator of Sexpr tokens on the given formatter *)
(** Print an iterator of Sexpr tokens on the given formatter *)
val pp_sexpr : ?indent:bool -> Format.formatter -> t -> unit
(** Pretty-print the S-expr. If [indent] is true, the S-expression
(** Pretty-print the S-expr. If [indent] is true, the S-expression
is printed with indentation. *)
(** {2 Serializing} *)
val output_seq : string -> token Iter.t -> (token -> unit) -> unit
(** print a pair "(name @,iterator)" *)
(** print a pair "(name @,iterator)" *)
val output_str : string -> string -> (token -> unit) -> unit
(** print a pair "(name str)" *)
(** print a pair "(name str)" *)
(** {2 Parsing} *)
@ -79,54 +79,53 @@ type 'a parser
exception ParseFailure of string
val (>>=) : 'a parser -> ('a -> 'b parser) -> 'b parser
(** Monadic bind: computes a parser from the result of
val ( >>= ) : 'a parser -> ('a -> 'b parser) -> 'b parser
(** Monadic bind: computes a parser from the result of
the first parser *)
val (>>) : 'a parser -> 'b parser -> 'b parser
(** Like (>>=), but ignores the result of the first parser *)
val ( >> ) : 'a parser -> 'b parser -> 'b parser
(** Like (>>=), but ignores the result of the first parser *)
val return : 'a -> 'a parser
(** Parser that consumes no input and return the given value *)
(** Parser that consumes no input and return the given value *)
val fail : string -> 'a parser
(** Fails parsing with the given message *)
(** Fails parsing with the given message *)
val one : (token -> 'a) -> 'a parser
(** consumes one token with the function *)
(** consumes one token with the function *)
val skip : unit parser
(** Skip the token *)
(** Skip the token *)
val lookahead : (token -> 'a parser) -> 'a parser
(** choose parser given current token *)
(** choose parser given current token *)
val left : unit parser
(** Parses a `Open *)
(** Parses a `Open *)
val right : unit parser
(** Parses a `Close *)
(** Parses a `Close *)
val pair : 'a parser -> 'b parser -> ('a * 'b) parser
val triple : 'a parser -> 'b parser -> 'c parser -> ('a * 'b * 'c) parser
val (^||) : (string * (unit -> 'a parser)) -> 'a parser -> 'a parser
(** [(name,p) ^|| p'] behaves as [p ()] if the next token is [`Atom name], and
val ( ^|| ) : string * (unit -> 'a parser) -> 'a parser -> 'a parser
(** [(name,p) ^|| p'] behaves as [p ()] if the next token is [`Atom name], and
like [p'] otherwise *)
val map : 'a parser -> ('a -> 'b) -> 'b parser
(** Maps the value returned by the parser *)
(** Maps the value returned by the parser *)
val p_str : string parser
val p_int : int parser
val p_bool : bool parser
val many : 'a parser -> 'a list parser
val many1 : 'a parser -> 'a list parser
val parse : 'a parser -> token Iter.t -> 'a
(** Parses exactly one value from the iterator of tokens. Raises
(** Parses exactly one value from the iterator of tokens. Raises
ParseFailure if anything goes wrong. *)
val parse_seq : 'a parser -> token Iter.t -> 'a Iter.t
(** Parses an iterator of values *)
(** Parses an iterator of values *)

153
examples/test_sexpr.ml
View file

@ -1,59 +1,85 @@
(** {2 Test iterators} *)
(** print a list of items using the printing function *)
let pp_list ?(sep=", ") pp_item formatter l =
let pp_list ?(sep = ", ") pp_item formatter l =
Iter.pp_seq ~sep pp_item formatter (Iter.of_list l)
(** Set of integers *)
module ISet = Set.Make(struct type t = int let compare = compare end)
module ISet = Set.Make (struct
type t = int
let compare = compare
end)
let iset = (module ISet : Set.S with type elt = int and type t = ISet.t)
module OrderedString = struct type t = string let compare = compare end
module SMap = Iter.Map.Make(OrderedString)
module OrderedString = struct
type t = string
let my_map = SMap.of_seq (Iter.of_list ["1", 1; "2", 2; "3", 3; "answer", 42])
let compare = compare
end
module SMap = Iter.Map.Make (OrderedString)
let my_map = SMap.of_seq (Iter.of_list [ "1", 1; "2", 2; "3", 3; "answer", 42 ])
let sexpr = "(foo bar (bazz quux hello 42) world (zoo foo bar (1 2 (3 4))))"
type term = | Lambda of term | Const of string | Var of int | Apply of term * term
type term =
| Lambda of term
| Const of string
| Var of int
| Apply of term * term
let random_term () =
let max = 10
and num = ref 0 in
let max = 10 and num = ref 0 in
let rec build depth =
if depth > 4 || !num > max then Const (random_const ()) else
match Random.int 6 with
| 0 -> if depth > 0 then Var (Random.int depth) else Const (random_const ())
| 1 -> incr num; Lambda (build (depth+1))
| 2 -> Const (random_const ())
| _ -> incr num; Apply ((build depth), (build depth))
and random_const () = [|"a"; "b"; "c"; "f"; "g"; "h"|].(Random.int 6)
in build 0
if depth > 4 || !num > max then
Const (random_const ())
else (
match Random.int 6 with
| 0 ->
if depth > 0 then
Var (Random.int depth)
else
Const (random_const ())
| 1 ->
incr num;
Lambda (build (depth + 1))
| 2 -> Const (random_const ())
| _ ->
incr num;
Apply (build depth, build depth)
)
and random_const () = [| "a"; "b"; "c"; "f"; "g"; "h" |].(Random.int 6) in
build 0
let rec sexpr_of_term t =
let f t k = match t with
let f t k =
match t with
| Var i -> Sexpr.output_str "var" (string_of_int i) k
| Lambda t' -> Sexpr.output_seq "lambda" (sexpr_of_term t') k
| Apply (t1, t2) -> Sexpr.output_seq "apply" (Iter.append (sexpr_of_term t1) (sexpr_of_term t2)) k
| Apply (t1, t2) ->
Sexpr.output_seq "apply"
(Iter.append (sexpr_of_term t1) (sexpr_of_term t2))
k
| Const s -> Sexpr.output_str "const" s k
in Iter.from_iter (f t)
in
Iter.from_iter (f t)
let term_parser =
let open Sexpr in
let rec p_term () =
left >>
(("lambda", p_lambda) ^|| ("var", p_var) ^|| ("const", p_const) ^||
("apply", p_apply) ^|| fail "bad term") >>= fun x ->
right >> return x
left
>> ("lambda", p_lambda) ^|| ("var", p_var) ^|| ("const", p_const)
^|| ("apply", p_apply) ^|| fail "bad term"
>>= fun x -> right >> return x
and p_apply () =
p_term () >>= fun x ->
p_term () >>= fun y ->
return (Apply (x,y))
p_term () >>= fun y -> return (Apply (x, y))
and p_var () = p_int >>= fun i -> return (Var i)
and p_const () = p_str >>= fun s -> return (Const s)
and p_lambda () = p_term () >>= fun t -> return (Lambda t)
in p_term ()
and p_lambda () = p_term () >>= fun t -> return (Lambda t) in
p_term ()
let term_of_sexp seq = Sexpr.parse term_parser seq
@ -67,65 +93,80 @@ let test_term () =
let _ =
(* lists *)
let l = [0;1;2;3;4;5;6] in
let l' = Iter.to_list
(Iter.filter (fun x -> x mod 2 = 0) (Iter.of_list l)) in
let l'' = Iter.to_list
(Iter.take 3 (Iter.drop 1 (Iter.of_list l))) in
let l = [ 0; 1; 2; 3; 4; 5; 6 ] in
let l' = Iter.to_list (Iter.filter (fun x -> x mod 2 = 0) (Iter.of_list l)) in
let l'' = Iter.to_list (Iter.take 3 (Iter.drop 1 (Iter.of_list l))) in
let h = Hashtbl.create 3 in
for i = 0 to 5 do
Hashtbl.add h i (i*i);
Hashtbl.add h i (i * i)
done;
let l2 = Iter.to_list
(Iter.map (fun (x, y) -> (string_of_int x) ^ " -> " ^ (string_of_int y))
(Iter.of_hashtbl h))
let l2 =
Iter.to_list
(Iter.map
(fun (x, y) -> string_of_int x ^ " -> " ^ string_of_int y)
(Iter.of_hashtbl h))
in
let l3 = Iter.to_list (Iter.rev (Iter.int_range ~start:0 ~stop:42)) in
let set = List.fold_left (fun set x -> ISet.add x set) ISet.empty [4;3;100;42] in
let set =
List.fold_left (fun set x -> ISet.add x set) ISet.empty [ 4; 3; 100; 42 ]
in
let l4 = Iter.to_list (Iter.of_set iset set) in
Format.printf "l=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l;
Format.printf "l'=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l';
Format.printf "l''=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l'';
Format.printf "l2=@[<h>[%a]@]@." (pp_list Format.pp_print_string) l2;
Format.printf "l3=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l3;
Format.printf "s={@[<h>%a@]}@." (Iter.pp_seq Format.pp_print_int) (Iter.of_set iset set);
Format.printf "s={@[<h>%a@]}@."
(Iter.pp_seq Format.pp_print_int)
(Iter.of_set iset set);
Format.printf "l4=@[<h>[%a]@]@." (pp_list Format.pp_print_int) l4;
Format.printf "l3[:5]+l4=@[<h>[%a]@]@." (Iter.pp_seq Format.pp_print_int)
Format.printf "l3[:5]+l4=@[<h>[%a]@]@."
(Iter.pp_seq Format.pp_print_int)
(Iter.of_array
(Iter.to_array (Iter.append
(Iter.take 5 (Iter.of_list l3)) (Iter.of_list l4))));
(Iter.to_array
(Iter.append (Iter.take 5 (Iter.of_list l3)) (Iter.of_list l4))));
(* iterator, persistent, etc *)
let seq = Iter.int_range ~start:0 ~stop:100000 in
let seq' = Iter.persistent seq in
let stream = Iter.to_stream seq' in
Format.printf "test length [0..100000]: persistent1 %d, stream %d, persistent2 %d"
(Iter.length seq') (Iter.length (Iter.of_stream stream)) (Iter.length seq');
Format.printf
"test length [0..100000]: persistent1 %d, stream %d, persistent2 %d"
(Iter.length seq') (Iter.length seq') (Iter.length seq');
(* maps *)
Format.printf "@[<h>map: %a@]@."
(Iter.pp_seq (fun formatter (k,v) -> Format.fprintf formatter "\"%s\" -> %d" k v))
(Iter.pp_seq (fun formatter (k, v) ->
Format.fprintf formatter "\"%s\" -> %d" k v))
(SMap.to_seq my_map);
let module MyMapSeq = Iter.Map.Adapt(Map.Make(OrderedString)) in
let my_map' = MyMapSeq.of_seq (Iter.of_list ["1", 1; "2", 2; "3", 3; "answer", 42]) in
let module MyMapSeq = Iter.Map.Adapt (Map.Make (OrderedString)) in
let my_map' =
MyMapSeq.of_seq (Iter.of_list [ "1", 1; "2", 2; "3", 3; "answer", 42 ])
in
Format.printf "@[<h>map: %a@]@."
(Iter.pp_seq (fun formatter (k,v) -> Format.fprintf formatter "\"%s\" -> %d" k v))
(Iter.pp_seq (fun formatter (k, v) ->
Format.fprintf formatter "\"%s\" -> %d" k v))
(MyMapSeq.to_seq my_map');
(* sum *)
let n = 1000000 in
let sum = Iter.fold (+) 0 (Iter.take n (Iter.repeat 1)) in
let sum = Iter.fold ( + ) 0 (Iter.take n (Iter.repeat 1)) in
Format.printf "%dx1 = %d@." n sum;
assert (n=sum);
assert (n = sum);
(* sexpr *)
let s = Sexpr.of_seq (Sexpr.lex (Iter.of_str sexpr)) in
let s = Sexpr.of_seq (Iter.map
(function | `Atom s -> `Atom (String.capitalize_ascii s) | tok -> tok)
(Sexpr.traverse s))
let s =
Sexpr.of_seq
(Iter.map
(function
| `Atom s -> `Atom (String.capitalize_ascii s)
| tok -> tok)
(Sexpr.traverse s))
in
Format.printf "@[<hov2>transform @[<h>%s@] into @[<h>%a@]@]@." sexpr (Sexpr.pp_sexpr ~indent:false) s;
Format.printf "@[<hov2>transform @[<h>%s@] into @[<h>%a@]@]@." sexpr
(Sexpr.pp_sexpr ~indent:false)
s;
Format.printf "@[<hv2> cycle:%a@]@." Sexpr.pp_tokens
(Iter.concat (Iter.take 10 (Iter.repeat (Sexpr.traverse s))));
(* sexpr parsing/printing *)
for i = 0 to 20 do
Format.printf "%d-th term test@." i;
test_term ();
test_term ()
done;
()

6
iter.opam
View file

@ -15,10 +15,10 @@ depends: [
"result"
"seq"
"ocaml" { >= "4.03.0" }
"dune" { >= "1.1" }
"dune" { >= "2.0" }
"dune-configurator"
"qcheck" {with-test}
"qtest" {with-test}
"qcheck-core" {with-test}
"ounit2" {with-test}
"mdx" {with-test & >= "1.3" }
"odoc" {with-doc}
]

18
qtest/Makefile
View file

@ -1,18 +0,0 @@
QTEST_PREAMBLE='open Iter_shims_;; '
DONTTEST=../src/iterLabels.ml ../src/mkshims.ml ../src/bigarray/mkshims.ml
QTESTABLE=$(filter-out $(DONTTEST), \
$(wildcard ../src/*.ml) \
$(wildcard ../src/*.mli) \
)
qtest-gen:
@rm run_qtest.ml 2>/dev/null || true
@if which qtest > /dev/null ; then \
qtest extract --preamble $(QTEST_PREAMBLE) \
-o run_qtest.ml \
$(QTESTABLE) 2> /dev/null ; \
else touch run_qtest.ml ; \
fi
.PHONY: qtest-gen

22
qtest/dune
View file

@ -1,22 +0,0 @@
(rule
(targets run_qtest.ml)
(deps Makefile (source_tree ../src)) ; (glob_files ../src/**/*.ml{,i})))
(mode fallback)
;(libraries (qtest qcheck))
(action
(run make qtest-gen))
)
(executable
(name run_qtest)
(flags :standard -warn-error -a+8 -safe-string -w -33)
(libraries iter qcheck)
)
(alias
(name runtest)
(deps run_qtest.exe)
(action (run %{deps}))
)

1305
src/Iter.ml
View file

File diff suppressed because it is too large Load diff

123
src/Iter.mli
View file

@ -1,9 +1,6 @@
(** Simple and Efficient Iterators
(* This file is free software, part of iter. See file "license" for more details. *)
(** {1 Simple and Efficient Iterators} *)
(** The iterators are designed to allow easy transfer (mappings) between data
The iterators are designed to allow easy transfer (mappings) between data
structures, without defining [n^2] conversions between the [n] types. The
implementation relies on the assumption that an iterator can be iterated
on as many times as needed; this choice allows for high performance
@ -37,12 +34,6 @@ type +'a t = ('a -> unit) -> unit
it will be applied to every element of the iterator successively. *)
type +'a iter = 'a t
(** {b NOTE} Type [('a, 'b) t2 = ('a -> 'b -> unit) -> unit]
has been removed and subsumed by [('a * 'b) t]
@since 1.0
*)
type 'a equal = 'a -> 'a -> bool
type 'a hash = 'a -> int
@ -118,7 +109,7 @@ val iter : ('a -> unit) -> 'a t -> unit
Basically [iter f seq] is just [seq f]. *)
val iteri : (int -> 'a -> unit) -> 'a t -> unit
(** Iterate on elements and their index in the iterator *)
(** Iterate on elements and their index in the iterator *)
val for_each : 'a t -> ('a -> unit) -> unit
(** Consume the iterator, passing all its arguments to the function.
@ -311,15 +302,13 @@ val group_succ_by : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
{b note}: Order of items in each list is unspecified.
@since 0.6 *)
val group_by : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) ->
'a t -> 'a list t
val group_by : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
(** Group equal elements, disregarding their order of appearance.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
{b note}: Order of items in each list is unspecified.
@since 0.6 *)
val count : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) ->
'a t -> ('a * int) t
val count : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) -> 'a t -> ('a * int) t
(** Map each distinct element to its number of occurrences in the whole seq.
Similar to [group_by seq |> map (fun l->List.hd l, List.length l)]
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@ -351,8 +340,11 @@ val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t
the two elements do not combine. Assume that [b] allows for multiple
iterations. *)
val join_by : ?eq:'key equal -> ?hash:'key hash ->
('a -> 'key) -> ('b -> 'key) ->
val join_by :
?eq:'key equal ->
?hash:'key hash ->
('a -> 'key) ->
('b -> 'key) ->
merge:('key -> 'a -> 'b -> 'c option) ->
'a t ->
'b t ->
@ -366,8 +358,11 @@ val join_by : ?eq:'key equal -> ?hash:'key hash ->
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@since 0.10 *)
val join_all_by : ?eq:'key equal -> ?hash:'key hash ->
('a -> 'key) -> ('b -> 'key) ->
val join_all_by :
?eq:'key equal ->
?hash:'key hash ->
('a -> 'key) ->
('b -> 'key) ->
merge:('key -> 'a list -> 'b list -> 'c option) ->
'a t ->
'b t ->
@ -383,7 +378,9 @@ val join_all_by : ?eq:'key equal -> ?hash:'key hash ->
and [c] is inserted in the result.
@since 0.10 *)
val group_join_by : ?eq:'a equal -> ?hash:'a hash ->
val group_join_by :
?eq:'a equal ->
?hash:'a hash ->
('b -> 'a) ->
'a t ->
'b t ->
@ -398,9 +395,7 @@ val group_join_by : ?eq:'a equal -> ?hash:'a hash ->
(** {2 Set-like} *)
val inter :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> 'a t
val inter : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> 'a t
(** Intersection of two collections. Each element will occur at most once
in the result. Eager.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@ -411,9 +406,7 @@ val inter :
[] (inter (0--5) (6--10) |> to_list)
*)
val union :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> 'a t
val union : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> 'a t
(** Union of two collections. Each element will occur at most once
in the result. Eager.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@ -423,9 +416,7 @@ val union :
[2;4;5;6] (union (4--6) (cons 2 (4--5)) |> sort |> to_list)
*)
val diff :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> 'a t
val diff : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> 'a t
(** Set difference. Eager.
@since 0.10 *)
@ -433,9 +424,7 @@ val diff :
[1;2;8;9;10] (diff (1--10) (3--7) |> to_list)
*)
val subset :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> bool
val subset : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> bool
(** [subset a b] returns [true] if all elements of [a] belong to [b]. Eager.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@since 0.10 *)
@ -494,7 +483,7 @@ val take_while : ('a -> bool) -> 'a t -> 'a t
Will work on an infinite iterator [s] if the predicate is false for at
least one element of [s]. *)
val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
val fold_while : ('a -> 'b -> 'a * [ `Stop | `Continue ]) -> 'a -> 'b t -> 'a
(** Folds over elements of the iterator, stopping early if the accumulator
returns [('a, `Stop)]
@since 0.5.5 *)
@ -517,9 +506,7 @@ val zip_i : 'a t -> (int * 'a) t
(** {2 Pair iterators} *)
val fold2 : ('c -> 'a -> 'b -> 'c) -> 'c -> ('a * 'b) t -> 'c
val iter2 : ('a -> 'b -> unit) -> ('a * 'b) t -> unit
val map2 : ('a -> 'b -> 'c) -> ('a * 'b) t -> 'c t
val map2_2 : ('a -> 'b -> 'c) -> ('a -> 'b -> 'd) -> ('a * 'b) t -> ('c * 'd) t
@ -604,9 +591,8 @@ val of_hashtbl : ('a, 'b) Hashtbl.t -> ('a * 'b) t
val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a t
val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b t
val of_str : string -> char t
val to_str : char t -> string
val to_str : char t -> string
val concat_str : string t -> string
(** Concatenate strings together, eagerly.
@ -668,6 +654,7 @@ val to_gen : 'a t -> 'a gen
module Set : sig
module type S = sig
include Set.S
val of_iter : elt iter -> t
val to_iter : t -> elt iter
val to_list : t -> elt list
@ -681,10 +668,10 @@ module Set : sig
end
(** Create an enriched Set module from the given one *)
module Adapt(X : Set.S) : S with type elt = X.elt and type t = X.t
module Adapt (X : Set.S) : S with type elt = X.elt and type t = X.t
(** Functor to build an extended Set module from an ordered type *)
module Make(X : Set.OrderedType) : S with type elt = X.t
module Make (X : Set.OrderedType) : S with type elt = X.t
end
(** {2 Maps} *)
@ -692,6 +679,7 @@ end
module Map : sig
module type S = sig
include Map.S
val to_iter : 'a t -> (key * 'a) iter
val of_iter : (key * 'a) iter -> 'a t
val keys : 'a t -> key iter
@ -707,10 +695,10 @@ module Map : sig
end
(** Adapt a pre-existing Map module to make it iterator-aware *)
module Adapt(M : Map.S) : S with type key = M.key and type 'a t = 'a M.t
module Adapt (M : Map.S) : S with type key = M.key and type 'a t = 'a M.t
(** Create an enriched Map module, with iterator-aware functions *)
module Make(V : Map.OrderedType) : S with type key = V.t
module Make (V : Map.OrderedType) : S with type key = V.t
end
(** {1 Random iterators} *)
@ -747,7 +735,7 @@ val shuffle_buffer : int -> 'a t -> 'a t
(** {2 Sampling} *)
val sample : int -> 'a t -> 'a array
(** [sample n seq] returns k samples of [seq], with uniform probability.
(** [sample n seq] returns k samples of [seq], with uniform probability.
It will consume the iterator and use O(n) memory.
It returns an array of size [min (length seq) n].
@ -756,28 +744,28 @@ val sample : int -> 'a t -> 'a array
(** {1 Infix functions} *)
module Infix : sig
val (--) : int -> int -> int t
val ( -- ) : int -> int -> int t
(** [a -- b] is the range of integers from [a] to [b], both included,
in increasing order. It will therefore be empty if [a > b]. *)
val (--^) : int -> int -> int t
val ( --^ ) : int -> int -> int t
(** [a --^ b] is the range of integers from [b] to [a], both included,
in decreasing order (starts from [a]).
It will therefore be empty if [a < b]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
(** Monadic bind (infix version of {!flat_map}
@since 0.5 *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
@since 0.5 *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
(** Applicative operator (product+application)
@since 0.5 *)
val (<+>) : 'a t -> 'a t -> 'a t
val ( <+> ) : 'a t -> 'a t -> 'a t
(** Concatenation of iterators
@since 0.5 *)
end
@ -786,19 +774,22 @@ include module type of Infix
(** {1 Pretty printing} *)
val pp_seq : ?sep:string -> (Format.formatter -> 'a -> unit) ->
Format.formatter -> 'a t -> unit
val pp_seq :
?sep:string ->
(Format.formatter -> 'a -> unit) ->
Format.formatter ->
'a t ->
unit
(** Pretty print an iterator of ['a], using the given pretty printer
to print each elements. An optional separator string can be provided. *)
val pp_buf : ?sep:string -> (Buffer.t -> 'a -> unit) ->
Buffer.t -> 'a t -> unit
val pp_buf : ?sep:string -> (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a t -> unit
(** Print into a buffer *)
val to_string : ?sep:string -> ('a -> string) -> 'a t -> string
(** Print into a string *)
(** {1 Basic IO}
(** Basic IO
Very basic interface to manipulate files as iterator of chunks/lines. The
iterators take care of opening and closing files properly; every time
@ -823,10 +814,8 @@ val to_string : ?sep:string -> ('a -> string) -> 'a t -> string
]}
@since 0.5.1 *)
module IO : sig
val lines_of : ?mode:int -> ?flags:open_flag list ->
string -> string t
val lines_of : ?mode:int -> ?flags:open_flag list -> string -> string t
(** [lines_of filename] reads all lines of the given file. It raises the
same exception as would opening the file and read from it, except
from [End_of_file] (which is caught). The file is {b always} properly
@ -836,29 +825,29 @@ module IO : sig
@param mode default [0o644]
@param flags default: [[Open_rdonly]] *)
val chunks_of : ?mode:int -> ?flags:open_flag list -> ?size:int ->
string -> string t
val chunks_of :
?mode:int -> ?flags:open_flag list -> ?size:int -> string -> string t
(** Read chunks of the given [size] from the file. The last chunk might be
smaller. Behaves like {!lines_of} regarding errors and options.
Every time the iterator is iterated on, the file is opened again, so
different iterations might return different results *)
val write_to : ?mode:int -> ?flags:open_flag list ->
string -> string t -> unit
val write_to :
?mode:int -> ?flags:open_flag list -> string -> string t -> unit
(** [write_to filename seq] writes all strings from [seq] into the given
file. It takes care of opening and closing the file.
@param mode default [0o644]
@param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. *)
val write_bytes_to : ?mode:int -> ?flags:open_flag list ->
string -> Bytes.t t -> unit
val write_bytes_to :
?mode:int -> ?flags:open_flag list -> string -> Bytes.t t -> unit
(** @since 0.5.4 *)
val write_lines : ?mode:int -> ?flags:open_flag list ->
string -> string t -> unit
val write_lines :
?mode:int -> ?flags:open_flag list -> string -> string t -> unit
(** Same as {!write_to}, but intercales ['\n'] between each string *)
val write_bytes_lines : ?mode:int -> ?flags:open_flag list ->
string -> Bytes.t t -> unit
val write_bytes_lines :
?mode:int -> ?flags:open_flag list -> string -> Bytes.t t -> unit
(** @since 0.5.4 *)
end

118
src/IterLabels.mli
View file

@ -1,7 +1,5 @@
(* This file is free software, part of iterator. See file "license" for more details. *)
(** {1 Simple and Efficient Iterators}
Version of {!Iterator} with labels
@ -112,7 +110,8 @@ val fold_map : f:('acc -> 'a -> 'acc * 'b) -> init:'acc -> 'a t -> 'b t
information to the map function.
@since 0.9 *)
val fold_filter_map : f:('acc -> 'a -> 'acc * 'b option) -> init:'acc -> 'a t -> 'b t
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 *)
@ -124,7 +123,7 @@ val mapi : f:(int -> 'a -> 'b) -> 'a t -> 'b t
(** Map objects, along with their index in the iterator *)
val map_by_2 : f:('a -> 'a -> 'a) -> 'a t -> 'a t
(** Map objects two by two. lazily.
(** Map objects two by two. lazily.
The last element is kept in the iterator if the count is odd.
@since 0.7 *)
@ -171,7 +170,6 @@ val length : 'a t -> int
val is_empty : 'a t -> bool
(** Is the iterator empty? Forces the iterator. *)
(** {2 Transformation} *)
val filter : f:('a -> bool) -> 'a t -> 'a t
@ -275,15 +273,13 @@ val group_succ_by : ?eq:('a -> 'a -> bool) -> 'a t -> 'a list t
Formerly synonym to [group].
@since 0.6 *)
val group_by : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) ->
'a t -> 'a list t
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 iterator is traversable as many times as required.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@since 0.6 *)
val count : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) ->
'a t -> ('a * int) t
val count : ?hash:('a -> int) -> ?eq:('a -> 'a -> bool) -> 'a t -> ('a * int) t
(** Map each distinct element to its number of occurrences in the whole seq.
Similar to [group_by seq |> map (fun l->List.hd l, List.length l)]
@since 0.10 *)
@ -314,8 +310,11 @@ val join : join_row:('a -> 'b -> 'c option) -> 'a t -> 'b t -> 'c t
the two elements do not combine. Assume that [b] allows for multiple
iterations. *)
val join_by : ?eq:'key equal -> ?hash:'key hash ->
('a -> 'key) -> ('b -> 'key) ->
val join_by :
?eq:'key equal ->
?hash:'key hash ->
('a -> 'key) ->
('b -> 'key) ->
merge:('key -> 'a -> 'b -> 'c option) ->
'a t ->
'b t ->
@ -329,8 +328,11 @@ val join_by : ?eq:'key equal -> ?hash:'key hash ->
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@since 0.10 *)
val join_all_by : ?eq:'key equal -> ?hash:'key hash ->
('a -> 'key) -> ('b -> 'key) ->
val join_all_by :
?eq:'key equal ->
?hash:'key hash ->
('a -> 'key) ->
('b -> 'key) ->
merge:('key -> 'a list -> 'b list -> 'c option) ->
'a t ->
'b t ->
@ -346,7 +348,9 @@ val join_all_by : ?eq:'key equal -> ?hash:'key hash ->
and [c] is inserted in the result.
@since 0.10 *)
val group_join_by : ?eq:'a equal -> ?hash:'a hash ->
val group_join_by :
?eq:'a equal ->
?hash:'a hash ->
('b -> 'a) ->
'a t ->
'b t ->
@ -359,9 +363,7 @@ val group_join_by : ?eq:'a equal -> ?hash:'a hash ->
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@since 0.10 *)
val inter :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> 'a t
val inter : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> 'a t
(** Intersection of two collections. Each element will occur at most once
in the result. Eager.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@ -372,9 +374,7 @@ val inter :
[] (inter (0--5) (6--10) |> to_list)
*)
val union :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> 'a t
val union : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> 'a t
(** Union of two collections. Each element will occur at most once
in the result. Eager.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@ -384,9 +384,7 @@ val union :
[2;4;5;6] (union (4--6) (cons 2 (4--5)) |> sort |> to_list)
*)
val diff :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> 'a t
val diff : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> 'a t
(** Set difference. Eager.
@since 0.10 *)
@ -394,9 +392,7 @@ val diff :
[1;2;8;9;10] (diff (1--10) (3--7) |> to_list)
*)
val subset :
?eq:'a equal -> ?hash:'a hash ->
'a t -> 'a t -> bool
val subset : ?eq:'a equal -> ?hash:'a hash -> 'a t -> 'a t -> bool
(** [subset a b] returns [true] if all elements of [a] belong to [b]. Eager.
precondition: for any [x] and [y], if [eq x y] then [hash x=hash y] must hold.
@since 0.10 *)
@ -459,7 +455,8 @@ val take_while : f:('a -> bool) -> 'a t -> 'a t
Will work on an infinite iterator [s] if the predicate is false for at
least one element of [s]. *)
val fold_while : f:('a -> 'b -> 'a * [`Stop | `Continue]) -> init:'a -> 'b t -> 'a
val fold_while :
f:('a -> 'b -> 'a * [ `Stop | `Continue ]) -> init:'a -> 'b t -> 'a
(** Folds over elements of the iterator, stopping early if the accumulator
returns [('a, `Stop)]
@since 0.5.5 *)
@ -480,15 +477,13 @@ val zip_i : 'a t -> (int * 'a) t
@since 1.0 Changed type to just give an iterator of pairs *)
val fold2 : f:('c -> 'a -> 'b -> 'c) -> init:'c -> ('a * 'b) t -> 'c
val iter2 : f:('a -> 'b -> unit) -> ('a * 'b) t -> unit
val map2 : f:('a -> 'b -> 'c) -> ('a * 'b) t -> 'c t
val map2_2 : f:('a -> 'b -> 'c) -> ('a -> 'b -> 'd) -> ('a * 'b) t -> ('c * 'd) t
val map2_2 :
f:('a -> 'b -> 'c) -> ('a -> 'b -> 'd) -> ('a * 'b) t -> ('c * 'd) t
(** [map2_2 f g seq2] maps each [x, y] of seq2 into [f x y, g x y] *)
(** {2 Data structures converters} *)
val to_list : 'a t -> 'a list
@ -568,9 +563,8 @@ val of_hashtbl : ('a, 'b) Hashtbl.t -> ('a * 'b) t
val hashtbl_keys : ('a, 'b) Hashtbl.t -> 'a t
val hashtbl_values : ('a, 'b) Hashtbl.t -> 'b t
val of_str : string -> char t
val to_str : char t -> string
val to_str : char t -> string
val concat_str : string t -> string
(** Concatenate strings together, eagerly.
@ -633,6 +627,7 @@ val to_gen : 'a t -> 'a gen
module Set : sig
module type S = sig
include Set.S
val of_iter : elt iter -> t
val to_iter : t -> elt iter
val to_list : t -> elt list
@ -646,10 +641,10 @@ module Set : sig
end
(** Create an enriched Set module from the given one *)
module Adapt(X : Set.S) : S with type elt = X.elt and type t = X.t
module Adapt (X : Set.S) : S with type elt = X.elt and type t = X.t
(** Functor to build an extended Set module from an ordered type *)
module Make(X : Set.OrderedType) : S with type elt = X.t
module Make (X : Set.OrderedType) : S with type elt = X.t
end
(** {3 Maps} *)
@ -657,6 +652,7 @@ end
module Map : sig
module type S = sig
include Map.S
val to_iter : 'a t -> (key * 'a) iter
val of_iter : (key * 'a) iter -> 'a t
val keys : 'a t -> key iter
@ -672,10 +668,10 @@ module Map : sig
end
(** Adapt a pre-existing Map module to make it iterator-aware *)
module Adapt(M : Map.S) : S with type key = M.key and type 'a t = 'a M.t
module Adapt (M : Map.S) : S with type key = M.key and type 'a t = 'a M.t
(** Create an enriched Map module, with iterator-aware functions *)
module Make(V : Map.OrderedType) : S with type key = V.t
module Make (V : Map.OrderedType) : S with type key = V.t
end
(** {2 Random iterators} *)
@ -712,7 +708,7 @@ val shuffle_buffer : n:int -> 'a t -> 'a t
(** {3 Sampling} *)
val sample : n:int -> 'a t -> 'a array
(** [sample n seq] returns k samples of [seq], with uniform probability.
(** [sample n seq] returns k samples of [seq], with uniform probability.
It will consume the iterator and use O(n) memory.
It returns an array of size [min (length seq) n].
@ -721,28 +717,28 @@ val sample : n:int -> 'a t -> 'a array
(** {2 Infix functions} *)
module Infix : sig
val (--) : int -> int -> int t
val ( -- ) : int -> int -> int t
(** [a -- b] is the range of integers from [a] to [b], both included,
in increasing order. It will therefore be empty if [a > b]. *)
val (--^) : int -> int -> int t
val ( --^ ) : int -> int -> int t
(** [a --^ b] is the range of integers from [b] to [a], both included,
in decreasing order (starts from [a]).
It will therefore be empty if [a < b]. *)
val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
(** Monadic bind (infix version of {!flat_map}
@since 0.5 *)
val (>|=) : 'a t -> ('a -> 'b) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
(** Infix version of {!map}
@since 0.5 *)
val (<*>) : ('a -> 'b) t -> 'a t -> 'b t
val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
(** Applicative operator (product+application)
@since 0.5 *)
val (<+>) : 'a t -> 'a t -> 'a t
val ( <+> ) : 'a t -> 'a t -> 'a t
(** Concatenation of iterators
@since 0.5 *)
end
@ -751,13 +747,16 @@ include module type of Infix
(** {2 Pretty printing} *)
val pp_seq : ?sep:string -> (Format.formatter -> 'a -> unit) ->
Format.formatter -> 'a t -> unit
val pp_seq :
?sep:string ->
(Format.formatter -> 'a -> unit) ->
Format.formatter ->
'a t ->
unit
(** Pretty print an iterator of ['a], using the given pretty printer
to print each elements. An optional separator string can be provided. *)
val pp_buf : ?sep:string -> (Buffer.t -> 'a -> unit) ->
Buffer.t -> 'a t -> unit
val pp_buf : ?sep:string -> (Buffer.t -> 'a -> unit) -> Buffer.t -> 'a t -> unit
(** Print into a buffer *)
val to_string : ?sep:string -> ('a -> string) -> 'a t -> string
@ -790,8 +789,7 @@ val to_string : ?sep:string -> ('a -> string) -> 'a t -> string
@since 0.5.1 *)
module IO : sig
val lines_of : ?mode:int -> ?flags:open_flag list ->
string -> string t
val lines_of : ?mode:int -> ?flags:open_flag list -> string -> string t
(** [lines_of filename] reads all lines of the given file. It raises the
same exception as would opening the file and read from it, except
from [End_of_file] (which is caught). The file is {b always} properly
@ -801,29 +799,29 @@ module IO : sig
@param mode default [0o644]
@param flags default: [[Open_rdonly]] *)
val chunks_of : ?mode:int -> ?flags:open_flag list -> ?size:int ->
string -> string t
val chunks_of :
?mode:int -> ?flags:open_flag list -> ?size:int -> string -> string t
(** Read chunks of the given [size] from the file. The last chunk might be
smaller. Behaves like {!lines_of} regarding errors and options.
Every time the iterator is iterated on, the file is opened again, so
different iterations might return different results *)
val write_to : ?mode:int -> ?flags:open_flag list ->
string -> string t -> unit
val write_to :
?mode:int -> ?flags:open_flag list -> string -> string t -> unit
(** [write_to filename seq] writes all strings from [seq] into the given
file. It takes care of opening and closing the file.
@param mode default [0o644]
@param flags used by [open_out_gen]. Default: [[Open_creat;Open_wronly]]. *)
val write_bytes_to : ?mode:int -> ?flags:open_flag list ->
string -> Bytes.t t -> unit
val write_bytes_to :
?mode:int -> ?flags:open_flag list -> string -> Bytes.t t -> unit
(** @since 0.5.4 *)
val write_lines : ?mode:int -> ?flags:open_flag list ->
string -> string t -> unit
val write_lines :
?mode:int -> ?flags:open_flag list -> string -> string t -> unit
(** Same as {!write_to}, but intercales ['\n'] between each string *)
val write_bytes_lines : ?mode:int -> ?flags:open_flag list ->
string -> Bytes.t t -> unit
val write_bytes_lines :
?mode:int -> ?flags:open_flag list -> string -> Bytes.t t -> unit
(** @since 0.5.4 *)
end

110
src/bench/bench_persistent.ml
View file

@ -2,91 +2,106 @@
module MList = struct
type 'a t = {
content : 'a array; (* elements of the node *)
mutable len : int; (* number of elements in content *)
mutable tl : 'a t; (* tail *)
} (** A list that contains some elements, and may point to another list *)
content: 'a array; (* elements of the node *)
mutable len: int; (* number of elements in content *)
mutable tl: 'a t; (* tail *)
}
(** A list that contains some elements, and may point to another list *)
(** Empty list, for the tl field *)
let _empty () : 'a t = Obj.magic 0
(** Empty list, for the tl field *)
let make n =
assert (n > 0);
{ content = Array.make n (Obj.magic 0);
len = 0;
tl = _empty ();
}
{ content = Array.make n (Obj.magic 0); len = 0; tl = _empty () }
let rec is_empty l =
l.len = 0 && (l.tl == _empty () || is_empty l.tl)
let rec is_empty l = l.len = 0 && (l.tl == _empty () || is_empty l.tl)
let rec iter f l =
for i = 0 to l.len - 1 do f l.content.(i); done;
for i = 0 to l.len - 1 do
f l.content.(i)
done;
if l.tl != _empty () then iter f l.tl
let iteri f l =
let rec iteri i f l =
for j = 0 to l.len - 1 do f (i+j) l.content.(j); done;
if l.tl != _empty () then iteri (i+l.len) f l.tl
in iteri 0 f l
for j = 0 to l.len - 1 do
f (i + j) l.content.(j)
done;
if l.tl != _empty () then iteri (i + l.len) f l.tl
in
iteri 0 f l
let rec iter_rev f l =
(if l.tl != _empty () then iter_rev f l.tl);
for i = l.len - 1 downto 0 do f l.content.(i); done
if l.tl != _empty () then iter_rev f l.tl;
for i = l.len - 1 downto 0 do
f l.content.(i)
done
let length l =
let rec len acc l =
if l.tl == _empty () then acc+l.len else len (acc+l.len) l.tl
in len 0 l
if l.tl == _empty () then
acc + l.len
else
len (acc + l.len) l.tl
in
len 0 l
(** Get element by index *)
let rec get l i =
if i < l.len then l.content.(i)
else if i >= l.len && l.tl == _empty () then raise (Invalid_argument "MList.get")
else get l.tl (i - l.len)
if i < l.len then
l.content.(i)
else if i >= l.len && l.tl == _empty () then
raise (Invalid_argument "MList.get")
else
get l.tl (i - l.len)
(** Push [x] at the end of the list. It returns the block in which the
element is inserted. *)
let rec push x l =
if l.len = Array.length l.content
then begin (* insert in the next block *)
(if l.tl == _empty () then
let n = Array.length l.content in
l.tl <- make (n + n lsr 1));
push x l.tl
end else begin (* insert in l *)
l.content.(l.len) <- x;
l.len <- l.len + 1;
l
end
if l.len = Array.length l.content then (
(* insert in the next block *)
if l.tl == _empty () then (
let n = Array.length l.content in
l.tl <- make (n + (n lsr 1))
);
push x l.tl
) else (
(* insert in l *)
l.content.(l.len) <- x;
l.len <- l.len + 1;
l
)
(** Reverse list (in place), and returns the new head *)
let rev l =
let rec rev prev l =
(* reverse array *)
for i = 0 to (l.len-1) / 2 do
for i = 0 to (l.len - 1) / 2 do
let x = l.content.(i) in
l.content.(i) <- l.content.(l.len - i - 1);
l.content.(l.len - i - 1) <- x;
l.content.(l.len - i - 1) <- x
done;
(* reverse next block *)
let l' = l.tl in
l.tl <- prev;
if l' == _empty () then l else rev l l'
if l' == _empty () then
l
else
rev l l'
in
rev (_empty ()) l
(** Build a MList of elements of the Seq. The optional argument indicates
the size of the blocks *)
let of_seq ?(size=8) seq =
let of_seq ?(size = 8) seq =
(* read iterator into a MList.t *)
let start = make size in
let l = ref start in
seq (fun x -> l := push x !l);
start
let to_seq l =
fun k -> iter k l
let to_seq l k = iter k l
end
(** Store content of the seqerator in an enum *)
@ -114,14 +129,17 @@ let bench_current n =
done
let () =
let bench_n n =
let bench_n n =
Printf.printf "BENCH for %d\n" n;
let res = Benchmark.throughputN 5
[ "mlist", bench_mlist, n
; "naive", bench_naive, n
; "current", bench_current, n
]
in Benchmark.tabulate res
let res =
Benchmark.throughputN 5
[
"mlist", bench_mlist, n;
"naive", bench_naive, n;
"current", bench_current, n;
]
in
Benchmark.tabulate res
in
bench_n 100;
bench_n 100_000;

118
src/bench/bench_persistent_read.ml
View file

@ -1,90 +1,105 @@
module MList = struct
type 'a t = {
content : 'a array; (* elements of the node *)
mutable len : int; (* number of elements in content *)
mutable tl : 'a t; (* tail *)
} (** A list that contains some elements, and may point to another list *)
content: 'a array; (* elements of the node *)
mutable len: int; (* number of elements in content *)
mutable tl: 'a t; (* tail *)
}
(** A list that contains some elements, and may point to another list *)
(** Empty list, for the tl field *)
let _empty () : 'a t = Obj.magic 0
(** Empty list, for the tl field *)
let make n =
assert (n > 0);
{ content = Array.make n (Obj.magic 0);
len = 0;
tl = _empty ();
}
{ content = Array.make n (Obj.magic 0); len = 0; tl = _empty () }
let rec is_empty l =
l.len = 0 && (l.tl == _empty () || is_empty l.tl)
let rec is_empty l = l.len = 0 && (l.tl == _empty () || is_empty l.tl)
let rec iter f l =
for i = 0 to l.len - 1 do f l.content.(i); done;
for i = 0 to l.len - 1 do
f l.content.(i)
done;
if l.tl != _empty () then iter f l.tl
let iteri f l =
let rec iteri i f l =
for j = 0 to l.len - 1 do f (i+j) l.content.(j); done;
if l.tl != _empty () then iteri (i+l.len) f l.tl
in iteri 0 f l
for j = 0 to l.len - 1 do
f (i + j) l.content.(j)
done;
if l.tl != _empty () then iteri (i + l.len) f l.tl
in
iteri 0 f l
let rec iter_rev f l =
(if l.tl != _empty () then iter_rev f l.tl);
for i = l.len - 1 downto 0 do f l.content.(i); done
if l.tl != _empty () then iter_rev f l.tl;
for i = l.len - 1 downto 0 do
f l.content.(i)
done
let length l =
let rec len acc l =
if l.tl == _empty () then acc+l.len else len (acc+l.len) l.tl
in len 0 l
if l.tl == _empty () then
acc + l.len
else
len (acc + l.len) l.tl
in
len 0 l
(** Get element by index *)
let rec get l i =
if i < l.len then l.content.(i)
else if i >= l.len && l.tl == _empty () then raise (Invalid_argument "MList.get")
else get l.tl (i - l.len)
if i < l.len then
l.content.(i)
else if i >= l.len && l.tl == _empty () then
raise (Invalid_argument "MList.get")
else
get l.tl (i - l.len)
(** Push [x] at the end of the list. It returns the block in which the
element is inserted. *)
let rec push x l =
if l.len = Array.length l.content
then begin (* insert in the next block *)
(if l.tl == _empty () then
let n = Array.length l.content in
l.tl <- make (n + n lsr 1));
push x l.tl
end else begin (* insert in l *)
l.content.(l.len) <- x;
l.len <- l.len + 1;
l
end
if l.len = Array.length l.content then (
(* insert in the next block *)
if l.tl == _empty () then (
let n = Array.length l.content in
l.tl <- make (n + (n lsr 1))
);
push x l.tl
) else (
(* insert in l *)
l.content.(l.len) <- x;
l.len <- l.len + 1;
l
)
(** Reverse list (in place), and returns the new head *)
let rev l =
let rec rev prev l =
(* reverse array *)
for i = 0 to (l.len-1) / 2 do
for i = 0 to (l.len - 1) / 2 do
let x = l.content.(i) in
l.content.(i) <- l.content.(l.len - i - 1);
l.content.(l.len - i - 1) <- x;
l.content.(l.len - i - 1) <- x
done;
(* reverse next block *)
let l' = l.tl in
l.tl <- prev;
if l' == _empty () then l else rev l l'
if l' == _empty () then
l
else
rev l l'
in
rev (_empty ()) l
(** Build a MList of elements of the Seq. The optional argument indicates
the size of the blocks *)
let of_seq ?(size=8) seq =
let of_seq ?(size = 8) seq =
(* read iterator into a MList.t *)
let start = make size in
let l = ref start in
seq (fun x -> l := push x !l);
start
let to_seq l =
fun k -> iter k l
let to_seq l k = iter k l
end
(** Store content of the seqerator in an enum *)
@ -92,8 +107,7 @@ let persistent_mlist seq =
let l = MList.of_seq seq in
MList.to_seq l
let bench_mlist n =
persistent_mlist Iter.(1 -- n)
let bench_mlist n = persistent_mlist Iter.(1 -- n)
let bench_list n =
let l = Iter.to_rev_list Iter.(1 -- n) in
@ -101,18 +115,16 @@ let bench_list n =
let bench_naive n =
let s = Iter.(1 -- n) in
Iter.iter ignore s ;
Iter.iter ignore s;
s
let bench_current n =
Iter.persistent Iter.(1 -- n)
let bench_current n = Iter.persistent Iter.(1 -- n)
let bench_array n =
let a = Iter.to_array Iter.(1 -- n) in
Iter.of_array a
let read s =
Iter.map (fun x -> x + 1) s
let read s = Iter.map (fun x -> x + 1) s
let () =
let bench_n n =
@ -124,13 +136,15 @@ let () =
let array = bench_current n in
let naive = bench_naive n in
Benchmark.throughputN 5
[ "mlist", read, mlist
; "list", read, list
; "current", read, current
; "array", read, array
; "naive", read, naive
[
"mlist", read, mlist;
"list", read, list;
"current", read, current;
"array", read, array;
"naive", read, naive;
]
in Benchmark.tabulate res
in
Benchmark.tabulate res
in
bench_n 100;
bench_n 100_000;

30
src/bench/benchs.ml
View file

@ -1,36 +1,32 @@
module S = Iter
open Iter.Infix
[@@@ocaml.warning "-5"]
let small = [10;20;50;100;500]
let medium = small @ [1000;10_000;100_000]
let big = medium @ [500_000; 1_000_000; 2_000_000]
let bench_fold n =
0 -- n |> S.fold (+) 0 |> ignore
let small = [ 10; 20; 50; 100; 500 ]
let medium = small @ [ 1000; 10_000; 100_000 ]
let big = medium @ [ 500_000; 1_000_000; 2_000_000 ]
let bench_fold n = 0 -- n |> S.fold ( + ) 0 |> ignore
let bench_flatmap n =
0 -- n |> S.flat_map (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 _ -> ())
let bench_product n = S.product (0 -- n) (0 -- n) (fun _ -> ())
let _ =
List.iter
(fun (name,bench,sizes) ->
(fun (name, bench, sizes) ->
Format.printf "-------------------------------------------------------@.";
Format.printf "bench %s@." name;
List.iter
(fun n ->
let name = name ^ " on " ^ string_of_int n in
let res = Benchmark.throughput1 2 ~name bench n in
Benchmark.tabulate res;
) sizes
)
[ "fold", bench_fold, big
; "flatmap", bench_flatmap, medium
; "product", bench_product, small
Benchmark.tabulate res)
sizes)
[
"fold", bench_fold, big;
"flatmap", bench_flatmap, medium;
"product", bench_product, small;
];
()

12
src/bench/dune
View file

@ -1,8 +1,6 @@
(executables
(names bench_persistent_read bench_persistent benchs)
(libraries iter benchmark)
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
(ocamlopt_flags :standard -O3 -color always
-unbox-closures -unbox-closures-factor 20)
)
(names bench_persistent_read bench_persistent benchs)
(libraries iter benchmark)
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -color always)
(ocamlopt_flags :standard -O3 -color always -unbox-closures
-unbox-closures-factor 20))

3
src/bench/simple_bench.ml
View file

@ -1,11 +1,10 @@
open Iter.Infix
let _ =
let n = int_of_string Sys.argv.(1) in
let seq = 0 -- n in
let start = Unix.gettimeofday () in
seq |> Iter.persistent |> Iter.fold (+) 0 |> ignore;
seq |> Iter.persistent |> Iter.fold ( + ) 0 |> ignore;
let stop = Unix.gettimeofday () in
Format.printf "iter on %d: %.4f@." n (stop -. start);
()

28
src/bigarray/IterBigarray.ml
View file

@ -1,4 +1,3 @@
(* This file is free software, part of iter. See file "license" for more details. *)
(** {1 Interface and Helpers for bigarrays} *)
@ -7,20 +6,19 @@ open! IterBigarrayShims_
let of_bigarray b yield =
let len = Bigarray.Array1.dim b in
for i=0 to len-1 do
for i = 0 to len - 1 do
yield b.{i}
done
let mmap filename =
fun yield ->
let fd = Unix.openfile filename [Unix.O_RDONLY] 0 in
let len = Unix.lseek fd 0 Unix.SEEK_END in
let _ = Unix.lseek fd 0 Unix.SEEK_SET in
let b = bigarray_map_file fd Bigarray.char Bigarray.c_layout false len in
try
of_bigarray b yield;
Unix.close fd
with e ->
Unix.close fd;
raise e
[@@ocaml.warning "-3"]
let mmap filename yield =
let fd = Unix.openfile filename [ Unix.O_RDONLY ] 0 in
let len = Unix.lseek fd 0 Unix.SEEK_END in
let _ = Unix.lseek fd 0 Unix.SEEK_SET in
let b = bigarray_map_file fd Bigarray.char Bigarray.c_layout false len in
try
of_bigarray b yield;
Unix.close fd
with e ->
Unix.close fd;
raise e
[@@ocaml.warning "-3"]

5
src/bigarray/IterBigarray.mli
View file

@ -1,7 +1,4 @@
(* This file is free software, part of iter. See file "license" for more details. *)
(** {1 Interface and Helpers for bigarrays}
(** Interface and Helpers for bigarrays
@since 0.5.4 *)

28
src/bigarray/dune
View file

@ -1,18 +1,20 @@
(library
(name iter_bigarray)
(public_name iter.bigarray)
(libraries iter bigarray unix)
(modules IterBigarray IterBigarrayShims_)
(wrapped false)
(optional))
(name iter_bigarray)
(public_name iter.bigarray)
(libraries iter bigarray unix)
(modules IterBigarray IterBigarrayShims_)
(wrapped false)
(optional))
(executable
(name mkshims)
(modules mkshims)
(libraries dune.configurator))
(name mkshims)
(modules mkshims)
(libraries dune.configurator))
(rule
(targets IterBigarrayShims_.ml)
(deps mkshims.exe)
(action (with-stdout-to %{targets} (run ./mkshims.exe))))
(targets IterBigarrayShims_.ml)
(deps mkshims.exe)
(action
(with-stdout-to
%{targets}
(run ./mkshims.exe))))

28
src/bigarray/mkshims.ml
View file

@ -1,17 +1,21 @@
module C = Configurator.V1
let shims_pre_408 = "
open! Bigarray
let bigarray_map_file = Bigarray.Array1.map_file
"
let shims_post_408 = "
let bigarray_map_file fd ty lay b len =
Unix.map_file fd ty lay b [| len |] |> Bigarray.array1_of_genarray
"
let shims_pre_408 =
"\nopen! Bigarray\nlet bigarray_map_file = Bigarray.Array1.map_file\n"
let shims_post_408 =
"\n\
let bigarray_map_file fd ty lay b len =\n\
\ Unix.map_file fd ty lay b [| len |] |> Bigarray.array1_of_genarray\n"
let () =
C.main ~name:"mkshims" (fun c ->
let version = C.ocaml_config_var_exn c "version" in
let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
print_endline (if (major, minor) >= (4,8) then shims_post_408 else shims_pre_408))
let version = C.ocaml_config_var_exn c "version" in
let major, minor =
Scanf.sscanf version "%u.%u" (fun maj min -> maj, min)
in
print_endline
(if (major, minor) >= (4, 8) then
shims_post_408
else
shims_pre_408))

35
src/dune
View file

@ -1,24 +1,25 @@
(executable
(name mkshims)
(modules mkshims)
(libraries dune.configurator))
(name mkshims)
(modules mkshims)
(libraries dune.configurator))
(rule
(targets Iter_shims_.ml)
(deps mkshims.exe)
(action (with-stdout-to %{targets} (run ./mkshims.exe))))
(targets Iter_shims_.ml)
(deps mkshims.exe)
(action
(with-stdout-to
%{targets}
(run ./mkshims.exe))))
(library
(name iter)
(public_name iter)
(wrapped false)
(modules Iter IterLabels Iter_shims_)
(flags :standard -nolabels)
(libraries bytes result seq))
(name iter)
(public_name iter)
(wrapped false)
(modules Iter IterLabels Iter_shims_)
(flags :standard -w +a -warn-error -a+8 -nolabels)
(libraries bytes result seq))
(env
(_
(flags :standard -warn-error -a+8 -safe-string -strict-sequence)
(ocamlopt_flags :standard -O3 -unbox-closures -unbox-closures-factor 20)))
(_
(flags :standard -w +a -warn-error -a+8 -strict-sequence)
(ocamlopt_flags :standard -O3 -unbox-closures -unbox-closures-factor 20)))

13
src/mkshims.ml
View file

@ -1,4 +1,3 @@
module C = Configurator.V1
let shims_pre_408 = "module Stdlib = Pervasives"
@ -6,6 +5,12 @@ let shims_post_408 = "module Stdlib = Stdlib"
let () =
C.main ~name:"mkshims" (fun c ->
let version = C.ocaml_config_var_exn c "version" in
let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
print_endline (if (major, minor) >= (4,8) then shims_post_408 else shims_pre_408))
let version = C.ocaml_config_var_exn c "version" in
let major, minor =
Scanf.sscanf version "%u.%u" (fun maj min -> maj, min)
in
print_endline
(if (major, minor) >= (4, 8) then
shims_post_408
else
shims_pre_408))

4
tests/unit/dune Normal file
View file

@ -0,0 +1,4 @@
(tests
(names t_iter)
(libraries iter qcheck-core qcheck-core.runner ounit2))

335
tests/unit/t_iter.ml Normal file
View file

@ -0,0 +1,335 @@
module Q = QCheck
open Iter
let spf = Printf.sprintf
let pp_ilist = Q.Print.(list int)
let qchecks = ref []
let add_qcheck line gen prop =
let test = Q.Test.make gen prop ~name:(spf "qcheck %d" line) in
qchecks := test :: !qchecks
let () =
let seq = empty in
OUnit.assert_bool "empty" (is_empty seq);
OUnit.assert_bool "empty"
(try
iter (fun _ -> raise Exit) seq;
true
with Exit -> false)
let () =
let seq = repeat "hello" in
OUnit.assert_equal [ "hello"; "hello"; "hello" ] (seq |> take 3 |> to_list)
let () =
OUnit.assert_equal [ 0; 1; 2; 3; 4 ] (init (fun x -> x) |> take 5 |> to_list)
let () =
let n = 1 -- 10 |> fold ( + ) 0 in
OUnit.assert_equal 55 n;
()
let () =
let l =
[ "hello"; "world" ] |> of_list |> foldi (fun acc i x -> (i, x) :: acc) []
in
OUnit.assert_equal [ 1, "world"; 0, "hello" ] l;
()
let () =
OUnit.assert_equal
~printer:Q.Print.(list int)
[ 0; 1; 3; 5 ]
(0 -- 3 |> fold_map (fun prev x -> x, prev + x) 0 |> to_list)
let () =
let s1 = 1 -- 5 in
let s2 = 6 -- 10 in
let l = [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ] in
OUnit.assert_equal l (to_list (append s1 s2));
()
let () =
1 -- 1000
|> map (fun i -> i -- (i + 1))
|> concat |> length |> OUnit.assert_equal 2000
let () =
1 -- 1000
|> flat_map (fun i -> i -- (i + 1))
|> length |> OUnit.assert_equal 2000
let test = OUnit.assert_equal ~printer:Q.Print.(list @@ list int)
let () =
test
[ [ 1; 2 ]; [ 1; 3 ] ]
(seq_list [ singleton 1; doubleton 2 3 ] |> to_list)
let () = test [] (seq_list [ singleton 1; empty; doubleton 2 3 ] |> to_list)
let () =
test
[ [ 1; 2; 4 ]; [ 1; 3; 4 ] ]
(seq_list [ singleton 1; doubleton 2 3; singleton 4 ] |> to_list)
let () =
add_qcheck __LINE__
Q.(list int)
(fun l ->
let seq = of_list l and f x = x mod 2 = 0 in
filter_count f seq = (filter f seq |> length))
let () =
1 -- 100
|> (fun seq -> intersperse 0 seq)
|> take 10 |> to_list
|> OUnit.assert_equal [ 1; 0; 2; 0; 3; 0; 4; 0; 5; 0 ]
let () =
let printer = pp_ilist in
let iter =
of_gen_once
(let i = ref (-1) in
fun () ->
incr i;
if !i < 5 then
Some !i
else
None)
in
(* consume iter into a persistent version of itself *)
let iter' = persistent iter in
OUnit.assert_raises OneShotSequence (fun () -> iter |> to_list);
OUnit.assert_equal ~printer [ 0; 1; 2; 3; 4 ] (iter' |> to_list);
OUnit.assert_equal ~printer [ 0; 1; 2; 3; 4 ] (iter' |> to_list);
OUnit.assert_equal ~printer [ 0; 1; 2; 3; 4 ]
(iter' |> to_seq_persistent |> of_seq |> to_list);
()
let () =
let printer = pp_ilist in
let iter = 0 -- 10_000 in
let iter' = persistent iter in
OUnit.assert_equal 10_001 (length iter');
OUnit.assert_equal 10_001 (length iter');
OUnit.assert_equal ~printer [ 0; 1; 2; 3 ] (iter' |> take 4 |> to_list);
()
let () =
1 -- 100
|> sort ~cmp:(fun i j -> j - i)
|> take 4 |> to_list
|> OUnit.assert_equal [ 100; 99; 98; 97 ]
let test line p = OUnit.assert_bool (spf "test at %d" line) p
let () = test __LINE__ @@ (of_list [ 1; 2; 3; 4 ] |> sorted)
let () = test __LINE__ @@ not (of_list [ 1; 2; 3; 0; 4 ] |> sorted)
let () = test __LINE__ @@ sorted empty
let () =
[ 1; 2; 3; 3; 2; 2; 3; 4 ] |> of_list |> group_succ_by ?eq:None |> to_list
|> OUnit.assert_equal [ [ 1 ]; [ 2 ]; [ 3; 3 ]; [ 2; 2 ]; [ 3 ]; [ 4 ] ]
let () =
[ 1; 2; 3; 3; 2; 2; 3; 4 ] |> of_list
|> group_by ?eq:None ?hash:None
|> sort ?cmp:None |> to_list
|> OUnit.assert_equal [ [ 1 ]; [ 2; 2; 2 ]; [ 3; 3; 3 ]; [ 4 ] ]
let () =
[ 1; 2; 3; 3; 2; 2; 3; 4 ] |> of_list |> count ?eq:None ?hash:None
|> sort ?cmp:None |> to_list
|> OUnit.assert_equal [ 1, 1; 2, 3; 3, 3; 4, 1 ]
let () =
[ 1; 2; 2; 3; 4; 4; 4; 3; 3 ]
|> of_list |> uniq ?eq:None |> to_list
|> OUnit.assert_equal [ 1; 2; 3; 4; 3 ]
let () =
[ 42; 1; 2; 3; 4; 5; 4; 3; 2; 1 ]
|> of_list |> sort_uniq ?cmp:None |> to_list
|> OUnit.assert_equal [ 1; 2; 3; 4; 5; 42 ]
let () =
let a = 0 -- 2 in
let b = of_list [ "a"; "b"; "c" ] in
let s =
product a b |> map (fun (x, y) -> y, x) |> to_list |> List.sort compare
in
OUnit.assert_equal
[ "a", 0; "a", 1; "a", 2; "b", 0; "b", 1; "b", 2; "c", 0; "c", 1; "c", 2 ]
s
let () =
OUnit.assert_equal [ 0, 1; 0, 2; 1, 2 ] (diagonal_l [ 0; 1; 2 ] |> to_list)
let () =
OUnit.assert_equal
[ 0, 1; 0, 2; 1, 2 ]
(of_list [ 0; 1; 2 ] |> diagonal |> to_list)
let () =
let s1 = 1 -- 3 in
let s2 = of_list [ "1"; "2" ] in
let join_row i j =
if string_of_int i = j then
Some (string_of_int i ^ " = " ^ j)
else
None
in
let s = join ~join_row s1 s2 in
OUnit.assert_equal [ "1 = 1"; "2 = 2" ] (to_list s);
()
let () =
OUnit.assert_equal
[ 'a', [ "abc"; "attic" ]; 'b', [ "barbary"; "boom"; "bop" ]; 'c', [] ]
(group_join_by
(fun s -> s.[0])
(of_str "abc")
(of_list [ "abc"; "boom"; "attic"; "deleted"; "barbary"; "bop" ])
|> map (fun (c, l) -> c, List.sort Stdlib.compare l)
|> sort |> to_list)
let () =
let f x =
if x < 5 then
Some (string_of_int x, x + 1)
else
None
in
unfoldr f 0 |> to_list |> OUnit.assert_equal [ "0"; "1"; "2"; "3"; "4" ]
let () =
1 -- 5 |> scan ( + ) 0 |> to_list
|> OUnit.assert_equal ~printer:pp_ilist [ 0; 1; 3; 6; 10; 15 ]
let test = OUnit.assert_equal ~printer:Q.Print.int
let () = test 100 (0 -- 100 |> max_exn ?lt:None)
let () = test 0 (0 -- 100 |> min_exn ?lt:None)
let () = OUnit.assert_equal 6 (of_list [ 1; 2; 3 ] |> sum)
let () =
let seq = of_list [ 10000.0; 3.14159; 2.71828 ] in
OUnit.assert_equal ~printer:string_of_float 10005.85987 (sumf seq)
let () =
let l = to_list (take 0 (of_list [ 1 ])) in
OUnit.assert_equal ~printer:pp_ilist [] l;
let l = to_list (take 5 (of_list [ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10 ])) in
OUnit.assert_equal ~printer:pp_ilist [ 1; 2; 3; 4; 5 ] l;
()
let () =
let n =
of_list [ true; true; false; true ]
|> fold_while
(fun acc b ->
if b then
acc + 1, `Continue
else
acc, `Stop)
0
in
OUnit.assert_equal 2 n;
()
let () = 1 -- 5 |> drop 2 |> to_list |> OUnit.assert_equal [ 3; 4; 5 ]
let () = 1 -- 5 |> rev |> to_list |> OUnit.assert_equal [ 5; 4; 3; 2; 1 ]
let () =
OUnit.assert_bool "true" (for_all (fun x -> x < 10) (1 -- 9));
OUnit.assert_bool "false" (not (for_all (fun x -> x < 10) (2 -- 11)));
OUnit.assert_bool "true" (for_all (fun _ -> false) empty);
OUnit.assert_bool "nested"
(for_all
(fun seq -> not (for_all (fun x -> x < 8) seq))
(1 -- 10 >|= fun x -> x -- 20));
()
let () =
1 -- 100 |> exists (fun x -> x = 59) |> OUnit.assert_bool "exists";
1 -- 100
|> exists (fun x -> x < 0)
|> (fun x -> not x)
|> OUnit.assert_bool "not exists";
()
let () = 1 -- 1000 |> length |> OUnit.assert_equal 1000
let () =
let h = 1 -- 5 |> zip_i |> to_hashtbl in
0 -- 4 |> iter (fun i -> OUnit.assert_equal (i + 1) (Hashtbl.find h i));
OUnit.assert_equal [ 0; 1; 2; 3; 4 ]
(hashtbl_keys h |> sort ?cmp:None |> to_list);
()
let () =
let b = Buffer.create 4 in
let upp = function
| 'a' .. 'z' as c -> Char.chr (Char.code c - Char.code 'a' + Char.code 'A')
| c -> c
in
("hello world" |> of_str |> rev |> map upp |> fun seq -> to_buffer seq b);
OUnit.assert_equal "DLROW OLLEH" (Buffer.contents b);
()
let () =
OUnit.assert_equal ~printer:pp_ilist [ 1; 2; 3; 4 ] (to_list (1 -- 4));
OUnit.assert_equal ~printer:pp_ilist [ 10; 9; 8; 7; 6 ] (to_list (10 --^ 6));
OUnit.assert_equal ~printer:pp_ilist [] (to_list (10 -- 4));
OUnit.assert_equal ~printer:pp_ilist [] (to_list (10 --^ 60));
()
let test = OUnit.assert_equal ~printer:Q.Print.(list int)
let () = test [ 1; 2; 3; 4 ] (int_range_by ~step:1 1 4 |> to_list)
let () = test [ 4; 3; 2; 1 ] (int_range_by ~step:~-1 4 1 |> to_list)
let () = test [ 6; 4; 2 ] (int_range_by 6 1 ~step:~-2 |> to_list)
let () = test [] (int_range_by ~step:1 4 1 |> to_list)
let () =
add_qcheck __LINE__
Q.(pair small_int small_int)
(fun (i, j) ->
let i = Stdlib.min i j and j = Stdlib.max i j in
i -- j |> to_list = (int_range_by ~step:1 i j |> to_list))
let () =
add_qcheck __LINE__
Q.(pair small_int small_int)
(fun (i, j) ->
let i = Stdlib.min i j and j = Stdlib.max i j in
i -- j |> to_rev_list = (int_range_by ~step:~-1 j i |> to_list))
open struct
let array_for_all f a =
try
for i = 0 to Array.length a - 1 do
if not (f a.(i)) then raise Exit
done;
true
with Exit -> false
end
let () =
add_qcheck __LINE__
Q.(pair (list int) (1 -- 20))
(fun (l, n) ->
let seq = of_list l in
let a = sample n seq in
array_for_all (fun x -> exists (( = ) x) seq) a
&& Array.length a = Stdlib.min (length seq) n)
(* regression tests *)
let () =
let s = take 10 (repeat 1) in
OUnit.assert_bool "not empty" (not (is_empty s));
()
let () =
let errcode = QCheck_base_runner.run_tests ~colors:false !qchecks in
if errcode <> 0 then exit errcode