diff --git a/.github/workflows/compat.yml b/.github/workflows/compat.yml new file mode 100644 index 00000000..b626372f --- /dev/null +++ b/.github/workflows/compat.yml @@ -0,0 +1,38 @@ + +name: compat + +on: + push: + branches: + - master + pull_request: + branches: + - master + +jobs: + run: + name: build + strategy: + fail-fast: true + matrix: + os: + - ubuntu-latest + ocaml-compiler: + - '4.03.x' + - '4.06.x' + - '4.07.x' + - '4.08.x' + - '4.13.x' + + runs-on: ${{ matrix.os }} + steps: + - uses: actions/checkout@v2 + - name: Use OCaml ${{ matrix.ocaml-compiler }} + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: ${{ matrix.ocaml-compiler }} + + - run: opam pin -n . + - run: opam depext -y containers containers-data containers-thread + - run: opam install containers containers-data containers-thread --deps-only + - run: opam exec -- dune build '@install' diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 700f1de6..c3c77594 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -1,4 +1,4 @@ -name: Build and test +name: build and test on: push: @@ -10,9 +10,9 @@ on: jobs: run: - name: Build + name: build strategy: - fail-fast: false + fail-fast: true matrix: os: - macos-latest @@ -20,7 +20,6 @@ jobs: - windows-latest ocaml-compiler: - '4.03.x' - - '4.08.x' - '4.13.x' runs-on: ${{ matrix.os }} @@ -39,11 +38,11 @@ jobs: if: matrix.os == 'ubuntu-latest' - run: | - opam install -t containers --deps-only + opam install -t containers --deps-only ; opam install containers-data containers-thread --deps-only # no test deps if: matrix.os != 'ubuntu-latest' - - run: opam exec -- dune build + - run: opam exec -- dune build '@install' - run: opam exec -- dune runtest if: ${{ matrix.os == 'ubuntu-latest' }} diff --git a/benchs/dune b/benchs/dune index ff3ac80f..c8430fc7 100644 --- a/benchs/dune +++ b/benchs/dune @@ -4,5 +4,6 @@ containers-thread benchmark gen iter qcheck oseq batteries base sek) (flags :standard -warn-error -3-5 -safe-string -color always -open CCShims_) + (optional) (ocamlopt_flags :standard -O3 -color always -unbox-closures -unbox-closures-factor 20)) diff --git a/containers-data.opam b/containers-data.opam index 202f4899..c30d80d4 100644 --- a/containers-data.opam +++ b/containers-data.opam @@ -11,7 +11,7 @@ build: [ ] depends: [ "ocaml" { >= "4.03.0" } - "dune" { >= "1.4" } + "dune" { >= "2.0" } "containers" { = version } "seq" "qtest" { with-test } diff --git a/containers-thread.opam b/containers-thread.opam index d4c32535..6af5aaf7 100644 --- a/containers-thread.opam +++ b/containers-thread.opam @@ -11,7 +11,7 @@ build: [ ] depends: [ "ocaml" { >= "4.03.0" } - "dune" { >= "1.4" } + "dune" { >= "2.0" } "base-threads" "dune-configurator" "containers" { = version } diff --git a/containers.opam b/containers.opam index 4330b193..59be282c 100644 --- a/containers.opam +++ b/containers.opam @@ -12,7 +12,7 @@ build: [ ] depends: [ "ocaml" { >= "4.03.0" } - "dune" { >= "1.4" } + "dune" { >= "2.0" } "dune-configurator" "seq" # compat "either" # compat diff --git a/dune b/dune index f8d56234..655216a2 100644 --- a/dune +++ b/dune @@ -1,9 +1,12 @@ (rule (targets README.md.corrected) (deps (package containers-data) ./src/mdx_runner.exe) + (enabled_if (= %{system} "linux")) (action (run ./src/mdx_runner.exe))) -(alias - (name runtest) +(rule + (alias runtest) (package containers-data) + (enabled_if (= %{system} "linux")) + (locks /ctest) (action (diff README.md README.md.corrected))) diff --git a/dune-project b/dune-project index f9337290..929c696e 100644 --- a/dune-project +++ b/dune-project @@ -1 +1 @@ -(lang dune 1.4) +(lang dune 2.0) diff --git a/examples/dune b/examples/dune index 13b6e613..e8ed9dc0 100644 --- a/examples/dune +++ b/examples/dune @@ -4,16 +4,16 @@ (libraries containers) (flags :standard -warn-error -a+8)) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (deps (source_tree test_data)) (action (ignore-stdout (run ./id_sexp.exe test_data/benchpress.sexp)))) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (deps (source_tree test_data)) (action @@ -30,8 +30,8 @@ (enabled_if (< %{ocaml_version} "4.08")) (action (with-stdout-to %{targets} (run echo "let() = print_endline {|ok|}")))) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (deps (source_tree test_data)) (enabled_if (>= %{ocaml_version} "4.08")) diff --git a/fuzz/dune b/fuzz/dune index 5f57001d..11342443 100644 --- a/fuzz/dune +++ b/fuzz/dune @@ -3,4 +3,5 @@ (names ccsexp_parse_string_does_not_crash ccutf8_string_uchar_to_bytes_is_same_as_simple_version ccsexp_csexp_reparse) + (optional) (libraries crowbar containers)) diff --git a/qtest/dune b/qtest/dune index 5775f212..f55c6a09 100644 --- a/qtest/dune +++ b/qtest/dune @@ -6,8 +6,8 @@ (rule (targets run_qtest.ml) - (deps make.bc (source_tree ../src)) - (action (run ./make.bc -target %{targets} ../src/core ../src/unix/))) + (deps ./make.exe (source_tree ../src)) + (action (run ./make.exe -target %{targets} ../src/core ../src/unix/))) (executable (name run_qtest) @@ -17,16 +17,16 @@ (flags :standard -warn-error -a -w -3-33-35-27-39-50) (libraries iter gen qcheck containers containers.unix unix uutf threads)) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (package containers) (action (run ./run_qtest.exe))) (rule (targets run_qtest_data.ml) - (deps make.bc (source_tree ../src/data)) - (action (run ./make.bc -target %{targets} ../src/data))) + (deps make.exe (source_tree ../src/data)) + (action (run ./make.exe -target %{targets} ../src/data))) (executable (name run_qtest_data) @@ -36,16 +36,16 @@ (flags :standard -warn-error -a -w -3-33-35-27-39-50) (libraries iter gen qcheck containers containers-data)) -(alias - (name runtest) +(rule + (alias runtest) (package containers-data) (locks /ctest) (action (run ./run_qtest_data.exe))) (rule (targets run_qtest_thread.ml) - (deps make.bc (source_tree ../src/threads)) - (action (run ./make.bc -target %{targets} ../src/threads))) + (deps make.exe (source_tree ../src/threads)) + (action (run ./make.exe -target %{targets} ../src/threads))) (executable (name run_qtest_thread) @@ -55,8 +55,8 @@ (flags :standard -warn-error -a -w -3-33-35-27-39-50) (libraries qcheck containers containers-thread iter threads)) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (package containers-thread) (action (run ./run_qtest_thread.exe))) diff --git a/qtest/make.ml b/qtest/make.ml index bb4cb540..5c63c9d3 100644 --- a/qtest/make.ml +++ b/qtest/make.ml @@ -18,11 +18,11 @@ let is_code file = is_suffix ~sub:".ml" file || is_suffix ~sub:".mli" file let do_not_test file = assert (not (is_suffix ~sub:"make.ml" file)); str_sub ~sub:"Labels.ml" file || + is_suffix ~sub:".pp.ml" file || + is_suffix ~sub:".pp.mli" file || is_suffix ~sub:"containers.ml" file || is_suffix ~sub:"_top.ml" file || - is_suffix ~sub:"mkflags.ml" file || - is_suffix ~sub:"mkshims.ml" file || - is_suffix ~sub:"unlabel.ml" file || + is_suffix ~sub:"cpp.ml" file || is_suffix ~sub:"check_labelled_mods.ml" file || is_suffix ~sub:"test_random.ml" file || is_suffix ~sub:"test_hash.ml" file || diff --git a/src/codegen/tests/dune b/src/codegen/tests/dune index 320af55e..4aeb4c37 100644 --- a/src/codegen/tests/dune +++ b/src/codegen/tests/dune @@ -19,6 +19,6 @@ (flags :standard -warn-error -a+8) (libraries containers)) -(alias - (name runtest) +(rule + (alias runtest) (action (run ./test_bitfield.exe))) diff --git a/src/core/CCArray.ml b/src/core/CCArray.ml index 09a8af01..87a439d7 100644 --- a/src/core/CCArray.ml +++ b/src/core/CCArray.ml @@ -16,8 +16,24 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) -include CCShims_ -include CCShimsArray_ +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 = [| |] @@ -704,12 +720,15 @@ module Infix = struct let (--) = (--) let (--^) = (--^) - include CCShimsMkLet_.Make(struct - type 'a t = 'a array - let (>>=) = (>>=) - let (>|=) = (>|=) - let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2 - end) + [@@@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 diff --git a/src/core/CCArray.mli b/src/core/CCArray.mli index 99590017..34f95264 100644 --- a/src/core/CCArray.mli +++ b/src/core/CCArray.mli @@ -14,8 +14,31 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) -include module type of CCShimsArray_ -(** @inline *) +[@@@ifge 4.8] + +include module type of Array +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) + +[@@@elifge 4.6] + +include module type of Array +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) + +type 'a t = 'a array + +[@@@else_] + +include module type of Array +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) + +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 [[||]]. *) @@ -294,10 +317,14 @@ 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 *) - include CCShimsMkLet_.S with type 'a t_let := 'a array + + [@@@endif] end include module type of Infix diff --git a/src/core/CCArrayLabels.mli b/src/core/CCArrayLabels.mli index c385c721..8be4f679 100644 --- a/src/core/CCArrayLabels.mli +++ b/src/core/CCArrayLabels.mli @@ -14,8 +14,32 @@ type 'a printer = Format.formatter -> 'a -> unit (** {2 Arrays} *) -include module type of CCShimsArrayLabels_ -(** @inline *) +[@@@ifge 4.8] + + +include module type of ArrayLabels with module Floatarray = Array.Floatarray +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) + +[@@@elifge 4.6] + +include module type of ArrayLabels with module Floatarray = Array.Floatarray +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) + +type 'a t = 'a array + +[@@@else_] + +include module type of ArrayLabels +(** {{: http://caml.inria.fr/pub/docs/manual-ocaml/libref/ArrayLabels.html} Documentation for the standard ArrayLabels module}*) + +module Floatarray = CCArray.Floatarray +type 'a t = 'a array +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) + +[@@@endif] val empty : 'a t (** [empty] is the empty array, physically equal to [||]. *) @@ -310,10 +334,14 @@ 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 *) - include CCShimsMkLet_.S with type 'a t_let := 'a array + + [@@@endif] end include module type of Infix diff --git a/src/core/CCAtomic.ml b/src/core/CCAtomic.ml new file mode 100644 index 00000000..dbdc8061 --- /dev/null +++ b/src/core/CCAtomic.ml @@ -0,0 +1,35 @@ + +[@@@ifge 4.12] + +include Atomic + + +[@@@else_] + +open CCShims_.Stdlib (* for == *) + +type 'a t = {mutable x: 'a} +let[@inline] make x = {x} +let[@inline] get {x} = x +let[@inline] set r x = r.x <- x +let[@inline] exchange r x = + let y = r.x in + r.x <- x; + y + +let[@inline] compare_and_set r seen v = + if r.x == seen then ( + r.x <- v; + true + ) else false + +let[@inline] fetch_and_add r x = + let v = r.x in + r.x <- x + r.x; + v + +let[@inline] incr r = r.x <- 1 + r.x +let[@inline] decr r = r.x <- r.x - 1 + + +[@@@endif] diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml index 192a9597..18783909 100644 --- a/src/core/CCFormat.ml +++ b/src/core/CCFormat.ml @@ -362,18 +362,45 @@ let mark_close_tag st ~or_else s = if !color_enabled then string_of_style_list style else "" | exception No_such_style -> or_else s +[@@@ifge 4.8] + + +let pp_open_tag out s = pp_open_stag out (String_tag s) +let pp_close_tag out () = pp_close_stag out () + +[@@@ocaml.warning "-3"] +let pp_get_formatter_tag_functions = pp_get_formatter_tag_functions +let pp_set_formatter_tag_functions = pp_set_formatter_tag_functions + +let update_tag_funs_ funs f1 f2 = + { funs with + mark_open_tag = f1 ~or_else:funs.mark_open_tag; + mark_close_tag = f2 ~or_else:funs.mark_close_tag; + } + +[@@@ocaml.warning "+3"] + +[@@@else_] + +let update_tag_funs_ funs f1 f2 = + { funs with + mark_open_tag = f1 funs.mark_open_tag; + mark_close_tag = f2 funs.mark_close_tag; + } + +[@@@endif] + (* add color handling to formatter [ppf] *) let set_color_tag_handling ppf = - let open Format in - let functions = CCShimsFormat_.pp_get_formatter_tag_functions ppf () in + let functions = pp_get_formatter_tag_functions ppf () in let st = Stack.create () in (* stack of styles *) let functions' = - CCShimsFormat_.cc_update_funs functions + update_tag_funs_ functions (mark_open_tag st) (mark_close_tag st) in pp_set_mark_tags ppf true; (* enable tags *) - CCShimsFormat_.pp_set_formatter_tag_functions ppf functions' + pp_set_formatter_tag_functions ppf functions' let set_color_default = let first = ref true in @@ -398,14 +425,14 @@ let set_color_default = *) let with_color s pp out x = - CCShimsFormat_.pp_open_tag out s; + pp_open_tag out s; pp out x; - CCShimsFormat_.pp_close_tag out () + pp_close_tag out () let with_colorf s out fmt = - CCShimsFormat_.pp_open_tag out s; + pp_open_tag out s; Format.kfprintf - (fun out -> CCShimsFormat_.pp_close_tag out ()) + (fun out -> pp_close_tag out ()) out fmt (* c: whether colors are enabled *) @@ -422,10 +449,10 @@ let with_color_ksf ~f s fmt = let buf = Buffer.create 64 in let out = Format.formatter_of_buffer buf in if !color_enabled then set_color_tag_handling out; - CCShimsFormat_.pp_open_tag out s; + pp_open_tag out s; Format.kfprintf (fun out -> - CCShimsFormat_.pp_close_tag out (); + pp_close_tag out (); Format.pp_print_flush out (); f (Buffer.contents buf)) out fmt diff --git a/src/core/CCFun.ml b/src/core/CCFun.ml index ea7c3322..9424c667 100644 --- a/src/core/CCFun.ml +++ b/src/core/CCFun.ml @@ -9,7 +9,27 @@ let opaque_identity x = x include Sys include CCShims_.Stdlib -include CCShimsFun_ + +[@@@ifge 4.8] + +include Fun + +[@@@else_] + +external id : 'a -> 'a = "%identity" +let[@inline] flip f x y = f y x +let[@inline] const x _ = x +let[@inline] negate f x = not (f x) +let[@inline] protect ~finally f = + try + let x= f() in + finally(); + x + with e -> + finally(); + raise e + +[@@@endif] let compose f g x = g (f x) diff --git a/src/core/CCFun.mli b/src/core/CCFun.mli index 83b98328..4ba8fb2f 100644 --- a/src/core/CCFun.mli +++ b/src/core/CCFun.mli @@ -3,9 +3,24 @@ (** Basic operations on Functions *) -include module type of CCShimsFun_ +[@@@ifge 4.8] +include module type of Fun (** @inline *) +[@@@else_] + +(** This is an API imitating the new standard Fun module *) +external id : 'a -> 'a = "%identity" +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. *) diff --git a/src/core/CCInt.ml b/src/core/CCInt.ml index 191a44ed..8f2e38f6 100644 --- a/src/core/CCInt.ml +++ b/src/core/CCInt.ml @@ -1,9 +1,17 @@ (* This file is free software, part of containers. See file "license" for more details. *) -open CCShims_ +[@@@ifge 4.07] +[@@@else_] -include CCShimsInt_ +module Stdlib = Pervasives +[@@@endif] + +[@@@ifge 4.08] + +include Int + +[@@@endif] type t = int type 'a iter = ('a -> unit) -> unit diff --git a/src/core/CCInt.mli b/src/core/CCInt.mli index 182a51df..d430f07b 100644 --- a/src/core/CCInt.mli +++ b/src/core/CCInt.mli @@ -3,8 +3,14 @@ (** Basic Int functions *) -include module type of CCShimsInt_ -(** @inline *) +[@@@ifge 4.08] + +include module type of Int +(** @inline + + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Int.html} Documentation for the standard Int module}*) + +[@@@endif] type t = int diff --git a/src/core/CCList.ml b/src/core/CCList.ml index a371b964..aa777a27 100644 --- a/src/core/CCList.ml +++ b/src/core/CCList.ml @@ -66,7 +66,16 @@ let rec assq_opt x = function (* end of backport *) -include CCShimsList_ +[@@@ifge 4.8] + +include List + +[@@@else_] + +include List +type +'a t = 'a list + +[@@@endif] let empty = [] @@ -1992,16 +2001,16 @@ module Infix = struct let (--) = (--) let (--^) = (--^) - include CCShimsMkLet_.Make(struct - type 'a t = 'a list - let (>|=) = (>|=) - let (>>=) = (>>=) - let[@inline] monoid_product l1 l2 = product (fun x y -> x,y) l1 l2 - end) + [@@@ifge 4.8] - include CCShimsMkLetList_.Make(struct - let combine_shortest=combine_shortest - end) + 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 diff --git a/src/core/CCList.mli b/src/core/CCList.mli index 034b8a31..bda8c72b 100644 --- a/src/core/CCList.mli +++ b/src/core/CCList.mli @@ -11,10 +11,23 @@ type 'a gen = unit -> 'a option type 'a printer = Format.formatter -> 'a -> unit type 'a random_gen = Random.State.t -> 'a -include module type of List -(** {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html} Documentation for the standard List module}*) +[@@@ifge 4.8] -type 'a t = 'a list +include module type of List with type 'a t := 'a list +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html} Documentation for the standard List module}*) + +type +'a t = 'a list + +[@@@else_] + +include module type of List +(** @inline + {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/List.html} Documentation for the standard List module}*) + +type +'a t = 'a list + +[@@@endif] val empty : 'a t (** [empty] is [[]]. *) @@ -925,13 +938,29 @@ module Infix : sig (** [i --^ j] is the infix alias for [range']. Second bound [j] excluded. @since 0.17 *) - (** Let operators on OCaml >= 4.08.0, nothing otherwise - @since 2.8 - @inline *) - include CCShimsMkLet_.S with type 'a t_let := 'a list + [@@@ifge 4.08] - include CCShimsMkLetList_.S + include CCShims_syntax.LET with type 'a t := 'a t (** @inline *) + + val (and&) : 'a list -> 'b list -> ('a * 'b) list + (** [(and&)] is {!combine_shortest}. + It allows to perform a synchronized product between two lists, + stopping gently at the shortest. Usable both with [let+] and [let*]. + {[ + # let f xs ys zs = + let+ x = xs + and& y = ys + and& z = zs in + x + y + z;; + val f : int list -> int list -> int list -> int list = + # f [1;2] [5;6;7] [10;10];; + - : int list = [16; 18] + ]} + @since 3.1 + *) + + [@@@endif] end include module type of Infix diff --git a/src/core/CCListLabels.mli b/src/core/CCListLabels.mli index ef937b2e..6b85dfdf 100644 --- a/src/core/CCListLabels.mli +++ b/src/core/CCListLabels.mli @@ -852,38 +852,7 @@ val of_gen : 'a gen -> 'a t @since 0.16 *) -module Infix : sig - val (>|=) : 'a t -> ('a -> 'b) -> 'b t - (** [l >|= f] is the infix version of [map] with reversed arguments. *) - - val (@) : 'a t -> 'a t -> 'a t - (** [l1 @ l2] concatenates two lists [l1] and [l2]. - As {!append}. *) - - val (<*>) : ('a -> 'b) t -> 'a t -> 'b t - (** [funs <*> l] is [product (fun f x -> f x) funs l]. *) - - val (<$>) : ('a -> 'b) -> 'a t -> 'b t - (** [f <$> l] is like {!map}. *) - - val (>>=) : 'a t -> ('a -> 'b t) -> 'b t - (** [l >>= f] is [flat_map f l]. *) - - val (--) : int -> int -> int t - (** [i -- j] is the infix alias for [range]. Bounds included. *) - - val (--^) : int -> int -> int t - (** [i --^ j] is the infix alias for [range']. Second bound [j] excluded. - @since 0.17 *) - - (** Let operators on OCaml >= 4.08.0, nothing otherwise - @since 2.8 - @inline *) - include CCShimsMkLet_.S with type 'a t_let := 'a list - - include CCShimsMkLetList_.S - (** @inline *) -end +module Infix : module type of CCList.Infix include module type of Infix diff --git a/src/core/CCOption.ml b/src/core/CCOption.ml index 327278f4..81a522ca 100644 --- a/src/core/CCOption.ml +++ b/src/core/CCOption.ml @@ -176,14 +176,16 @@ module Infix = struct let (<$>) = map let (<+>) = (<+>) - include CCShimsMkLet_.Make(struct - type 'a t = 'a option - let (>|=) = (>|=) - let (>>=) = (>>=) - let[@inline] monoid_product o1 o2 = match o1, o2 with - | Some x, Some y -> Some (x,y) - | _ -> None - end) + [@@@ifge 4.8] + + let (let+) = (>|=) + let (let*) = (>>=) + let[@inline] (and+) o1 o2 = match o1, o2 with + | Some x, Some y -> Some (x,y) + | _ -> None + let (and*) = (and+) + + [@@@endif] end include Infix diff --git a/src/core/CCOption.mli b/src/core/CCOption.mli index 81b8884c..0c46ddbf 100644 --- a/src/core/CCOption.mli +++ b/src/core/CCOption.mli @@ -171,11 +171,15 @@ 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 *) - include CCShimsMkLet_.S with type 'a t_let := 'a option + + [@@@endif] end include module type of Infix diff --git a/src/core/CCParse.ml b/src/core/CCParse.ml index 0d33f9ea..5849a6ac 100644 --- a/src/core/CCParse.ml +++ b/src/core/CCParse.ml @@ -355,12 +355,14 @@ module Infix = struct let (|||) = both let[@inline] () p msg = set_error_message msg p - include CCShimsMkLet_.Make(struct - type nonrec 'a t = 'a t - let (>>=) = (>>=) - let (>|=) = (>|=) - let monoid_product = both - end) + [@@@ifge 4.8] + + let (let+) = (>|=) + let (let*) = (>>=) + let (and+) = both + let (and*) = (and+) + + [@@@endif] end include Infix diff --git a/src/core/CCParse.mli b/src/core/CCParse.mli index 86d59a9d..f34bc00a 100644 --- a/src/core/CCParse.mli +++ b/src/core/CCParse.mli @@ -665,10 +665,14 @@ 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 *) - include CCShimsMkLet_.S with type 'a t_let := 'a t + + [@@@endif] end include module type of Infix diff --git a/src/core/CCRandom.ml b/src/core/CCRandom.ml index 0f24d77b..c1567b65 100644 --- a/src/core/CCRandom.ml +++ b/src/core/CCRandom.ml @@ -196,12 +196,14 @@ let pure x _st = x let (<*>) f g st = f st (g st) -include CCShimsMkLet_.Make(struct - type nonrec 'a t = 'a t - let (>>=) = (>>=) - let (>|=) = (>|=) - let monoid_product a1 a2 st = a1 st, a2 st - end) +[@@@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 () diff --git a/src/core/CCRandom.mli b/src/core/CCRandom.mli index b8a86626..f351f8e7 100644 --- a/src/core/CCRandom.mli +++ b/src/core/CCRandom.mli @@ -150,10 +150,14 @@ 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 *) -include CCShimsMkLet_.S with type 'a t_let := 'a t + +[@@@endif] (** {4 Run a generator} *) diff --git a/src/core/CCResult.ml b/src/core/CCResult.ml index 90e6159d..469c143a 100644 --- a/src/core/CCResult.ml +++ b/src/core/CCResult.ml @@ -295,15 +295,17 @@ module Infix = struct let (>>=) e f = flat_map f e let (<*>) = (<*>) - include CCShimsMkLet_.Make2(struct - type ('a,'e) t = ('a,'e) result - let (>>=) = (>>=) - let (>|=) = (>|=) - let monoid_product x1 x2 = match x1, x2 with - | Ok x, Ok y -> Ok (x,y) - | Error e, _ -> Error e - | _, Error e -> Error e - end) + [@@@ifge 4.8] + + let (let+) = (>|=) + let (let*) = (>>=) + let[@inline] (and+) x1 x2 = match x1, x2 with + | Ok x, Ok y -> Ok (x,y) + | Error e, _ -> Error e + | _, Error e -> Error e + let (and*) = (and+) + + [@@@endif] end include Infix diff --git a/src/core/CCResult.mli b/src/core/CCResult.mli index 78f21ef8..ac6b19d4 100644 --- a/src/core/CCResult.mli +++ b/src/core/CCResult.mli @@ -194,10 +194,21 @@ module Infix : sig [Ok (a b)]. Otherwise, it fails, and the error of [a] is chosen over the error of [b] if both fail. *) - (** Let operators on OCaml >= 4.08.0, nothing otherwise - @since 2.8 - @inline *) - include CCShimsMkLet_.S2 with type ('a,'e) t_let2 := ('a,'e) result + [@@@ifge 4.08] + + val (let+) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t + (** @since 2.8 *) + + val (and+) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t + (** @since 2.8 *) + + val (let*) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t + (** @since 2.8 *) + + val (and*) : ('a,'e) t -> ('b,'e) t -> ('a * 'b,'e) t + (** @since 2.8 *) + + [@@@endif] end include module type of Infix diff --git a/src/core/CCShims_.ml b/src/core/CCShims_.ml new file mode 100644 index 00000000..7fd31b22 --- /dev/null +++ b/src/core/CCShims_.ml @@ -0,0 +1,10 @@ + +[@@@ifge 4.07] + +module Stdlib = Stdlib + +[@@@else_] + +module Stdlib = Pervasives + +[@@@endif] diff --git a/src/core/CCShims_syntax.mli b/src/core/CCShims_syntax.mli new file mode 100644 index 00000000..5b789d85 --- /dev/null +++ b/src/core/CCShims_syntax.mli @@ -0,0 +1,19 @@ + +[@@@ifge 4.8] + +(** Let operators on OCaml >= 4.08.0, nothing otherwise + @since 2.8 + @inline *) +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] diff --git a/src/core/CCString.ml b/src/core/CCString.ml index a651349b..84991e40 100644 --- a/src/core/CCString.ml +++ b/src/core/CCString.ml @@ -469,9 +469,14 @@ module Split = struct *) 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] + (*$= & ~printer:Q.Print.(list string) ["a"; "few"; "words"; "from"; "our"; "sponsors"] \ (split_on_char ' ' "a few words from our sponsors") diff --git a/src/core/CCUnit.ml b/src/core/CCUnit.ml new file mode 100644 index 00000000..9aee1240 --- /dev/null +++ b/src/core/CCUnit.ml @@ -0,0 +1,13 @@ + +[@@@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] diff --git a/src/core/CCVector.ml b/src/core/CCVector.ml index 29f9a01c..77fb42fa 100644 --- a/src/core/CCVector.ml +++ b/src/core/CCVector.ml @@ -1159,9 +1159,13 @@ let pp ?(pp_start=fun _ () -> ()) ?(pp_stop=fun _ () -> ()) ) v; pp_stop fmt () -include CCShimsMkLet_.Make2(struct - type nonrec ('a,'e) t = ('a,'e) t - let (>|=) = (>|=) - let (>>=) = (>>=) - let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2 - end) +[@@@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] + + diff --git a/src/core/CCVector.mli b/src/core/CCVector.mli index 08221d73..e7d63c19 100644 --- a/src/core/CCVector.mli +++ b/src/core/CCVector.mli @@ -389,7 +389,20 @@ val pp : ?pp_start:unit printer -> ?pp_stop:unit printer -> ?pp_sep:unit printer By defaults [pp_start] and [pp_stop] does nothing and [pp_sep] defaults to (fun out -> Format.fprintf out ",@ "). *) -(** Let operators on OCaml >= 4.08.0, nothing otherwise - @since 2.8 - @inline *) -include CCShimsMkLet_.S2 with type ('a,'e) t_let2 := ('a,'e) t + + +[@@@ifge 4.08] + +val (let+) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t +(** @since 2.8 *) + +val (and+) : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t +(** @since 2.8 *) + +val (let*) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t +(** @since 2.8 *) + +val (and*) : ('a,'e) t -> ('b,'e) t -> ('a * 'b,'e) t +(** @since 2.8 *) + +[@@@endif] diff --git a/src/core/cpp/cpp.ml b/src/core/cpp/cpp.ml new file mode 100644 index 00000000..03c85c20 --- /dev/null +++ b/src/core/cpp/cpp.ml @@ -0,0 +1,111 @@ + +module C = Configurator.V1 + +type op = Le | Ge + +type line = + | If of op * int * int + | Elseif of op * int * int + | Else + | Endif + | Raw of string + | Eof + +let prefix ~pre s = + let len = String.length pre in + if len > String.length s then false + else ( + let rec check i = + if i=len then true + else if (String.unsafe_get s i) <> (String.unsafe_get pre i) then false + else check (i+1) + in + check 0 + ) + +let eval ~major ~minor op i j = + match op with + | Le -> (major,minor) <= (i,j) + | Ge -> (major,minor) >= (i,j) + +let preproc_lines ~file ~major ~minor (ic:in_channel) : unit = + let pos = ref 0 in + let fail msg = failwith (Printf.sprintf "at line %d: %s" !pos msg) in + let pp_pos () = Printf.printf "#%d %S\n" !pos file in + + let parse_line () : line = + match input_line ic with + | exception End_of_file -> Eof + | line -> + let line' = String.trim line in + incr pos; + if line' <> "" && line'.[0] = '[' then ( + if prefix line' ~pre:"[@@@ifle" then + Scanf.sscanf line' "[@@@ifle %d.%d]" (fun x y -> If(Le,x,y)) + else if prefix line' ~pre:"[@@@ifge" then + Scanf.sscanf line' "[@@@ifge %d.%d]" (fun x y -> If(Ge,x,y)) + else if prefix line' ~pre:"[@@@elifle" then + Scanf.sscanf line' "[@@@elifle %d.%d]" (fun x y -> Elseif(Le,x,y)) + else if prefix line' ~pre:"[@@@elifge" then + Scanf.sscanf line' "[@@@elifge %d.%d]" (fun x y -> Elseif(Ge,x,y)) + else if line'="[@@@else_]" then Else + else if line'="[@@@endif]" then Endif + else Raw line + ) else Raw line + in + + (* entry point *) + let rec top () = + match parse_line () with + | Eof -> () + | If (op,i,j) -> + if eval ~major ~minor op i j then ( + pp_pos(); + cat_block () + ) else skip_block ~elseok:true () + | Raw s -> print_endline s; top() + | Elseif _ | Else | Endif -> + fail "unexpected elseif|else|endif" + + (* current block is the valid one *) + and cat_block () = + match parse_line () with + | Eof -> fail "unexpected EOF" + | If _ -> fail "nested if not supported" + | Raw s -> print_endline s; cat_block() + | Endif -> pp_pos(); top() + | Elseif _ | Else -> skip_block ~elseok:false () + + (* skip current block. + @param elseok if true, we should evaluate "elseif" *) + and skip_block ~elseok () = + match parse_line () with + | Eof -> fail "unexpected EOF" + | If _ -> fail "nested if not supported" + | Raw _ -> skip_block ~elseok () + | Endif -> pp_pos(); top() + | Elseif (op,i,j) -> + if elseok && eval ~major ~minor op i j then ( + pp_pos(); + cat_block () + ) else skip_block ~elseok () + | Else -> + if elseok then ( + pp_pos(); + cat_block() + ) else skip_block ~elseok () + in + top() + +let () = + let t0 = Unix.gettimeofday()in + let file = Sys.argv.(1) in + let c = C.create "main" in + let version = C.ocaml_config_var_exn c "version" in + let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in + + let ic = open_in file in + preproc_lines ~file ~major ~minor ic; + + Printf.printf "(* file preprocessed in %.3fs *)\n" (Unix.gettimeofday() -. t0); + () diff --git a/src/core/cpp/dune b/src/core/cpp/dune new file mode 100644 index 00000000..dff668db --- /dev/null +++ b/src/core/cpp/dune @@ -0,0 +1,6 @@ +; our little preprocessor +(executable + (name cpp) + (flags :standard -warn-error -a+8) + (modes native) + (libraries dune.configurator)) diff --git a/src/core/dune b/src/core/dune index ca13aa78..8d7c1a4e 100644 --- a/src/core/dune +++ b/src/core/dune @@ -1,24 +1,12 @@ -(executable - (name mkshims) - (modules mkshims) - (libraries dune.configurator)) - -(rule - (targets CCShims_.ml CCShimsList_.ml CCShimsFun_.ml CCShimsFun_.mli - CCShimsArray_.ml CCShimsFormat_.ml CCShimsMkLet_.ml CCShimsMkLetList_.ml - CCShimsArrayLabels_.ml CCShimsInt_.ml CCAtomic.ml CCUnit.ml) - (deps ./mkshims.exe) - (action - (run ./mkshims.exe))) - (library (name containers) (public_name containers) (wrapped false) - (modules :standard \ mkshims) - (flags :standard -warn-error -a+8 -w -32 -safe-string -strict-sequence -nolabels -open - CCMonomorphic) + (modules_without_implementation CCShims_syntax) + (preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) + (flags :standard -warn-error -a+8 -w -32-70 -safe-string + -strict-sequence -nolabels -open CCMonomorphic) (libraries seq either containers.monomorphic)) (ocamllex (modules CCSexp_lex)) diff --git a/src/core/mkshims.ml b/src/core/mkshims.ml deleted file mode 100644 index 8cb652b3..00000000 --- a/src/core/mkshims.ml +++ /dev/null @@ -1,270 +0,0 @@ -module C = Configurator.V1 - -let write_file f s = - let out = open_out f in - output_string out s; flush out; close_out out - -let shims_pre_407 = "module Stdlib = Pervasives" - -let shims_post_407 = "module Stdlib = Stdlib" - -let shims_fmt_pre_408 = " -include Format -let cc_update_funs funs f1 f2 = - let open Format in - { - funs with - mark_open_tag = f1 funs.mark_open_tag; - mark_close_tag = f2 funs.mark_close_tag; - } - -" -let shims_fmt_post_408 = " -open Format - -[@@@ocaml.warning \"-3\"] - -let pp_open_tag = pp_open_tag -let pp_close_tag = pp_close_tag -let pp_get_formatter_tag_functions = pp_get_formatter_tag_functions -let pp_set_formatter_tag_functions = pp_set_formatter_tag_functions - -let cc_update_funs funs f1 f2 = - let open Format in - { - funs with - mark_open_tag = f1 ~or_else:funs.mark_open_tag; - mark_close_tag = f2 ~or_else:funs.mark_close_tag; - } -" - -let shims_fun_pre_408 = " - external id : 'a -> 'a = \"%identity\" - let[@inline] flip f x y = f y x - let[@inline] const x _ = x - let[@inline] negate f x = not (f x) - let[@inline] protect ~finally f = - try - let x= f() in - finally(); - x - with e -> - finally(); - raise e - -" -let shims_fun_mli_pre_408 = " - (** This is an API imitating the new standard Fun module *) - external id : 'a -> 'a = \"%identity\" - 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. *) -" - -let shims_fun_post_408 = "include Fun" -let shims_fun_mli_post_408 = "include module type of Fun" - -let shims_list_pre_408 = " - include List - type +'a t = 'a list -" -let shims_list_post_408 = "include List" - -let shims_array_pre_406 = " - include Array - (** {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) - - module Floatarray = struct type t = float array end - type 'a t = 'a array - " - -let shims_array_label_pre_406 = " - include ArrayLabels - (** {{: http://caml.inria.fr/pub/docs/manual-ocaml/libref/ArrayLabels.html} Documentation for the standard ArrayLabels module}*) - - module Floatarray = CCShimsArray_.Floatarray - type 'a t = 'a array - " - -let shims_array_label_406_408 = " - include (ArrayLabels : module type of ArrayLabels with module Floatarray = Array.Floatarray) - (** {{: http://caml.inria.fr/pub/docs/manual-ocaml/libref/ArrayLabels.html} Documentation for the standard ArrayLabels module}*) - - type 'a t = 'a array - " - -let shims_array_406_408 = " - include Array - (** {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) - - type 'a t = 'a array -" -let shims_array_post_408 = " - include Array - (** {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Array.html} Documentation for the standard Array module}*) -" -let shims_array_label_post_408 = " - include (ArrayLabels : module type of ArrayLabels with module Floatarray = Array.Floatarray) - (** {{: http://caml.inria.fr/pub/docs/manual-ocaml/libref/ArrayLabels.html} Documentation for the standard ArrayLabels module}*) -" - -let shims_let_op_pre_408 = - " - (** glue code for let-operators on OCaml < 4.08 (auto generated) *) - module type S = sig type 'a t_let end - module Make(X:sig type 'a t end) = struct type 'a t_let = 'a X.t end - - module type S2 = sig type ('a,'b) t_let2 end - module Make2(X:sig type ('a,'b) t end) = struct type ('a,'b) t_let2 = ('a,'b) X.t end -" -let shims_let_op_post_408 = - " (** glue code for let-operators on OCaml >= 4.08 (auto generated) *) - module type S = sig - type 'a t_let - val (let+) : 'a t_let -> ('a -> 'b) -> 'b t_let - val (and+) : 'a t_let -> 'b t_let -> ('a * 'b) t_let - val (let*) : 'a t_let -> ('a -> 'b t_let) -> 'b t_let - val (and*) : 'a t_let -> 'b t_let -> ('a * 'b) t_let - end - module Make(X:sig - type 'a t - val (>|=) : 'a t -> ('a -> 'b) -> 'b t - val monoid_product : 'a t -> 'b t -> ('a * 'b) t - val (>>=) : 'a t -> ('a -> 'b t) -> 'b t - end) : S with type 'a t_let = 'a X.t = struct - type 'a t_let = 'a X.t - let (let+) = X.(>|=) - let (and+) = X.monoid_product - let (let*) = X.(>>=) - let (and*) = X.monoid_product - end[@@inline] - - module type S2 = sig - type ('a,'e) t_let2 - val (let+) : ('a,'e) t_let2 -> ('a -> 'b) -> ('b,'e) t_let2 - val (and+) : ('a,'e) t_let2 -> ('b,'e) t_let2 -> ('a * 'b, 'e) t_let2 - val (let*) : ('a,'e) t_let2 -> ('a -> ('b,'e) t_let2) -> ('b,'e) t_let2 - val (and*) : ('a,'e) t_let2 -> ('b,'e) t_let2 -> ('a * 'b,'e) t_let2 - end - - module Make2(X:sig - type ('a,'b) t - val (>|=) : ('a,'e) t -> ('a -> 'b) -> ('b,'e) t - val monoid_product : ('a,'e) t -> ('b,'e) t -> ('a * 'b, 'e) t - val (>>=) : ('a,'e) t -> ('a -> ('b,'e) t) -> ('b,'e) t - end) : S2 with type ('a,'e) t_let2 = ('a,'e) X.t = struct - type ('a,'e) t_let2 = ('a,'e) X.t - let (let+) = X.(>|=) - let (and+) = X.monoid_product - let (let*) = X.(>>=) - let (and*) = X.monoid_product - end[@@inline] -" - -let shims_let_op_list_pre_408 = - " - (** glue code for let-operators on OCaml < 4.08 (auto generated) *) - module type S = sig end - module Make(X:sig end) = struct end -" -let shims_let_op_list_post_408 = - "module type S = sig - val (and&) : 'a list -> 'b list -> ('a * 'b) list - (** [(and&)] is {!combine_shortest}. - It allows to perform a synchronized product between two lists, - stopping gently at the shortest. Usable both with [let+] and [let*]. - {[ - # let f xs ys zs = - let+ x = xs - and& y = ys - and& z = zs in - x + y + z;; - val f : int list -> int list -> int list -> int list = - # f [1;2] [5;6;7] [10;10];; - - : int list = [16; 18] - ]} - @since 3.1 - *) - end - - module Make(X:sig - val combine_shortest : 'a list -> 'b list -> ('a*'b) list - end) = struct - let (and&) = X.combine_shortest - end -" - -let shims_int_pre_408 = "" -let shims_int_post_408 = " - include Int - (** {{: https://caml.inria.fr/pub/docs/manual-ocaml/libref/Int.html} Documentation for the standard Int module}*) -" - -let shims_unit_before_408 = {| -type t = unit -let[@inline] equal (_:t) (_:t) = true -let[@inline] compare (_:t) (_:t) = 0 -let to_string () = "()" -|} - -let shims_unit_after_408 = "include Unit" - -let shims_atomic_before_412 = {| - open CCShims_.Stdlib (* for == *) - - type 'a t = {mutable x: 'a} - let[@inline] make x = {x} - let[@inline] get {x} = x - let[@inline] set r x = r.x <- x - let[@inline] exchange r x = - let y = r.x in - r.x <- x; - y - - let[@inline] compare_and_set r seen v = - if r.x == seen then ( - r.x <- v; - true - ) else false - - let[@inline] fetch_and_add r x = - let v = r.x in - r.x <- x + r.x; - v - - let[@inline] incr r = r.x <- 1 + r.x - let[@inline] decr r = r.x <- r.x - 1 - |} - -let shims_atomic_after_412 = {|include Atomic|} - -let () = - C.main ~name:"mkshims" (fun c -> - let version = C.ocaml_config_var_exn c "version" in - let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in - write_file "CCShims_.ml" (if (major, minor) >= (4,7) then shims_post_407 else shims_pre_407); - write_file "CCShimsList_.ml" (if (major, minor) >= (4,8) then shims_list_post_408 else shims_list_pre_408); - write_file "CCShimsArray_.ml" - (if (major, minor) >= (4,8) then shims_array_post_408 - else if (major, minor) >= (4,6) then shims_array_406_408 - else shims_array_pre_406); - write_file "CCShimsArrayLabels_.ml" - (if (major, minor) >= (4,8) then shims_array_label_post_408 - else if (major, minor) >= (4,6) then shims_array_label_406_408 - else shims_array_label_pre_406); - write_file "CCShimsFormat_.ml" (if (major, minor) >= (4,8) then shims_fmt_post_408 else shims_fmt_pre_408); - write_file "CCShimsFun_.ml" (if (major, minor) >= (4,8) then shims_fun_post_408 else shims_fun_pre_408); - write_file "CCShimsFun_.mli" (if (major, minor) >= (4,8) then shims_fun_mli_post_408 else shims_fun_mli_pre_408); - write_file "CCShimsMkLet_.ml" (if (major, minor) >= (4,8) then shims_let_op_post_408 else shims_let_op_pre_408); - write_file "CCShimsMkLetList_.ml" (if (major, minor) >= (4,8) then shims_let_op_list_post_408 else shims_let_op_list_pre_408); - write_file "CCShimsInt_.ml" - (if (major, minor) >= (4,8) then shims_int_post_408 else shims_int_pre_408); - write_file "CCAtomic.ml" - (if (major, minor) >= (4,12) then shims_atomic_after_412 else shims_atomic_before_412); - write_file "CCUnit.ml" - (if (major, minor) >= (4,8) then shims_unit_after_408 else shims_unit_before_408); - ) diff --git a/src/core/tests/check_labelled_mods.ml b/src/core/tests/check_labelled_mods.ml index 7745095b..05d4dc91 100644 --- a/src/core/tests/check_labelled_mods.ml +++ b/src/core/tests/check_labelled_mods.ml @@ -2,7 +2,7 @@ module A = struct (* test consistency of interfaces *) - module FA = CCShimsArray_.Floatarray + module FA = CCArray.Floatarray module type L = module type of CCArray with module Floatarray := FA module type LL = module type of CCArrayLabels with module Floatarray := FA diff --git a/src/core/tests/dune b/src/core/tests/dune index 03ca9a0d..7a26dadc 100644 --- a/src/core/tests/dune +++ b/src/core/tests/dune @@ -24,21 +24,21 @@ (modules test_csexp) (libraries containers csexp qcheck-core qcheck)) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (package containers) (action (run ./test_random.exe))) -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (package containers) (action (run ./test_csexp.exe))) ; what matters is that it compiles -(alias - (name runtest) +(rule + (alias runtest) (locks /ctest) (package containers) (action (run ./check_labelled_mods.exe))) diff --git a/src/data/CCMutHeap_intf.ml b/src/data/CCMutHeap_intf.ml index fc64ce92..ec5aa81e 100644 --- a/src/data/CCMutHeap_intf.ml +++ b/src/data/CCMutHeap_intf.ml @@ -5,9 +5,14 @@ module type RANKED = sig type t - val idx: t -> int (** Index in heap. return -1 if never set *) - val set_idx : t -> int -> unit (** Update index in heap *) - val lt : t -> t -> bool (** [cmp a b] is true iff [a < b] *) + val idx: t -> int + (** Index in heap. return -1 if never set *) + + val set_idx : t -> int -> unit + (** Update index in heap *) + + val lt : t -> t -> bool + (** [cmp a b] is true iff [a < b] *) end module type S = sig diff --git a/src/data/CCPersistentArray.mli b/src/data/CCPersistentArray.mli index 9fc760a9..729aa74a 100644 --- a/src/data/CCPersistentArray.mli +++ b/src/data/CCPersistentArray.mli @@ -78,6 +78,7 @@ val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t val iter : ('a -> unit) -> 'a t -> unit (** [iter f t] applies function [f] to all elements of the persistent array, in order from element [0] to element [length t - 1]. *) + val iteri : (int -> 'a -> unit) -> 'a t -> unit val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a diff --git a/src/data/dune b/src/data/dune index 7c5c1868..fe2d6cc0 100644 --- a/src/data/dune +++ b/src/data/dune @@ -3,5 +3,6 @@ (name containers_data) (public_name containers-data) (wrapped false) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -open CCShims_) + (flags :standard -warn-error -3 -w -70 -color always + -safe-string -strict-sequence -open CCShims_) (libraries containers)) diff --git a/src/dune b/src/dune index 21bb22a5..8cff22c0 100644 --- a/src/dune +++ b/src/dune @@ -1,7 +1,7 @@ (env (_ - (flags :standard -warn-error -3 -color always) + (flags :standard -warn-error -a+8 -w -32-70 -color always -safe-string -strict-sequence) (ocamlopt_flags :standard -O3 -unbox-closures -unbox-closures-factor 20 -inline 100) )) diff --git a/src/mdx_runner.ml b/src/mdx_runner.ml index e485d0ca..719a366d 100644 --- a/src/mdx_runner.ml +++ b/src/mdx_runner.ml @@ -20,7 +20,7 @@ let () = printf "warning: ocaml-mdx exited with code %d\n" e; just_copy(); ) else ( - print_endline "ocaml-mdx returned 0"; + print_endline "ocaml-mdx returned 0 ✔"; ) with Sys_error e -> printf "error when running mdx: %s\n" e; diff --git a/src/monomorphic/CCMonomorphic.ml b/src/monomorphic/CCMonomorphic.ml index 462cf2b1..14bf732e 100644 --- a/src/monomorphic/CCMonomorphic.ml +++ b/src/monomorphic/CCMonomorphic.ml @@ -1,7 +1,10 @@ (* This file is free software, part of containers. See file "license" for more details. *) -open CCMonomorphicShims_ +[@@@ifge 4.07] +[@@@else_] +module Stdlib = Pervasives +[@@@endif] let (=) : int -> int -> bool = Stdlib.(=) let (<>) : int -> int -> bool = Stdlib.(<>) diff --git a/src/monomorphic/dune b/src/monomorphic/dune index c3a3bdbd..be29afd5 100644 --- a/src/monomorphic/dune +++ b/src/monomorphic/dune @@ -1,17 +1,6 @@ - -(executable - (name mkshims) - (modules mkshims) - (libraries dune.configurator)) - -(rule - (targets CCMonomorphicShims_.ml) - (deps ./mkshims.exe) - (action (with-stdout-to %{targets} (run ./mkshims.exe)))) - (library (name containers_monomorphic) (public_name containers.monomorphic) - (modules CCMonomorphic CCMonomorphicShims_) - (wrapped false) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string)) + (preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) + (modules CCMonomorphic) + (wrapped false)) diff --git a/src/monomorphic/mkshims.ml b/src/monomorphic/mkshims.ml deleted file mode 100644 index f391a32c..00000000 --- a/src/monomorphic/mkshims.ml +++ /dev/null @@ -1,11 +0,0 @@ - -module C = Configurator.V1 - -let shims_pre_408 = "module Stdlib = Pervasives" -let shims_post_408 = "module Stdlib = Stdlib" - -let () = - C.main ~name:"mkshims" (fun c -> - let version = C.ocaml_config_var_exn c "version" in - let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in - print_endline (if (major, minor) >= (4,8) then shims_post_408 else shims_pre_408)) diff --git a/src/threads/CCPool.ml b/src/threads/CCPool.ml index eee1dd73..60e8687d 100644 --- a/src/threads/CCPool.ml +++ b/src/threads/CCPool.ml @@ -710,13 +710,14 @@ module Make(P : PARAM) = struct let (>|=) a f = map f a let (<*>) = app + [@@@ifge 4.8] - include CCShimsMkLet_.Make(struct - type nonrec 'a t = 'a t - let (>>=) = (>>=) - let (>|=) = (>|=) - let monoid_product a1 a2 = monoid_product (fun x y->x,y) a1 a2 - end) + 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 diff --git a/src/threads/CCPool.mli b/src/threads/CCPool.mli index 603cc1e3..b9892fc2 100644 --- a/src/threads/CCPool.mli +++ b/src/threads/CCPool.mli @@ -154,23 +154,15 @@ module Make(P : PARAM) : sig 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 *) - include CCShimsMkLet_.S with type 'a t_let := 'a t + + [@@@endif] end - val (>>=) : 'a t -> ('a -> 'b t) -> 'b t - - val (>>) : 'a t -> (unit -> 'b t) -> 'b t - - val (>|=) : 'a t -> ('a -> 'b) -> 'b t - (** Alias to {!map}. *) - - val (<*>): ('a -> 'b) t -> 'a t -> 'b t - (** Alias to {!app}. *) - - (** Let operators on OCaml >= 4.08.0, nothing otherwise - @since 2.8 *) - include CCShimsMkLet_.S with type 'a t_let := 'a t + include module type of Infix end end diff --git a/src/threads/dune b/src/threads/dune index f27b5e65..1959f433 100644 --- a/src/threads/dune +++ b/src/threads/dune @@ -5,5 +5,6 @@ (wrapped false) (optional) (flags :standard -warn-error -a+8 -w -32 -safe-string -open CCShims_) + (preprocess (action (run %{project_root}/src/core/cpp/cpp.exe %{input-file}))) (libraries containers threads)) diff --git a/src/top/dune b/src/top/dune index 29a6a6b4..5c8f3724 100644 --- a/src/top/dune +++ b/src/top/dune @@ -4,5 +4,4 @@ (name containers_top) (public_name containers.top) (wrapped false) - (flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string) (libraries compiler-libs.common containers containers.unix))