From 3d43a5e0eba2617412867eaf15552d4b7b94cb3a Mon Sep 17 00:00:00 2001 From: Kate Date: Mon, 7 Feb 2022 16:28:57 +0000 Subject: [PATCH 1/6] Add support for OCaml 5.0 Signed-off-by: Kate --- shadow-stdlib/gen/mapper.mll | 9 --------- src/import0.ml | 6 ++---- src/string0.ml | 2 +- src/type_equal.ml | 13 ++----------- 4 files changed, 5 insertions(+), 25 deletions(-) diff --git a/shadow-stdlib/gen/mapper.mll b/shadow-stdlib/gen/mapper.mll index a1d7c23..3b9915c 100644 --- a/shadow-stdlib/gen/mapper.mll +++ b/shadow-stdlib/gen/mapper.mll @@ -2,15 +2,6 @@ open StdLabels open Printf -module String = struct - [@@@warning "-32-3"] - let capitalize_ascii = String.capitalize - let uncapitalize_ascii = String.uncapitalize - let uppercase_ascii = String.uppercase - let lowercase_ascii = String.lowercase - include String -end - let deprecated_msg ~is_exn what = sprintf "[%sdeprecated \"\\\n\ diff --git a/src/import0.ml b/src/import0.ml index f680d21..95e82c8 100644 --- a/src/import0.ml +++ b/src/import0.ml @@ -45,6 +45,8 @@ type 'a ref = 'a Caml.ref = { mutable contents : 'a } (* Reshuffle [Caml] so that we choose the modules using labels when available. *) module Caml = struct + include Caml + module Arg = Caml.Arg (** @canonical Caml.Arg *) module Array = Caml.StdLabels.Array (** @canonical Caml.StdLabels.Array *) @@ -109,8 +111,6 @@ module Caml = struct module Stack = Caml.Stack (** @canonical Caml.Stack *) - module Stream = Caml.Stream [@ocaml.warning "-3"] (** @canonical Caml.Stream *) - module String = Caml.StdLabels.String (** @canonical Caml.StdLabels.String *) module Sys = Caml.Sys (** @canonical Caml.Sys *) @@ -119,8 +119,6 @@ module Caml = struct module Unit = Caml.Unit (** @canonical Caml.Unit *) - include Pervasives [@ocaml.warning "-3"] - exception Not_found = Caml.Not_found end diff --git a/src/string0.ml b/src/string0.ml index ea8e3d5..96877e2 100644 --- a/src/string0.ml +++ b/src/string0.ml @@ -32,7 +32,7 @@ let max_length = Sys.max_string_length let ( ^ ) = ( ^ ) let capitalize = Caml.String.capitalize_ascii let compare = Caml.String.compare -let[@warning "-3"] copy = Caml.String.copy +let copy x = Caml.Bytes.to_string (Caml.Bytes.copy (Caml.Bytes.of_string x)) let escaped = Caml.String.escaped let lowercase = Caml.String.lowercase_ascii let make = Caml.String.make diff --git a/src/type_equal.ml b/src/type_equal.ml index e004cd8..2ab9a0c 100644 --- a/src/type_equal.ml +++ b/src/type_equal.ml @@ -74,15 +74,6 @@ module Composition_preserves_injectivity (M1 : Injective) (M2 : Injective) = str let strip e = M1.strip (M2.strip e) end -module Obj = struct - module Extension_constructor = struct - [@@@ocaml.warning "-3"] - - let id = Caml.Obj.extension_id - let of_val = Caml.Obj.extension_constructor - end -end - module Id = struct module Uid = Int @@ -100,7 +91,7 @@ module Id = struct [@@@end] let sexp_of_t _sexp_of_a t = - `type_witness (Obj.Extension_constructor.id (Obj.Extension_constructor.of_val t)) + `type_witness (Caml.Obj.Extension_constructor.id (Caml.Obj.Extension_constructor.of_val t)) |> sexp_of_type_witness_int ;; end @@ -126,7 +117,7 @@ module Id = struct ;; let uid (type a) (module M : S with type t = a) = - Obj.Extension_constructor.id (Obj.Extension_constructor.of_val M.Key) + Caml.Obj.Extension_constructor.id (Caml.Obj.Extension_constructor.of_val M.Key) ;; (* We want a constant allocated once that [same] can return whenever it gets the same From 7cb48b5ee4ab3aeb2b2e7dc128178e8070df15ee Mon Sep 17 00:00:00 2001 From: "Aaron L. Zeng" Date: Tue, 8 Feb 2022 12:07:43 -0500 Subject: [PATCH 2/6] Reduce number of copies in String.copy and apply ocamlformat Signed-off-by: Aaron L. Zeng --- src/string.ml | 4 +++- src/string0.ml | 9 ++++++++- src/type_equal.ml | 3 ++- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/string.ml b/src/string.ml index 0ee495a..1f50489 100644 --- a/src/string.ml +++ b/src/string.ml @@ -1,7 +1,9 @@ open! Import module Array = Array0 -module Bytes = Bytes0 include String0 +module Bytes = Bytes0 +(* This alias is necessary despite [String0] defining [Bytes = Bytes0], in order to + convince ocamldep that this file doesn't depend on bytes.ml. *) let invalid_argf = Printf.invalid_argf let raise_s = Error.raise_s diff --git a/src/string0.ml b/src/string0.ml index 96877e2..4ebb46f 100644 --- a/src/string0.ml +++ b/src/string0.ml @@ -16,6 +16,7 @@ ocamldep from mistakenly causing a file to depend on [Base.String]. *) open! Import0 +module Bytes = Bytes0 module Sys = Sys0 module String = struct @@ -32,7 +33,13 @@ let max_length = Sys.max_string_length let ( ^ ) = ( ^ ) let capitalize = Caml.String.capitalize_ascii let compare = Caml.String.compare -let copy x = Caml.Bytes.to_string (Caml.Bytes.copy (Caml.Bytes.of_string x)) + +let copy x = + Bytes.unsafe_to_string + ~no_mutation_while_string_reachable: + (Bytes.copy (Bytes.unsafe_of_string_promise_no_mutation x)) +;; + let escaped = Caml.String.escaped let lowercase = Caml.String.lowercase_ascii let make = Caml.String.make diff --git a/src/type_equal.ml b/src/type_equal.ml index 2ab9a0c..dad04f7 100644 --- a/src/type_equal.ml +++ b/src/type_equal.ml @@ -91,7 +91,8 @@ module Id = struct [@@@end] let sexp_of_t _sexp_of_a t = - `type_witness (Caml.Obj.Extension_constructor.id (Caml.Obj.Extension_constructor.of_val t)) + `type_witness + (Caml.Obj.Extension_constructor.id (Caml.Obj.Extension_constructor.of_val t)) |> sexp_of_type_witness_int ;; end From 40998a3ca157665a0af8eca7bc88deedab60d4ab Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 18 Jun 2022 08:42:24 +0100 Subject: [PATCH 3/6] Remove the Bytes_set_primitives generated module Base hasn't supported OCaml 4.03 and earlier since v0.9 Signed-off-by: David Allsopp --- src/bytes0.ml | 4 ++-- src/dune | 5 ----- src/select-bytes-set-primitives/select.ml | 20 -------------------- src/string0.ml | 4 ++-- 4 files changed, 4 insertions(+), 29 deletions(-) delete mode 100644 src/select-bytes-set-primitives/select.ml diff --git a/src/bytes0.ml b/src/bytes0.ml index 6669184..01abb18 100644 --- a/src/bytes0.ml +++ b/src/bytes0.ml @@ -21,8 +21,8 @@ module Primitives = struct external get : bytes -> int -> char = "%bytes_safe_get" external length : bytes -> int = "%bytes_length" external unsafe_get : bytes -> int -> char = "%bytes_unsafe_get" - - include Bytes_set_primitives + external set : bytes -> int -> char -> unit = "%bytes_safe_set" + external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" (* [unsafe_blit_string] is not exported in the [stdlib] so we export it here *) external unsafe_blit_string diff --git a/src/dune b/src/dune index 04f42d5..af3358b 100644 --- a/src/dune +++ b/src/dune @@ -1,8 +1,3 @@ -(rule (targets bytes_set_primitives.ml) - (deps (:first_dep select-bytes-set-primitives/select.ml)) - (action - (run %{ocaml} %{first_dep} -ocaml-version %{ocaml_version} -o %{targets}))) - (rule (targets pow_overflow_bounds.ml) (deps (:first_dep ../generate/generate_pow_overflow_bounds.exe)) (action (run %{first_dep} -atomic -o %{targets})) (mode fallback)) diff --git a/src/select-bytes-set-primitives/select.ml b/src/select-bytes-set-primitives/select.ml deleted file mode 100644 index 20cfcbe..0000000 --- a/src/select-bytes-set-primitives/select.ml +++ /dev/null @@ -1,20 +0,0 @@ -let () = - let ver, output = - try - match Sys.argv with - | [|_; "-ocaml-version"; v; "-o"; fn|] -> - (Scanf.sscanf v "%d.%d" (fun major minor -> (major, minor)), - fn) - | _ -> raise Exit - with _ -> - failwith "bad command line arguments" - in - let prefix = - if ver >= (4, 04) then "bytes" else "string" - in - let oc = open_out output in - Printf.fprintf oc {| -external set : %s -> int -> char -> unit = "%%%s_safe_set" -external unsafe_set : %s -> int -> char -> unit = "%%%s_unsafe_set" -|} prefix prefix prefix prefix; - close_out oc diff --git a/src/string0.ml b/src/string0.ml index 4ebb46f..f1ae861 100644 --- a/src/string0.ml +++ b/src/string0.ml @@ -23,8 +23,8 @@ module String = struct external get : string -> int -> char = "%string_safe_get" external length : string -> int = "%string_length" external unsafe_get : string -> int -> char = "%string_unsafe_get" - - include Bytes_set_primitives + external set : bytes -> int -> char -> unit = "%bytes_safe_set" + external unsafe_set : bytes -> int -> char -> unit = "%bytes_unsafe_set" end include String From 247bc8e558000369c9d5ff025fa4abbe6435ff0c Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Sat, 18 Jun 2022 08:43:19 +0100 Subject: [PATCH 4/6] Support both OCaml 4.x and 5.x Random.State modules Signed-off-by: David Allsopp --- src/dune | 5 +++ src/random.ml | 52 ++++++++++------------------ src/select-random-repr/select.ml | 59 ++++++++++++++++++++++++++++++++ 3 files changed, 83 insertions(+), 33 deletions(-) create mode 100644 src/select-random-repr/select.ml diff --git a/src/dune b/src/dune index af3358b..785c1a9 100644 --- a/src/dune +++ b/src/dune @@ -1,3 +1,8 @@ +(rule (targets random_repr.ml) + (deps (:first_dep select-random-repr/select.ml)) + (action + (run %{ocaml} %{first_dep} -ocaml-version %{ocaml_version} -o %{targets}))) + (rule (targets pow_overflow_bounds.ml) (deps (:first_dep ../generate/generate_pow_overflow_bounds.exe)) (action (run %{first_dep} -atomic -o %{targets})) (mode fallback)) diff --git a/src/random.ml b/src/random.ml index 029b722..a0553d2 100644 --- a/src/random.ml +++ b/src/random.ml @@ -1,5 +1,4 @@ open! Import -module Array = Array0 module Int = Int0 module Char = Char0 @@ -55,21 +54,7 @@ module State = struct Lazy.from_val (Caml.Random.State.make_self_init ()) ;; - module Repr = struct - type t = - { st : int array - ; mutable idx : int - } - - let of_state : Caml.Random.State.t -> t = Caml.Obj.magic - end - - let assign t1 t2 = - let t1 = Repr.of_state (Lazy.force t1) in - let t2 = Repr.of_state (Lazy.force t2) in - Array.blit ~src:t2.st ~src_pos:0 ~dst:t1.st ~dst_pos:0 ~len:(Array.length t1.st); - t1.idx <- t2.idx - ;; + let assign = Random_repr.assign let full_init t seed = assign t (make seed) @@ -249,22 +234,23 @@ module State = struct ;; end -let default = State.default -let bits () = State.bits default -let int x = State.int default x -let int32 x = State.int32 default x -let nativeint x = State.nativeint default x -let int64 x = State.int64 default x -let float x = State.float default x -let int_incl x y = State.int_incl default x y -let int32_incl x y = State.int32_incl default x y -let nativeint_incl x y = State.nativeint_incl default x y -let int64_incl x y = State.int64_incl default x y -let float_range x y = State.float_range default x y -let bool () = State.bool default -let char () = State.char default -let ascii () = State.ascii default -let full_init seed = State.full_init default seed +let default = Random_repr.make_default State.default + +let bits () = State.bits (Random_repr.get_state default) +let int x = State.int (Random_repr.get_state default) x +let int32 x = State.int32 (Random_repr.get_state default) x +let nativeint x = State.nativeint (Random_repr.get_state default) x +let int64 x = State.int64 (Random_repr.get_state default) x +let float x = State.float (Random_repr.get_state default) x +let int_incl x y = State.int_incl (Random_repr.get_state default) x y +let int32_incl x y = State.int32_incl (Random_repr.get_state default) x y +let nativeint_incl x y = State.nativeint_incl (Random_repr.get_state default) x y +let int64_incl x y = State.int64_incl (Random_repr.get_state default) x y +let float_range x y = State.float_range (Random_repr.get_state default) x y +let bool () = State.bool (Random_repr.get_state default) +let char () = State.char (Random_repr.get_state default) +let ascii () = State.ascii (Random_repr.get_state default) +let full_init seed = State.full_init (Random_repr.get_state default) seed let init seed = full_init [| seed |] let self_init ?allow_in_tests () = full_init (random_seed ?allow_in_tests ()) -let set_state s = State.assign default s +let set_state s = State.assign (Random_repr.get_state default) s diff --git a/src/select-random-repr/select.ml b/src/select-random-repr/select.ml new file mode 100644 index 0000000..acae62c --- /dev/null +++ b/src/select-random-repr/select.ml @@ -0,0 +1,59 @@ +let () = + let ver, output = + try + match Sys.argv with + | [|_; "-ocaml-version"; v; "-o"; fn|] -> + (Scanf.sscanf v "%d.%d" (fun major minor -> (major, minor)), + fn) + | _ -> raise Exit + with _ -> + failwith "bad command line arguments" + in + let oc = open_out output in + if ver >= (5, 0) then + Printf.fprintf oc {| +module Repr = struct + open Caml.Bigarray + + type t = (int64, int64_elt, c_layout) Array1.t + + let of_state : Caml.Random.State.t -> t = Caml.Obj.magic +end + +let assign dst src = + let dst = Repr.of_state (Lazy.force dst) in + let src = Repr.of_state (Lazy.force src) in + Caml.Bigarray.Array1.blit src dst + +let make_default default = + let split_from_parent v = + Lazy.from_val (Caml.Random.State.split (Lazy.force v)) + in + Caml.Domain.DLS.new_key ~split_from_parent (fun () -> default) + +let get_state random_key = Caml.Domain.DLS.get random_key +|} + else + Printf.fprintf oc {| +module Array = Array0 + +module Repr = struct + type t = + { st : int array + ; mutable idx : int + } + + let of_state : Caml.Random.State.t -> t = Caml.Obj.magic +end + +let assign t1 t2 = + let t1 = Repr.of_state (Lazy.force t1) in + let t2 = Repr.of_state (Lazy.force t2) in + Array.blit ~src:t2.st ~src_pos:0 ~dst:t1.st ~dst_pos:0 ~len:(Array.length t1.st); + t1.idx <- t2.idx + +let make_default default = default + +let[@inline always] get_state state = state +|}; + close_out oc From 54b87748c77a03a65f260e07d37f7377b6d732ef Mon Sep 17 00:00:00 2001 From: David Allsopp Date: Mon, 25 Jul 2022 16:46:52 +0100 Subject: [PATCH 5/6] Split the state lazily on Domain spawn Signed-off-by: David Allsopp --- src/select-random-repr/select.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/select-random-repr/select.ml b/src/select-random-repr/select.ml index acae62c..3f2074b 100644 --- a/src/select-random-repr/select.ml +++ b/src/select-random-repr/select.ml @@ -27,7 +27,7 @@ let assign dst src = let make_default default = let split_from_parent v = - Lazy.from_val (Caml.Random.State.split (Lazy.force v)) + Caml.Lazy.map_val Caml.Random.State.split v in Caml.Domain.DLS.new_key ~split_from_parent (fun () -> default) From ef71b7076434fc7e9db2aab504a831e0325ac0ca Mon Sep 17 00:00:00 2001 From: "Jesse A. Tov" Date: Tue, 26 Jul 2022 10:01:25 -0400 Subject: [PATCH 6/6] Use Bytes.of_string instead of Bytes.copy & Bytes.unsafe_of_string_promise_no_mutation Signed-off-by: Jesse Tov Co-authored-by: hhugo --- src/string0.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/string0.ml b/src/string0.ml index f1ae861..069de9c 100644 --- a/src/string0.ml +++ b/src/string0.ml @@ -37,7 +37,7 @@ let compare = Caml.String.compare let copy x = Bytes.unsafe_to_string ~no_mutation_while_string_reachable: - (Bytes.copy (Bytes.unsafe_of_string_promise_no_mutation x)) + (Bytes.of_string x) ;; let escaped = Caml.String.escaped