remove conditional over OCaml >= 4.08

in particular, all the let-ops are now unconditional!
This commit is contained in:
Simon Cruanes 2023-06-24 15:22:21 -04:00
parent d0903a09be
commit 1a23731730
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
58 changed files with 229 additions and 540 deletions

View file

@ -2,7 +2,7 @@
(names run_benchs run_bench_hash run_objsize) (names run_benchs run_bench_hash run_objsize)
(libraries containers containers-data containers-thread benchmark gen iter (libraries containers containers-data containers-thread benchmark gen iter
qcheck oseq batteries base sek) 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) (optional)
(ocamlopt_flags :standard -O3 -color always -unbox-closures (ocamlopt_flags :standard -O3 -color always -unbox-closures
-unbox-closures-factor 20)) -unbox-closures-factor 20))

View file

@ -44,9 +44,6 @@ let rec pp_diagnostic out (self : t) =
let to_string_diagnostic (self : t) : string = let to_string_diagnostic (self : t) : string =
Format.asprintf "@[<h>%a@]" pp_diagnostic self Format.asprintf "@[<h>%a@]" pp_diagnostic self
(* we use funtions from Bytes *)
[@@@ifge 4.08]
exception Indefinite exception Indefinite
let[@inline] i64_to_int i = let[@inline] i64_to_int i =
@ -323,5 +320,3 @@ let encode ?(buf = Buffer.create 32) (self : t) : string =
in in
encode_val self; encode_val self;
Buffer.contents buf Buffer.contents buf
[@@@endif]

View file

@ -5,9 +5,6 @@
{b note} this is experimental. {b note} this is experimental.
{b note} this is only available on OCaml >= 4.08. Below that, the module
is empty.
@since 3.9 @since 3.9
*) *)
@ -26,15 +23,9 @@ type 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
(* we use funtions from Bytes *)
[@@@ifge 4.08]
val encode : ?buf:Buffer.t -> t -> string val encode : ?buf:Buffer.t -> t -> string
val decode : string -> (t, string) result val decode : string -> (t, string) result
val decode_exn : string -> t val decode_exn : string -> t
(** Like {!decode}. (** Like {!decode}.
@raise Failure if the string isn't valid *) @raise Failure if the string isn't valid *)
[@@@endif]

View file

@ -11,30 +11,8 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Arrays} *) (** {2 Arrays} *)
open CCShims_
[@@@ifge 4.8]
include Array 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 empty = [||]
let get_safe a i = let get_safe a i =
@ -619,16 +597,12 @@ module Infix = struct
let ( -- ) = ( -- ) let ( -- ) = ( -- )
let ( --^ ) = ( --^ ) let ( --^ ) = ( --^ )
[@@@ifge 4.8]
type 'a t = 'a array type 'a t = 'a array
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2 let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]
end end
include Infix include Infix

View file

@ -14,31 +14,9 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Arrays} *) (** {2 Arrays} *)
[@@@ifge 4.8]
include module type of Array include module type of Array
(** @inline *) (** @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 val empty : 'a t
(** [empty] is the empty array, physically equal to [[||]]. *) (** [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. @raise Invalid_argument if [a] is empty.
@since 3.12 *) @since 3.12 *)
val argmax : ('a -> 'a -> int) -> 'a t -> int option val argmax : ('a -> 'a -> int) -> 'a t -> int option
(** [argmax cmp a] returns [None] if [a] is empty, otherwise, returns [Some i] where [i] (** [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]. 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. (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
@since 0.17 *) @since 0.17 *)
[@@@ifge 4.8] val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
include CCShims_syntax.LET with type 'a t := 'a array val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
(** Let operators on OCaml >= 4.08.0, nothing otherwise val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
@since 2.8
@inline *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -14,29 +14,9 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Arrays} *) (** {2 Arrays} *)
[@@@ifge 4.8]
include module type of ArrayLabels with module Floatarray = Array.Floatarray include module type of ArrayLabels with module Floatarray = Array.Floatarray
(** @inline *) (** @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 val empty : 'a t
(** [empty] is the empty array, physically equal to [[||]]. *) (** [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. @raise Invalid_argument if [a] is empty.
@since 3.12 *) @since 3.12 *)
val argmax : cmp:('a -> 'a -> int) -> 'a t -> int option 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] (** [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]. 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. (** [x --^ y] creates an array containing integers in the range [x .. y]. Right bound excluded.
@since 0.17 *) @since 0.17 *)
[@@@ifge 4.8] val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
include CCShims_syntax.LET with type 'a t := 'a array val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
(** Let operators on OCaml >= 4.08.0, nothing otherwise val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
@since 2.8
@inline *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -4,7 +4,7 @@ include Atomic
[@@@else_] [@@@else_]
open CCShims_.Stdlib (* for == *) open Stdlib (* for == *)
type 'a t = { mutable x: 'a } type 'a t = { mutable x: 'a }

View file

@ -1,6 +1,6 @@
(* 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. *)
open CCShims_
type t = bool type t = bool

View file

@ -2,7 +2,7 @@
(** {1 Simple S-expression parsing/printing} *) (** {1 Simple S-expression parsing/printing} *)
open CCShims_
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

View file

@ -14,12 +14,12 @@ let to_int = Char.code
let to_string c = String.make 1 c let to_string c = String.make 1 c
module Infix = struct module Infix = struct
let ( = ) : t -> t -> bool = CCShims_.Stdlib.( = ) let ( = ) : t -> t -> bool = Stdlib.( = )
let ( <> ) : t -> t -> bool = CCShims_.Stdlib.( <> ) let ( <> ) : t -> t -> bool = Stdlib.( <> )
let ( < ) : t -> t -> bool = CCShims_.Stdlib.( < ) let ( < ) : t -> t -> bool = Stdlib.( < )
let ( > ) : t -> t -> bool = CCShims_.Stdlib.( > ) let ( > ) : t -> t -> bool = Stdlib.( > )
let ( <= ) : t -> t -> bool = CCShims_.Stdlib.( <= ) let ( <= ) : t -> t -> bool = Stdlib.( <= )
let ( >= ) : t -> t -> bool = CCShims_.Stdlib.( >= ) let ( >= ) : t -> t -> bool = Stdlib.( >= )
end end
include Infix include Infix

View file

@ -2,7 +2,7 @@
(** {1 Equality Combinators} *) (** {1 Equality Combinators} *)
open CCShims_
type 'a t = 'a -> 'a -> bool type 'a t = 'a -> 'a -> bool

View file

@ -1,6 +1,6 @@
(* 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. *)
open CCShims_
type t = float type t = float

View file

@ -3,7 +3,7 @@
(** Basic operations on floating-point numbers (** Basic operations on floating-point numbers
@since 0.6.1 *) @since 0.6.1 *)
open CCShims_
type t = float type t = float

View file

@ -301,8 +301,6 @@ let mark_close_style st : string =
else else
"" ""
[@@@ifge 4.8]
type stag += Style of ANSI_codes.style list type stag += Style of ANSI_codes.style list
let pp_open_tag out s = pp_open_stag out (String_tag s) let pp_open_tag out s = pp_open_stag out (String_tag s)
@ -359,41 +357,6 @@ let set_color_tag_handling ppf =
in in
pp_set_formatter_stag_functions ppf funs' 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 set_color_default =
let first = ref true in let first = ref true in
fun b -> fun b ->

View file

@ -10,10 +10,10 @@ type 'a iter = ('a -> unit) -> unit
see https://discuss.ocaml.org/t/extend-existing-module/1389/4 see https://discuss.ocaml.org/t/extend-existing-module/1389/4
*) *)
(** @inline *)
include module type of struct include module type of struct
include Format include Format
end end
(** @inline *)
type t = Format.formatter type t = Format.formatter
type -'a printer = t -> 'a -> unit type -'a printer = t -> 'a -> unit
@ -30,7 +30,6 @@ val int : int printer
val string : string printer val string : string printer
val bool : bool printer val bool : bool printer
val float3 : float printer (* 3 digits after . *) val float3 : float printer (* 3 digits after . *)
val float : float printer val float : float printer
val exn : exn printer val exn : exn printer
@ -334,8 +333,6 @@ module ANSI_codes : sig
is a very shiny style. *) is a very shiny style. *)
end end
[@@@ifge 4.8]
val styling : ANSI_codes.style list -> 'a printer -> 'a printer val styling : ANSI_codes.style list -> 'a printer -> 'a printer
(** [styling st p] is the same printer as [p], except it locally sets (** [styling st p] is the same printer as [p], except it locally sets
the style [st]. the style [st].
@ -363,8 +360,6 @@ val with_styling : ANSI_codes.style list -> t -> (unit -> 'a) -> 'a
Available only on OCaml >= 4.08. Available only on OCaml >= 4.08.
@since 3.7 *) @since 3.7 *)
[@@@endif]
(** {2 IO} *) (** {2 IO} *)
val output : t -> 'a printer -> 'a -> unit val output : t -> 'a printer -> 'a -> unit

View file

@ -11,34 +11,9 @@ let opaque_identity x = x
(* import standard implementations, if any *) (* import standard implementations, if any *)
include Sys include Sys
include CCShims_.Stdlib include Stdlib
[@@@ifge 4.8]
include Fun 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 f g x = g (f x)
let compose_binop f g x y = g (f x) (f y) let compose_binop f g x y = g (f x) (f y)
let curry f x y = f (x, y) let curry f x y = f (x, y)
@ -92,16 +67,11 @@ let rec iterate n f x =
module Infix = struct module Infix = struct
(* default implem for some operators *) (* default implem for some operators *)
let ( |> ) = CCShims_.Stdlib.( |> ) let ( |> ) = Stdlib.( |> )
let ( @@ ) = CCShims_.Stdlib.( @@ ) let ( @@ ) = Stdlib.( @@ )
let ( %> ) = compose let ( %> ) = compose
let[@inline] ( % ) f g x = f (g x) let[@inline] ( % ) f g x = f (g x)
[@@@ifge 4.8]
let ( let@ ) = ( @@ ) let ( let@ ) = ( @@ )
[@@@endif]
end end
include Infix include Infix

View file

@ -2,27 +2,9 @@
(** Basic operations on Functions *) (** Basic operations on Functions *)
[@@@ifge 4.8]
include module type of Fun include module type of Fun
(** @inline *) (** @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 val compose : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c
(** [compose f g x] is [g (f x)]. Composition. *) (** [compose f g x] is [g (f x)]. Composition. *)
@ -102,14 +84,10 @@ module Infix : sig
val ( % ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c val ( % ) : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c
(** [(f % g) x] or [(%) f g x] is [f (g x)]. Mathematical composition. *) (** [(f % g) x] or [(%) f g x] is [f (g x)]. Mathematical composition. *)
[@@@ifge 4.8]
val ( let@ ) : ('a -> 'b) -> 'a -> 'b val ( let@ ) : ('a -> 'b) -> 'a -> 'b
(** [let@ x = foo in bar] is the equivalent of [foo @@ fun x -> bar]. (** [let@ x = foo in bar] is the equivalent of [foo @@ fun x -> bar].
It can be very useful for resource management, alongside with {!protect}. It can be very useful for resource management, alongside with {!protect}.
@since 3.11 *) @since 3.11 *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -1,17 +1,7 @@
(* 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. *)
[@@@ifge 4.07]
[@@@else_]
module Stdlib = Pervasives
[@@@endif]
[@@@ifge 4.08]
include Int include Int
[@@@endif]
type t = int type t = int
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit

View file

@ -2,13 +2,9 @@
(** Basic Int functions *) (** Basic Int functions *)
[@@@ifge 4.08]
include module type of Int include module type of Int
(** @inline *) (** @inline *)
[@@@endif]
type t = int type t = int
val zero : t val zero : t

View file

@ -1,6 +1,6 @@
(* 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. *)
open CCShims_
include Int32 include Int32
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min

View file

@ -1,6 +1,6 @@
(* 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. *)
open CCShims_
include Int64 include Int64
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min
@ -22,7 +22,7 @@ let hash_to_int64 (n : t) =
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 CCShims_.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 =

View file

@ -2,8 +2,6 @@
(** {1 Complements to list} *) (** {1 Complements to list} *)
open CCShims_
(* backport new functions from stdlib here *) (* backport new functions from stdlib here *)
[@@@ocaml.warning "-32"] [@@@ocaml.warning "-32"]
@ -52,18 +50,8 @@ let rec assq_opt x = function
(* end of backport *) (* end of backport *)
[@@@ifge 4.8]
include List include List
[@@@else_]
include List
type +'a t = 'a list
[@@@endif]
let empty = [] let empty = []
let is_empty = function let is_empty = function
@ -1473,16 +1461,11 @@ module Infix = struct
let ( <$> ) = map let ( <$> ) = map
let ( -- ) = ( -- ) let ( -- ) = ( -- )
let ( --^ ) = ( --^ ) let ( --^ ) = ( --^ )
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
let[@inline] ( and+ ) l1 l2 = product (fun x y -> x, y) l1 l2 let[@inline] ( and+ ) l1 l2 = product (fun x y -> x, y) l1 l2
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
let ( and& ) = combine_shortest let ( and& ) = combine_shortest
[@@@endif]
end end
include Infix include Infix

View file

@ -10,22 +10,11 @@ type 'a gen = unit -> 'a option
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
type 'a random_gen = Random.State.t -> 'a type 'a random_gen = Random.State.t -> 'a
[@@@ifge 4.8]
include module type of List with type 'a t := 'a list include module type of List with type 'a t := 'a list
(** @inline *) (** @inline *)
type +'a t = 'a list type +'a t = 'a list
[@@@else_]
include module type of List
(** @inline *)
type +'a t = 'a list
[@@@endif]
val empty : 'a t val empty : 'a t
(** [empty] is [[]]. *) (** [empty] is [[]]. *)
@ -936,10 +925,10 @@ module Infix : sig
(** [i --^ j] is the infix alias for [range']. Second bound [j] excluded. (** [i --^ j] is the infix alias for [range']. Second bound [j] excluded.
@since 0.17 *) @since 0.17 *)
[@@@ifge 4.08] val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
include CCShims_syntax.LET with type 'a t := 'a t val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
(** @inline *) val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
val ( and& ) : 'a list -> 'b list -> ('a * 'b) list val ( and& ) : 'a list -> 'b list -> ('a * 'b) list
(** [(and&)] is {!combine_shortest}. (** [(and&)] is {!combine_shortest}.
@ -957,8 +946,6 @@ module Infix : sig
]} ]}
@since 3.1 @since 3.1
*) *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -1,6 +1,6 @@
(* 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. *)
open CCShims_
include Nativeint include Nativeint
let min : t -> t -> t = Stdlib.min let min : t -> t -> t = Stdlib.min

View file

@ -181,9 +181,6 @@ module Infix = struct
let ( <*> ) = ( <*> ) let ( <*> ) = ( <*> )
let ( <$> ) = map let ( <$> ) = map
let ( <+> ) = ( <+> ) let ( <+> ) = ( <+> )
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
@ -193,8 +190,6 @@ module Infix = struct
| _ -> None | _ -> None
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]
end end
include Infix include Infix

View file

@ -175,14 +175,10 @@ module Infix : sig
val ( <+> ) : 'a t -> 'a t -> 'a t val ( <+> ) : 'a t -> 'a t -> 'a t
(** [o1 <+> o2] is [o1] if [o1] is [Some _], [o2] if [o1] is [None]. *) (** [o1 <+> o2] is [o1] if [o1] is [Some _], [o2] if [o1] is [None]. *)
[@@@ifge 4.08] val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
include CCShims_syntax.LET with type 'a t := 'a t val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
(** Let operators on OCaml >= 4.08.0, nothing otherwise val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
@since 2.8
@inline *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -2,7 +2,7 @@
(** {1 Comparisons} *) (** {1 Comparisons} *)
open CCShims_
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 *)

View file

@ -1,5 +1,3 @@
open CCShims_
module Memo_tbl = Hashtbl.Make (struct module Memo_tbl = Hashtbl.Make (struct
type t = int * int (* id of parser, position *) type t = int * int (* id of parser, position *)
@ -246,15 +244,10 @@ module Infix = struct
let ( <|> ) = or_ let ( <|> ) = or_
let ( ||| ) = both let ( ||| ) = both
let[@inline] ( <?> ) p msg = set_error_message msg p let[@inline] ( <?> ) p msg = set_error_message msg p
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
let ( and+ ) = both let ( and+ ) = both
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]
end end
include Infix include Infix
@ -302,7 +295,7 @@ let recurse slice p : _ t =
(fun st ~ok ~err -> (fun st ~ok ~err ->
(* make sure these states are related. all slices share the (* make sure these states are related. all slices share the
same reference as the initial state they derive from. *) 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); p.run slice ~ok:(fun _st x -> ok st x) ~err);
} }
@ -761,7 +754,7 @@ let set_current_slice sl : _ t =
{ {
run = run =
(fun _st ~ok ~err:_ -> (fun _st ~ok ~err:_ ->
assert (CCShims_.Stdlib.(_st.cs == sl.cs)); assert (Stdlib.(_st.cs == sl.cs));
ok sl ()) ok sl ())
(* jump to slice *); (* jump to slice *);
} }

View file

@ -1,4 +1,3 @@
(** Very Simple Parser Combinators (** Very Simple Parser Combinators
These combinators can be used to write very simple parsers, for example 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. [a ||| b] parses [a], then [b], then returns the pair of their results.
@since 3.6 *) @since 3.6 *)
[@@@ifge 4.08] val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
include CCShims_syntax.LET with type 'a t := 'a t val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
(** Let operators on OCaml >= 4.08.0, nothing otherwise val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
@since 2.8
@inline *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -177,15 +177,9 @@ let fix ?(sub1 = []) ?(sub2 = []) ?(subn = []) ~base fuel st =
let pure x _st = x let pure x _st = x
let ( <*> ) f g st = f st (g st) let ( <*> ) f g st = f st (g st)
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
let[@inline] ( and+ ) a1 a2 st = a1 st, a2 st let[@inline] ( and+ ) a1 a2 st = a1 st, a2 st
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]
let __default_state = Random.State.make_self_init () let __default_state = Random.State.make_self_init ()
let run ?(st = __default_state) g = g st let run ?(st = __default_state) g = g st

View file

@ -2,10 +2,10 @@
(** Random Generators *) (** Random Generators *)
(** @inline *)
include module type of struct include module type of struct
include Random include Random
end end
(** @inline *)
type state = Random.State.t type state = Random.State.t
@ -151,15 +151,10 @@ val fix :
val pure : 'a -> 'a t val pure : 'a -> 'a t
val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
[@@@ifge 4.08] val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
include CCShims_syntax.LET with type 'a t := 'a t val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8
@inline *)
[@@@endif]
(** {4 Run a generator} *) (** {4 Run a generator} *)

View file

@ -263,9 +263,6 @@ module Infix = struct
let ( >|= ) e f = map f e let ( >|= ) e f = map f e
let ( >>= ) e f = flat_map f e let ( >>= ) e f = flat_map f e
let ( <*> ) = ( <*> ) let ( <*> ) = ( <*> )
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
@ -276,8 +273,6 @@ module Infix = struct
| _, Error e -> Error e | _, Error e -> Error e
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]
end end
include Infix include Infix

View file

@ -186,8 +186,6 @@ module Infix : sig
[Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen [Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen
over the error of [b] if both fail. *) over the error of [b] if both fail. *)
[@@@ifge 4.08]
val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
(** @since 2.8 *) (** @since 2.8 *)
@ -199,8 +197,6 @@ module Infix : sig
val ( and* ) : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t val ( and* ) : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t
(** @since 2.8 *) (** @since 2.8 *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -6,17 +6,8 @@ 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
[@@@ifge 4.07]
include Seq 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 nil () = Nil
let cons a b () = Cons (a, b) let cons a b () = Cons (a, b)
let empty = nil let empty = nil
@ -24,7 +15,10 @@ let singleton x () = Cons (x, nil)
let init n f = let init n f =
let rec aux i () = 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 in
aux 0 aux 0
@ -101,8 +95,8 @@ let fold_left = fold
let foldi f acc res = let foldi f acc res =
let rec aux acc i res = let rec aux acc i res =
match res () with match res () with
| Nil -> acc | Nil -> acc
| Cons (s, cont) -> aux (f acc i s) (i+1) cont | Cons (s, cont) -> aux (f acc i s) (i + 1) cont
in in
aux acc 0 res aux acc 0 res
@ -193,7 +187,6 @@ let rec append l1 l2 () =
| Cons (x, l1') -> Cons (x, append l1' l2) | Cons (x, l1') -> Cons (x, append l1' l2)
let rec cycle l () = append l (cycle l) () let rec cycle l () = append l (cycle l) ()
let rec iterate f a () = Cons (a, iterate f (f a)) let rec iterate f a () = Cons (a, iterate f (f a))
let rec unfold f acc () = let rec unfold f acc () =
@ -213,23 +206,28 @@ let rec exists p l =
let rec find p l = let rec find p l =
match l () with match l () with
| Nil -> None | Nil -> None
| Cons (x, tl) -> | Cons (x, tl) ->
if p x then Some x else find p tl if p x then
Some x
else
find p tl
let rec find_map f l = let rec find_map f l =
match l () with match l () with
| Nil -> None | Nil -> None
| Cons (x, tl) -> | Cons (x, tl) ->
match f x with (match f x with
| None -> find_map f tl | None -> find_map f tl
| e -> e | 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 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 () = let rec flat_map f l () =
match l () with match l () with
@ -267,7 +265,6 @@ let product_with f l1 l2 =
_next_left [] l1 [] l2 _next_left [] l1 [] l2
let map_product = product_with let map_product = product_with
let product l1 l2 = product_with (fun x y -> x, y) l1 l2 let product l1 l2 = product_with (fun x y -> x, y) l1 l2
let rec group eq l () = let rec group eq l () =
@ -297,7 +294,6 @@ let rec filter_map f l () =
| Some y -> Cons (y, filter_map f l')) | Some y -> Cons (y, filter_map f l'))
let flatten l = flat_map (fun x -> x) l let flatten l = flat_map (fun x -> x) l
let concat = flatten let concat = flatten
let range i j = let range i j =

View file

@ -13,18 +13,9 @@ type 'a printer = Format.formatter -> 'a -> unit
(** {2 Basics} *) (** {2 Basics} *)
[@@@ifge 4.07]
include module type of Seq include module type of Seq
(** @inline *) (** @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 nil : 'a t
val empty : 'a t val empty : 'a t
val cons : 'a -> 'a t -> '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 *) @since 3.10 *)
val flat_map : ('a -> 'b t) -> 'a t -> 'b t val flat_map : ('a -> 'b t) -> 'a t -> 'b t
val concat_map : ('a -> 'b t) -> 'a t -> 'b t val concat_map : ('a -> 'b t) -> 'a t -> 'b t
(** Alias of {!flat_map} (** Alias of {!flat_map}
@since 3.10 *) @since 3.10 *)
val filter_map : ('a -> 'b option) -> 'a t -> 'b t val filter_map : ('a -> 'b option) -> 'a t -> 'b t
val flatten : 'a t t -> 'a t val flatten : 'a t t -> 'a t
val concat : 'a t t -> 'a t val concat : 'a t t -> 'a t
(** Alias of {!flatten}. (** Alias of {!flatten}.
@since 3.10 *) @since 3.10 *)

View file

@ -2,7 +2,7 @@
(** {1 Simple S-expression parsing/printing} *) (** {1 Simple S-expression parsing/printing} *)
open CCShims_
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

View file

@ -1,5 +1,4 @@
{ {
open CCShims_
type token = type token =
| ATOM of string | ATOM of string
| LIST_OPEN | LIST_OPEN

View file

@ -1,9 +0,0 @@
[@@@ifge 4.07]
module Stdlib = Stdlib
[@@@else_]
module Stdlib = Pervasives
[@@@endif]

View file

@ -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]

View file

@ -2,8 +2,6 @@
(** {1 Basic String Utils} *) (** {1 Basic String Utils} *)
open CCShims_
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option 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 let right ~by s = try Some (right_exn ~by s) with Not_found -> None
end 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 split ~by s = Split.list_cpy ~by s
let compare_versions a b = let compare_versions a b =
@ -979,10 +969,10 @@ let pp fmt s = Format.fprintf fmt "\"%s\"" s
module Infix = struct module Infix = struct
let ( = ) = equal let ( = ) = equal
let ( <> ) a b = not (equal a b) let ( <> ) a b = not (equal a b)
let ( > ) : t -> t -> bool = CCShims_.Stdlib.( > ) let ( > ) : t -> t -> bool = Stdlib.( > )
let ( >= ) : t -> t -> bool = CCShims_.Stdlib.( >= ) let ( >= ) : t -> t -> bool = Stdlib.( >= )
let ( < ) : t -> t -> bool = CCShims_.Stdlib.( < ) let ( < ) : t -> t -> bool = Stdlib.( < )
let ( <= ) : t -> t -> bool = CCShims_.Stdlib.( <= ) let ( <= ) : t -> t -> bool = Stdlib.( <= )
end end
include Infix include Infix

View file

@ -1,13 +1 @@
[@@@ifge 4.08]
include Unit include Unit
[@@@else_]
type t = unit
let[@inline] equal (_ : t) (_ : t) = true
let[@inline] compare (_ : t) (_ : t) = 0
let to_string () = "()"
[@@@endif]

View file

@ -4,7 +4,7 @@
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 *)
open CCShims_
type uchar = Uchar.t type uchar = Uchar.t
type 'a gen = unit -> 'a option type 'a gen = unit -> 'a option

View file

@ -671,11 +671,7 @@ let pp ?(pp_start = fun _ () -> ()) ?(pp_stop = fun _ () -> ())
v; v;
pp_stop fmt () pp_stop fmt ()
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2 let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]

View file

@ -397,8 +397,6 @@ val pp :
By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to
(fun out -> Format.fprintf out ",@ "). *) (fun out -> Format.fprintf out ",@ "). *)
[@@@ifge 4.08]
val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t val ( let+ ) : ('a, 'e) t -> ('a -> 'b) -> ('b, 'e) t
(** @since 2.8 *) (** @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 val ( and* ) : ('a, 'e) t -> ('b, 'e) t -> ('a * 'b, 'e) t
(** @since 2.8 *) (** @since 2.8 *)
[@@@endif]

View file

@ -55,5 +55,5 @@ module Atomic = CCAtomic
module Sexp = CCSexp module Sexp = CCSexp
module Sexp_intf = CCSexp_intf module Sexp_intf = CCSexp_intf
module Canonical_sexp = CCCanonical_sexp module Canonical_sexp = CCCanonical_sexp
module Stdlib = CCShims_.Stdlib module Stdlib = Stdlib
include Monomorphic include Monomorphic

View file

@ -52,5 +52,5 @@ module Monomorphic = CCMonomorphic
module Utf8_string = CCUtf8_string module Utf8_string = CCUtf8_string
module Sexp = CCSexp module Sexp = CCSexp
module Sexp_intf = CCSexp_intf module Sexp_intf = CCSexp_intf
module Stdlib = CCShims_.Stdlib module Stdlib = Stdlib
include Monomorphic include Monomorphic

View file

@ -2,7 +2,6 @@
(name containers) (name containers)
(public_name containers) (public_name containers)
(wrapped false) (wrapped false)
(modules_without_implementation CCShims_syntax)
(preprocess (preprocess
(action (action
(run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))

View file

@ -24,7 +24,7 @@ let uniformity_test ?(size_hint = 10) k rng st =
let confidence = 4. in let confidence = 4. in
let std = confidence *. sqrt (kf *. variance) in let std = confidence *. sqrt (kf *. variance) in
let predicate _key n acc = 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 acc && abs_float (average -. float_of_int n) < std
in in
Hashtbl.fold predicate histogram true Hashtbl.fold predicate histogram true

View file

@ -3,5 +3,5 @@
(public_name containers-data) (public_name containers-data)
(wrapped false) (wrapped false)
(flags :standard -warn-error -3 -w -70 -color always -safe-string (flags :standard -warn-error -3 -w -70 -color always -safe-string
-strict-sequence -open CCShims_) -strict-sequence)
(libraries containers)) (libraries containers))

View file

@ -1,12 +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. *)
[@@@ifge 4.07]
[@@@else_]
module Stdlib = Pervasives
[@@@endif]
let ( = ) : int -> int -> bool = Stdlib.( = ) let ( = ) : int -> int -> bool = Stdlib.( = )
let ( <> ) : int -> int -> bool = Stdlib.( <> ) let ( <> ) : int -> int -> bool = Stdlib.( <> )
let ( < ) : int -> int -> bool = Stdlib.( < ) let ( < ) : int -> int -> bool = Stdlib.( < )

View file

@ -31,19 +31,9 @@ module Test = struct
in in
Printf.sprintf "(test :file '%s'%s :n %d)" self.__FILE__ what self.n 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 = let get_state (r : _ QCheck.TestResult.t) : _ QCheck.TestResult.state =
QCheck.TestResult.get_state r 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 = let run ?(long = false) ~seed (self : t) : _ result =
match match
let what = CCOption.map_or ~default:"" (fun s -> s ^ " ") self.name in let what = CCOption.map_or ~default:"" (fun s -> s ^ " ") self.name in

View file

@ -518,15 +518,10 @@ module Make (P : PARAM) = struct
let ( >> ) a f = and_then a f let ( >> ) a f = and_then a f
let ( >|= ) a f = map f a let ( >|= ) a f = map f a
let ( <*> ) = app let ( <*> ) = app
[@@@ifge 4.8]
let ( let+ ) = ( >|= ) let ( let+ ) = ( >|= )
let ( let* ) = ( >>= ) let ( let* ) = ( >>= )
let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2 let[@inline] ( and+ ) a1 a2 = monoid_product (fun x y -> x, y) a1 a2
let ( and* ) = ( and+ ) let ( and* ) = ( and+ )
[@@@endif]
end end
include Infix include Infix

View file

@ -148,14 +148,10 @@ module Make (P : PARAM) : sig
val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t val ( >> ) : 'a t -> (unit -> 'b t) -> 'b t
val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t val ( >|= ) : 'a t -> ('a -> 'b) -> 'b t
val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t
val ( let+ ) : 'a t -> ('a -> 'b) -> 'b t
[@@@ifge 4.08] val ( and+ ) : 'a t -> 'b t -> ('a * 'b) t
val ( let* ) : 'a t -> ('a -> 'b t) -> 'b t
include CCShims_syntax.LET with type 'a t := 'a t val ( and* ) : 'a t -> 'b t -> ('a * 'b) t
(** Let operators on OCaml >= 4.08.0, nothing otherwise
@since 2.8 *)
[@@@endif]
end end
include module type of Infix include module type of Infix

View file

@ -3,7 +3,7 @@
(public_name containers-thread) (public_name containers-thread)
(wrapped false) (wrapped false)
(optional) (optional)
(flags :standard -warn-error -a+8 -w -32 -safe-string -open CCShims_) (flags :standard -warn-error -a+8 -w -32 -safe-string)
(preprocess (preprocess
(action (action
(run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) (run %{project_root}/src/core/cpp/cpp.exe %{input-file})))

View file

@ -1,7 +1,5 @@
let verbose = try Sys.getenv "VERBOSE" = "1" with _ -> false let verbose = try Sys.getenv "VERBOSE" = "1" with _ -> false
[@@@ifge 4.08]
module J = Yojson.Safe module J = Yojson.Safe
module Fmt = CCFormat module Fmt = CCFormat
module Cbor = Containers_cbor module Cbor = Containers_cbor
@ -174,5 +172,3 @@ let () =
(*Format.printf "tests: %a@." (Fmt.Dump.list Test.pp) tests;*) (*Format.printf "tests: %a@." (Fmt.Dump.list Test.pp) tests;*)
run_tests tests; run_tests tests;
() ()
[@@@endif]

View file

@ -1,8 +1,6 @@
include (val Containers_testlib.make ~__FILE__ ()) include (val Containers_testlib.make ~__FILE__ ())
module Cbor = Containers_cbor module Cbor = Containers_cbor
[@@@ifge 4.08]
let gen_c : Cbor.t Q.Gen.t = let gen_c : Cbor.t Q.Gen.t =
let open Q.Gen in let open Q.Gen in
sized @@ fix sized @@ fix
@ -110,5 +108,3 @@ if not (c = c') then
Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]" Q.Test.fail_reportf "@[<hv2>roundtrip failed:@ from %a@ to %a@]"
Cbor.pp_diagnostic c Cbor.pp_diagnostic c'; Cbor.pp_diagnostic c Cbor.pp_diagnostic c';
true true
[@@@endif]

View file

@ -1,97 +1,158 @@
open CCFormat open CCFormat
module T = (val Containers_testlib.make ~__FILE__ ()) module T = (val Containers_testlib.make ~__FILE__ ())
include T;; include T
let to_string_test s = CCFormat.sprintf_no_color "@[<h>%a@]%!" s ();; 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
eq ~printer:(fun s->CCFormat.sprintf "%S" s) ", " (to_string_test (return ",@ "));; ~printer:(fun s -> CCFormat.sprintf "%S" s)
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "and then" (to_string_test (return "@{<Red>and then@}@,"));; "a b"
eq ~printer:(fun s->CCFormat.sprintf "%S" s) "a b" (to_string_test (return "@[<h>a@ b@]"));; (to_string_test (return "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
;; ;;
[@@@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 () -> t @@ fun () ->
set_color_default true; let buf1 = Buffer.create 42 in
let s = sprintf let buf2 = Buffer.create 42 in
"what is your @{<White>favorite color@}? @{<blue>blue@}! No, @{<red>red@}! Ahhhhhhh@." let f1 = Format.formatter_of_buffer buf1 in
in let f2 = Format.formatter_of_buffer buf2 in
assert_equal ~printer:CCFun.id let fmt = tee f1 f2 in
"what is your \027[37;1mfavorite color\027[0m? \027[34mblue\027[0m! No, \027[31mred\027[0m! Ahhhhhhh\n" Format.fprintf fmt "coucou@.";
s; assert_equal ~printer:CCFun.id "coucou\n" (Buffer.contents buf1);
true;; 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 "yolo %s %d" "a b" 42 = "yolo a b 42";;
t @@ fun () -> sprintf "%d " 0 = "0 ";; t @@ fun () -> sprintf "%d " 0 = "0 ";;
t @@ fun () -> sprintf_no_color "%d " 0 = "0 ";; t @@ fun () -> sprintf_no_color "%d " 0 = "0 ";;
t @@ fun () -> t @@ fun () ->
set_color_default true; set_color_default true;
assert_equal "\027[31myolo\027[0m" (sprintf "@{<red>yolo@}"); assert_equal "\027[31myolo\027[0m" (sprintf "@{<red>yolo@}");
assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}"); assert_equal "yolo" (sprintf_no_color "@{<red>yolo@}");
true;; true
;;
eq ~printer:CCFormat.(to_string (opt string)) eq
~printer:CCFormat.(to_string (opt string))
(Some "hello world") (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
eq ~printer:(fun s->s) "Some 1" (to_string Dump.(option int) (Some 1));; ~printer:(fun s -> s)
eq ~printer:(fun s->s) "[None;Some \"a b\"]" (to_string Dump.(list (option string)) [None; Some "a b"]);; "[None;Some \"a b\"]"
eq ~printer:(fun s->s) "[(Ok \"a b c\");(Error \"nope\")]" (to_string Dump.(list (option string)) [ None; Some "a b" ])
(to_string Dump.(list (result string)) [Ok "a b c"; Error "nope"]);; ;;
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"

View file

@ -1,7 +1,7 @@
module T = (val Containers_testlib.make ~__FILE__ ()) module T = (val Containers_testlib.make ~__FILE__ ())
include T include T
open CCString open CCString
open CCShims_.Stdlib;; .Stdlib;;
q Q.printable_string (fun s -> s = rev (rev s));; q Q.printable_string (fun s -> s = rev (rev s));;
q Q.printable_string (fun s -> length s = length (rev s));; q Q.printable_string (fun s -> length s = length (rev s));;