mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-05 19:00:31 -05:00
Merge pull request #401 from c-cube/experiment-preproc
custom preprocessor rather than shim modules
This commit is contained in:
commit
40189757ca
57 changed files with 652 additions and 507 deletions
38
.github/workflows/compat.yml
vendored
Normal file
38
.github/workflows/compat.yml
vendored
Normal file
|
|
@ -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'
|
||||
11
.github/workflows/main.yml
vendored
11
.github/workflows/main.yml
vendored
|
|
@ -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' }}
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ build: [
|
|||
]
|
||||
depends: [
|
||||
"ocaml" { >= "4.03.0" }
|
||||
"dune" { >= "1.4" }
|
||||
"dune" { >= "2.0" }
|
||||
"containers" { = version }
|
||||
"seq"
|
||||
"qtest" { with-test }
|
||||
|
|
|
|||
|
|
@ -11,7 +11,7 @@ build: [
|
|||
]
|
||||
depends: [
|
||||
"ocaml" { >= "4.03.0" }
|
||||
"dune" { >= "1.4" }
|
||||
"dune" { >= "2.0" }
|
||||
"base-threads"
|
||||
"dune-configurator"
|
||||
"containers" { = version }
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ build: [
|
|||
]
|
||||
depends: [
|
||||
"ocaml" { >= "4.03.0" }
|
||||
"dune" { >= "1.4" }
|
||||
"dune" { >= "2.0" }
|
||||
"dune-configurator"
|
||||
"seq" # compat
|
||||
"either" # compat
|
||||
|
|
|
|||
7
dune
7
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)))
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
(lang dune 1.4)
|
||||
(lang dune 2.0)
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
24
qtest/dune
24
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)))
|
||||
|
|
|
|||
|
|
@ -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 ||
|
||||
|
|
|
|||
|
|
@ -19,6 +19,6 @@
|
|||
(flags :standard -warn-error -a+8)
|
||||
(libraries containers))
|
||||
|
||||
(alias
|
||||
(name runtest)
|
||||
(rule
|
||||
(alias runtest)
|
||||
(action (run ./test_bitfield.exe)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
35
src/core/CCAtomic.ml
Normal file
35
src/core/CCAtomic.ml
Normal file
|
|
@ -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]
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 = <fun>
|
||||
# f [1;2] [5;6;7] [10;10];;
|
||||
- : int list = [16; 18]
|
||||
]}
|
||||
@since 3.1
|
||||
*)
|
||||
|
||||
[@@@endif]
|
||||
end
|
||||
|
||||
include module type of Infix
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
||||
|
|
|
|||
|
|
@ -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} *)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
10
src/core/CCShims_.ml
Normal file
10
src/core/CCShims_.ml
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
|
||||
[@@@ifge 4.07]
|
||||
|
||||
module Stdlib = Stdlib
|
||||
|
||||
[@@@else_]
|
||||
|
||||
module Stdlib = Pervasives
|
||||
|
||||
[@@@endif]
|
||||
19
src/core/CCShims_syntax.mli
Normal file
19
src/core/CCShims_syntax.mli
Normal file
|
|
@ -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]
|
||||
|
|
@ -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")
|
||||
|
|
|
|||
13
src/core/CCUnit.ml
Normal file
13
src/core/CCUnit.ml
Normal file
|
|
@ -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]
|
||||
|
|
@ -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]
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
|
|
|
|||
111
src/core/cpp/cpp.ml
Normal file
111
src/core/cpp/cpp.ml
Normal file
|
|
@ -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);
|
||||
()
|
||||
6
src/core/cpp/dune
Normal file
6
src/core/cpp/dune
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
; our little preprocessor
|
||||
(executable
|
||||
(name cpp)
|
||||
(flags :standard -warn-error -a+8)
|
||||
(modes native)
|
||||
(libraries dune.configurator))
|
||||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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 = <fun>
|
||||
# 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);
|
||||
)
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
2
src/dune
2
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)
|
||||
))
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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.(<>)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue