mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2026-01-21 16:56:39 -05:00
reformat all the things
This commit is contained in:
parent
042d5b4f68
commit
0b0dd83423
91 changed files with 498 additions and 173 deletions
|
|
@ -5,7 +5,7 @@ if-then-else=k-r
|
||||||
parens-ite=true
|
parens-ite=true
|
||||||
parens-tuple=multi-line-only
|
parens-tuple=multi-line-only
|
||||||
sequence-style=terminator
|
sequence-style=terminator
|
||||||
type-decl=compact
|
type-decl=sparse
|
||||||
break-cases=toplevel
|
break-cases=toplevel
|
||||||
cases-exp-indent=2
|
cases-exp-indent=2
|
||||||
field-space=tight-decl
|
field-space=tight-decl
|
||||||
|
|
|
||||||
7
Makefile
7
Makefile
|
|
@ -17,6 +17,13 @@ doc:
|
||||||
examples:
|
examples:
|
||||||
dune build examples/id_sexp.exe
|
dune build examples/id_sexp.exe
|
||||||
|
|
||||||
|
format:
|
||||||
|
@dune build $(DUNE_OPTS) @fmt --auto-promote
|
||||||
|
|
||||||
|
format-check:
|
||||||
|
@dune build $(DUNE_OPTS) @fmt --display=quiet
|
||||||
|
|
||||||
|
|
||||||
VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam)
|
VERSION=$(shell awk '/^version:/ {print $$2}' containers.opam)
|
||||||
|
|
||||||
update_next_tag:
|
update_next_tag:
|
||||||
|
|
|
||||||
25
benchs/dune
25
benchs/dune
|
|
@ -1,9 +1,24 @@
|
||||||
(executables
|
(executables
|
||||||
(names run_benchs run_bench_hash run_objsize)
|
(names run_benchs run_bench_hash run_objsize)
|
||||||
(libraries containers containers_pvec
|
(libraries
|
||||||
containers-data benchmark gen iter
|
containers
|
||||||
qcheck oseq batteries base sek)
|
containers_pvec
|
||||||
|
containers-data
|
||||||
|
benchmark
|
||||||
|
gen
|
||||||
|
iter
|
||||||
|
qcheck
|
||||||
|
oseq
|
||||||
|
batteries
|
||||||
|
base
|
||||||
|
sek)
|
||||||
(flags :standard -warn-error -3-5 -safe-string -color always)
|
(flags :standard -warn-error -3-5 -safe-string -color always)
|
||||||
(optional)
|
(optional)
|
||||||
(ocamlopt_flags :standard -O3 -color always -unbox-closures
|
(ocamlopt_flags
|
||||||
-unbox-closures-factor 20))
|
:standard
|
||||||
|
-O3
|
||||||
|
-color
|
||||||
|
always
|
||||||
|
-unbox-closures
|
||||||
|
-unbox-closures-factor
|
||||||
|
20))
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,8 @@
|
||||||
(** Test hash functions *)
|
(** Test hash functions *)
|
||||||
|
|
||||||
type tree = Empty | Node of int * tree list
|
type tree =
|
||||||
|
| Empty
|
||||||
|
| Node of int * tree list
|
||||||
|
|
||||||
let mk_node i l = Node (i, l)
|
let mk_node i l = Node (i, l)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -794,7 +794,9 @@ module Tbl = struct
|
||||||
val compare : t -> t -> int
|
val compare : t -> t -> int
|
||||||
end
|
end
|
||||||
|
|
||||||
type _ key_type = Int : int key_type | Str : string key_type
|
type _ key_type =
|
||||||
|
| Int : int key_type
|
||||||
|
| Str : string key_type
|
||||||
|
|
||||||
let arg_make : type a. a key_type -> (module KEY with type t = a) * string =
|
let arg_make : type a. a key_type -> (module KEY with type t = a) * string =
|
||||||
function
|
function
|
||||||
|
|
@ -918,7 +920,10 @@ module Tbl = struct
|
||||||
|
|
||||||
module M = CCHashTrie.Make (K)
|
module M = CCHashTrie.Make (K)
|
||||||
|
|
||||||
type 'a t = { id: CCHashTrie.Transient.t; mutable map: 'a M.t }
|
type 'a t = {
|
||||||
|
id: CCHashTrie.Transient.t;
|
||||||
|
mutable map: 'a M.t;
|
||||||
|
}
|
||||||
|
|
||||||
let create _ = { id = CCHashTrie.Transient.create (); map = M.empty }
|
let create _ = { id = CCHashTrie.Transient.create (); map = M.empty }
|
||||||
let find m k = M.get_exn k m.map
|
let find m k = M.get_exn k m.map
|
||||||
|
|
@ -1237,7 +1242,11 @@ module Deque = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Base : DEQUE = struct
|
module Base : DEQUE = struct
|
||||||
type 'a elt = { content: 'a; mutable prev: 'a elt; mutable next: 'a elt }
|
type 'a elt = {
|
||||||
|
content: 'a;
|
||||||
|
mutable prev: 'a elt;
|
||||||
|
mutable next: 'a elt;
|
||||||
|
}
|
||||||
(** A cell holding a single element *)
|
(** A cell holding a single element *)
|
||||||
|
|
||||||
and 'a t = 'a elt option ref
|
and 'a t = 'a elt option ref
|
||||||
|
|
|
||||||
|
|
@ -14,7 +14,11 @@ let pp_datetime out d =
|
||||||
CCFormat.(
|
CCFormat.(
|
||||||
fprintf out "{y=%d;M=%d;d=%d;h=%d;m=%d;s=%d}" year month day hour min sec)
|
fprintf out "{y=%d;M=%d;d=%d;h=%d;m=%d;s=%d}" year month day hour min sec)
|
||||||
|
|
||||||
type msg = { timestamp: datetime; user: string; msg: string }
|
type msg = {
|
||||||
|
timestamp: datetime;
|
||||||
|
user: string;
|
||||||
|
msg: string;
|
||||||
|
}
|
||||||
|
|
||||||
let pp_msg out m =
|
let pp_msg out m =
|
||||||
CCFormat.fprintf out "{@[time=%a;@ user=%S;@ msg=%S@]}" pp_datetime
|
CCFormat.fprintf out "{@[time=%a;@ user=%S;@ msg=%S@]}" pp_datetime
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,8 @@
|
||||||
open CCParse
|
open CCParse
|
||||||
|
|
||||||
type sexp = Atom of string | List of sexp list
|
type sexp =
|
||||||
|
| Atom of string
|
||||||
|
| List of sexp list
|
||||||
|
|
||||||
let rec pp_sexpr out (s : sexp) : unit =
|
let rec pp_sexpr out (s : sexp) : unit =
|
||||||
match s with
|
match s with
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,9 @@
|
||||||
(executables
|
(executables
|
||||||
(flags
|
(flags
|
||||||
(-w "+a-4-9-29-37-40-42-44-48-50-32" -g))
|
(-w "+a-4-9-29-37-40-42-44-48-50-32" -g))
|
||||||
(names ccsexp_parse_string_does_not_crash
|
(names
|
||||||
ccutf8_string_uchar_to_bytes_is_same_as_simple_version
|
ccsexp_parse_string_does_not_crash
|
||||||
ccsexp_csexp_reparse)
|
ccutf8_string_uchar_to_bytes_is_same_as_simple_version
|
||||||
|
ccsexp_csexp_reparse)
|
||||||
(optional)
|
(optional)
|
||||||
(libraries crowbar containers))
|
(libraries crowbar containers))
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,10 @@
|
||||||
module Str_map = Map.Make (String)
|
module Str_map = Map.Make (String)
|
||||||
|
|
||||||
type t = Int of int64 | String of string | List of t list | Map of t Str_map.t
|
type t =
|
||||||
|
| Int of int64
|
||||||
|
| String of string
|
||||||
|
| List of t list
|
||||||
|
| Map of t Str_map.t
|
||||||
|
|
||||||
let rec equal t1 t2 =
|
let rec equal t1 t2 =
|
||||||
match t1, t2 with
|
match t1, t2 with
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,11 @@
|
||||||
|
|
||||||
module Str_map : module type of Map.Make (String)
|
module Str_map : module type of Map.Make (String)
|
||||||
|
|
||||||
type t = Int of int64 | String of string | List of t list | Map of t Str_map.t
|
type t =
|
||||||
|
| Int of int64
|
||||||
|
| String of string
|
||||||
|
| List of t list
|
||||||
|
| Map of t Str_map.t
|
||||||
|
|
||||||
val equal : t -> t -> bool
|
val equal : t -> t -> bool
|
||||||
val hash : t -> int
|
val hash : t -> int
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,8 @@ type t =
|
||||||
| `Text of string
|
| `Text of string
|
||||||
| `Array of t list
|
| `Array of t list
|
||||||
| `Map of (t * t) list
|
| `Map of (t * t) list
|
||||||
| `Tag of int * t ]
|
| `Tag of int * t
|
||||||
|
]
|
||||||
|
|
||||||
let rec pp_diagnostic out (self : t) =
|
let rec pp_diagnostic out (self : t) =
|
||||||
match self with
|
match self with
|
||||||
|
|
|
||||||
|
|
@ -19,7 +19,8 @@ type t =
|
||||||
| `Text of string
|
| `Text of string
|
||||||
| `Array of t list
|
| `Array of t list
|
||||||
| `Map of (t * t) list
|
| `Map of (t * t) list
|
||||||
| `Tag of int * t ]
|
| `Tag of int * t
|
||||||
|
]
|
||||||
|
|
||||||
val pp_diagnostic : t CCFormat.printer
|
val pp_diagnostic : t CCFormat.printer
|
||||||
val to_string_diagnostic : t -> string
|
val to_string_diagnostic : t -> string
|
||||||
|
|
|
||||||
|
|
@ -31,8 +31,15 @@ module Code = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Bitfield = struct
|
module Bitfield = struct
|
||||||
type field = { f_name: string; f_offset: int; f_def: field_def }
|
type field = {
|
||||||
and field_def = F_bit | F_int of { width: int }
|
f_name: string;
|
||||||
|
f_offset: int;
|
||||||
|
f_def: field_def;
|
||||||
|
}
|
||||||
|
|
||||||
|
and field_def =
|
||||||
|
| F_bit
|
||||||
|
| F_int of { width: int }
|
||||||
|
|
||||||
type t = {
|
type t = {
|
||||||
name: string;
|
name: string;
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,9 @@
|
||||||
type 'a iter = ('a -> unit) -> unit
|
type 'a iter = ('a -> unit) -> unit
|
||||||
type t = { mutable bytes: bytes; mutable len: int }
|
|
||||||
|
type t = {
|
||||||
|
mutable bytes: bytes;
|
||||||
|
mutable len: int;
|
||||||
|
}
|
||||||
|
|
||||||
let create ?(cap = 0) () : t =
|
let create ?(cap = 0) () : t =
|
||||||
let bytes =
|
let bytes =
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,10 @@
|
||||||
@since 3.7
|
@since 3.7
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type t = { mutable bytes: bytes; mutable len: int }
|
type t = {
|
||||||
|
mutable bytes: bytes;
|
||||||
|
mutable len: int;
|
||||||
|
}
|
||||||
(** The byte buffer.
|
(** The byte buffer.
|
||||||
The definition is public since NEXT_RELEASE *)
|
The definition is public since NEXT_RELEASE *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,6 @@
|
||||||
|
|
||||||
(** {1 Simple S-expression parsing/printing} *)
|
(** {1 Simple S-expression parsing/printing} *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type 'a or_error = ('a, string) result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
|
@ -255,7 +253,10 @@ module Make (Sexp : SEXP) = struct
|
||||||
_with_in filename (parse_chan_list_ ~file:filename)
|
_with_in filename (parse_chan_list_ ~file:filename)
|
||||||
end
|
end
|
||||||
|
|
||||||
type t = [ `Atom of string | `List of t list ]
|
type t =
|
||||||
|
[ `Atom of string
|
||||||
|
| `List of t list
|
||||||
|
]
|
||||||
|
|
||||||
let rec equal a b =
|
let rec equal a b =
|
||||||
match a, b with
|
match a, b with
|
||||||
|
|
|
||||||
|
|
@ -19,7 +19,10 @@ module Make (Sexp : SEXP) : S with type t = Sexp.t
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
type t = [ `Atom of string | `List of t list ]
|
type t =
|
||||||
|
[ `Atom of string
|
||||||
|
| `List of t list
|
||||||
|
]
|
||||||
(** A simple, structural representation of S-expressions.
|
(** A simple, structural representation of S-expressions.
|
||||||
Compatible with {!CCSexp}. *)
|
Compatible with {!CCSexp}. *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,10 +4,10 @@
|
||||||
|
|
||||||
@since 0.14 *)
|
@since 0.14 *)
|
||||||
|
|
||||||
|
(** @inline *)
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include Char
|
include Char
|
||||||
end
|
end
|
||||||
(** @inline *)
|
|
||||||
|
|
||||||
val compare : t -> t -> int
|
val compare : t -> t -> int
|
||||||
(** The comparison function for characters, with the same specification as
|
(** The comparison function for characters, with the same specification as
|
||||||
|
|
|
||||||
|
|
@ -7,7 +7,9 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
type ('a, 'b) t = ('a, 'b) Either.t = Left of 'a | Right of 'b
|
type ('a, 'b) t = ('a, 'b) Either.t =
|
||||||
|
| Left of 'a
|
||||||
|
| Right of 'b
|
||||||
|
|
||||||
let left l = Left l
|
let left l = Left l
|
||||||
let right r = Right r
|
let right r = Right r
|
||||||
|
|
|
||||||
|
|
@ -15,7 +15,9 @@ type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
type ('a, 'b) t = ('a, 'b) Either.t = Left of 'a | Right of 'b
|
type ('a, 'b) t = ('a, 'b) Either.t =
|
||||||
|
| Left of 'a
|
||||||
|
| Right of 'b
|
||||||
|
|
||||||
val left : 'a -> ('a, 'b) t
|
val left : 'a -> ('a, 'b) t
|
||||||
(** [left l] is [Left l] *)
|
(** [left l] is [Left l] *)
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,6 @@
|
||||||
|
|
||||||
(** {1 Equality Combinators} *)
|
(** {1 Equality Combinators} *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type 'a t = 'a -> 'a -> bool
|
type 'a t = 'a -> 'a -> bool
|
||||||
|
|
||||||
let poly = Stdlib.( = )
|
let poly = Stdlib.( = )
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,5 @@
|
||||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type t = float
|
type t = float
|
||||||
|
|
||||||
type fpclass = Stdlib.fpclass =
|
type fpclass = Stdlib.fpclass =
|
||||||
|
|
|
||||||
|
|
@ -3,8 +3,6 @@
|
||||||
(** Basic operations on floating-point numbers
|
(** Basic operations on floating-point numbers
|
||||||
@since 0.6.1 *)
|
@since 0.6.1 *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type t = float
|
type t = float
|
||||||
|
|
||||||
type fpclass = Stdlib.fpclass =
|
type fpclass = Stdlib.fpclass =
|
||||||
|
|
|
||||||
|
|
@ -204,7 +204,15 @@ let to_file filename format =
|
||||||
|
|
||||||
module ANSI_codes = struct
|
module ANSI_codes = struct
|
||||||
type color =
|
type color =
|
||||||
[ `Black | `Red | `Yellow | `Green | `Blue | `Magenta | `Cyan | `White ]
|
[ `Black
|
||||||
|
| `Red
|
||||||
|
| `Yellow
|
||||||
|
| `Green
|
||||||
|
| `Blue
|
||||||
|
| `Magenta
|
||||||
|
| `Cyan
|
||||||
|
| `White
|
||||||
|
]
|
||||||
|
|
||||||
let int_of_color_ = function
|
let int_of_color_ = function
|
||||||
| `Black -> 0
|
| `Black -> 0
|
||||||
|
|
@ -220,7 +228,8 @@ module ANSI_codes = struct
|
||||||
[ `FG of color (* foreground *)
|
[ `FG of color (* foreground *)
|
||||||
| `BG of color (* background *)
|
| `BG of color (* background *)
|
||||||
| `Bold
|
| `Bold
|
||||||
| `Reset ]
|
| `Reset
|
||||||
|
]
|
||||||
|
|
||||||
let code_of_style : style -> int = function
|
let code_of_style : style -> int = function
|
||||||
| `FG c -> 30 + int_of_color_ c
|
| `FG c -> 30 + int_of_color_ c
|
||||||
|
|
|
||||||
|
|
@ -296,14 +296,23 @@ val with_color_ksf :
|
||||||
@since 3.5 *)
|
@since 3.5 *)
|
||||||
module ANSI_codes : sig
|
module ANSI_codes : sig
|
||||||
type color =
|
type color =
|
||||||
[ `Black | `Red | `Yellow | `Green | `Blue | `Magenta | `Cyan | `White ]
|
[ `Black
|
||||||
|
| `Red
|
||||||
|
| `Yellow
|
||||||
|
| `Green
|
||||||
|
| `Blue
|
||||||
|
| `Magenta
|
||||||
|
| `Cyan
|
||||||
|
| `White
|
||||||
|
]
|
||||||
(** An ANSI color *)
|
(** An ANSI color *)
|
||||||
|
|
||||||
type style =
|
type style =
|
||||||
[ `FG of color (** foreground *)
|
[ `FG of color (** foreground *)
|
||||||
| `BG of color (** background *)
|
| `BG of color (** background *)
|
||||||
| `Bold
|
| `Bold
|
||||||
| `Reset ]
|
| `Reset
|
||||||
|
]
|
||||||
(** A style. Styles can be composed in a list. *)
|
(** A style. Styles can be composed in a list. *)
|
||||||
|
|
||||||
val clear_line : string
|
val clear_line : string
|
||||||
|
|
|
||||||
|
|
@ -165,7 +165,10 @@ end
|
||||||
|
|
||||||
module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct
|
module Make (E : PARTIAL_ORD) : S with type elt = E.t = struct
|
||||||
type elt = E.t
|
type elt = E.t
|
||||||
type t = E | N of int * elt * t * t
|
|
||||||
|
type t =
|
||||||
|
| E
|
||||||
|
| N of int * elt * t * t
|
||||||
|
|
||||||
let empty = E
|
let empty = E
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -153,7 +153,9 @@ let read_lines_l ic =
|
||||||
with End_of_file -> List.rev !l
|
with End_of_file -> List.rev !l
|
||||||
|
|
||||||
(* thanks to nicoo for this trick *)
|
(* thanks to nicoo for this trick *)
|
||||||
type _ ret_type = Ret_string : string ret_type | Ret_bytes : Bytes.t ret_type
|
type _ ret_type =
|
||||||
|
| Ret_string : string ret_type
|
||||||
|
| Ret_bytes : Bytes.t ret_type
|
||||||
|
|
||||||
let read_all_ : type a. op:a ret_type -> size:int -> in_channel -> a =
|
let read_all_ : type a. op:a ret_type -> size:int -> in_channel -> a =
|
||||||
fun ~op ~size ic ->
|
fun ~op ~size ic ->
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||||
|
|
||||||
|
|
||||||
include Int32
|
include Int32
|
||||||
|
|
||||||
let min : t -> t -> t = Stdlib.min
|
let min : t -> t -> t = Stdlib.min
|
||||||
|
|
|
||||||
|
|
@ -13,10 +13,10 @@
|
||||||
|
|
||||||
@since 2.1 *)
|
@since 2.1 *)
|
||||||
|
|
||||||
|
(** @inline *)
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include Int32
|
include Int32
|
||||||
end
|
end
|
||||||
(** @inline *)
|
|
||||||
|
|
||||||
val min : t -> t -> t
|
val min : t -> t -> t
|
||||||
(** [min x y] returns the minimum of the two integers [x] and [y].
|
(** [min x y] returns the minimum of the two integers [x] and [y].
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||||
|
|
||||||
|
|
||||||
include Int64
|
include Int64
|
||||||
|
|
||||||
let min : t -> t -> t = Stdlib.min
|
let min : t -> t -> t = Stdlib.min
|
||||||
|
|
@ -21,8 +20,7 @@ let hash_to_int64 (n : t) =
|
||||||
done;
|
done;
|
||||||
logand !h max_int
|
logand !h max_int
|
||||||
|
|
||||||
let[@inline] hash (n : t) : int =
|
let[@inline] hash (n : t) : int = to_int (hash_to_int64 n) land Stdlib.max_int
|
||||||
to_int (hash_to_int64 n) land Stdlib.max_int
|
|
||||||
|
|
||||||
(* see {!CCInt.popcount} for more details *)
|
(* see {!CCInt.popcount} for more details *)
|
||||||
let[@inline] popcount (b : t) : int =
|
let[@inline] popcount (b : t) : int =
|
||||||
|
|
|
||||||
|
|
@ -13,10 +13,10 @@
|
||||||
|
|
||||||
@since 0.13 *)
|
@since 0.13 *)
|
||||||
|
|
||||||
|
(** @inline *)
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include Int64
|
include Int64
|
||||||
end
|
end
|
||||||
(** @inline *)
|
|
||||||
|
|
||||||
val min : t -> t -> t
|
val min : t -> t -> t
|
||||||
(** [min x y] returns the minimum of the two integers [x] and [y].
|
(** [min x y] returns the minimum of the two integers [x] and [y].
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
(* This file is free software, part of containers. See file "license" for more details. *)
|
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||||
|
|
||||||
|
|
||||||
include Nativeint
|
include Nativeint
|
||||||
|
|
||||||
let min : t -> t -> t = Stdlib.min
|
let min : t -> t -> t = Stdlib.min
|
||||||
|
|
|
||||||
|
|
@ -14,10 +14,10 @@
|
||||||
|
|
||||||
@since 2.1 *)
|
@since 2.1 *)
|
||||||
|
|
||||||
|
(** @inline *)
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include Nativeint
|
include Nativeint
|
||||||
end
|
end
|
||||||
(** @inline *)
|
|
||||||
|
|
||||||
val min : t -> t -> t
|
val min : t -> t -> t
|
||||||
(** [min x y] returns the minimum of the two integers [x] and [y].
|
(** [min x y] returns the minimum of the two integers [x] and [y].
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,6 @@
|
||||||
|
|
||||||
(** {1 Comparisons} *)
|
(** {1 Comparisons} *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type 'a t = 'a -> 'a -> int
|
type 'a t = 'a -> 'a -> int
|
||||||
(** Comparison (total ordering) between two elements, that returns an int *)
|
(** Comparison (total ordering) between two elements, that returns an int *)
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -85,7 +85,10 @@ module Position = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Error = struct
|
module Error = struct
|
||||||
type t = { msg: unit -> string; pos: position }
|
type t = {
|
||||||
|
msg: unit -> string;
|
||||||
|
pos: position;
|
||||||
|
}
|
||||||
|
|
||||||
let position self = self.pos
|
let position self = self.pos
|
||||||
let line_and_column self = Position.line_and_column self.pos
|
let line_and_column self = Position.line_and_column self.pos
|
||||||
|
|
|
||||||
|
|
@ -259,7 +259,8 @@ val chars_fold :
|
||||||
[ `Continue of 'acc
|
[ `Continue of 'acc
|
||||||
| `Consume_and_stop of 'acc
|
| `Consume_and_stop of 'acc
|
||||||
| `Stop of 'acc
|
| `Stop of 'acc
|
||||||
| `Fail of string ]) ->
|
| `Fail of string
|
||||||
|
]) ->
|
||||||
'acc ->
|
'acc ->
|
||||||
('acc * slice) t
|
('acc * slice) t
|
||||||
(** [chars_fold f acc0] folds over characters of the input.
|
(** [chars_fold f acc0] folds over characters of the input.
|
||||||
|
|
@ -289,7 +290,8 @@ val chars_fold_transduce :
|
||||||
| `Yield of 'acc * char
|
| `Yield of 'acc * char
|
||||||
| `Consume_and_stop
|
| `Consume_and_stop
|
||||||
| `Stop
|
| `Stop
|
||||||
| `Fail of string ]) ->
|
| `Fail of string
|
||||||
|
]) ->
|
||||||
'acc ->
|
'acc ->
|
||||||
('acc * string) t
|
('acc * string) t
|
||||||
(** Same as {!chars_fold} but with the following differences:
|
(** Same as {!chars_fold} but with the following differences:
|
||||||
|
|
|
||||||
|
|
@ -13,7 +13,9 @@ type nonrec (+'good, +'bad) result = ('good, 'bad) result =
|
||||||
| Ok of 'good
|
| Ok of 'good
|
||||||
| Error of 'bad
|
| Error of 'bad
|
||||||
|
|
||||||
type (+'good, +'bad) t = ('good, 'bad) result = Ok of 'good | Error of 'bad
|
type (+'good, +'bad) t = ('good, 'bad) result =
|
||||||
|
| Ok of 'good
|
||||||
|
| Error of 'bad
|
||||||
|
|
||||||
let return x = Ok x
|
let return x = Ok x
|
||||||
let fail s = Error s
|
let fail s = Error s
|
||||||
|
|
@ -333,7 +335,10 @@ let to_iter e k =
|
||||||
| Ok x -> k x
|
| Ok x -> k x
|
||||||
| Error _ -> ()
|
| Error _ -> ()
|
||||||
|
|
||||||
type ('a, 'b) error = [ `Ok of 'a | `Error of 'b ]
|
type ('a, 'b) error =
|
||||||
|
[ `Ok of 'a
|
||||||
|
| `Error of 'b
|
||||||
|
]
|
||||||
|
|
||||||
let of_err = function
|
let of_err = function
|
||||||
| `Ok x -> Ok x
|
| `Ok x -> Ok x
|
||||||
|
|
|
||||||
|
|
@ -20,7 +20,9 @@ type nonrec (+'good, +'bad) result = ('good, 'bad) result =
|
||||||
| Ok of 'good
|
| Ok of 'good
|
||||||
| Error of 'bad
|
| Error of 'bad
|
||||||
|
|
||||||
type (+'good, +'bad) t = ('good, 'bad) result = Ok of 'good | Error of 'bad
|
type (+'good, +'bad) t = ('good, 'bad) result =
|
||||||
|
| Ok of 'good
|
||||||
|
| Error of 'bad
|
||||||
|
|
||||||
val return : 'a -> ('a, 'err) t
|
val return : 'a -> ('a, 'err) t
|
||||||
(** Successfully return a value. *)
|
(** Successfully return a value. *)
|
||||||
|
|
@ -263,7 +265,10 @@ val to_seq : ('a, _) t -> 'a Seq.t
|
||||||
(** Renamed from [to_std_seq] since 3.0.
|
(** Renamed from [to_std_seq] since 3.0.
|
||||||
@since 3.0 *)
|
@since 3.0 *)
|
||||||
|
|
||||||
type ('a, 'b) error = [ `Ok of 'a | `Error of 'b ]
|
type ('a, 'b) error =
|
||||||
|
[ `Ok of 'a
|
||||||
|
| `Error of 'b
|
||||||
|
]
|
||||||
|
|
||||||
val of_err : ('a, 'b) error -> ('a, 'b) t
|
val of_err : ('a, 'b) error -> ('a, 'b) t
|
||||||
(** @since 0.17 *)
|
(** @since 0.17 *)
|
||||||
|
|
|
||||||
|
|
@ -481,7 +481,9 @@ let to_gen l =
|
||||||
l := l';
|
l := l';
|
||||||
Some x
|
Some x
|
||||||
|
|
||||||
type 'a of_gen_state = Of_gen_thunk of 'a gen | Of_gen_saved of 'a node
|
type 'a of_gen_state =
|
||||||
|
| Of_gen_thunk of 'a gen
|
||||||
|
| Of_gen_saved of 'a node
|
||||||
|
|
||||||
let of_gen g =
|
let of_gen g =
|
||||||
let rec consume r () =
|
let rec consume r () =
|
||||||
|
|
@ -508,7 +510,9 @@ let sort_uniq ~cmp l =
|
||||||
let l = to_list l in
|
let l = to_list l in
|
||||||
uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l))
|
uniq (fun x y -> cmp x y = 0) (of_list (List.sort cmp l))
|
||||||
|
|
||||||
type 'a memoize = MemoThunk | MemoSave of 'a node
|
type 'a memoize =
|
||||||
|
| MemoThunk
|
||||||
|
| MemoSave of 'a node
|
||||||
|
|
||||||
let rec memoize f =
|
let rec memoize f =
|
||||||
let r = ref MemoThunk in
|
let r = ref MemoThunk in
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,6 @@
|
||||||
|
|
||||||
(** {1 Simple S-expression parsing/printing} *)
|
(** {1 Simple S-expression parsing/printing} *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type 'a or_error = ('a, string) result
|
type 'a or_error = ('a, string) result
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
|
@ -151,7 +149,10 @@ module Make (Sexp : SEXP) = struct
|
||||||
(** A parser of ['a] can return [Yield x] when it parsed a value,
|
(** A parser of ['a] can return [Yield x] when it parsed a value,
|
||||||
or [Fail e] when a parse error was encountered, or
|
or [Fail e] when a parse error was encountered, or
|
||||||
[End] if the input was empty *)
|
[End] if the input was empty *)
|
||||||
type 'a parse_result = Yield of 'a | Fail of string | End
|
type 'a parse_result =
|
||||||
|
| Yield of 'a
|
||||||
|
| Fail of string
|
||||||
|
| End
|
||||||
|
|
||||||
module Decoder = struct
|
module Decoder = struct
|
||||||
module L = CCSexp_lex
|
module L = CCSexp_lex
|
||||||
|
|
@ -311,7 +312,10 @@ module Make (Sexp : SEXP) = struct
|
||||||
_with_in filename (parse_chan_list_ ~file:filename)
|
_with_in filename (parse_chan_list_ ~file:filename)
|
||||||
end
|
end
|
||||||
|
|
||||||
type t = [ `Atom of string | `List of t list ]
|
type t =
|
||||||
|
[ `Atom of string
|
||||||
|
| `List of t list
|
||||||
|
]
|
||||||
|
|
||||||
let rec equal a b =
|
let rec equal a b =
|
||||||
match a, b with
|
match a, b with
|
||||||
|
|
|
||||||
|
|
@ -31,7 +31,10 @@ module Make (Sexp : SEXP) : S with type t = Sexp.t and type loc = Sexp.loc
|
||||||
|
|
||||||
(** {2 Basics} *)
|
(** {2 Basics} *)
|
||||||
|
|
||||||
type t = [ `Atom of string | `List of t list ]
|
type t =
|
||||||
|
[ `Atom of string
|
||||||
|
| `List of t list
|
||||||
|
]
|
||||||
(** A simple, structural representation of S-expressions. *)
|
(** A simple, structural representation of S-expressions. *)
|
||||||
|
|
||||||
include S with type t := t
|
include S with type t := t
|
||||||
|
|
|
||||||
|
|
@ -129,7 +129,10 @@ module type S = sig
|
||||||
(** A parser of ['a] can return [Yield x] when it parsed a value,
|
(** A parser of ['a] can return [Yield x] when it parsed a value,
|
||||||
or [Fail e] when a parse error was encountered, or
|
or [Fail e] when a parse error was encountered, or
|
||||||
[End] if the input was empty. *)
|
[End] if the input was empty. *)
|
||||||
type 'a parse_result = Yield of 'a | Fail of string | End
|
type 'a parse_result =
|
||||||
|
| Yield of 'a
|
||||||
|
| Fail of string
|
||||||
|
| End
|
||||||
|
|
||||||
module Decoder : sig
|
module Decoder : sig
|
||||||
type t
|
type t
|
||||||
|
|
|
||||||
|
|
@ -44,7 +44,10 @@ type _ direction =
|
||||||
|
|
||||||
(* we follow https://en.wikipedia.org/wiki/Knuth–Morris–Pratt_algorithm *)
|
(* we follow https://en.wikipedia.org/wiki/Knuth–Morris–Pratt_algorithm *)
|
||||||
module Find = struct
|
module Find = struct
|
||||||
type 'a kmp_pattern = { failure: int array; str: string }
|
type 'a kmp_pattern = {
|
||||||
|
failure: int array;
|
||||||
|
str: string;
|
||||||
|
}
|
||||||
(* invariant: [length failure = length str].
|
(* invariant: [length failure = length str].
|
||||||
We use a phantom type to avoid mixing the directions. *)
|
We use a phantom type to avoid mixing the directions. *)
|
||||||
|
|
||||||
|
|
@ -169,7 +172,9 @@ module Find = struct
|
||||||
else
|
else
|
||||||
-1
|
-1
|
||||||
|
|
||||||
type 'a pattern = P_char of char | P_KMP of 'a kmp_pattern
|
type 'a pattern =
|
||||||
|
| P_char of char
|
||||||
|
| P_KMP of 'a kmp_pattern
|
||||||
|
|
||||||
let pattern_length = function
|
let pattern_length = function
|
||||||
| P_char _ -> 1
|
| P_char _ -> 1
|
||||||
|
|
@ -279,12 +284,17 @@ let replace ?(which = `All) ~sub ~by s =
|
||||||
Buffer.contents b
|
Buffer.contents b
|
||||||
|
|
||||||
module Split = struct
|
module Split = struct
|
||||||
type drop_if_empty = { first: bool; last: bool }
|
type drop_if_empty = {
|
||||||
|
first: bool;
|
||||||
|
last: bool;
|
||||||
|
}
|
||||||
|
|
||||||
let no_drop = { first = false; last = false }
|
let no_drop = { first = false; last = false }
|
||||||
let default_drop = no_drop
|
let default_drop = no_drop
|
||||||
|
|
||||||
type split_state = SplitStop | SplitAt of int (* previous *)
|
type split_state =
|
||||||
|
| SplitStop
|
||||||
|
| SplitAt of int (* previous *)
|
||||||
|
|
||||||
let rec _split ~by s state =
|
let rec _split ~by s state =
|
||||||
match state with
|
match state with
|
||||||
|
|
@ -414,7 +424,9 @@ let compare_versions a b =
|
||||||
in
|
in
|
||||||
cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
|
cmp_rec (Split.gen_cpy ~by:"." a) (Split.gen_cpy ~by:"." b)
|
||||||
|
|
||||||
type nat_chunk = NC_char of char | NC_int of int
|
type nat_chunk =
|
||||||
|
| NC_char of char
|
||||||
|
| NC_int of int
|
||||||
|
|
||||||
let compare_natural a b =
|
let compare_natural a b =
|
||||||
(* stream of chunks *)
|
(* stream of chunks *)
|
||||||
|
|
|
||||||
|
|
@ -8,10 +8,10 @@ type 'a iter = ('a -> unit) -> unit
|
||||||
|
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
(** @inline *)
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include String
|
include String
|
||||||
end
|
end
|
||||||
(** @inline *)
|
|
||||||
|
|
||||||
val length : t -> int
|
val length : t -> int
|
||||||
(** [length s] returns the length (number of characters) of the given string [s]. *)
|
(** [length s] returns the length (number of characters) of the given string [s]. *)
|
||||||
|
|
@ -369,7 +369,10 @@ end
|
||||||
(** {2 Splitting} *)
|
(** {2 Splitting} *)
|
||||||
|
|
||||||
module Split : sig
|
module Split : sig
|
||||||
type drop_if_empty = { first: bool; last: bool }
|
type drop_if_empty = {
|
||||||
|
first: bool;
|
||||||
|
last: bool;
|
||||||
|
}
|
||||||
(** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"].
|
(** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"].
|
||||||
|
|
||||||
- [{first=false; last=false}] will return [""; "a"; "b"; ""]
|
- [{first=false; last=false}] will return [""; "a"; "b"; ""]
|
||||||
|
|
|
||||||
|
|
@ -8,10 +8,10 @@ type 'a iter = ('a -> unit) -> unit
|
||||||
|
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
|
(** @inline *)
|
||||||
include module type of struct
|
include module type of struct
|
||||||
include StringLabels
|
include StringLabels
|
||||||
end
|
end
|
||||||
(** @inline *)
|
|
||||||
|
|
||||||
val length : t -> int
|
val length : t -> int
|
||||||
(** [length s] returns the length (number of characters) of the given string [s]. *)
|
(** [length s] returns the length (number of characters) of the given string [s]. *)
|
||||||
|
|
@ -406,7 +406,10 @@ end
|
||||||
(** {2 Splitting} *)
|
(** {2 Splitting} *)
|
||||||
|
|
||||||
module Split : sig
|
module Split : sig
|
||||||
type drop_if_empty = { first: bool; last: bool }
|
type drop_if_empty = {
|
||||||
|
first: bool;
|
||||||
|
last: bool;
|
||||||
|
}
|
||||||
(** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"].
|
(** Specification of what to do with empty blocks, as in [split ~by:"-" "-a-b-"].
|
||||||
|
|
||||||
- [{first=false; last=false}] will return [""; "a"; "b"; ""]
|
- [{first=false; last=false}] will return [""; "a"; "b"; ""]
|
||||||
|
|
|
||||||
|
|
@ -4,8 +4,6 @@
|
||||||
|
|
||||||
We only deal with UTF8 strings as they naturally map to OCaml bytestrings *)
|
We only deal with UTF8 strings as they naturally map to OCaml bytestrings *)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
type uchar = Uchar.t
|
type uchar = Uchar.t
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
type 'a iter = ('a -> unit) -> unit
|
type 'a iter = ('a -> unit) -> unit
|
||||||
|
|
@ -30,7 +28,11 @@ let to_string x = x
|
||||||
|
|
||||||
(** State for decoding *)
|
(** State for decoding *)
|
||||||
module Dec = struct
|
module Dec = struct
|
||||||
type t = { s: string; len: int; (* max offset *) mutable i: int (* offset *) }
|
type t = {
|
||||||
|
s: string;
|
||||||
|
len: int;
|
||||||
|
(* max offset *) mutable i: int; (* offset *)
|
||||||
|
}
|
||||||
|
|
||||||
let make ?(idx = 0) (s : string) : t = { s; i = idx; len = String.length s }
|
let make ?(idx = 0) (s : string) : t = { s; i = idx; len = String.length s }
|
||||||
end
|
end
|
||||||
|
|
|
||||||
|
|
@ -10,7 +10,10 @@ type 'a equal = 'a -> 'a -> bool
|
||||||
type 'a ord = 'a -> 'a -> int
|
type 'a ord = 'a -> 'a -> int
|
||||||
type 'a printer = Format.formatter -> 'a -> unit
|
type 'a printer = Format.formatter -> 'a -> unit
|
||||||
|
|
||||||
type ('a, 'mut) t = { mutable size: int; mutable vec: 'a array }
|
type ('a, 'mut) t = {
|
||||||
|
mutable size: int;
|
||||||
|
mutable vec: 'a array;
|
||||||
|
}
|
||||||
(** A vector of 'a. *)
|
(** A vector of 'a. *)
|
||||||
|
|
||||||
type 'a vector = ('a, rw) t
|
type 'a vector = ('a, rw) t
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,10 @@
|
||||||
module C = Configurator.V1
|
module C = Configurator.V1
|
||||||
|
|
||||||
type op = Le | Ge | Gt | Lt
|
type op =
|
||||||
|
| Le
|
||||||
|
| Ge
|
||||||
|
| Gt
|
||||||
|
| Lt
|
||||||
|
|
||||||
type line =
|
type line =
|
||||||
| If of op * int * int
|
| If of op * int * int
|
||||||
|
|
|
||||||
|
|
@ -3,5 +3,6 @@
|
||||||
(executable
|
(executable
|
||||||
(name cpp)
|
(name cpp)
|
||||||
(flags :standard -warn-error -a+8)
|
(flags :standard -warn-error -a+8)
|
||||||
(modes (best exe))
|
(modes
|
||||||
|
(best exe))
|
||||||
(libraries dune.configurator))
|
(libraries dune.configurator))
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,10 @@
|
||||||
module H = CCHash
|
module H = CCHash
|
||||||
|
|
||||||
module Hist = struct
|
module Hist = struct
|
||||||
type t = { tbl: (int, int) Hashtbl.t; mutable n_samples: int }
|
type t = {
|
||||||
|
tbl: (int, int) Hashtbl.t;
|
||||||
|
mutable n_samples: int;
|
||||||
|
}
|
||||||
|
|
||||||
let create () : t = { tbl = Hashtbl.create 32; n_samples = 0 }
|
let create () : t = { tbl = Hashtbl.create 32; n_samples = 0 }
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -55,7 +55,10 @@ let[@inline] __popcount8 (b : int) : int =
|
||||||
- [Bytes.length v.b >= div_ v.size] (enough storage)
|
- [Bytes.length v.b >= div_ v.size] (enough storage)
|
||||||
- all bits above [size] are 0 in [v.b]
|
- all bits above [size] are 0 in [v.b]
|
||||||
*)
|
*)
|
||||||
type t = { mutable b: bytes; mutable size: int }
|
type t = {
|
||||||
|
mutable b: bytes;
|
||||||
|
mutable size: int;
|
||||||
|
}
|
||||||
|
|
||||||
let length t = t.size
|
let length t = t.size
|
||||||
let empty () = { b = Bytes.empty; size = 0 }
|
let empty () = { b = Bytes.empty; size = 0 }
|
||||||
|
|
|
||||||
|
|
@ -46,7 +46,10 @@ module Make (L : OrderedType) (R : OrderedType) = struct
|
||||||
module MapL = Map.Make (L)
|
module MapL = Map.Make (L)
|
||||||
module MapR = Map.Make (R)
|
module MapR = Map.Make (R)
|
||||||
|
|
||||||
type t = { left: right MapL.t; right: left MapR.t }
|
type t = {
|
||||||
|
left: right MapL.t;
|
||||||
|
right: left MapR.t;
|
||||||
|
}
|
||||||
|
|
||||||
let empty = { left = MapL.empty; right = MapR.empty }
|
let empty = { left = MapL.empty; right = MapR.empty }
|
||||||
let cardinal m = MapL.cardinal m.left
|
let cardinal m = MapL.cardinal m.left
|
||||||
|
|
|
||||||
|
|
@ -67,7 +67,9 @@ let dummy =
|
||||||
}
|
}
|
||||||
|
|
||||||
module Linear = struct
|
module Linear = struct
|
||||||
type ('a, 'b) bucket = Empty | Pair of 'a * 'b
|
type ('a, 'b) bucket =
|
||||||
|
| Empty
|
||||||
|
| Pair of 'a * 'b
|
||||||
|
|
||||||
type ('a, 'b) t = {
|
type ('a, 'b) t = {
|
||||||
eq: 'a equal;
|
eq: 'a equal;
|
||||||
|
|
@ -121,7 +123,9 @@ let linear ~eq size =
|
||||||
}
|
}
|
||||||
|
|
||||||
module Replacing = struct
|
module Replacing = struct
|
||||||
type ('a, 'b) bucket = Empty | Pair of 'a * 'b
|
type ('a, 'b) bucket =
|
||||||
|
| Empty
|
||||||
|
| Pair of 'a * 'b
|
||||||
|
|
||||||
type ('a, 'b) t = {
|
type ('a, 'b) t = {
|
||||||
eq: 'a equal;
|
eq: 'a equal;
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,10 @@ type 'a node =
|
||||||
be anything but [Three] (all the intermediate ones are [Three])
|
be anything but [Three] (all the intermediate ones are [Three])
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type 'a t = { mutable cur: 'a node; mutable size: int }
|
type 'a t = {
|
||||||
|
mutable cur: 'a node;
|
||||||
|
mutable size: int;
|
||||||
|
}
|
||||||
(** The deque, a double linked list of cells *)
|
(** The deque, a double linked list of cells *)
|
||||||
|
|
||||||
exception Empty
|
exception Empty
|
||||||
|
|
|
||||||
|
|
@ -91,7 +91,11 @@ end
|
||||||
|
|
||||||
(** {2 Functors} *)
|
(** {2 Functors} *)
|
||||||
|
|
||||||
type 'a t = { size: int; leaves: 'a A.t; subs: 'a t A.t }
|
type 'a t = {
|
||||||
|
size: int;
|
||||||
|
leaves: 'a A.t;
|
||||||
|
subs: 'a t A.t;
|
||||||
|
}
|
||||||
(* invariant:
|
(* invariant:
|
||||||
- [A.length leaves < A.max_length ==> A.is_empty subs]
|
- [A.length leaves < A.max_length ==> A.is_empty subs]
|
||||||
- either:
|
- either:
|
||||||
|
|
@ -108,7 +112,9 @@ let is_empty { size; _ } = size = 0
|
||||||
let length { size; _ } = size
|
let length { size; _ } = size
|
||||||
let return x = { leaves = A.return x; subs = A.empty; size = 1 }
|
let return x = { leaves = A.return x; subs = A.empty; size = 1 }
|
||||||
|
|
||||||
type idx_l = I_one of int | I_cons of int * idx_l
|
type idx_l =
|
||||||
|
| I_one of int
|
||||||
|
| I_cons of int * idx_l
|
||||||
|
|
||||||
(* split an index into a low and high parts *)
|
(* split an index into a low and high parts *)
|
||||||
let low_idx_ i = i land A.mask
|
let low_idx_ i = i land A.mask
|
||||||
|
|
|
||||||
|
|
@ -121,7 +121,9 @@ let mk_stack () =
|
||||||
|
|
||||||
(** Implementation from http://en.wikipedia.org/wiki/Skew_heap *)
|
(** Implementation from http://en.wikipedia.org/wiki/Skew_heap *)
|
||||||
module Heap = struct
|
module Heap = struct
|
||||||
type 'a t = E | N of 'a * 'a t * 'a t
|
type 'a t =
|
||||||
|
| E
|
||||||
|
| N of 'a * 'a t * 'a t
|
||||||
|
|
||||||
let is_empty = function
|
let is_empty = function
|
||||||
| E -> true
|
| E -> true
|
||||||
|
|
@ -212,14 +214,19 @@ module Traverse = struct
|
||||||
generic_tag ~tags ~bag:(mk_stack ()) ~graph iter
|
generic_tag ~tags ~bag:(mk_stack ()) ~graph iter
|
||||||
|
|
||||||
module Event = struct
|
module Event = struct
|
||||||
type edge_kind = [ `Forward | `Back | `Cross ]
|
type edge_kind =
|
||||||
|
[ `Forward
|
||||||
|
| `Back
|
||||||
|
| `Cross
|
||||||
|
]
|
||||||
|
|
||||||
type ('v, 'e) t =
|
type ('v, 'e) t =
|
||||||
[ `Enter of
|
[ `Enter of
|
||||||
'v * int * ('v, 'e) path
|
'v * int * ('v, 'e) path
|
||||||
(* unique index in traversal, path from start *)
|
(* unique index in traversal, path from start *)
|
||||||
| `Exit of 'v
|
| `Exit of 'v
|
||||||
| `Edge of 'v * 'e * 'v * edge_kind ]
|
| `Edge of 'v * 'e * 'v * edge_kind
|
||||||
|
]
|
||||||
(** A traversal is a iteruence of such events *)
|
(** A traversal is a iteruence of such events *)
|
||||||
|
|
||||||
let get_vertex = function
|
let get_vertex = function
|
||||||
|
|
@ -333,7 +340,10 @@ let topo_sort ~eq ?rev ~tbl ~graph iter =
|
||||||
(** {2 Lazy Spanning Tree} *)
|
(** {2 Lazy Spanning Tree} *)
|
||||||
|
|
||||||
module Lazy_tree = struct
|
module Lazy_tree = struct
|
||||||
type ('v, 'e) t = { vertex: 'v; children: ('e * ('v, 'e) t) list Lazy.t }
|
type ('v, 'e) t = {
|
||||||
|
vertex: 'v;
|
||||||
|
children: ('e * ('v, 'e) t) list Lazy.t;
|
||||||
|
}
|
||||||
|
|
||||||
let make_ vertex children = { vertex; children }
|
let make_ vertex children = { vertex; children }
|
||||||
|
|
||||||
|
|
@ -462,7 +472,8 @@ module Dot = struct
|
||||||
| `Weight of int
|
| `Weight of int
|
||||||
| `Style of string
|
| `Style of string
|
||||||
| `Label of string
|
| `Label of string
|
||||||
| `Other of string * string ]
|
| `Other of string * string
|
||||||
|
]
|
||||||
(** Dot attribute *)
|
(** Dot attribute *)
|
||||||
|
|
||||||
let pp_list pp_x out l =
|
let pp_list pp_x out l =
|
||||||
|
|
@ -474,7 +485,10 @@ module Dot = struct
|
||||||
l;
|
l;
|
||||||
Format.pp_print_string out "]"
|
Format.pp_print_string out "]"
|
||||||
|
|
||||||
type vertex_state = { mutable explored: bool; id: int }
|
type vertex_state = {
|
||||||
|
mutable explored: bool;
|
||||||
|
id: int;
|
||||||
|
}
|
||||||
|
|
||||||
(** Print an enum of Full.traverse_event *)
|
(** Print an enum of Full.traverse_event *)
|
||||||
let pp_all ~tbl ~eq ?(attrs_v = fun _ -> []) ?(attrs_e = fun _ -> [])
|
let pp_all ~tbl ~eq ?(attrs_v = fun _ -> []) ?(attrs_e = fun _ -> [])
|
||||||
|
|
|
||||||
|
|
@ -143,14 +143,19 @@ module Traverse : sig
|
||||||
|
|
||||||
(** {2 More detailed interface} *)
|
(** {2 More detailed interface} *)
|
||||||
module Event : sig
|
module Event : sig
|
||||||
type edge_kind = [ `Forward | `Back | `Cross ]
|
type edge_kind =
|
||||||
|
[ `Forward
|
||||||
|
| `Back
|
||||||
|
| `Cross
|
||||||
|
]
|
||||||
|
|
||||||
type ('v, 'e) t =
|
type ('v, 'e) t =
|
||||||
[ `Enter of
|
[ `Enter of
|
||||||
'v * int * ('v, 'e) path
|
'v * int * ('v, 'e) path
|
||||||
(* unique index in traversal, path from start *)
|
(* unique index in traversal, path from start *)
|
||||||
| `Exit of 'v
|
| `Exit of 'v
|
||||||
| `Edge of 'v * 'e * 'v * edge_kind ]
|
| `Edge of 'v * 'e * 'v * edge_kind
|
||||||
|
]
|
||||||
(** A traversal is a sequence of such events *)
|
(** A traversal is a sequence of such events *)
|
||||||
|
|
||||||
val get_vertex : ('v, 'e) t -> ('v * [ `Enter | `Exit ]) option
|
val get_vertex : ('v, 'e) t -> ('v * [ `Enter | `Exit ]) option
|
||||||
|
|
@ -222,7 +227,10 @@ val topo_sort_tag :
|
||||||
(** {2 Lazy Spanning Tree} *)
|
(** {2 Lazy Spanning Tree} *)
|
||||||
|
|
||||||
module Lazy_tree : sig
|
module Lazy_tree : sig
|
||||||
type ('v, 'e) t = { vertex: 'v; children: ('e * ('v, 'e) t) list Lazy.t }
|
type ('v, 'e) t = {
|
||||||
|
vertex: 'v;
|
||||||
|
children: ('e * ('v, 'e) t) list Lazy.t;
|
||||||
|
}
|
||||||
|
|
||||||
val map_v : ('a -> 'b) -> ('a, 'e) t -> ('b, 'e) t
|
val map_v : ('a -> 'b) -> ('a, 'e) t -> ('b, 'e) t
|
||||||
val fold_v : ('acc -> 'v -> 'acc) -> 'acc -> ('v, _) t -> 'acc
|
val fold_v : ('acc -> 'v -> 'acc) -> 'acc -> ('v, _) t -> 'acc
|
||||||
|
|
@ -277,7 +285,8 @@ module Dot : sig
|
||||||
| `Weight of int
|
| `Weight of int
|
||||||
| `Style of string
|
| `Style of string
|
||||||
| `Label of string
|
| `Label of string
|
||||||
| `Other of string * string ]
|
| `Other of string * string
|
||||||
|
]
|
||||||
(** Dot attribute *)
|
(** Dot attribute *)
|
||||||
|
|
||||||
type vertex_state
|
type vertex_state
|
||||||
|
|
|
||||||
|
|
@ -12,7 +12,6 @@ module Transient = struct
|
||||||
type t = { mutable frozen: bool }
|
type t = { mutable frozen: bool }
|
||||||
|
|
||||||
let empty = { frozen = true } (* special value *)
|
let empty = { frozen = true } (* special value *)
|
||||||
|
|
||||||
let equal a b = Stdlib.( == ) a b
|
let equal a b = Stdlib.( == ) a b
|
||||||
let create () = { frozen = false }
|
let create () = { frozen = false }
|
||||||
let active st = not st.frozen
|
let active st = not st.frozen
|
||||||
|
|
@ -166,7 +165,11 @@ let popcount (b : I64.t) : int =
|
||||||
|
|
||||||
(* sparse array, using a bitfield and POPCOUNT *)
|
(* sparse array, using a bitfield and POPCOUNT *)
|
||||||
module A_SPARSE = struct
|
module A_SPARSE = struct
|
||||||
type 'a t = { bits: int64; arr: 'a array; id: Transient.t }
|
type 'a t = {
|
||||||
|
bits: int64;
|
||||||
|
arr: 'a array;
|
||||||
|
id: Transient.t;
|
||||||
|
}
|
||||||
|
|
||||||
let length_log = 6
|
let length_log = 6
|
||||||
let length = 1 lsl length_log
|
let length = 1 lsl length_log
|
||||||
|
|
@ -283,11 +286,9 @@ module Make (Key : KEY) : S with type key = Key.t = struct
|
||||||
|
|
||||||
val make : Key.t -> t
|
val make : Key.t -> t
|
||||||
val zero : t (* special "hash" *)
|
val zero : t (* special "hash" *)
|
||||||
|
|
||||||
val is_0 : t -> bool
|
val is_0 : t -> bool
|
||||||
val equal : t -> t -> bool
|
val equal : t -> t -> bool
|
||||||
val rem : t -> int (* [A.length_log] last bits *)
|
val rem : t -> int (* [A.length_log] last bits *)
|
||||||
|
|
||||||
val quotient : t -> t (* remove [A.length_log] last bits *)
|
val quotient : t -> t (* remove [A.length_log] last bits *)
|
||||||
end = struct
|
end = struct
|
||||||
type t = int
|
type t = int
|
||||||
|
|
|
||||||
|
|
@ -70,7 +70,6 @@ type 'a gen = unit -> 'a option
|
||||||
let of_list = Array.of_list
|
let of_list = Array.of_list
|
||||||
let to_list = Array.to_list
|
let to_list = Array.to_list
|
||||||
let of_array_unsafe a = a (* careful with that axe, Eugene *)
|
let of_array_unsafe a = a (* careful with that axe, Eugene *)
|
||||||
|
|
||||||
let to_iter a k = iter k a
|
let to_iter a k = iter k a
|
||||||
|
|
||||||
let of_iter s =
|
let of_iter s =
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,6 @@ module Bit : sig
|
||||||
val is_0 : bit:t -> int -> bool
|
val is_0 : bit:t -> int -> bool
|
||||||
val is_1 : bit:t -> int -> bool
|
val is_1 : bit:t -> int -> bool
|
||||||
val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *)
|
val mask : mask:t -> int -> int (* zeroes the bit, puts all lower bits to 1 *)
|
||||||
|
|
||||||
val lt : t -> t -> bool
|
val lt : t -> t -> bool
|
||||||
val gt : t -> t -> bool
|
val gt : t -> t -> bool
|
||||||
val equal_int : int -> t -> bool
|
val equal_int : int -> t -> bool
|
||||||
|
|
|
||||||
|
|
@ -109,7 +109,10 @@ let dfs ~pset t =
|
||||||
|
|
||||||
(** Functional queues for BFS *)
|
(** Functional queues for BFS *)
|
||||||
module FQ = struct
|
module FQ = struct
|
||||||
type 'a t = { hd: 'a list; tl: 'a list }
|
type 'a t = {
|
||||||
|
hd: 'a list;
|
||||||
|
tl: 'a list;
|
||||||
|
}
|
||||||
|
|
||||||
exception Empty
|
exception Empty
|
||||||
|
|
||||||
|
|
@ -216,7 +219,8 @@ module Dot = struct
|
||||||
| `Style of string
|
| `Style of string
|
||||||
| `Label of string
|
| `Label of string
|
||||||
| `Id of string
|
| `Id of string
|
||||||
| `Other of string * string ]
|
| `Other of string * string
|
||||||
|
]
|
||||||
(** Dot attributes for nodes *)
|
(** Dot attributes for nodes *)
|
||||||
|
|
||||||
type graph = string * attribute list t list
|
type graph = string * attribute list t list
|
||||||
|
|
|
||||||
|
|
@ -108,7 +108,8 @@ module Dot : sig
|
||||||
| `Style of string
|
| `Style of string
|
||||||
| `Label of string
|
| `Label of string
|
||||||
| `Id of string (** Unique ID in the graph. Allows sharing. *)
|
| `Id of string (** Unique ID in the graph. Allows sharing. *)
|
||||||
| `Other of string * string ]
|
| `Other of string * string
|
||||||
|
]
|
||||||
(** Dot attributes for nodes *)
|
(** Dot attributes for nodes *)
|
||||||
|
|
||||||
type graph = string * attribute list t list
|
type graph = string * attribute list t list
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,10 @@
|
||||||
(** {1 Lazy List} *)
|
(** {1 Lazy List} *)
|
||||||
|
|
||||||
type +'a t = 'a node lazy_t
|
type +'a t = 'a node lazy_t
|
||||||
and +'a node = Nil | Cons of 'a * 'a t
|
|
||||||
|
and +'a node =
|
||||||
|
| Nil
|
||||||
|
| Cons of 'a * 'a t
|
||||||
|
|
||||||
let empty = Lazy.from_val Nil
|
let empty = Lazy.from_val Nil
|
||||||
let return x = Lazy.from_val (Cons (x, empty))
|
let return x = Lazy.from_val (Cons (x, empty))
|
||||||
|
|
|
||||||
|
|
@ -5,7 +5,10 @@
|
||||||
@since 0.17 *)
|
@since 0.17 *)
|
||||||
|
|
||||||
type +'a t = 'a node lazy_t
|
type +'a t = 'a node lazy_t
|
||||||
and +'a node = Nil | Cons of 'a * 'a t
|
|
||||||
|
and +'a node =
|
||||||
|
| Nil
|
||||||
|
| Cons of 'a * 'a t
|
||||||
|
|
||||||
val empty : 'a t
|
val empty : 'a t
|
||||||
(** Empty list. *)
|
(** Empty list. *)
|
||||||
|
|
|
||||||
|
|
@ -9,7 +9,11 @@ module IMap = Map.Make (struct
|
||||||
end)
|
end)
|
||||||
|
|
||||||
type t = (unit -> unit) IMap.t
|
type t = (unit -> unit) IMap.t
|
||||||
and 'a key = { id: int; mutable opt: 'a option }
|
|
||||||
|
and 'a key = {
|
||||||
|
id: int;
|
||||||
|
mutable opt: 'a option;
|
||||||
|
}
|
||||||
|
|
||||||
let newkey_n_ = ref 0
|
let newkey_n_ = ref 0
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -280,7 +280,10 @@ module MakeBidir (L : OrderedType) (R : OrderedType) = struct
|
||||||
module MapL = Make (L) (R)
|
module MapL = Make (L) (R)
|
||||||
module MapR = Make (R) (L)
|
module MapR = Make (R) (L)
|
||||||
|
|
||||||
type t = { left: MapL.t; right: MapR.t }
|
type t = {
|
||||||
|
left: MapL.t;
|
||||||
|
right: MapR.t;
|
||||||
|
}
|
||||||
|
|
||||||
let empty = { left = MapL.empty; right = MapR.empty }
|
let empty = { left = MapL.empty; right = MapR.empty }
|
||||||
let is_empty m = MapL.is_empty m.left
|
let is_empty m = MapL.is_empty m.left
|
||||||
|
|
|
||||||
|
|
@ -14,9 +14,7 @@ module Make (Elt : RANKED) = struct
|
||||||
let _absent_index = -1
|
let _absent_index = -1
|
||||||
let create () = { heap = Vec.create () }
|
let create () = { heap = Vec.create () }
|
||||||
let[@inline] left i = (i lsl 1) + 1 (* i*2 + 1 *)
|
let[@inline] left i = (i lsl 1) + 1 (* i*2 + 1 *)
|
||||||
|
|
||||||
let[@inline] right i = (i + 1) lsl 1 (* (i+1)*2 *)
|
let[@inline] right i = (i + 1) lsl 1 (* (i+1)*2 *)
|
||||||
|
|
||||||
let[@inline] parent i = (i - 1) asr 1 (* (i-1) / 2 *)
|
let[@inline] parent i = (i - 1) asr 1 (* (i-1) / 2 *)
|
||||||
|
|
||||||
(*
|
(*
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,10 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||||
(* Persistent arrays *)
|
(* Persistent arrays *)
|
||||||
|
|
||||||
type 'a t = 'a data ref
|
type 'a t = 'a data ref
|
||||||
and 'a data = Array of 'a array | Diff of int * 'a * 'a t
|
|
||||||
|
and 'a data =
|
||||||
|
| Array of 'a array
|
||||||
|
| Diff of int * 'a * 'a t
|
||||||
|
|
||||||
let make n a = ref (Array (Array.make n a))
|
let make n a = ref (Array (Array.make n a))
|
||||||
let init n f = ref (Array (Array.init n f))
|
let init n f = ref (Array (Array.init n f))
|
||||||
|
|
|
||||||
|
|
@ -133,10 +133,14 @@ module Make (H : HashedType) : S with type key = H.t = struct
|
||||||
}
|
}
|
||||||
|
|
||||||
(* piece of a persistent array *)
|
(* piece of a persistent array *)
|
||||||
and 'a p_array = Arr of 'a bucket array | Set of int * 'a bucket * 'a t
|
and 'a p_array =
|
||||||
|
| Arr of 'a bucket array
|
||||||
|
| Set of int * 'a bucket * 'a t
|
||||||
|
|
||||||
(* bucket of the hashtbl *)
|
(* bucket of the hashtbl *)
|
||||||
and 'a bucket = Nil | Cons of key * 'a * 'a bucket
|
and 'a bucket =
|
||||||
|
| Nil
|
||||||
|
| Cons of key * 'a * 'a bucket
|
||||||
|
|
||||||
(* first power of two that is bigger than [than], starting from [n] *)
|
(* first power of two that is bigger than [than], starting from [n] *)
|
||||||
let rec power_two_larger ~than n =
|
let rec power_two_larger ~than n =
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,9 @@
|
||||||
(** {1 Random-Access Lists} *)
|
(** {1 Random-Access Lists} *)
|
||||||
|
|
||||||
(** A complete binary tree *)
|
(** A complete binary tree *)
|
||||||
type +'a tree = Leaf of 'a | Node of 'a * 'a tree * 'a tree
|
type +'a tree =
|
||||||
|
| Leaf of 'a
|
||||||
|
| Node of 'a * 'a tree * 'a tree
|
||||||
|
|
||||||
and +'a t =
|
and +'a t =
|
||||||
| Nil
|
| Nil
|
||||||
|
|
|
||||||
|
|
@ -6,7 +6,10 @@ type 'a iter = ('a -> unit) -> unit
|
||||||
type 'a printer = Format.formatter -> 'a -> unit
|
type 'a printer = Format.formatter -> 'a -> unit
|
||||||
type 'a gen = unit -> 'a option
|
type 'a gen = unit -> 'a option
|
||||||
|
|
||||||
type 'a t = { hd: 'a list; tl: 'a list }
|
type 'a t = {
|
||||||
|
hd: 'a list;
|
||||||
|
tl: 'a list;
|
||||||
|
}
|
||||||
(** Queue containing elements of type 'a *)
|
(** Queue containing elements of type 'a *)
|
||||||
|
|
||||||
let empty = { hd = []; tl = [] }
|
let empty = { hd = []; tl = [] }
|
||||||
|
|
|
||||||
|
|
@ -495,7 +495,9 @@ module Make (W : WORD) : S with type char_ = W.char_ and type key = W.t = struct
|
||||||
| Yield of 'a * char_ difflist
|
| Yield of 'a * char_ difflist
|
||||||
| Explore of 'a t * char_ difflist
|
| Explore of 'a t * char_ difflist
|
||||||
|
|
||||||
type direction = Above | Below
|
type direction =
|
||||||
|
| Above
|
||||||
|
| Below
|
||||||
|
|
||||||
let rec explore ~dir k alt =
|
let rec explore ~dir k alt =
|
||||||
match alt with
|
match alt with
|
||||||
|
|
|
||||||
|
|
@ -135,7 +135,10 @@ end
|
||||||
module MakeFull (K : KEY) : S with type key = K.t = struct
|
module MakeFull (K : KEY) : S with type key = K.t = struct
|
||||||
type key = K.t
|
type key = K.t
|
||||||
type weight = int
|
type weight = int
|
||||||
type +'a t = E | N of key * 'a * 'a t * 'a t * weight
|
|
||||||
|
type +'a t =
|
||||||
|
| E
|
||||||
|
| N of key * 'a * 'a t * 'a t * weight
|
||||||
|
|
||||||
let empty = E
|
let empty = E
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -2,6 +2,14 @@
|
||||||
(name containers_data)
|
(name containers_data)
|
||||||
(public_name containers-data)
|
(public_name containers-data)
|
||||||
(wrapped false)
|
(wrapped false)
|
||||||
(flags :standard -warn-error -3 -w -70 -color always -safe-string
|
(flags
|
||||||
-strict-sequence)
|
:standard
|
||||||
|
-warn-error
|
||||||
|
-3
|
||||||
|
-w
|
||||||
|
-70
|
||||||
|
-color
|
||||||
|
always
|
||||||
|
-safe-string
|
||||||
|
-strict-sequence)
|
||||||
(libraries containers))
|
(libraries containers))
|
||||||
|
|
|
||||||
24
src/dune
24
src/dune
|
|
@ -1,9 +1,25 @@
|
||||||
(env
|
(env
|
||||||
(_
|
(_
|
||||||
(flags :standard -warn-error -a+8 -w -32-48-70 -w +a-4-40-42-44-70
|
(flags
|
||||||
-color always -safe-string -strict-sequence)
|
:standard
|
||||||
(ocamlopt_flags :standard -O3 -unbox-closures -unbox-closures-factor 20
|
-warn-error
|
||||||
-inline 100)))
|
-a+8
|
||||||
|
-w
|
||||||
|
-32-48-70
|
||||||
|
-w
|
||||||
|
+a-4-40-42-44-70
|
||||||
|
-color
|
||||||
|
always
|
||||||
|
-safe-string
|
||||||
|
-strict-sequence)
|
||||||
|
(ocamlopt_flags
|
||||||
|
:standard
|
||||||
|
-O3
|
||||||
|
-unbox-closures
|
||||||
|
-unbox-closures-factor
|
||||||
|
20
|
||||||
|
-inline
|
||||||
|
100)))
|
||||||
|
|
||||||
(executable
|
(executable
|
||||||
(name mdx_runner)
|
(name mdx_runner)
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,13 @@ end
|
||||||
|
|
||||||
module Ext = struct
|
module Ext = struct
|
||||||
type view = ..
|
type view = ..
|
||||||
type 'a key = { id: int; inject: 'a -> view; extract: view -> 'a option }
|
|
||||||
|
type 'a key = {
|
||||||
|
id: int;
|
||||||
|
inject: 'a -> view;
|
||||||
|
extract: view -> 'a option;
|
||||||
|
}
|
||||||
|
|
||||||
type map = view Int_map.t
|
type map = view Int_map.t
|
||||||
|
|
||||||
let empty : map = Int_map.empty
|
let empty : map = Int_map.empty
|
||||||
|
|
@ -79,7 +85,10 @@ and view =
|
||||||
| Text_sub of string * int * int
|
| Text_sub of string * int * int
|
||||||
| Text_zero_width of string
|
| Text_zero_width of string
|
||||||
| Group of t
|
| Group of t
|
||||||
| Fill of { sep: t; l: t list }
|
| Fill of {
|
||||||
|
sep: t;
|
||||||
|
l: t list;
|
||||||
|
}
|
||||||
| Wrap : 'a Ext.t * 'a * t -> view
|
| Wrap : 'a Ext.t * 'a * t -> view
|
||||||
|
|
||||||
(* debug printer *)
|
(* debug printer *)
|
||||||
|
|
@ -214,7 +223,11 @@ module Flatten = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Pretty = struct
|
module Pretty = struct
|
||||||
type st = { out: Out.t; width: int; ext_map: Ext.map }
|
type st = {
|
||||||
|
out: Out.t;
|
||||||
|
width: int;
|
||||||
|
ext_map: Ext.map;
|
||||||
|
}
|
||||||
|
|
||||||
(** Add [i] spaces of indentation. *)
|
(** Add [i] spaces of indentation. *)
|
||||||
let add_indent st (i : int) =
|
let add_indent st (i : int) =
|
||||||
|
|
@ -460,14 +473,23 @@ end
|
||||||
|
|
||||||
module Term_color = struct
|
module Term_color = struct
|
||||||
type color =
|
type color =
|
||||||
[ `Black | `Red | `Yellow | `Green | `Blue | `Magenta | `Cyan | `White ]
|
[ `Black
|
||||||
|
| `Red
|
||||||
|
| `Yellow
|
||||||
|
| `Green
|
||||||
|
| `Blue
|
||||||
|
| `Magenta
|
||||||
|
| `Cyan
|
||||||
|
| `White
|
||||||
|
]
|
||||||
|
|
||||||
type style =
|
type style =
|
||||||
[ `FG of color (* foreground *)
|
[ `FG of color (* foreground *)
|
||||||
| `BG of color (* background *)
|
| `BG of color (* background *)
|
||||||
| `Bold
|
| `Bold
|
||||||
| `Reset
|
| `Reset
|
||||||
| `Underline ]
|
| `Underline
|
||||||
|
]
|
||||||
|
|
||||||
let int_of_color_ = function
|
let int_of_color_ = function
|
||||||
| `Black -> 0
|
| `Black -> 0
|
||||||
|
|
|
||||||
|
|
@ -261,9 +261,23 @@ end
|
||||||
(** Simple colors in terminals *)
|
(** Simple colors in terminals *)
|
||||||
module Term_color : sig
|
module Term_color : sig
|
||||||
type color =
|
type color =
|
||||||
[ `Black | `Blue | `Cyan | `Green | `Magenta | `Red | `White | `Yellow ]
|
[ `Black
|
||||||
|
| `Blue
|
||||||
|
| `Cyan
|
||||||
|
| `Green
|
||||||
|
| `Magenta
|
||||||
|
| `Red
|
||||||
|
| `White
|
||||||
|
| `Yellow
|
||||||
|
]
|
||||||
|
|
||||||
type style = [ `BG of color | `Bold | `FG of color | `Reset | `Underline ]
|
type style =
|
||||||
|
[ `BG of color
|
||||||
|
| `Bold
|
||||||
|
| `FG of color
|
||||||
|
| `Reset
|
||||||
|
| `Underline
|
||||||
|
]
|
||||||
|
|
||||||
val color : color -> t -> t
|
val color : color -> t -> t
|
||||||
val style_l : style list -> t -> t
|
val style_l : style list -> t -> t
|
||||||
|
|
|
||||||
11
src/pp/dune
11
src/pp/dune
|
|
@ -1,7 +1,6 @@
|
||||||
|
|
||||||
(library
|
(library
|
||||||
(name containers_pp)
|
(name containers_pp)
|
||||||
(public_name containers.pp)
|
(public_name containers.pp)
|
||||||
(synopsis "Pretty printer for Containers")
|
(synopsis "Pretty printer for Containers")
|
||||||
(flags :standard)
|
(flags :standard)
|
||||||
(libraries containers))
|
(libraries containers))
|
||||||
|
|
|
||||||
|
|
@ -58,7 +58,10 @@ module A = struct
|
||||||
)
|
)
|
||||||
end
|
end
|
||||||
|
|
||||||
type 'a tree = Empty | Node of 'a tree A.t | Leaf of 'a A.t
|
type 'a tree =
|
||||||
|
| Empty
|
||||||
|
| Node of 'a tree A.t
|
||||||
|
| Leaf of 'a A.t
|
||||||
|
|
||||||
type 'a t = {
|
type 'a t = {
|
||||||
t: 'a tree; (** The 32-way tree *)
|
t: 'a tree; (** The 32-way tree *)
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,7 @@
|
||||||
|
|
||||||
(library
|
(library
|
||||||
(name containers_pvec)
|
(name containers_pvec)
|
||||||
(public_name containers.pvec)
|
(public_name containers.pvec)
|
||||||
(preprocess
|
(preprocess
|
||||||
(action
|
(action
|
||||||
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||||
(synopsis "Persistent vector for OCaml"))
|
(synopsis "Persistent vector for OCaml"))
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
|
|
||||||
(library
|
(library
|
||||||
(name containers_scc)
|
(name containers_scc)
|
||||||
(public_name containers.scc)
|
(public_name containers.scc)
|
||||||
(synopsis "strongly connected components algorithm")
|
(synopsis "strongly connected components algorithm")
|
||||||
(libraries containers))
|
(libraries containers))
|
||||||
|
|
|
||||||
|
|
@ -8,7 +8,13 @@ type 'a print = 'a -> string
|
||||||
module Test = struct
|
module Test = struct
|
||||||
type run =
|
type run =
|
||||||
| T of { prop: unit -> bool }
|
| T of { prop: unit -> bool }
|
||||||
| Eq : { eq: 'a eq option; print: 'a print option; lhs: 'a; rhs: 'a } -> run
|
| Eq : {
|
||||||
|
eq: 'a eq option;
|
||||||
|
print: 'a print option;
|
||||||
|
lhs: 'a;
|
||||||
|
rhs: 'a;
|
||||||
|
}
|
||||||
|
-> run
|
||||||
| Q : {
|
| Q : {
|
||||||
count: int option;
|
count: int option;
|
||||||
arb: 'a Q.arbitrary;
|
arb: 'a Q.arbitrary;
|
||||||
|
|
@ -20,7 +26,12 @@ module Test = struct
|
||||||
}
|
}
|
||||||
-> run
|
-> run
|
||||||
|
|
||||||
type t = { name: string option; run: run; __FILE__: string; n: int }
|
type t = {
|
||||||
|
name: string option;
|
||||||
|
run: run;
|
||||||
|
__FILE__: string;
|
||||||
|
n: int;
|
||||||
|
}
|
||||||
|
|
||||||
(** Location for this test *)
|
(** Location for this test *)
|
||||||
let str_loc (self : t) : string =
|
let str_loc (self : t) : string =
|
||||||
|
|
|
||||||
|
|
@ -10,8 +10,16 @@ let pp_json = J.pretty_print ~std:true
|
||||||
let spf = Printf.sprintf
|
let spf = Printf.sprintf
|
||||||
|
|
||||||
module Test = struct
|
module Test = struct
|
||||||
type expect = Diagnostic of string | Decoded of json
|
type expect =
|
||||||
type t = { hex: string; raw: string; expect: expect; roundtrip: bool }
|
| Diagnostic of string
|
||||||
|
| Decoded of json
|
||||||
|
|
||||||
|
type t = {
|
||||||
|
hex: string;
|
||||||
|
raw: string;
|
||||||
|
expect: expect;
|
||||||
|
roundtrip: bool;
|
||||||
|
}
|
||||||
|
|
||||||
let pp_expect out = function
|
let pp_expect out = function
|
||||||
| Diagnostic s -> Fmt.fprintf out "(diagnostic %S)" s
|
| Diagnostic s -> Fmt.fprintf out "(diagnostic %S)" s
|
||||||
|
|
@ -51,7 +59,11 @@ let skip =
|
||||||
"5f42010243030405ff", "(requires representation of indefinite length)";
|
"5f42010243030405ff", "(requires representation of indefinite length)";
|
||||||
]
|
]
|
||||||
|
|
||||||
type count = { mutable n_ok: int; mutable n_err: int; mutable n_skip: int }
|
type count = {
|
||||||
|
mutable n_ok: int;
|
||||||
|
mutable n_err: int;
|
||||||
|
mutable n_skip: int;
|
||||||
|
}
|
||||||
|
|
||||||
let run_test (c : count) (t : Test.t) : unit =
|
let run_test (c : count) (t : Test.t) : unit =
|
||||||
try
|
try
|
||||||
|
|
|
||||||
|
|
@ -1,11 +1,21 @@
|
||||||
(test
|
(test
|
||||||
(name t)
|
(name t)
|
||||||
(flags :standard -strict-sequence -warn-error -a+8)
|
(flags :standard -strict-sequence -warn-error -a+8)
|
||||||
(modes (best exe))
|
(modes
|
||||||
|
(best exe))
|
||||||
(package containers)
|
(package containers)
|
||||||
(preprocess
|
(preprocess
|
||||||
(action
|
(action
|
||||||
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||||
(libraries containers containers.bencode containers.cbor
|
(libraries
|
||||||
containers.unix containers.pp
|
containers
|
||||||
threads containers_testlib iter gen uutf csexp))
|
containers.bencode
|
||||||
|
containers.cbor
|
||||||
|
containers.unix
|
||||||
|
containers.pp
|
||||||
|
threads
|
||||||
|
containers_testlib
|
||||||
|
iter
|
||||||
|
gen
|
||||||
|
uutf
|
||||||
|
csexp))
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,9 @@ module P = CCParse
|
||||||
open CCParse
|
open CCParse
|
||||||
|
|
||||||
module T = struct
|
module T = struct
|
||||||
type tree = L of int | N of tree * tree
|
type tree =
|
||||||
|
| L of int
|
||||||
|
| N of tree * tree
|
||||||
end
|
end
|
||||||
|
|
||||||
open T
|
open T
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,7 @@
|
||||||
(test
|
(test
|
||||||
(name t)
|
(name t)
|
||||||
(flags :standard -strict-sequence -warn-error -a+8)
|
(flags :standard -strict-sequence -warn-error -a+8)
|
||||||
(modes (best exe))
|
(modes
|
||||||
|
(best exe))
|
||||||
(package containers-data)
|
(package containers-data)
|
||||||
(libraries containers containers-data containers_testlib iter gen))
|
(libraries containers containers-data containers_testlib iter gen))
|
||||||
|
|
|
||||||
|
|
@ -236,8 +236,7 @@ q
|
||||||
Q.Test.fail_reportf "l1=%a, l2=%a" ppli l1 ppli l2)
|
Q.Test.fail_reportf "l1=%a, l2=%a" ppli l1 ppli l2)
|
||||||
;;
|
;;
|
||||||
|
|
||||||
eq ~cmp:equal ~printer:(CCFormat.to_string pp)
|
eq ~cmp:equal ~printer:(CCFormat.to_string pp) (of_list [ 0 ])
|
||||||
(of_list [ 0 ])
|
|
||||||
(let bv = empty () in
|
(let bv = empty () in
|
||||||
set bv 0;
|
set bv 0;
|
||||||
bv)
|
bv)
|
||||||
|
|
@ -714,7 +713,10 @@ module Op = struct
|
||||||
end
|
end
|
||||||
|
|
||||||
module Ref_ = struct
|
module Ref_ = struct
|
||||||
type t = { mutable set: Intset.t; mutable size: int }
|
type t = {
|
||||||
|
mutable set: Intset.t;
|
||||||
|
mutable size: int;
|
||||||
|
}
|
||||||
|
|
||||||
let empty () = { size = 0; set = Intset.empty }
|
let empty () = { size = 0; set = Intset.empty }
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,11 @@
|
||||||
module Test = (val Containers_testlib.make ~__FILE__ ())
|
module Test = (val Containers_testlib.make ~__FILE__ ())
|
||||||
open Test
|
open Test
|
||||||
|
|
||||||
type elt = { x: string; mutable rank: int; mutable idx: int }
|
type elt = {
|
||||||
|
x: string;
|
||||||
|
mutable rank: int;
|
||||||
|
mutable idx: int;
|
||||||
|
}
|
||||||
|
|
||||||
module Elt = struct
|
module Elt = struct
|
||||||
type t = elt
|
type t = elt
|
||||||
|
|
|
||||||
|
|
@ -388,7 +388,10 @@ let arb_op = Q.make ~shrink:shrink_op ~print:str_of_op gen_op
|
||||||
let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op
|
let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op
|
||||||
|
|
||||||
module L_impl = struct
|
module L_impl = struct
|
||||||
type t = { size: int; mutable l: char list }
|
type t = {
|
||||||
|
size: int;
|
||||||
|
mutable l: char list;
|
||||||
|
}
|
||||||
|
|
||||||
let create size = { size; l = [] }
|
let create size = { size; l = [] }
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -3,7 +3,10 @@ open Test
|
||||||
open CCWBTree
|
open CCWBTree
|
||||||
module M = Make (CCInt)
|
module M = Make (CCInt)
|
||||||
|
|
||||||
type op = Add of int * int | Remove of int | Remove_min
|
type op =
|
||||||
|
| Add of int * int
|
||||||
|
| Remove of int
|
||||||
|
| Remove_min
|
||||||
|
|
||||||
let gen_op =
|
let gen_op =
|
||||||
CCRandom.(
|
CCRandom.(
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
|
|
||||||
(test
|
(test
|
||||||
(name t)
|
(name t)
|
||||||
(flags :standard -strict-sequence -warn-error -a+8)
|
(flags :standard -strict-sequence -warn-error -a+8)
|
||||||
(modes (best exe))
|
(modes
|
||||||
|
(best exe))
|
||||||
(package containers)
|
(package containers)
|
||||||
(libraries containers containers.pvec containers_testlib iter))
|
(libraries containers containers.pvec containers_testlib iter))
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue