mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
remove conditional over OCaml >= 4.08
in particular, all the let-ops are now unconditional!
This commit is contained in:
parent
d0903a09be
commit
1a23731730
58 changed files with 229 additions and 540 deletions
|
|
@ -2,7 +2,7 @@
|
|||
(names run_benchs run_bench_hash run_objsize)
|
||||
(libraries containers containers-data containers-thread benchmark gen iter
|
||||
qcheck oseq batteries base sek)
|
||||
(flags :standard -warn-error -3-5 -safe-string -color always -open CCShims_)
|
||||
(flags :standard -warn-error -3-5 -safe-string -color always)
|
||||
(optional)
|
||||
(ocamlopt_flags :standard -O3 -color always -unbox-closures
|
||||
-unbox-closures-factor 20))
|
||||
|
|
|
|||
|
|
@ -44,9 +44,6 @@ let rec pp_diagnostic out (self : t) =
|
|||
let to_string_diagnostic (self : t) : string =
|
||||
Format.asprintf "@[<h>%a@]" pp_diagnostic self
|
||||
|
||||
(* we use funtions from Bytes *)
|
||||
[@@@ifge 4.08]
|
||||
|
||||
exception Indefinite
|
||||
|
||||
let[@inline] i64_to_int i =
|
||||
|
|
@ -323,5 +320,3 @@ let encode ?(buf = Buffer.create 32) (self : t) : string =
|
|||
in
|
||||
encode_val self;
|
||||
Buffer.contents buf
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -5,9 +5,6 @@
|
|||
|
||||
{b note} this is experimental.
|
||||
|
||||
{b note} this is only available on OCaml >= 4.08. Below that, the module
|
||||
is empty.
|
||||
|
||||
@since 3.9
|
||||
*)
|
||||
|
||||
|
|
@ -26,15 +23,9 @@ type t =
|
|||
|
||||
val pp_diagnostic : t CCFormat.printer
|
||||
val to_string_diagnostic : t -> string
|
||||
|
||||
(* we use funtions from Bytes *)
|
||||
[@@@ifge 4.08]
|
||||
|
||||
val encode : ?buf:Buffer.t -> t -> string
|
||||
val decode : string -> (t, string) result
|
||||
|
||||
val decode_exn : string -> t
|
||||
(** Like {!decode}.
|
||||
@raise Failure if the string isn't valid *)
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -11,30 +11,8 @@ type 'a printer = Format.formatter -> 'a -> unit
|
|||
|
||||
(** {2 Arrays} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include Array
|
||||
|
||||
[@@@elifge 4.6]
|
||||
|
||||
include Array
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
[@@@else_]
|
||||
|
||||
include Array
|
||||
|
||||
module Floatarray = struct
|
||||
type t = float array
|
||||
end
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let empty = [||]
|
||||
|
||||
let get_safe a i =
|
||||
|
|
@ -619,16 +597,12 @@ module Infix = struct
|
|||
let ( -- ) = ( -- )
|
||||
let ( --^ ) = ( --^ )
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
let ( let* ) = ( >>= )
|
||||
let ( let+ ) = ( >|= )
|
||||
let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -14,31 +14,9 @@ type 'a printer = Format.formatter -> 'a -> unit
|
|||
|
||||
(** {2 Arrays} *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include module type of Array
|
||||
(** @inline *)
|
||||
|
||||
[@@@elifge 4.6]
|
||||
|
||||
include module type of Array
|
||||
(** @inline *)
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
[@@@else_]
|
||||
|
||||
include module type of Array
|
||||
(** @inline *)
|
||||
|
||||
module Floatarray : sig
|
||||
type t = float array
|
||||
end
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
[@@@endif]
|
||||
|
||||
val empty : 'a t
|
||||
(** [empty] is the empty array, physically equal to [[||]]. *)
|
||||
|
||||
|
|
@ -152,7 +130,6 @@ val max_exn : ('a -> 'a -> int) -> 'a t -> 'a
|
|||
@raise Invalid_argument if [a] is empty.
|
||||
@since 3.12 *)
|
||||
|
||||
|
||||
val argmax : ('a -> 'a -> int) -> 'a t -> int option
|
||||
(** [argmax cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i]
|
||||
is the index of a maximum element in [a] with respect to [cmp].
|
||||
|
|
@ -375,14 +352,10 @@ module Infix : sig
|
|||
(** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
|
||||
@since 0.17 *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a array
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8
|
||||
@inline *)
|
||||
|
||||
[@@@endif]
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -14,29 +14,9 @@ type 'a printer = Format.formatter -> 'a -> unit
|
|||
|
||||
(** {2 Arrays} *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include module type of ArrayLabels with module Floatarray = Array.Floatarray
|
||||
(** @inline *)
|
||||
|
||||
[@@@elifge 4.6]
|
||||
|
||||
include module type of ArrayLabels with module Floatarray = Array.Floatarray
|
||||
(** @inline *)
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
[@@@else_]
|
||||
|
||||
include module type of ArrayLabels
|
||||
(** @inline *)
|
||||
|
||||
module Floatarray = CCArray.Floatarray
|
||||
|
||||
type 'a t = 'a array
|
||||
|
||||
[@@@endif]
|
||||
|
||||
val empty : 'a t
|
||||
(** [empty] is the empty array, physically equal to [[||]]. *)
|
||||
|
||||
|
|
@ -151,7 +131,6 @@ val max_exn : cmp:('a -> 'a -> int) -> 'a t -> 'a
|
|||
@raise Invalid_argument if [a] is empty.
|
||||
@since 3.12 *)
|
||||
|
||||
|
||||
val argmax : cmp:('a -> 'a -> int) -> 'a t -> int option
|
||||
(** [argmax ~cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i]
|
||||
is the index of a maximum element in [a] with respect to [cmp].
|
||||
|
|
@ -389,14 +368,10 @@ module Infix : sig
|
|||
(** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
|
||||
@since 0.17 *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a array
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8
|
||||
@inline *)
|
||||
|
||||
[@@@endif]
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@ include Atomic
|
|||
|
||||
[@@@else_]
|
||||
|
||||
open CCShims_.Stdlib (* for == *)
|
||||
open Stdlib (* for == *)
|
||||
|
||||
type 'a t = { mutable x: 'a }
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type t = bool
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(** {1 Simple S-expression parsing/printing} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type 'a or_error = ('a, string) result
|
||||
type 'a gen = unit -> 'a option
|
||||
|
|
|
|||
|
|
@ -14,12 +14,12 @@ let to_int = Char.code
|
|||
let to_string c = String.make 1 c
|
||||
|
||||
module Infix = struct
|
||||
let ( = ) : t -> t -> bool = CCShims_.Stdlib.( = )
|
||||
let ( <> ) : t -> t -> bool = CCShims_.Stdlib.( <> )
|
||||
let ( < ) : t -> t -> bool = CCShims_.Stdlib.( < )
|
||||
let ( > ) : t -> t -> bool = CCShims_.Stdlib.( > )
|
||||
let ( <= ) : t -> t -> bool = CCShims_.Stdlib.( <= )
|
||||
let ( >= ) : t -> t -> bool = CCShims_.Stdlib.( >= )
|
||||
let ( = ) : t -> t -> bool = Stdlib.( = )
|
||||
let ( <> ) : t -> t -> bool = Stdlib.( <> )
|
||||
let ( < ) : t -> t -> bool = Stdlib.( < )
|
||||
let ( > ) : t -> t -> bool = Stdlib.( > )
|
||||
let ( <= ) : t -> t -> bool = Stdlib.( <= )
|
||||
let ( >= ) : t -> t -> bool = Stdlib.( >= )
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(** {1 Equality Combinators} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type 'a t = 'a -> 'a -> bool
|
||||
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type t = float
|
||||
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
(** Basic operations on floating-point numbers
|
||||
@since 0.6.1 *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type t = float
|
||||
|
||||
|
|
|
|||
|
|
@ -301,8 +301,6 @@ let mark_close_style st : string =
|
|||
else
|
||||
""
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
type stag += Style of ANSI_codes.style list
|
||||
|
||||
let pp_open_tag out s = pp_open_stag out (String_tag s)
|
||||
|
|
@ -359,41 +357,6 @@ let set_color_tag_handling ppf =
|
|||
in
|
||||
pp_set_formatter_stag_functions ppf funs'
|
||||
|
||||
[@@@else_]
|
||||
|
||||
(* either prints the tag of [s] or delegate to [or_else] *)
|
||||
let mark_open_tag st ~or_else (s : string) : string =
|
||||
let open ANSI_codes in
|
||||
try
|
||||
let style = style_of_tag_ s in
|
||||
mark_open_style st style
|
||||
with No_such_style -> or_else s
|
||||
|
||||
let mark_close_tag st ~or_else (s : string) : string =
|
||||
let open ANSI_codes in
|
||||
(* check if it's indeed about color *)
|
||||
match style_of_tag_ s with
|
||||
| _ -> mark_close_style st
|
||||
| exception No_such_style -> or_else s
|
||||
|
||||
(* add color handling to formatter [ppf] *)
|
||||
let set_color_tag_handling ppf =
|
||||
let st = Stack.create () in
|
||||
(* stack of styles *)
|
||||
pp_set_mark_tags ppf true;
|
||||
(* enable tags *)
|
||||
let funs = pp_get_formatter_tag_functions ppf () in
|
||||
let functions =
|
||||
{
|
||||
funs with
|
||||
mark_open_tag = mark_open_tag st ~or_else:funs.mark_open_tag;
|
||||
mark_close_tag = mark_close_tag st ~or_else:funs.mark_close_tag;
|
||||
}
|
||||
in
|
||||
pp_set_formatter_tag_functions ppf functions
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let set_color_default =
|
||||
let first = ref true in
|
||||
fun b ->
|
||||
|
|
|
|||
|
|
@ -10,10 +10,10 @@ type 'a iter = ('a -> unit) -> unit
|
|||
see https://discuss.ocaml.org/t/extend-existing-module/1389/4
|
||||
*)
|
||||
|
||||
(** @inline *)
|
||||
include module type of struct
|
||||
include Format
|
||||
end
|
||||
(** @inline *)
|
||||
|
||||
type t = Format.formatter
|
||||
type -'a printer = t -> 'a -> unit
|
||||
|
|
@ -30,7 +30,6 @@ val int : int printer
|
|||
val string : string printer
|
||||
val bool : bool printer
|
||||
val float3 : float printer (* 3 digits after . *)
|
||||
|
||||
val float : float printer
|
||||
|
||||
val exn : exn printer
|
||||
|
|
@ -334,8 +333,6 @@ module ANSI_codes : sig
|
|||
is a very shiny style. *)
|
||||
end
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
val styling : ANSI_codes.style list -> 'a printer -> 'a printer
|
||||
(** [styling st p] is the same printer as [p], except it locally sets
|
||||
the style [st].
|
||||
|
|
@ -363,8 +360,6 @@ val with_styling : ANSI_codes.style list -> t -> (unit -> 'a) -> 'a
|
|||
Available only on OCaml >= 4.08.
|
||||
@since 3.7 *)
|
||||
|
||||
[@@@endif]
|
||||
|
||||
(** {2 IO} *)
|
||||
|
||||
val output : t -> 'a printer -> 'a -> unit
|
||||
|
|
|
|||
|
|
@ -11,34 +11,9 @@ let opaque_identity x = x
|
|||
(* import standard implementations, if any *)
|
||||
|
||||
include Sys
|
||||
include CCShims_.Stdlib
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include Stdlib
|
||||
include Fun
|
||||
|
||||
[@@@else_]
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
||||
external id : 'a -> 'a = "%identity"
|
||||
|
||||
let[@inline] protect ~finally f =
|
||||
try
|
||||
let x = f () in
|
||||
finally ();
|
||||
x
|
||||
with e ->
|
||||
finally ();
|
||||
raise e
|
||||
|
||||
[@@@ocaml.warning "+32"]
|
||||
|
||||
let[@inline] flip f x y = f y x
|
||||
let[@inline] const x _ = x
|
||||
let[@inline] negate f x = not (f x)
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let compose f g x = g (f x)
|
||||
let compose_binop f g x y = g (f x) (f y)
|
||||
let curry f x y = f (x, y)
|
||||
|
|
@ -92,16 +67,11 @@ let rec iterate n f x =
|
|||
|
||||
module Infix = struct
|
||||
(* default implem for some operators *)
|
||||
let ( |> ) = CCShims_.Stdlib.( |> )
|
||||
let ( @@ ) = CCShims_.Stdlib.( @@ )
|
||||
let ( |> ) = Stdlib.( |> )
|
||||
let ( @@ ) = Stdlib.( @@ )
|
||||
let ( %> ) = compose
|
||||
let[@inline] ( % ) f g x = f (g x)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let@ ) = ( @@ )
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -2,27 +2,9 @@
|
|||
|
||||
(** Basic operations on Functions *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include module type of Fun
|
||||
(** @inline *)
|
||||
|
||||
[@@@else_]
|
||||
|
||||
(* port from stdlib *)
|
||||
|
||||
external id : 'a -> 'a = "%identity"
|
||||
(** This is an API imitating the new standard Fun module *)
|
||||
|
||||
val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c
|
||||
val const : 'a -> _ -> 'a
|
||||
val negate : ('a -> bool) -> 'a -> bool
|
||||
val protect : finally:(unit -> unit) -> (unit -> 'a) -> 'a
|
||||
(* this doesn't have the exact same semantics as the stdlib's finally.
|
||||
It will not attempt to catch exceptions raised from [finally] at all. *)
|
||||
|
||||
[@@@endif]
|
||||
|
||||
val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
|
||||
(** [compose f g x] is [g (f x)]. Composition. *)
|
||||
|
||||
|
|
@ -102,14 +84,10 @@ module Infix : sig
|
|||
val ( % ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
|
||||
(** [(f % g) x] or [(%) f g x] is [f (g x)]. Mathematical composition. *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
val ( let@ ) : ('a -> 'b) -> 'a -> 'b
|
||||
(** [let@ x = foo in bar] is the equivalent of [foo @@ fun x -> bar].
|
||||
It can be very useful for resource management, alongside with {!protect}.
|
||||
@since 3.11 *)
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -1,17 +1,7 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
[@@@ifge 4.07]
|
||||
[@@@else_]
|
||||
|
||||
module Stdlib = Pervasives
|
||||
|
||||
[@@@endif]
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include Int
|
||||
|
||||
[@@@endif]
|
||||
|
||||
type t = int
|
||||
type 'a iter = ('a -> unit) -> unit
|
||||
|
||||
|
|
|
|||
|
|
@ -2,13 +2,9 @@
|
|||
|
||||
(** Basic Int functions *)
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include module type of Int
|
||||
(** @inline *)
|
||||
|
||||
[@@@endif]
|
||||
|
||||
type t = int
|
||||
|
||||
val zero : t
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
include Int32
|
||||
|
||||
let min : t -> t -> t = Stdlib.min
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
include Int64
|
||||
|
||||
let min : t -> t -> t = Stdlib.min
|
||||
|
|
@ -22,7 +22,7 @@ let hash_to_int64 (n : t) =
|
|||
logand !h max_int
|
||||
|
||||
let[@inline] hash (n : t) : int =
|
||||
to_int (hash_to_int64 n) land CCShims_.Stdlib.max_int
|
||||
to_int (hash_to_int64 n) land Stdlib.max_int
|
||||
|
||||
(* see {!CCInt.popcount} for more details *)
|
||||
let[@inline] popcount (b : t) : int =
|
||||
|
|
|
|||
|
|
@ -2,8 +2,6 @@
|
|||
|
||||
(** {1 Complements to list} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
(* backport new functions from stdlib here *)
|
||||
|
||||
[@@@ocaml.warning "-32"]
|
||||
|
|
@ -52,18 +50,8 @@ let rec assq_opt x = function
|
|||
|
||||
(* end of backport *)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include List
|
||||
|
||||
[@@@else_]
|
||||
|
||||
include List
|
||||
|
||||
type +'a t = 'a list
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let empty = []
|
||||
|
||||
let is_empty = function
|
||||
|
|
@ -1473,16 +1461,11 @@ module Infix = struct
|
|||
let ( <$> ) = map
|
||||
let ( -- ) = ( -- )
|
||||
let ( --^ ) = ( --^ )
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
let[@inline] ( and+ ) l1 l2 = product (fun x y -> x, y) l1 l2
|
||||
let ( and* ) = ( and+ )
|
||||
let ( and& ) = combine_shortest
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -10,22 +10,11 @@ type 'a gen = unit -> 'a option
|
|||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
type 'a random_gen = Random.State.t -> 'a
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
include module type of List with type 'a t := 'a list
|
||||
(** @inline *)
|
||||
|
||||
type +'a t = 'a list
|
||||
|
||||
[@@@else_]
|
||||
|
||||
include module type of List
|
||||
(** @inline *)
|
||||
|
||||
type +'a t = 'a list
|
||||
|
||||
[@@@endif]
|
||||
|
||||
val empty : 'a t
|
||||
(** [empty] is [[]]. *)
|
||||
|
||||
|
|
@ -936,10 +925,10 @@ module Infix : sig
|
|||
(** [i --^ j] is the infix alias for [range']. Second bound [j] excluded.
|
||||
@since 0.17 *)
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a t
|
||||
(** @inline *)
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
|
||||
val ( and& ) : 'a list -> 'b list -> ('a * 'b) list
|
||||
(** [(and&)] is {!combine_shortest}.
|
||||
|
|
@ -957,8 +946,6 @@ module Infix : sig
|
|||
]}
|
||||
@since 3.1
|
||||
*)
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
include Nativeint
|
||||
|
||||
let min : t -> t -> t = Stdlib.min
|
||||
|
|
|
|||
|
|
@ -181,9 +181,6 @@ module Infix = struct
|
|||
let ( <*> ) = ( <*> )
|
||||
let ( <$> ) = map
|
||||
let ( <+> ) = ( <+> )
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
|
||||
|
|
@ -193,8 +190,6 @@ module Infix = struct
|
|||
| _ -> None
|
||||
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -175,14 +175,10 @@ module Infix : sig
|
|||
val ( <+> ) : 'a t -> 'a t -> 'a t
|
||||
(** [o1 <+> o2] is [o1] if [o1] is [Some _], [o2] if [o1] is [None]. *)
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a t
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8
|
||||
@inline *)
|
||||
|
||||
[@@@endif]
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(** {1 Comparisons} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type 'a t = 'a -> 'a -> int
|
||||
(** Comparison (total ordering) between two elements, that returns an int *)
|
||||
|
|
|
|||
|
|
@ -1,5 +1,3 @@
|
|||
open CCShims_
|
||||
|
||||
module Memo_tbl = Hashtbl.Make (struct
|
||||
type t = int * int (* id of parser, position *)
|
||||
|
||||
|
|
@ -246,15 +244,10 @@ module Infix = struct
|
|||
let ( <|> ) = or_
|
||||
let ( ||| ) = both
|
||||
let[@inline] ( <?> ) p msg = set_error_message msg p
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
let ( and+ ) = both
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
@ -302,7 +295,7 @@ let recurse slice p : _ t =
|
|||
(fun st ~ok ~err ->
|
||||
(* make sure these states are related. all slices share the
|
||||
same reference as the initial state they derive from. *)
|
||||
assert (CCShims_.Stdlib.(st.cs == slice.cs));
|
||||
assert (Stdlib.(st.cs == slice.cs));
|
||||
p.run slice ~ok:(fun _st x -> ok st x) ~err);
|
||||
}
|
||||
|
||||
|
|
@ -761,7 +754,7 @@ let set_current_slice sl : _ t =
|
|||
{
|
||||
run =
|
||||
(fun _st ~ok ~err:_ ->
|
||||
assert (CCShims_.Stdlib.(_st.cs == sl.cs));
|
||||
assert (Stdlib.(_st.cs == sl.cs));
|
||||
ok sl ())
|
||||
(* jump to slice *);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,4 +1,3 @@
|
|||
|
||||
(** Very Simple Parser Combinators
|
||||
|
||||
These combinators can be used to write very simple parsers, for example
|
||||
|
|
@ -675,14 +674,10 @@ module Infix : sig
|
|||
[a ||| b] parses [a], then [b], then returns the pair of their results.
|
||||
@since 3.6 *)
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a t
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8
|
||||
@inline *)
|
||||
|
||||
[@@@endif]
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -177,15 +177,9 @@ let fix ?(sub1 = []) ?(sub2 = []) ?(subn = []) ~base fuel st =
|
|||
|
||||
let pure x _st = x
|
||||
let ( <*> ) f g st = f st (g st)
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
let[@inline] ( and+ ) a1 a2 st = a1 st, a2 st
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let __default_state = Random.State.make_self_init ()
|
||||
let run ?(st = __default_state) g = g st
|
||||
|
|
|
|||
|
|
@ -2,10 +2,10 @@
|
|||
|
||||
(** Random Generators *)
|
||||
|
||||
(** @inline *)
|
||||
include module type of struct
|
||||
include Random
|
||||
end
|
||||
(** @inline *)
|
||||
|
||||
type state = Random.State.t
|
||||
|
||||
|
|
@ -151,15 +151,10 @@ val fix :
|
|||
|
||||
val pure : 'a -> 'a t
|
||||
val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a t
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8
|
||||
@inline *)
|
||||
|
||||
[@@@endif]
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
|
||||
(** {4 Run a generator} *)
|
||||
|
||||
|
|
|
|||
|
|
@ -263,9 +263,6 @@ module Infix = struct
|
|||
let ( >|= ) e f = map f e
|
||||
let ( >>= ) e f = flat_map f e
|
||||
let ( <*> ) = ( <*> )
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
|
||||
|
|
@ -276,8 +273,6 @@ module Infix = struct
|
|||
| _, Error e -> Error e
|
||||
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -186,8 +186,6 @@ module Infix : sig
|
|||
[Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen
|
||||
over the error of [b] if both fail. *)
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
|
||||
(** @since 2.8 *)
|
||||
|
||||
|
|
@ -199,8 +197,6 @@ module Infix : sig
|
|||
|
||||
val ( and* ) : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t
|
||||
(** @since 2.8 *)
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -6,17 +6,8 @@ type 'a equal = 'a -> 'a -> bool
|
|||
type 'a ord = 'a -> 'a -> int
|
||||
type 'a printer = Format.formatter -> 'a -> unit
|
||||
|
||||
[@@@ifge 4.07]
|
||||
|
||||
include Seq
|
||||
|
||||
[@@@else_]
|
||||
|
||||
type +'a t = unit -> 'a node
|
||||
and +'a node = 'a Seq.node = Nil | Cons of 'a * 'a t
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let nil () = Nil
|
||||
let cons a b () = Cons (a, b)
|
||||
let empty = nil
|
||||
|
|
@ -24,7 +15,10 @@ let singleton x () = Cons (x, nil)
|
|||
|
||||
let init n f =
|
||||
let rec aux i () =
|
||||
if i >= n then Nil else Cons (f i, aux (i+1))
|
||||
if i >= n then
|
||||
Nil
|
||||
else
|
||||
Cons (f i, aux (i + 1))
|
||||
in
|
||||
aux 0
|
||||
|
||||
|
|
@ -101,8 +95,8 @@ let fold_left = fold
|
|||
let foldi f acc res =
|
||||
let rec aux acc i res =
|
||||
match res () with
|
||||
| Nil -> acc
|
||||
| Cons (s, cont) -> aux (f acc i s) (i+1) cont
|
||||
| Nil -> acc
|
||||
| Cons (s, cont) -> aux (f acc i s) (i + 1) cont
|
||||
in
|
||||
aux acc 0 res
|
||||
|
||||
|
|
@ -193,7 +187,6 @@ let rec append l1 l2 () =
|
|||
| Cons (x, l1') -> Cons (x, append l1' l2)
|
||||
|
||||
let rec cycle l () = append l (cycle l) ()
|
||||
|
||||
let rec iterate f a () = Cons (a, iterate f (f a))
|
||||
|
||||
let rec unfold f acc () =
|
||||
|
|
@ -213,23 +206,28 @@ let rec exists p l =
|
|||
|
||||
let rec find p l =
|
||||
match l () with
|
||||
| Nil -> None
|
||||
| Cons (x, tl) ->
|
||||
if p x then Some x else find p tl
|
||||
| Nil -> None
|
||||
| Cons (x, tl) ->
|
||||
if p x then
|
||||
Some x
|
||||
else
|
||||
find p tl
|
||||
|
||||
let rec find_map f l =
|
||||
match l () with
|
||||
| Nil -> None
|
||||
| Cons (x, tl) ->
|
||||
match f x with
|
||||
| None -> find_map f tl
|
||||
| e -> e
|
||||
|
||||
let rec scan f acc res () = Cons (acc, fun () ->
|
||||
match res () with
|
||||
| Nil -> Nil
|
||||
| Cons (s, cont) -> scan f (f acc s) cont ())
|
||||
| Nil -> None
|
||||
| Cons (x, tl) ->
|
||||
(match f x with
|
||||
| None -> find_map f tl
|
||||
| e -> e)
|
||||
|
||||
let rec scan f acc res () =
|
||||
Cons
|
||||
( acc,
|
||||
fun () ->
|
||||
match res () with
|
||||
| Nil -> Nil
|
||||
| Cons (s, cont) -> scan f (f acc s) cont () )
|
||||
|
||||
let rec flat_map f l () =
|
||||
match l () with
|
||||
|
|
@ -267,7 +265,6 @@ let product_with f l1 l2 =
|
|||
_next_left [] l1 [] l2
|
||||
|
||||
let map_product = product_with
|
||||
|
||||
let product l1 l2 = product_with (fun x y -> x, y) l1 l2
|
||||
|
||||
let rec group eq l () =
|
||||
|
|
@ -297,7 +294,6 @@ let rec filter_map f l () =
|
|||
| Some y -> Cons (y, filter_map f l'))
|
||||
|
||||
let flatten l = flat_map (fun x -> x) l
|
||||
|
||||
let concat = flatten
|
||||
|
||||
let range i j =
|
||||
|
|
|
|||
|
|
@ -13,18 +13,9 @@ type 'a printer = Format.formatter -> 'a -> unit
|
|||
|
||||
(** {2 Basics} *)
|
||||
|
||||
[@@@ifge 4.07]
|
||||
|
||||
include module type of Seq
|
||||
(** @inline *)
|
||||
|
||||
[@@@else_]
|
||||
|
||||
type +'a t = unit -> 'a node
|
||||
and +'a node = 'a Seq.node = Nil | Cons of 'a * 'a t
|
||||
|
||||
[@@@endif]
|
||||
|
||||
val nil : 'a t
|
||||
val empty : 'a t
|
||||
val cons : 'a -> 'a t -> 'a t
|
||||
|
|
@ -173,13 +164,14 @@ val scan : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a t
|
|||
@since 3.10 *)
|
||||
|
||||
val flat_map : ('a -> 'b t) -> 'a t -> 'b t
|
||||
|
||||
val concat_map : ('a -> 'b t) -> 'a t -> 'b t
|
||||
(** Alias of {!flat_map}
|
||||
@since 3.10 *)
|
||||
|
||||
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
|
||||
|
||||
val flatten : 'a t t -> 'a t
|
||||
|
||||
val concat : 'a t t -> 'a t
|
||||
(** Alias of {!flatten}.
|
||||
@since 3.10 *)
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(** {1 Simple S-expression parsing/printing} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type 'a or_error = ('a, string) result
|
||||
type 'a gen = unit -> 'a option
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
{
|
||||
open CCShims_
|
||||
type token =
|
||||
| ATOM of string
|
||||
| LIST_OPEN
|
||||
|
|
|
|||
|
|
@ -1,9 +0,0 @@
|
|||
[@@@ifge 4.07]
|
||||
|
||||
module Stdlib = Stdlib
|
||||
|
||||
[@@@else_]
|
||||
|
||||
module Stdlib = Pervasives
|
||||
|
||||
[@@@endif]
|
||||
|
|
@ -1,14 +0,0 @@
|
|||
[@@@ifge 4.8]
|
||||
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8 *)
|
||||
module type LET = sig
|
||||
type 'a t
|
||||
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
end
|
||||
|
||||
[@@@endif]
|
||||
|
|
@ -2,8 +2,6 @@
|
|||
|
||||
(** {1 Basic String Utils} *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
type 'a iter = ('a -> unit) -> unit
|
||||
type 'a gen = unit -> 'a option
|
||||
|
||||
|
|
@ -388,14 +386,6 @@ module Split = struct
|
|||
let right ~by s = try Some (right_exn ~by s) with Not_found -> None
|
||||
end
|
||||
|
||||
[@@@ifge 4.04]
|
||||
[@@@else_]
|
||||
|
||||
let split_on_char c s : _ list =
|
||||
Split.list_cpy ~drop:Split.no_drop ~by:(String.make 1 c) s
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let split ~by s = Split.list_cpy ~by s
|
||||
|
||||
let compare_versions a b =
|
||||
|
|
@ -979,10 +969,10 @@ let pp fmt s = Format.fprintf fmt "\"%s\"" s
|
|||
module Infix = struct
|
||||
let ( = ) = equal
|
||||
let ( <> ) a b = not (equal a b)
|
||||
let ( > ) : t -> t -> bool = CCShims_.Stdlib.( > )
|
||||
let ( >= ) : t -> t -> bool = CCShims_.Stdlib.( >= )
|
||||
let ( < ) : t -> t -> bool = CCShims_.Stdlib.( < )
|
||||
let ( <= ) : t -> t -> bool = CCShims_.Stdlib.( <= )
|
||||
let ( > ) : t -> t -> bool = Stdlib.( > )
|
||||
let ( >= ) : t -> t -> bool = Stdlib.( >= )
|
||||
let ( < ) : t -> t -> bool = Stdlib.( < )
|
||||
let ( <= ) : t -> t -> bool = Stdlib.( <= )
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -1,13 +1 @@
|
|||
[@@@ifge 4.08]
|
||||
|
||||
include Unit
|
||||
|
||||
[@@@else_]
|
||||
|
||||
type t = unit
|
||||
|
||||
let[@inline] equal (_ : t) (_ : t) = true
|
||||
let[@inline] compare (_ : t) (_ : t) = 0
|
||||
let to_string () = "()"
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
We only deal with UTF8 strings as they naturally map to OCaml bytestrings *)
|
||||
|
||||
open CCShims_
|
||||
|
||||
|
||||
type uchar = Uchar.t
|
||||
type 'a gen = unit -> 'a option
|
||||
|
|
|
|||
|
|
@ -671,11 +671,7 @@ let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
|
|||
v;
|
||||
pp_stop fmt ()
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -397,8 +397,6 @@ val pp :
|
|||
By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
|
||||
(fun out -> Format.fprintf out ",@ "). *)
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
|
||||
(** @since 2.8 *)
|
||||
|
||||
|
|
@ -410,5 +408,3 @@ val ( let* ) : ('a, 'e) t -> ('a -> ('b, 'e) t) -> ('b, 'e) t
|
|||
|
||||
val ( and* ) : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t
|
||||
(** @since 2.8 *)
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -55,5 +55,5 @@ module Atomic = CCAtomic
|
|||
module Sexp = CCSexp
|
||||
module Sexp_intf = CCSexp_intf
|
||||
module Canonical_sexp = CCCanonical_sexp
|
||||
module Stdlib = CCShims_.Stdlib
|
||||
module Stdlib = Stdlib
|
||||
include Monomorphic
|
||||
|
|
|
|||
|
|
@ -52,5 +52,5 @@ module Monomorphic = CCMonomorphic
|
|||
module Utf8_string = CCUtf8_string
|
||||
module Sexp = CCSexp
|
||||
module Sexp_intf = CCSexp_intf
|
||||
module Stdlib = CCShims_.Stdlib
|
||||
module Stdlib = Stdlib
|
||||
include Monomorphic
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@
|
|||
(name containers)
|
||||
(public_name containers)
|
||||
(wrapped false)
|
||||
(modules_without_implementation CCShims_syntax)
|
||||
(preprocess
|
||||
(action
|
||||
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@ let uniformity_test ?(size_hint = 10) k rng st =
|
|||
let confidence = 4. in
|
||||
let std = confidence *. sqrt (kf *. variance) in
|
||||
let predicate _key n acc =
|
||||
let ( < ) (a : float) b = CCShims_.Stdlib.( < ) a b in
|
||||
let ( < ) (a : float) b = Stdlib.( < ) a b in
|
||||
acc && abs_float (average -. float_of_int n) < std
|
||||
in
|
||||
Hashtbl.fold predicate histogram true
|
||||
|
|
|
|||
|
|
@ -3,5 +3,5 @@
|
|||
(public_name containers-data)
|
||||
(wrapped false)
|
||||
(flags :standard -warn-error -3 -w -70 -color always -safe-string
|
||||
-strict-sequence -open CCShims_)
|
||||
-strict-sequence)
|
||||
(libraries containers))
|
||||
|
|
|
|||
|
|
@ -1,12 +1,5 @@
|
|||
(* This file is free software, part of containers. See file "license" for more details. *)
|
||||
|
||||
[@@@ifge 4.07]
|
||||
[@@@else_]
|
||||
|
||||
module Stdlib = Pervasives
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let ( = ) : int -> int -> bool = Stdlib.( = )
|
||||
let ( <> ) : int -> int -> bool = Stdlib.( <> )
|
||||
let ( < ) : int -> int -> bool = Stdlib.( < )
|
||||
|
|
|
|||
|
|
@ -31,19 +31,9 @@ module Test = struct
|
|||
in
|
||||
Printf.sprintf "(test :file '%s'%s :n %d)" self.__FILE__ what self.n
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
let get_state (r : _ QCheck.TestResult.t) : _ QCheck.TestResult.state =
|
||||
QCheck.TestResult.get_state r
|
||||
|
||||
[@@@else_]
|
||||
|
||||
(* must have qcheck < 0.17 *)
|
||||
let get_state (r : _ QCheck.TestResult.t) : _ QCheck.TestResult.state =
|
||||
r.state
|
||||
|
||||
[@@@endif]
|
||||
|
||||
let run ?(long = false) ~seed (self : t) : _ result =
|
||||
match
|
||||
let what = CCOption.map_or ~default:"" (fun s -> s ^ " ") self.name in
|
||||
|
|
|
|||
|
|
@ -518,15 +518,10 @@ module Make (P : PARAM) = struct
|
|||
let ( >> ) a f = and_then a f
|
||||
let ( >|= ) a f = map f a
|
||||
let ( <*> ) = app
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
let ( let+ ) = ( >|= )
|
||||
let ( let* ) = ( >>= )
|
||||
let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2
|
||||
let ( and* ) = ( and+ )
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include Infix
|
||||
|
|
|
|||
|
|
@ -148,14 +148,10 @@ module Make (P : PARAM) : sig
|
|||
val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t
|
||||
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
include CCShims_syntax.LET with type 'a t := 'a t
|
||||
(** Let operators on OCaml >= 4.08.0, nothing otherwise
|
||||
@since 2.8 *)
|
||||
|
||||
[@@@endif]
|
||||
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
|
||||
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
|
||||
val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -3,7 +3,7 @@
|
|||
(public_name containers-thread)
|
||||
(wrapped false)
|
||||
(optional)
|
||||
(flags :standard -warn-error -a+8 -w -32 -safe-string -open CCShims_)
|
||||
(flags :standard -warn-error -a+8 -w -32 -safe-string)
|
||||
(preprocess
|
||||
(action
|
||||
(run %{project_root}/src/core/cpp/cpp.exe %{input-file})))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,5 @@
|
|||
let verbose = try Sys.getenv "VERBOSE" = "1" with _ -> false
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
module J = Yojson.Safe
|
||||
module Fmt = CCFormat
|
||||
module Cbor = Containers_cbor
|
||||
|
|
@ -174,5 +172,3 @@ let () =
|
|||
(*Format.printf "tests: %a@." (Fmt.Dump.list Test.pp) tests;*)
|
||||
run_tests tests;
|
||||
()
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
include (val Containers_testlib.make ~__FILE__ ())
|
||||
module Cbor = Containers_cbor
|
||||
|
||||
[@@@ifge 4.08]
|
||||
|
||||
let gen_c : Cbor.t Q.Gen.t =
|
||||
let open Q.Gen in
|
||||
sized @@ fix
|
||||
|
|
@ -110,5 +108,3 @@ if not (c = c') then
|
|||
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
|
||||
Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
|
||||
true
|
||||
|
||||
[@@@endif]
|
||||
|
|
|
|||
|
|
@ -1,97 +1,158 @@
|
|||
|
||||
open CCFormat
|
||||
|
||||
module T = (val Containers_testlib.make ~__FILE__ ())
|
||||
include T;;
|
||||
include T
|
||||
|
||||
let to_string_test s = CCFormat.sprintf_no_color "@[<h>%a@]%!" s ();;
|
||||
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "a b" (to_string_test (return "a@ b"));;
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s) ", " (to_string_test (return ",@ "));;
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "and then" (to_string_test (return "@{<Red>and then@}@,"));;
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "a b" (to_string_test (return "@[<h>a@ b@]"));;
|
||||
|
||||
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "a\nb\nc"
|
||||
(sprintf_no_color "@[<v>%a@]%!" text "a b c");;
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "a b\nc"
|
||||
(sprintf_no_color "@[<h>%a@]%!" text "a b\nc");;
|
||||
|
||||
|
||||
eq ~printer:(fun s->CCFormat.sprintf "%S" s)
|
||||
"(a\n b\n c)" (sprintf_no_color "(@[<v>%a@])" string_lines "a\nb\nc");;
|
||||
|
||||
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "foobar"
|
||||
(to_string_test (append (return "foo") (return "bar")));;
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "bar"
|
||||
(to_string_test (append (return "") (return "bar")));;
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "foo"
|
||||
(to_string_test (append (return "foo") (return "")));;
|
||||
|
||||
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "" (to_string_test @@ append_l []);;
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "foobarbaz" (to_string_test @@ append_l (List.map return ["foo"; "bar"; "baz"]));;
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "3141" (to_string_test @@ append_l (List.map (const int) [3; 14; 1]));;
|
||||
|
||||
t @@ fun () ->
|
||||
let buf1 = Buffer.create 42 in
|
||||
let buf2 = Buffer.create 42 in
|
||||
let f1 = Format.formatter_of_buffer buf1 in
|
||||
let f2 = Format.formatter_of_buffer buf2 in
|
||||
let fmt = tee f1 f2 in
|
||||
Format.fprintf fmt "coucou@.";
|
||||
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf1);
|
||||
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
|
||||
true;;
|
||||
|
||||
[@@@ifge 4.8]
|
||||
|
||||
t @@ fun () ->
|
||||
set_color_default true;
|
||||
let s = sprintf
|
||||
"what is your %a? %a! No, %a! Ahhhhhhh@."
|
||||
(styling [`FG `White; `Bold] string) "favorite color"
|
||||
(styling [`FG `Blue] string) "blue"
|
||||
(styling [`FG `Red] string) "red"
|
||||
in
|
||||
assert_equal ~printer:CCFun.id
|
||||
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \027[31mred\027[0m! Ahhhhhhh\n"
|
||||
s;
|
||||
true
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"a b"
|
||||
(to_string_test (return "a@ b"))
|
||||
;;
|
||||
|
||||
[@@@endif]
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
", "
|
||||
(to_string_test (return ",@ "))
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"and then"
|
||||
(to_string_test (return "@{<Red>and then@}@,"))
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"a b"
|
||||
(to_string_test (return "@[<h>a@ b@]"))
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"a\nb\nc"
|
||||
(sprintf_no_color "@[<v>%a@]%!" text "a b c")
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"a b\nc"
|
||||
(sprintf_no_color "@[<h>%a@]%!" text "a b\nc")
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"(a\n b\n c)"
|
||||
(sprintf_no_color "(@[<v>%a@])" string_lines "a\nb\nc")
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"foobar"
|
||||
(to_string_test (append (return "foo") (return "bar")))
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"bar"
|
||||
(to_string_test (append (return "") (return "bar")))
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"foo"
|
||||
(to_string_test (append (return "foo") (return "")))
|
||||
;;
|
||||
|
||||
eq ~printer:(fun s -> CCFormat.sprintf "%S" s) "" (to_string_test @@ append_l [])
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"foobarbaz"
|
||||
(to_string_test @@ append_l (List.map return [ "foo"; "bar"; "baz" ]))
|
||||
;;
|
||||
|
||||
eq
|
||||
~printer:(fun s -> CCFormat.sprintf "%S" s)
|
||||
"3141"
|
||||
(to_string_test @@ append_l (List.map (const int) [ 3; 14; 1 ]))
|
||||
;;
|
||||
|
||||
t @@ fun () ->
|
||||
set_color_default true;
|
||||
let s = sprintf
|
||||
"what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>red@}! Ahhhhhhh@."
|
||||
in
|
||||
assert_equal ~printer:CCFun.id
|
||||
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \027[31mred\027[0m! Ahhhhhhh\n"
|
||||
s;
|
||||
true;;
|
||||
let buf1 = Buffer.create 42 in
|
||||
let buf2 = Buffer.create 42 in
|
||||
let f1 = Format.formatter_of_buffer buf1 in
|
||||
let f2 = Format.formatter_of_buffer buf2 in
|
||||
let fmt = tee f1 f2 in
|
||||
Format.fprintf fmt "coucou@.";
|
||||
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf1);
|
||||
assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf2);
|
||||
true
|
||||
;;
|
||||
|
||||
t @@ fun () ->
|
||||
set_color_default true;
|
||||
let s =
|
||||
sprintf "what is your %a? %a! No, %a! Ahhhhhhh@."
|
||||
(styling [ `FG `White; `Bold ] string)
|
||||
"favorite color"
|
||||
(styling [ `FG `Blue ] string)
|
||||
"blue"
|
||||
(styling [ `FG `Red ] string)
|
||||
"red"
|
||||
in
|
||||
assert_equal ~printer:CCFun.id
|
||||
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \
|
||||
\027[31mred\027[0m! Ahhhhhhh\n"
|
||||
s;
|
||||
true
|
||||
;;
|
||||
|
||||
t @@ fun () ->
|
||||
set_color_default true;
|
||||
let s =
|
||||
sprintf
|
||||
"what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>red@}! \
|
||||
Ahhhhhhh@."
|
||||
in
|
||||
assert_equal ~printer:CCFun.id
|
||||
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \
|
||||
\027[31mred\027[0m! Ahhhhhhh\n"
|
||||
s;
|
||||
true
|
||||
;;
|
||||
|
||||
t @@ fun () -> sprintf "yolo %s %d" "a b" 42 = "yolo a b 42";;
|
||||
t @@ fun () -> sprintf "%d " 0 = "0 ";;
|
||||
t @@ fun () -> sprintf_no_color "%d " 0 = "0 ";;
|
||||
|
||||
t @@ fun () ->
|
||||
set_color_default true;
|
||||
assert_equal "\027[31myolo\027[0m" (sprintf "@{<red>yolo@}");
|
||||
assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}");
|
||||
true;;
|
||||
set_color_default true;
|
||||
assert_equal "\027[31myolo\027[0m" (sprintf "@{<red>yolo@}");
|
||||
assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}");
|
||||
true
|
||||
;;
|
||||
|
||||
eq ~printer:CCFormat.(to_string (opt string))
|
||||
eq
|
||||
~printer:CCFormat.(to_string (opt string))
|
||||
(Some "hello world")
|
||||
(ksprintf ~f:(fun s -> Some s) "hello %a" CCFormat.string "world");;
|
||||
(ksprintf ~f:(fun s -> Some s) "hello %a" CCFormat.string "world")
|
||||
;;
|
||||
|
||||
eq ~printer:(fun s -> s) "[1;2;3]" (to_string Dump.(list int) [ 1; 2; 3 ]);;
|
||||
eq ~printer:(fun s -> s) "Some 1" (to_string Dump.(option int) (Some 1));;
|
||||
|
||||
eq ~printer:(fun s->s) "[1;2;3]" (to_string Dump.(list int) [1;2;3]);;
|
||||
eq ~printer:(fun s->s) "Some 1" (to_string Dump.(option int) (Some 1));;
|
||||
eq ~printer:(fun s->s) "[None;Some \"a b\"]" (to_string Dump.(list (option string)) [None; Some "a b"]);;
|
||||
eq ~printer:(fun s->s) "[(Ok \"a b c\");(Error \"nope\")]"
|
||||
(to_string Dump.(list (result string)) [Ok "a b c"; Error "nope"]);;
|
||||
eq
|
||||
~printer:(fun s -> s)
|
||||
"[None;Some \"a b\"]"
|
||||
(to_string Dump.(list (option string)) [ None; Some "a b" ])
|
||||
;;
|
||||
|
||||
eq ANSI_codes.reset "\x1b[0m";;
|
||||
eq
|
||||
~printer:(fun s -> s)
|
||||
"[(Ok \"a b c\");(Error \"nope\")]"
|
||||
(to_string Dump.(list (result string)) [ Ok "a b c"; Error "nope" ])
|
||||
;;
|
||||
|
||||
eq ANSI_codes.reset "\x1b[0m"
|
||||
|
|
|
|||
|
|
@ -1,7 +1,7 @@
|
|||
module T = (val Containers_testlib.make ~__FILE__ ())
|
||||
include T
|
||||
open CCString
|
||||
open CCShims_.Stdlib;;
|
||||
.Stdlib;;
|
||||
|
||||
q Q.printable_string (fun s -> s = rev (rev s));;
|
||||
q Q.printable_string (fun s -> length s = length (rev s));;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue