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/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..785c1a9 100644 --- a/src/dune +++ b/src/dune @@ -1,5 +1,5 @@ -(rule (targets bytes_set_primitives.ml) - (deps (:first_dep select-bytes-set-primitives/select.ml)) +(rule (targets random_repr.ml) + (deps (:first_dep select-random-repr/select.ml)) (action (run %{ocaml} %{first_dep} -ocaml-version %{ocaml_version} -o %{targets}))) 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/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-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/select-random-repr/select.ml b/src/select-random-repr/select.ml new file mode 100644 index 0000000..3f2074b --- /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 = + Caml.Lazy.map_val Caml.Random.State.split 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 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 ea8e3d5..069de9c 100644 --- a/src/string0.ml +++ b/src/string0.ml @@ -16,14 +16,15 @@ ocamldep from mistakenly causing a file to depend on [Base.String]. *) open! Import0 +module Bytes = Bytes0 module Sys = Sys0 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 @@ -32,7 +33,13 @@ 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 = + Bytes.unsafe_to_string + ~no_mutation_while_string_reachable: + (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..dad04f7 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,8 @@ 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 +118,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