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)
(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))

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -4,7 +4,7 @@ include Atomic
[@@@else_]
open CCShims_.Stdlib (* for == *)
open Stdlib (* for == *)
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. *)
open CCShims_
type t = bool

View file

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

View file

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

View file

@ -2,7 +2,7 @@
(** {1 Equality Combinators} *)
open CCShims_
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. *)
open CCShims_
type t = float

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -2,7 +2,7 @@
(** {1 Comparisons} *)
open CCShims_
type 'a t = 'a -> 'a -> 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
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 *);
}

View file

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

View file

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

View file

@ -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} *)

View file

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

View file

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

View file

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

View file

@ -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 *)

View file

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

View file

@ -1,5 +1,4 @@
{
open CCShims_
type token =
| ATOM of string
| 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} *)
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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

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

View file

@ -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})))

View 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

View file

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

View file

@ -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.( < )

View file

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

View file

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

View file

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

View file

@ -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})))

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

View file

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

View file

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

View file

@ -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));;