From 842bb24a7543929282c1233fa0dc07a0bf66c2ad Mon Sep 17 00:00:00 2001 From: public-release Date: Wed, 30 Aug 2023 10:23:16 +0100 Subject: [PATCH] v0.17~preview.128.37+01 --- .ocamlformat | 1 + hash_types/src/base_internalhash_types.ml | 17 +- hash_types/test/test_immediate.ml | 6 +- lint/ppx_base_lint.ml | 18 +- md5/src/md5_lib.ml | 20 +- md5/src/md5_lib.mli | 3 - src/applicative.ml | 112 +- src/applicative_intf.ml | 117 +- src/array.ml | 68 +- src/array.mli | 13 +- src/array0.ml | 1 - src/avltree.ml | 23 +- src/base.ml | 234 +-- src/binary_search.ml | 26 +- src/binary_searchable.ml | 18 +- src/binary_searchable_intf.ml | 2 +- src/blit.ml | 54 +- src/blit_intf.ml | 24 +- src/bool.ml | 8 +- src/bool.mli | 2 +- src/bool0.ml | 2 +- src/bool0.mli | 2 +- src/buffer.ml | 2 +- src/bytes.ml | 6 +- src/bytes0.ml | 6 +- src/bytes_tr.ml | 2 +- src/char.ml | 6 +- src/char.mli | 1 - src/comparable.ml | 92 +- src/comparable_intf.ml | 76 +- src/comparator.ml | 80 +- src/comparator.mli | 74 +- src/container.ml | 46 +- src/container_intf.ml | 18 +- src/dictionary_immutable_intf.ml | 158 +- src/dictionary_mutable_intf.ml | 142 +- src/discover/discover.ml | 4 +- src/either.ml | 134 +- src/either0.ml | 122 +- src/error.ml | 8 +- src/exn.ml | 16 +- src/exn.mli | 3 - src/float.ml | 34 +- src/float.mli | 48 +- src/float0.ml | 100 +- src/fn.mli | 1 - src/globalize.mli | 1 - src/hash.ml | 26 +- src/hash_intf.ml | 18 +- src/hash_set.ml | 20 +- src/hash_set_intf.ml | 22 +- src/hasher.ml | 1 - src/hashtbl.ml | 44 +- src/hashtbl_intf.ml | 59 +- src/import0.ml | 70 +- src/indexed_container.ml | 56 +- src/indexed_container_intf.ml | 27 +- src/info.ml | 85 +- src/info_intf.ml | 1 - src/int.ml | 79 +- src/int32.ml | 74 +- src/int63.mli | 1 - src/int63_emul.ml | 72 +- src/int64.ml | 77 +- src/int64.mli | 2 +- src/int_conversions.ml | 32 +- src/int_conversions.mli | 35 +- src/int_math.ml | 26 +- src/intable.ml | 1 - src/lazy.ml | 12 +- src/lazy.mli | 1 - src/linked_queue.ml | 16 +- src/list.ml | 116 +- src/list.mli | 3 - src/list0.ml | 1 - src/map.ml | 297 ++- src/map_intf.ml | 421 ++-- src/maybe_bound.ml | 44 +- src/monad.ml | 110 +- src/monad_intf.ml | 74 +- src/nativeint.ml | 76 +- src/nothing.ml | 6 +- src/obj_array.ml | 16 +- src/obj_array.mli | 1 - src/option.ml | 100 +- src/option.mli | 13 +- src/option_array.ml | 26 +- src/or_error.ml | 51 +- src/ordered_collection_common0.ml | 4 +- src/ordering.ml | 12 +- src/popcount.mli | 1 - src/pow_overflow_bounds.ml | 774 +++---- src/pretty_printer.ml | 22 +- src/pretty_printer.mli | 15 +- src/printf.mli | 1 - src/queue.ml | 83 +- src/random.ml | 2 +- src/ref.ml | 102 +- src/result.ml | 182 +- src/result.mli | 4 +- src/sequence.ml | 476 +++-- src/sequence.mli | 7 +- src/set.ml | 57 +- src/set_intf.ml | 129 +- src/sexp.ml | 4 +- src/sexp.mli | 3 +- src/sexpable.ml | 40 +- src/sexpable.mli | 40 +- src/sign0.ml | 12 +- src/sign_or_nan.ml | 14 +- src/source_code_position.mli | 1 - src/source_code_position0.ml | 46 +- src/stack.ml | 14 +- src/stack_intf.ml | 1 - src/string.ml | 275 ++- src/string.mli | 7 +- src/sys.mli | 7 +- src/type_equal.ml | 29 +- src/type_equal_intf.ml | 4 +- src/uniform_array.ml | 42 +- src/uniform_array.mli | 4 - src/variant.mli | 2 +- src/with_return.mli | 1 - src/word_size.ml | 6 +- test/allocation/test_string_allocation.ml | 4 +- test/avltree_unit_tests.ml | 844 ++++---- test/hashtbl_tests.ml | 14 +- test/helpers/test_container.ml | 60 +- test/helpers/test_container.mli | 34 +- test/test_applicative.ml | 40 +- test/test_array.ml | 32 +- test/test_base_containers.ml | 2 +- test/test_blit.ml | 56 +- test/test_bytes.ml | 18 +- test/test_clz_ctz.ml | 112 +- test/test_container_module_types.ml | 25 +- test/test_dictionary_module_types.ml | 84 +- test/test_exported_int_conversions.ml | 29 +- test/test_float.ml | 75 +- test/test_globalize_lib.ml | 1 - test/test_hash_set.ml | 6 +- test/test_hashtbl.ml | 12 +- test/test_identifiable.ml | 6 +- test/test_indexed_container.ml | 16 +- test/test_int.ml | 38 +- test/test_int_conversions.ml | 18 +- test/test_int_math.ml | 4 +- test/test_list.ml | 10 +- test/test_map.ml | 20 +- test/test_map_comprehensive.ml | 86 +- test/test_map_interface.ml | 12 +- test/test_map_traversal.ml | 16 +- test/test_or_error.ml | 4 +- test/test_popcount.ml | 24 +- test/test_queue.ml | 2276 ++++++++++----------- test/test_sequence.ml | 6 +- test/test_set_interface.ml | 14 +- test/test_sexpable.ml | 22 +- test/test_sign.ml | 2 +- test/test_string.ml | 20 +- test/test_type_equal.ml | 2 +- test/test_uniform_array.ml | 10 +- 162 files changed, 5269 insertions(+), 5371 deletions(-) create mode 100644 .ocamlformat diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 00000000..3b217634 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1 @@ +profile=janestreet diff --git a/hash_types/src/base_internalhash_types.ml b/hash_types/src/base_internalhash_types.ml index 9a941f75..53cf9a28 100644 --- a/hash_types/src/base_internalhash_types.ml +++ b/hash_types/src/base_internalhash_types.ml @@ -1,12 +1,17 @@ (** [state] is defined as a subtype of [int] using the [private] keyword. This makes it an opaque type for most purposes, and tells the compiler that the type is immediate. *) type state = private int + type seed = int type hash_value = int -external create_seeded : seed -> state = "%identity" [@@noalloc] -external fold_int64 : state -> int64 -> state = "Base_internalhash_fold_int64" [@@noalloc] -external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc] -external fold_float : state -> float -> state = "Base_internalhash_fold_float" [@@noalloc] -external fold_string : state -> string -> state = "Base_internalhash_fold_string" [@@noalloc] -external get_hash_value : state -> hash_value = "Base_internalhash_get_hash_value" [@@noalloc] +external create_seeded : seed -> state = "%identity" [@@noalloc] +external fold_int64 : state -> int64 -> state = "Base_internalhash_fold_int64" [@@noalloc] +external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc] +external fold_float : state -> float -> state = "Base_internalhash_fold_float" [@@noalloc] + +external fold_string : state -> string -> state = "Base_internalhash_fold_string" + [@@noalloc] + +external get_hash_value : state -> hash_value = "Base_internalhash_get_hash_value" + [@@noalloc] diff --git a/hash_types/test/test_immediate.ml b/hash_types/test/test_immediate.ml index 47233aea..9aaea81b 100644 --- a/hash_types/test/test_immediate.ml +++ b/hash_types/test/test_immediate.ml @@ -5,8 +5,10 @@ let%expect_test "[Base.Hash.state] is still immediate" = require_no_allocation [%here] (fun () -> ignore (Sys.opaque_identity (Base.Hash.create ()))); [%expect {| |}] +;; let%expect_test _ = - print_s [%sexp (Stdlib.Obj.is_int (Stdlib.Obj.repr (Base.Hash.create ~seed:1 ())) : bool)]; - [%expect {| true |}]; + print_s + [%sexp (Stdlib.Obj.is_int (Stdlib.Obj.repr (Base.Hash.create ~seed:1 ())) : bool)]; + [%expect {| true |}] ;; diff --git a/lint/ppx_base_lint.ml b/lint/ppx_base_lint.ml index ab2e1c03..e0502492 100644 --- a/lint/ppx_base_lint.ml +++ b/lint/ppx_base_lint.ml @@ -25,7 +25,7 @@ let zero_modules () = |> Array.to_list |> List.filter ~f:(fun fn -> Stdlib.Filename.check_suffix fn "0.ml") |> List.map ~f:(fun fn -> - String.capitalize (String.sub fn ~pos:0 ~len:(String.length fn - 4))) + String.capitalize (String.sub fn ~pos:0 ~len:(String.length fn - 4))) |> Set.of_list (module String) ;; @@ -114,14 +114,14 @@ let check current_module = let expansion = Ppx_cold.expand_cold_attribute attr |> List.map ~f:(fun a -> - { a with - attr_name = - { a.attr_name with - txt = - String.chop_prefix a.attr_name.txt ~prefix:"ocaml." - |> Option.value ~default:a.attr_name.txt - } - }) + { a with + attr_name = + { a.attr_name with + txt = + String.chop_prefix a.attr_name.txt ~prefix:"ocaml." + |> Option.value ~default:a.attr_name.txt + } + }) in let is_part_of_expansion attr = List.exists expansion ~f:(fun a -> diff --git a/md5/src/md5_lib.ml b/md5/src/md5_lib.ml index 585968a0..ac522ae6 100644 --- a/md5/src/md5_lib.ml +++ b/md5/src/md5_lib.ml @@ -2,26 +2,20 @@ type t = string (* Share the digest of the empty string *) let empty = Digest.string "" -let make s = - if s = empty then - empty - else - s - +let make s = if s = empty then empty else s let compare = compare - let length = 16 - let to_binary s = s let to_binary_local s = s -let of_binary_exn s = assert (String.length s = length); make s -let unsafe_of_binary = make +let of_binary_exn s = + assert (String.length s = length); + make s +;; + +let unsafe_of_binary = make let to_hex = Digest.to_hex let of_hex_exn s = make (Digest.from_hex s) - let string s = make (Digest.string s) - let bytes s = make (Digest.bytes s) - let subbytes bytes ~pos ~len = make (Digest.subbytes bytes pos len) diff --git a/md5/src/md5_lib.mli b/md5/src/md5_lib.mli index ea541b8b..0eee25f0 100644 --- a/md5/src/md5_lib.mli +++ b/md5/src/md5_lib.mli @@ -14,9 +14,6 @@ val unsafe_of_binary : string -> t val to_hex : t -> string val of_hex_exn : string -> t - val string : string -> t - val bytes : bytes -> t - val subbytes : bytes -> pos:int -> len:int -> t diff --git a/src/applicative.ml b/src/applicative.ml index 3d5e526c..f6577982 100644 --- a/src/applicative.ml +++ b/src/applicative.ml @@ -65,22 +65,22 @@ module Make3 (X : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t = st end module Make2 (X : Basic2) : S2 with type ('a, 'e) t := ('a, 'e) X.t = Make3 (struct - include X + include X - type ('a, 'd, 'e) t = ('a, 'd) X.t - end) + type ('a, 'd, 'e) t = ('a, 'd) X.t +end) module Make (X : Basic) : S with type 'a t := 'a X.t = Make2 (struct - include X + include X - type ('a, 'e) t = 'a X.t - end) + type ('a, 'e) t = 'a X.t +end) module Make_let_syntax3 - (X : For_let_syntax3) (Intf : sig - module type S - end) - (Impl : Intf.S) = + (X : For_let_syntax3) (Intf : sig + module type S + end) + (Impl : Intf.S) = struct module Let_syntax = struct include X @@ -93,10 +93,10 @@ struct end module Make_let_syntax2 - (X : For_let_syntax2) (Intf : sig - module type S - end) - (Impl : Intf.S) = + (X : For_let_syntax2) (Intf : sig + module type S + end) + (Impl : Intf.S) = Make_let_syntax3 (struct include X @@ -107,10 +107,10 @@ module Make_let_syntax2 (Impl) module Make_let_syntax - (X : For_let_syntax) (Intf : sig - module type S - end) - (Impl : Intf.S) = + (X : For_let_syntax) (Intf : sig + module type S + end) + (Impl : Intf.S) = Make_let_syntax2 (struct include X @@ -158,17 +158,17 @@ end module Make2_using_map2 (X : Basic2_using_map2) : S2 with type ('a, 'e) t := ('a, 'e) X.t = Make3_using_map2 (struct - include X + include X - type ('a, 'd, 'e) t = ('a, 'd) X.t - end) + type ('a, 'd, 'e) t = ('a, 'd) X.t +end) module Make_using_map2 (X : Basic_using_map2) : S with type 'a t := 'a X.t = - Make2_using_map2 (struct - include X +Make2_using_map2 (struct + include X - type ('a, 'e) t = 'a X.t - end) + type ('a, 'e) t = 'a X.t +end) module Make3_using_map2_local (X : Basic3_using_map2_local) : S3_local with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t = struct @@ -207,66 +207,66 @@ end module Make2_using_map2_local (X : Basic2_using_map2_local) : S2_local with type ('a, 'e) t := ('a, 'e) X.t = Make3_using_map2_local (struct - include X + include X - type ('a, 'd, 'e) t = ('a, 'd) X.t - end) + type ('a, 'd, 'e) t = ('a, 'd) X.t +end) module Make_using_map2_local (X : Basic_using_map2_local) : S_local with type 'a t := 'a X.t = Make2_using_map2_local (struct - include X + include X - type ('a, 'e) t = 'a X.t - end) + type ('a, 'e) t = 'a X.t +end) module Of_monad2 (M : Monad.S2) : S2 with type ('a, 'e) t := ('a, 'e) M.t = Make2 (struct - type ('a, 'e) t = ('a, 'e) M.t + type ('a, 'e) t = ('a, 'e) M.t - let return = M.return - let apply mf mx = M.bind mf ~f:(fun f -> M.map mx ~f) - let map = `Custom M.map - end) + let return = M.return + let apply mf mx = M.bind mf ~f:(fun f -> M.map mx ~f) + let map = `Custom M.map +end) module Of_monad (M : Monad.S) : S with type 'a t := 'a M.t = Of_monad2 (struct - include M + include M - type ('a, _) t = 'a M.t - end) + type ('a, _) t = 'a M.t +end) module Compose (F : S) (G : S) : S with type 'a t = 'a F.t G.t = struct type 'a t = 'a F.t G.t include Make (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return a = G.return (F.return a) - let apply tf tx = G.apply (G.map ~f:F.apply tf) tx - let custom_map t ~f = G.map ~f:(F.map ~f) t - let map = `Custom custom_map - end) + let return a = G.return (F.return a) + let apply tf tx = G.apply (G.map ~f:F.apply tf) tx + let custom_map t ~f = G.map ~f:(F.map ~f) t + let map = `Custom custom_map + end) end module Pair (F : S) (G : S) : S with type 'a t = 'a F.t * 'a G.t = struct type 'a t = 'a F.t * 'a G.t include Make (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return a = F.return a, G.return a - let apply tf tx = F.apply (fst tf) (fst tx), G.apply (snd tf) (snd tx) - let custom_map t ~f = F.map ~f (fst t), G.map ~f (snd t) - let map = `Custom custom_map - end) + let return a = F.return a, G.return a + let apply tf tx = F.apply (fst tf) (fst tx), G.apply (snd tf) (snd tx) + let custom_map t ~f = F.map ~f (fst t), G.map ~f (snd t) + let map = `Custom custom_map + end) end module Ident = struct type 'a t = 'a include Make_using_map2_local (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return = Fn.id - let map2 a b ~f = f a b - let map = `Custom (fun a ~f -> f a) - end) + let return = Fn.id + let map2 a b ~f = f a b + let map = `Custom (fun a ~f -> f a) + end) end diff --git a/src/applicative_intf.ml b/src/applicative_intf.ml index 37bb8cee..f6d1ffb2 100644 --- a/src/applicative_intf.ml +++ b/src/applicative_intf.ml @@ -72,7 +72,6 @@ module type Applicative_infix_gen = sig type 'a t type ('a, 'b) fn - (** same as [apply] *) val ( <*> ) : ('a -> 'b) t -> 'a t -> 'b t @@ -100,13 +99,13 @@ end module type For_let_syntax = For_let_syntax_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b module type For_let_syntax_local = For_let_syntax_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b module type S_gen = sig include For_let_syntax_gen @@ -126,17 +125,17 @@ end module type S = S_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b - and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c - and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd module type S_local = S_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b - and type ('a, 'b, 'c) fun2 := 'a -> (('b -> 'c)[@local]) - and type ('a, 'b, 'c, 'd) fun3 := 'a -> (('b -> (('c -> 'd)[@local]))[@local]) + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> ('b -> 'c[@local]) + and type ('a, 'b, 'c, 'd) fun3 := 'a -> ('b -> ('c -> 'd[@local])[@local]) module type Let_syntax = sig type 'a t @@ -222,19 +221,19 @@ module type For_let_syntax2_gen = sig include Applicative_infix2_gen - with type ('a, 'e) t := ('a, 'e) t - and type ('a, 'b) fn := ('a, 'b) fn + with type ('a, 'e) t := ('a, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn end module type For_let_syntax2 = For_let_syntax2_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b module type For_let_syntax2_local = For_let_syntax2_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b module type S2_gen = sig include For_let_syntax2_gen @@ -256,23 +255,23 @@ module type S2_gen = sig module Applicative_infix : Applicative_infix2_gen - with type ('a, 'e) t := ('a, 'e) t - and type ('a, 'b) fn := ('a, 'b) fn + with type ('a, 'e) t := ('a, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn end module type S2 = S2_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b - and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c - and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd module type S2_local = S2_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b - and type ('a, 'b, 'c) fun2 := 'a -> (('b -> 'c)[@local]) - and type ('a, 'b, 'c, 'd) fun3 := 'a -> (('b -> (('c -> 'd)[@local]))[@local]) + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> ('b -> 'c[@local]) + and type ('a, 'b, 'c, 'd) fun3 := 'a -> ('b -> ('c -> 'd[@local])[@local]) module type Let_syntax2 = sig type ('a, 'e) t @@ -361,19 +360,19 @@ module type For_let_syntax3_gen = sig include Applicative_infix3_gen - with type ('a, 'd, 'e) t := ('a, 'd, 'e) t - and type ('a, 'b) fn := ('a, 'b) fn + with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn end module type For_let_syntax3 = For_let_syntax3_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b module type For_let_syntax3_local = For_let_syntax3_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b module type S3_gen = sig include For_let_syntax3_gen @@ -399,23 +398,23 @@ module type S3_gen = sig module Applicative_infix : Applicative_infix3_gen - with type ('a, 'd, 'e) t := ('a, 'd, 'e) t - and type ('a, 'b) fn := ('a, 'b) fn + with type ('a, 'd, 'e) t := ('a, 'd, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn end module type S3 = S3_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b - and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c - and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> 'b -> 'c + and type ('a, 'b, 'c, 'd) fun3 := 'a -> 'b -> 'c -> 'd module type S3_local = S3_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b - and type ('a, 'b, 'c) fun2 := 'a -> (('b -> 'c)[@local]) - and type ('a, 'b, 'c, 'd) fun3 := 'a -> (('b -> (('c -> 'd)[@local]))[@local]) + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + and type ('a, 'b, 'c) fun2 := 'a -> ('b -> 'c[@local]) + and type ('a, 'b, 'c, 'd) fun3 := 'a -> ('b -> ('c -> 'd[@local])[@local]) module type Let_syntax3 = sig type ('a, 'd, 'e) t @@ -487,27 +486,27 @@ module type Applicative = sig module Make3 (X : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t module Make_let_syntax - (X : For_let_syntax) (Intf : sig - module type S - end) - (Impl : Intf.S) : + (X : For_let_syntax) (Intf : sig + module type S + end) + (Impl : Intf.S) : Let_syntax with type 'a t := 'a X.t with module Open_on_rhs_intf := Intf module Make_let_syntax2 - (X : For_let_syntax2) (Intf : sig - module type S - end) - (Impl : Intf.S) : + (X : For_let_syntax2) (Intf : sig + module type S + end) + (Impl : Intf.S) : Let_syntax2 with type ('a, 'e) t := ('a, 'e) X.t with module Open_on_rhs_intf := Intf module Make_let_syntax3 - (X : For_let_syntax3) (Intf : sig - module type S - end) - (Impl : Intf.S) : + (X : For_let_syntax3) (Intf : sig + module type S + end) + (Impl : Intf.S) : Let_syntax3 - with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t - with module Open_on_rhs_intf := Intf + with type ('a, 'd, 'e) t := ('a, 'd, 'e) X.t + with module Open_on_rhs_intf := Intf module Make_using_map2 (X : Basic_using_map2) : S with type 'a t := 'a X.t diff --git a/src/array.ml b/src/array.ml index 0d4ccc09..345e97b9 100644 --- a/src/array.ml +++ b/src/array.ml @@ -4,11 +4,11 @@ include Array0 type 'a t = 'a array [@@deriving_inline compare ~localize, globalize, sexp, sexp_grammar] let compare__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> int = compare_array__local ;; @@ -17,8 +17,8 @@ let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_array let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = fun (type a__009_) - : (((a__009_[@ocaml.local]) -> a__009_) -> (a__009_ t[@ocaml.local]) -> a__009_ t) -> - globalize_array + : (((a__009_[@ocaml.local]) -> a__009_) -> (a__009_ t[@ocaml.local]) -> a__009_ t) -> + globalize_array ;; let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = array_of_sexp @@ -59,12 +59,12 @@ let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_gramma - http://www.sorting-algorithms.com/quick-sort-3-way *) module Sorter (S : sig - type 'a t + type 'a t - val get : 'a t -> int -> 'a - val set : 'a t -> int -> 'a -> unit - val length : 'a t -> int - end) = + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit + val length : 'a t -> int +end) = struct include S @@ -304,12 +304,12 @@ end [@@inline] module Sort = Sorter (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let get = unsafe_get - let set = unsafe_set - let length = length - end) + let get = unsafe_get + let set = unsafe_set + let length = length +end) let sort = Sort.sort let of_array t = t @@ -533,7 +533,7 @@ let filter_opt t = filter_map t ~f:Fn.id let raise_length_mismatch name n1 n2 = invalid_argf "length mismatch in %s: %d <> %d" name n1 n2 () -[@@cold] [@@inline never] [@@local never] [@@specialise never] + [@@cold] [@@inline never] [@@local never] [@@specialise never] ;; let check_length2_exn name t1 t2 = @@ -560,7 +560,6 @@ let fold2_exn t1 t2 ~init ~f = let filter t ~f = filter_map t ~f:(fun x -> if f x then Some x else None) [@nontail] let filteri t ~f = filter_mapi t ~f:(fun i x -> if f i x then Some x else None) [@nontail] - let exists t ~f = let i = ref (length t - 1) in let result = ref false in @@ -624,7 +623,6 @@ let for_all2_exn t1 t2 ~f = for_all2_local_exn t1 t2 ~f let equal__local equal t1 t2 = length t1 = length t2 && for_all2_local_exn t1 t2 ~f:equal let equal equal t1 t2 = equal__local equal t1 t2 - let map_inplace t ~f = for i = 0 to length t - 1 do unsafe_set t i (f (unsafe_get t i)) @@ -881,27 +879,27 @@ let transpose_exn tt = ;; include Binary_searchable.Make1 (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let get = get - let length = length - end) + let get = get + let length = length +end) include Blit.Make1 (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let length = length + let length = length - let create_like ~len t = - if len = 0 - then [||] - else ( - assert (length t > 0); - create ~len t.(0)) - ;; + let create_like ~len t = + if len = 0 + then [||] + else ( + assert (length t > 0); + create ~len t.(0)) + ;; - let unsafe_blit = unsafe_blit - end) + let unsafe_blit = unsafe_blit +end) let invariant invariant_a t = iter t ~f:invariant_a diff --git a/src/array.mli b/src/array.mli index 29e4dfd6..73d6d793 100644 --- a/src/array.mli +++ b/src/array.mli @@ -138,7 +138,6 @@ val fold_mapi where [n] is the length of the array [a]. *) val fold_right : 'a t -> f:(('a -> 'acc -> 'acc)[@local]) -> init:'acc -> 'acc - (** All sort functions in this module sort in increasing order by default. *) (** [sort] uses constant heap space. [stable_sort] uses linear heap space. @@ -220,7 +219,6 @@ val of_list_rev_mapi : 'a list -> f:((int -> 'a -> 'b)[@local]) -> 'b t (** Modifies an array in place, applying [f] to every element of the array *) val map_inplace : 'a t -> f:(('a -> 'a)[@local]) -> unit - (** [find_exn f t] returns the first [a] in [t] for which [f t.(i)] is true. It raises [Stdlib.Not_found] or [Not_found_s] if there is no such [a]. *) val find_exn : 'a t -> f:(('a -> bool)[@local]) -> 'a @@ -289,7 +287,6 @@ val equal__local -> ('a t[@local]) -> bool - (** The input array is copied internally so that future modifications of it do not change the sequence. *) val to_sequence : 'a t -> 'a Sequence.t @@ -333,12 +330,12 @@ module Private : sig end module Sorter (S : sig - type 'a t + type 'a t - val get : 'a t -> int -> 'a - val set : 'a t -> int -> 'a -> unit - val length : 'a t -> int - end) : sig + val get : 'a t -> int -> 'a + val set : 'a t -> int -> 'a -> unit + val length : 'a t -> int + end) : sig val sort : ?pos:int -> ?len:int diff --git a/src/array0.ml b/src/array0.ml index b336cf76..3d51925a 100644 --- a/src/array0.ml +++ b/src/array0.ml @@ -8,7 +8,6 @@ Defining [module Array = Array0] is also necessary because it prevents ocamldep from mistakenly causing a file to depend on [Base.Array]. *) - open! Import0 module Sys = Sys0 diff --git a/src/avltree.ml b/src/avltree.ml index 4b538a13..bca3cc7f 100644 --- a/src/avltree.ml +++ b/src/avltree.ml @@ -129,7 +129,7 @@ let balance tree = | Empty | Leaf _ -> assert false | Node ({ left = lr_left; key = _; value = _; height = _; right = lr_right } as - lr_node) -> + lr_node) -> left_node.right <- lr_left; root_node.left <- lr_right; lr_node.right <- tree; @@ -163,7 +163,7 @@ let balance tree = | Empty | Leaf _ -> assert false | Node ({ left = rl_left; key = _; value = _; height = _; right = rl_right } as - rl_node) -> + rl_node) -> right_node.left <- rl_right; root_node.right <- rl_left; rl_node.left <- tree; @@ -261,17 +261,16 @@ let rec last t = | Node { left = _; key = _; value = _; height = _; right = r } -> last r ;; - let[@inline always] rec findi_and_call_impl - t - ~compare - k - arg1 - arg2 - ~call_if_found - ~call_if_not_found - ~if_found - ~if_not_found + t + ~compare + k + arg1 + arg2 + ~call_if_found + ~call_if_not_found + ~if_found + ~if_not_found = match t with | Empty -> call_if_not_found ~if_not_found k arg1 arg2 diff --git a/src/base.ml b/src/base.ml index d7734aa9..3b489cf5 100644 --- a/src/base.ml +++ b/src/base.ml @@ -31,45 +31,45 @@ include ( Shadow_stdlib : module type of struct - include Shadow_stdlib - end - (* Modules defined in Base *) - with module Array := Shadow_stdlib.Array - with module Atomic := Shadow_stdlib.Atomic - with module Bool := Shadow_stdlib.Bool - with module Buffer := Shadow_stdlib.Buffer - with module Bytes := Shadow_stdlib.Bytes - with module Char := Shadow_stdlib.Char - with module Either := Shadow_stdlib.Either - with module Float := Shadow_stdlib.Float - with module Hashtbl := Shadow_stdlib.Hashtbl - with module In_channel := Shadow_stdlib.In_channel - with module Int := Shadow_stdlib.Int - with module Int32 := Shadow_stdlib.Int32 - with module Int64 := Shadow_stdlib.Int64 - with module Lazy := Shadow_stdlib.Lazy - with module List := Shadow_stdlib.List - with module Map := Shadow_stdlib.Map - with module Nativeint := Shadow_stdlib.Nativeint - with module Option := Shadow_stdlib.Option - with module Out_channel := Shadow_stdlib.Out_channel - with module Printf := Shadow_stdlib.Printf - with module Queue := Shadow_stdlib.Queue - with module Random := Shadow_stdlib.Random - with module Result := Shadow_stdlib.Result - with module Set := Shadow_stdlib.Set - with module Stack := Shadow_stdlib.Stack - with module String := Shadow_stdlib.String - with module Sys := Shadow_stdlib.Sys - with module Uchar := Shadow_stdlib.Uchar - with module Unit := Shadow_stdlib.Unit - (* Support for generated lexers *) - with module Lexing := Shadow_stdlib.Lexing - with type ('a, 'b, 'c) format := ('a, 'b, 'c) format - with type ('a, 'b, 'c, 'd) format4 := ('a, 'b, 'c, 'd) format4 - with type ('a, 'b, 'c, 'd, 'e, 'f) format6 := ('a, 'b, 'c, 'd, 'e, 'f) format6 - with type 'a ref := 'a ref) - [@ocaml.warning "-3"] + include Shadow_stdlib + end + (* Modules defined in Base *) + with module Array := Shadow_stdlib.Array + with module Atomic := Shadow_stdlib.Atomic + with module Bool := Shadow_stdlib.Bool + with module Buffer := Shadow_stdlib.Buffer + with module Bytes := Shadow_stdlib.Bytes + with module Char := Shadow_stdlib.Char + with module Either := Shadow_stdlib.Either + with module Float := Shadow_stdlib.Float + with module Hashtbl := Shadow_stdlib.Hashtbl + with module In_channel := Shadow_stdlib.In_channel + with module Int := Shadow_stdlib.Int + with module Int32 := Shadow_stdlib.Int32 + with module Int64 := Shadow_stdlib.Int64 + with module Lazy := Shadow_stdlib.Lazy + with module List := Shadow_stdlib.List + with module Map := Shadow_stdlib.Map + with module Nativeint := Shadow_stdlib.Nativeint + with module Option := Shadow_stdlib.Option + with module Out_channel := Shadow_stdlib.Out_channel + with module Printf := Shadow_stdlib.Printf + with module Queue := Shadow_stdlib.Queue + with module Random := Shadow_stdlib.Random + with module Result := Shadow_stdlib.Result + with module Set := Shadow_stdlib.Set + with module Stack := Shadow_stdlib.Stack + with module String := Shadow_stdlib.String + with module Sys := Shadow_stdlib.Sys + with module Uchar := Shadow_stdlib.Uchar + with module Unit := Shadow_stdlib.Unit + (* Support for generated lexers *) + with module Lexing := Shadow_stdlib.Lexing + with type ('a, 'b, 'c) format := ('a, 'b, 'c) format + with type ('a, 'b, 'c, 'd) format4 := ('a, 'b, 'c, 'd) format4 + with type ('a, 'b, 'c, 'd, 'e, 'f) format6 := ('a, 'b, 'c, 'd, 'e, 'f) format6 + with type 'a ref := 'a ref) +[@ocaml.warning "-3"] (**/**) @@ -190,11 +190,11 @@ module Export = struct [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] let compare_array__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a array[@ocaml.local]) - -> ('a array[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a array[@ocaml.local]) + -> ('a array[@ocaml.local]) + -> int = Array.compare__local ;; @@ -202,11 +202,11 @@ module Export = struct let compare_array : 'a. ('a -> 'a -> int) -> 'a array -> 'a array -> int = Array.compare let equal_array__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> ('a array[@ocaml.local]) - -> ('a array[@ocaml.local]) - -> bool + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> ('a array[@ocaml.local]) + -> ('a array[@ocaml.local]) + -> bool = Array.equal__local ;; @@ -214,12 +214,12 @@ module Export = struct let equal_array : 'a. ('a -> 'a -> bool) -> 'a array -> 'a array -> bool = Array.equal let globalize_array : - 'a. (('a[@ocaml.local]) -> 'a) -> ('a array[@ocaml.local]) -> 'a array + 'a. (('a[@ocaml.local]) -> 'a) -> ('a array[@ocaml.local]) -> 'a array = fun (type a__017_) - : (((a__017_[@ocaml.local]) -> a__017_) -> (a__017_ array[@ocaml.local]) - -> a__017_ array) -> - Array.globalize + : (((a__017_[@ocaml.local]) -> a__017_) -> (a__017_ array[@ocaml.local]) + -> a__017_ array) -> + Array.globalize ;; let array_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a array = @@ -231,7 +231,7 @@ module Export = struct ;; let array_sexp_grammar : - 'a. 'a Sexplib0.Sexp_grammar.t -> 'a array Sexplib0.Sexp_grammar.t + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a array Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar -> Array.t_sexp_grammar _'a_sexp_grammar ;; @@ -259,7 +259,7 @@ module Export = struct ;; let (hash_fold_bool : - Ppx_hash_lib.Std.Hash.state -> bool -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> bool -> Ppx_hash_lib.Std.Hash.state) = Bool.hash_fold_t @@ -295,7 +295,7 @@ module Export = struct ;; let (hash_fold_char : - Ppx_hash_lib.Std.Hash.state -> char -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> char -> Ppx_hash_lib.Std.Hash.state) = Char.hash_fold_t @@ -337,7 +337,7 @@ module Export = struct ;; let (hash_fold_float : - Ppx_hash_lib.Std.Hash.state -> float -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> float -> Ppx_hash_lib.Std.Hash.state) = Float.hash_fold_t @@ -407,7 +407,7 @@ module Export = struct ;; let (hash_fold_int32 : - Ppx_hash_lib.Std.Hash.state -> int32 -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> int32 -> Ppx_hash_lib.Std.Hash.state) = Int32.hash_fold_t @@ -443,7 +443,7 @@ module Export = struct ;; let (hash_fold_int64 : - Ppx_hash_lib.Std.Hash.state -> int64 -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> int64 -> Ppx_hash_lib.Std.Hash.state) = Int64.hash_fold_t @@ -463,11 +463,11 @@ module Export = struct compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] let compare_list__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a list[@ocaml.local]) - -> ('a list[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a list[@ocaml.local]) + -> ('a list[@ocaml.local]) + -> int = List.compare__local ;; @@ -475,11 +475,11 @@ module Export = struct let compare_list : 'a. ('a -> 'a -> int) -> 'a list -> 'a list -> int = List.compare let equal_list__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> ('a list[@ocaml.local]) - -> ('a list[@ocaml.local]) - -> bool + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> ('a list[@ocaml.local]) + -> ('a list[@ocaml.local]) + -> bool = List.equal__local ;; @@ -487,20 +487,20 @@ module Export = struct let equal_list : 'a. ('a -> 'a -> bool) -> 'a list -> 'a list -> bool = List.equal let globalize_list : - 'a. (('a[@ocaml.local]) -> 'a) -> ('a list[@ocaml.local]) -> 'a list + 'a. (('a[@ocaml.local]) -> 'a) -> ('a list[@ocaml.local]) -> 'a list = fun (type a__078_) - : (((a__078_[@ocaml.local]) -> a__078_) -> (a__078_ list[@ocaml.local]) - -> a__078_ list) -> - List.globalize + : (((a__078_[@ocaml.local]) -> a__078_) -> (a__078_ list[@ocaml.local]) + -> a__078_ list) -> + List.globalize ;; let hash_fold_list : - 'a. - (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) - -> Ppx_hash_lib.Std.Hash.state - -> 'a list - -> Ppx_hash_lib.Std.Hash.state + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a list + -> Ppx_hash_lib.Std.Hash.state = List.hash_fold_t ;; @@ -514,7 +514,7 @@ module Export = struct ;; let list_sexp_grammar : - 'a. 'a Sexplib0.Sexp_grammar.t -> 'a list Sexplib0.Sexp_grammar.t + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a list Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar -> List.t_sexp_grammar _'a_sexp_grammar ;; @@ -527,7 +527,7 @@ module Export = struct let compare_nativeint__local = (Nativeint.compare__local - : (nativeint[@ocaml.local]) -> (nativeint[@ocaml.local]) -> int) + : (nativeint[@ocaml.local]) -> (nativeint[@ocaml.local]) -> int) ;; let compare_nativeint = @@ -536,7 +536,7 @@ module Export = struct let equal_nativeint__local = (Nativeint.equal__local - : (nativeint[@ocaml.local]) -> (nativeint[@ocaml.local]) -> bool) + : (nativeint[@ocaml.local]) -> (nativeint[@ocaml.local]) -> bool) ;; let equal_nativeint = @@ -548,7 +548,7 @@ module Export = struct ;; let (hash_fold_nativeint : - Ppx_hash_lib.Std.Hash.state -> nativeint -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> nativeint -> Ppx_hash_lib.Std.Hash.state) = Nativeint.hash_fold_t @@ -571,11 +571,11 @@ module Export = struct compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] let compare_option__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a option[@ocaml.local]) - -> ('a option[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a option[@ocaml.local]) + -> ('a option[@ocaml.local]) + -> int = Option.compare__local ;; @@ -585,11 +585,11 @@ module Export = struct ;; let equal_option__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> ('a option[@ocaml.local]) - -> ('a option[@ocaml.local]) - -> bool + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> ('a option[@ocaml.local]) + -> ('a option[@ocaml.local]) + -> bool = Option.equal__local ;; @@ -599,20 +599,20 @@ module Export = struct ;; let globalize_option : - 'a. (('a[@ocaml.local]) -> 'a) -> ('a option[@ocaml.local]) -> 'a option + 'a. (('a[@ocaml.local]) -> 'a) -> ('a option[@ocaml.local]) -> 'a option = fun (type a__109_) - : (((a__109_[@ocaml.local]) -> a__109_) -> (a__109_ option[@ocaml.local]) - -> a__109_ option) -> - Option.globalize + : (((a__109_[@ocaml.local]) -> a__109_) -> (a__109_ option[@ocaml.local]) + -> a__109_ option) -> + Option.globalize ;; let hash_fold_option : - 'a. - (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) - -> Ppx_hash_lib.Std.Hash.state - -> 'a option - -> Ppx_hash_lib.Std.Hash.state + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a option + -> Ppx_hash_lib.Std.Hash.state = Option.hash_fold_t ;; @@ -626,7 +626,7 @@ module Export = struct ;; let option_sexp_grammar : - 'a. 'a Sexplib0.Sexp_grammar.t -> 'a option Sexplib0.Sexp_grammar.t + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a option Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar -> Option.t_sexp_grammar _'a_sexp_grammar ;; @@ -637,11 +637,11 @@ module Export = struct [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] let compare_ref__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a ref[@ocaml.local]) - -> ('a ref[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a ref[@ocaml.local]) + -> ('a ref[@ocaml.local]) + -> int = Ref.compare__local ;; @@ -649,11 +649,11 @@ module Export = struct let compare_ref : 'a. ('a -> 'a -> int) -> 'a ref -> 'a ref -> int = Ref.compare let equal_ref__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> ('a ref[@ocaml.local]) - -> ('a ref[@ocaml.local]) - -> bool + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> ('a ref[@ocaml.local]) + -> ('a ref[@ocaml.local]) + -> bool = Ref.equal__local ;; @@ -662,9 +662,9 @@ module Export = struct let globalize_ref : 'a. (('a[@ocaml.local]) -> 'a) -> ('a ref[@ocaml.local]) -> 'a ref = fun (type a__134_) - : (((a__134_[@ocaml.local]) -> a__134_) -> (a__134_ ref[@ocaml.local]) - -> a__134_ ref) -> - Ref.globalize + : (((a__134_[@ocaml.local]) -> a__134_) -> (a__134_ ref[@ocaml.local]) + -> a__134_ ref) -> + Ref.globalize ;; let ref_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a ref = @@ -702,7 +702,7 @@ module Export = struct ;; let (hash_fold_string : - Ppx_hash_lib.Std.Hash.state -> string -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> string -> Ppx_hash_lib.Std.Hash.state) = String.hash_fold_t @@ -763,7 +763,7 @@ module Export = struct ;; let (hash_fold_unit : - Ppx_hash_lib.Std.Hash.state -> unit -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> unit -> Ppx_hash_lib.Std.Hash.state) = Unit.hash_fold_t diff --git a/src/binary_search.ml b/src/binary_search.ml index bf9e5cfb..4ceb06da 100644 --- a/src/binary_search.ml +++ b/src/binary_search.ml @@ -32,7 +32,7 @@ let rec find_range_near_first_satisfying t ~get ~lo ~hi ~pred = else ( let mid = lo + ((hi - lo) / 2) in if pred (get t mid) - (* INVARIANT check: it means the first satisfying element is between [lo] and [mid] *) + (* INVARIANT check: it means the first satisfying element is between [lo] and [mid] *) then find_range_near_first_satisfying t ~get ~lo ~hi:mid ~pred (* INVARIANT check: it means the first satisfying element, if it exists, @@ -72,22 +72,22 @@ let find_last_satisfying ?pos ?len t ~pred ~get ~length = ;; let binary_search - ?pos - ?len - t - ~length:((length : _ -> _) [@local]) - ~get:((get : _ -> _ -> _) [@local]) - ~compare:((compare : _ -> _ -> _) [@local]) - how - v + ?pos + ?len + t + ~length:((length : _ -> _) [@local]) + ~get:((get : _ -> _ -> _) [@local]) + ~compare:((compare : _ -> _ -> _) [@local]) + how + v = match how with | `Last_strictly_less_than -> find_last_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v < 0) [@nontail - ] + ] | `Last_less_than_or_equal_to -> find_last_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v <= 0) [@nontail - ] + ] | `First_equal_to -> (match find_first_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v >= 0) @@ -102,10 +102,10 @@ let binary_search | None | Some _ -> None) | `First_greater_than_or_equal_to -> find_first_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v >= 0) [@nontail - ] + ] | `First_strictly_greater_than -> find_first_satisfying ?pos ?len t ~get ~length ~pred:(fun x -> compare x v > 0) [@nontail - ] + ] ;; let binary_search_segmented ?pos ?len t ~length ~get ~segment_of how = diff --git a/src/binary_searchable.ml b/src/binary_searchable.ml index 3de24e65..539dfb96 100644 --- a/src/binary_searchable.ml +++ b/src/binary_searchable.ml @@ -23,16 +23,16 @@ module Make_gen (T : Arg) = struct end module Make (T : Indexable) = Make_gen (struct - include T + include T - type 'a elt = T.elt - type 'a t = T.t - end) + type 'a elt = T.elt + type 'a t = T.t +end) module Make1 (T : Indexable1) = Make_gen (struct - type 'a elt = 'a - type 'a t = 'a T.t + type 'a elt = 'a + type 'a t = 'a T.t - let get = T.get - let length = T.length - end) + let get = T.get + let length = T.length +end) diff --git a/src/binary_searchable_intf.ml b/src/binary_searchable_intf.ml index 80d7f722..07b6e24d 100644 --- a/src/binary_searchable_intf.ml +++ b/src/binary_searchable_intf.ml @@ -40,7 +40,7 @@ module Which_target_by_key = struct ; `First_greater_than_or_equal_to ; `First_strictly_greater_than ] - : t list) + : t list) ;; [@@@end] diff --git a/src/blit.ml b/src/blit.ml index 998f2d14..310eadc2 100644 --- a/src/blit.ml +++ b/src/blit.ml @@ -8,12 +8,12 @@ module type Sequence_gen = sig end module Make_gen - (Src : Sequence_gen) (Dst : sig - include Sequence_gen + (Src : Sequence_gen) (Dst : sig + include Sequence_gen - val create_like : len:int -> 'a Src.t -> 'a t - val unsafe_blit : ('a Src.t, 'a t) blit - end) = + val create_like : len:int -> 'a Src.t -> 'a t + val unsafe_blit : ('a Src.t, 'a t) blit + end) = struct let unsafe_blit = Dst.unsafe_blit @@ -30,12 +30,12 @@ struct ;; let blito - ~src - ?(src_pos = 0) - ?(src_len = Src.length src - src_pos) - ~dst - ?(dst_pos = 0) - () + ~src + ?(src_pos = 0) + ?(src_len = Src.length src - src_pos) + ~dst + ?(dst_pos = 0) + () = blit ~src ~src_pos ~len:src_len ~dst ~dst_pos ;; @@ -62,21 +62,21 @@ struct end module Make1 (Sequence : sig - include Sequence_gen + include Sequence_gen - val create_like : len:int -> 'a t -> 'a t - val unsafe_blit : ('a t, 'a t) blit - end) = + val create_like : len:int -> 'a t -> 'a t + val unsafe_blit : ('a t, 'a t) blit +end) = Make_gen (Sequence) (Sequence) module Make1_generic (Sequence : Sequence1) = Make_gen (Sequence) (Sequence) module Make (Sequence : sig - include Sequence + include Sequence - val create : len:int -> t - val unsafe_blit : (t, t) blit - end) = + val create : len:int -> t + val unsafe_blit : (t, t) blit +end) = struct module Sequence = struct type 'a t = Sequence.t @@ -92,12 +92,12 @@ struct end module Make_distinct - (Src : Sequence) (Dst : sig - include Sequence + (Src : Sequence) (Dst : sig + include Sequence - val create : len:int -> t - val unsafe_blit : (Src.t, t) blit - end) = + val create : len:int -> t + val unsafe_blit : (Src.t, t) blit + end) = Make_gen (struct type 'a t = Src.t @@ -117,9 +117,9 @@ module Make_distinct end) module Make_to_string (T : sig - type t - end) - (To_bytes : S_distinct with type src := T.t with type dst := bytes) = + type t +end) +(To_bytes : S_distinct with type src := T.t with type dst := bytes) = struct open To_bytes diff --git a/src/blit_intf.ml b/src/blit_intf.ml index bf1fdf86..3ec290b3 100644 --- a/src/blit_intf.ml +++ b/src/blit_intf.ml @@ -148,25 +148,25 @@ module type Blit = sig (** [Make] is for blitting between two values of the same monomorphic type. *) module Make (Sequence : sig - include Sequence + include Sequence - val create : len:int -> t - val unsafe_blit : (t, t) blit - end) : S with type t := Sequence.t + val create : len:int -> t + val unsafe_blit : (t, t) blit + end) : S with type t := Sequence.t (** [Make_distinct] is for blitting between values of distinct monomorphic types. *) module Make_distinct - (Src : Sequence) (Dst : sig - include Sequence + (Src : Sequence) (Dst : sig + include Sequence - val create : len:int -> t - val unsafe_blit : (Src.t, t) blit - end) : S_distinct with type src := Src.t with type dst := Dst.t + val create : len:int -> t + val unsafe_blit : (Src.t, t) blit + end) : S_distinct with type src := Src.t with type dst := Dst.t module Make_to_string (T : sig - type t - end) - (To_bytes : S_distinct with type src := T.t with type dst := bytes) : + type t + end) + (To_bytes : S_distinct with type src := T.t with type dst := bytes) : S_to_string with type t := T.t (** [Make1] is for blitting between two values of the same polymorphic type. *) diff --git a/src/bool.ml b/src/bool.ml index 5b2be87a..ba5edeb6 100644 --- a/src/bool.ml +++ b/src/bool.ml @@ -40,11 +40,11 @@ include T include Comparator.Make (T) include Pretty_printer.Register (struct - type nonrec t = t + type nonrec t = t - let to_string = to_string - let module_name = "Base.Bool" - end) + let to_string = to_string + let module_name = "Base.Bool" +end) (* Open replace_polymorphic_compare after including functor instantiations so they do not shadow its definitions. This is here so that efficient versions of the comparison diff --git a/src/bool.mli b/src/bool.mli index 9bea7b9d..50068715 100644 --- a/src/bool.mli +++ b/src/bool.mli @@ -31,7 +31,7 @@ external select -> ('a[@local_opt]) -> ('a[@local_opt]) = "caml_csel_value" -[@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] + [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] module Non_short_circuiting : sig (** Non-short circuiting and branch-free boolean operators. diff --git a/src/bool0.ml b/src/bool0.ml index 0ebd4c4c..0994b685 100644 --- a/src/bool0.ml +++ b/src/bool0.ml @@ -4,4 +4,4 @@ external select -> ('a[@local_opt]) -> ('a[@local_opt]) = "caml_csel_value" -[@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] + [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] diff --git a/src/bool0.mli b/src/bool0.mli index 0ebd4c4c..0994b685 100644 --- a/src/bool0.mli +++ b/src/bool0.mli @@ -4,4 +4,4 @@ external select -> ('a[@local_opt]) -> ('a[@local_opt]) = "caml_csel_value" -[@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] + [@@noalloc] [@@no_effects] [@@no_coeffects] [@@builtin] diff --git a/src/buffer.ml b/src/buffer.ml index 7c0b0096..0c969c5a 100644 --- a/src/buffer.ml +++ b/src/buffer.ml @@ -14,7 +14,7 @@ let caml_buffer_length = let caml_buffer_blit = (Stdlib.Obj.magic (Stdlib.Buffer.blit : Stdlib.Buffer.t -> int -> Bytes.t -> int -> int -> unit) - : (Stdlib.Buffer.t[@local]) -> int -> (Bytes.t[@local]) -> int -> int -> unit) + : (Stdlib.Buffer.t[@local]) -> int -> (Bytes.t[@local]) -> int -> int -> unit) ;; module To_bytes = diff --git a/src/bytes.ml b/src/bytes.ml index 9f3e22a4..ae21d32b 100644 --- a/src/bytes.ml +++ b/src/bytes.ml @@ -22,10 +22,10 @@ end include T module To_bytes = Blit.Make (struct - include T + include T - let create ~len = create len - end) + let create ~len = create len +end) include To_bytes include Comparator.Make (T) diff --git a/src/bytes0.ml b/src/bytes0.ml index e2bf9c4d..cc3b2e34 100644 --- a/src/bytes0.ml +++ b/src/bytes0.ml @@ -50,7 +50,7 @@ module Primitives = struct -> len:int -> unit = "caml_blit_string" - [@@noalloc] + [@@noalloc] external unsafe_get_int64 : (bytes[@local_opt]) @@ -102,7 +102,7 @@ let copy = Stdlib.Bytes.copy let create = Stdlib.Bytes.create external unsafe_create_local : int -> (bytes[@local]) = "Base_unsafe_create_local_bytes" -[@@noalloc] + [@@noalloc] let create_local len = @@ -147,7 +147,7 @@ external unsafe_blit -> len:int -> unit = "caml_blit_bytes" -[@@noalloc] + [@@noalloc] let to_string = Stdlib.Bytes.to_string let of_string = Stdlib.Bytes.of_string diff --git a/src/bytes_tr.ml b/src/bytes_tr.ml index ea1268e9..6c3a3108 100644 --- a/src/bytes_tr.ml +++ b/src/bytes_tr.ml @@ -35,7 +35,7 @@ let tr_create_map ~target ~replacement = (* quick check on the first target character which will 99% be true *) let first_target = target.[0] in if Char.( <> ) (Bytes0.unsafe_get tr_map (Char.to_int first_target)) first_target - || have_any_different tr_map 0 + || have_any_different tr_map 0 then Some (Bytes0.unsafe_to_string ~no_mutation_while_string_reachable:tr_map) else None ;; diff --git a/src/char.ml b/src/char.ml index 2adb875f..381a855c 100644 --- a/src/char.ml +++ b/src/char.ml @@ -35,10 +35,10 @@ end include T include Identifiable.Make (struct - include T + include T - let module_name = "Base.Char" - end) + let module_name = "Base.Char" +end) let pp fmt c = Stdlib.Format.fprintf fmt "%C" c diff --git a/src/char.mli b/src/char.mli index 821a10dd..01c63cc7 100644 --- a/src/char.mli +++ b/src/char.mli @@ -28,7 +28,6 @@ val to_int : t -> int the range 0 to 255. *) val of_int : int -> t option - (** Returns the character with the given ASCII code. Raises [Failure] if the argument is outside the range 0 to 255. *) val of_int_exn : int -> t diff --git a/src/comparable.ml b/src/comparable.ml index fad88eec..e55dca76 100644 --- a/src/comparable.ml +++ b/src/comparable.ml @@ -2,14 +2,14 @@ open! Import include Comparable_intf module With_zero (T : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] + [@@@end] - val zero : t - end) = + val zero : t +end) = struct open T @@ -21,12 +21,12 @@ struct end module Poly (T : sig - type t [@@deriving_inline sexp_of] + type t [@@deriving_inline sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] - end) = + [@@@end] +end) = struct module Replace_polymorphic_compare = struct type t = T.t [@@deriving_inline sexp_of] @@ -76,12 +76,12 @@ let min cmp t t' = if leq cmp t t' then t else t' let max cmp t t' = if geq cmp t t' then t else t' module Infix (T : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) : Infix with type t := T.t = struct + [@@@end] +end) : Infix with type t := T.t = struct let ( > ) a b = gt T.compare a b let ( < ) a b = lt T.compare a b let ( >= ) a b = geq T.compare a b @@ -92,12 +92,12 @@ end [@@inline always] module Comparisons (T : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) : Comparisons with type t := T.t = struct + [@@@end] +end) : Comparisons with type t := T.t = struct include Infix (T) let compare = T.compare @@ -108,14 +108,14 @@ end [@@inline always] module Make_using_comparator (T : sig - type t [@@deriving_inline sexp_of] + type t [@@deriving_inline sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] + [@@@end] - include Comparator.S with type t := t - end) : S with type t := T.t and type comparator_witness = T.comparator_witness = struct + include Comparator.S with type t := t +end) : S with type t := T.t and type comparator_witness = T.comparator_witness = struct module T = struct include T @@ -148,43 +148,43 @@ module Make_using_comparator (T : sig end module Make (T : sig - type t [@@deriving_inline compare, sexp_of] + type t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] - end) = - Make_using_comparator [@inlined hint] (struct - include T - include Comparator.Make (T) - end) + [@@@end] +end) = +Make_using_comparator [@inlined hint] (struct + include T + include Comparator.Make (T) +end) module Inherit (C : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) (T : sig - type t [@@deriving_inline sexp_of] + [@@@end] +end) (T : sig + type t [@@deriving_inline sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] + [@@@end] - val component : t -> C.t - end) = - Make (struct - type t = T.t [@@deriving_inline sexp_of] + val component : t -> C.t +end) = +Make (struct + type t = T.t [@@deriving_inline sexp_of] - let sexp_of_t = (T.sexp_of_t : t -> Sexplib0.Sexp.t) + let sexp_of_t = (T.sexp_of_t : t -> Sexplib0.Sexp.t) - [@@@end] + [@@@end] - let compare t t' = C.compare (T.component t) (T.component t') - end) + let compare t t' = C.compare (T.component t) (T.component t') +end) (* compare [x] and [y] lexicographically using functions in the list [cmps] *) let lexicographic cmps x y = diff --git a/src/comparable_intf.ml b/src/comparable_intf.ml index 8f4280a6..30bd0b00 100644 --- a/src/comparable_intf.ml +++ b/src/comparable_intf.ml @@ -57,7 +57,6 @@ end module type S = sig include Comparisons - (** [ascending] is identical to [compare]. [descending x y = ascending y x]. These are intended to be mnemonic when used like [List.sort ~compare:ascending] and [List.sort ~cmp:descending], since they cause the list to be sorted in ascending or descending @@ -94,7 +93,6 @@ end module type Comparable = sig (** Defines functors for making modules comparable. *) - (** Usage example: {[ @@ -155,77 +153,77 @@ module type Comparable = sig without need for the [sexp_of_t] required by [Make*] (see below). *) module Infix (T : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) : Infix with type t := T.t + [@@@end] + end) : Infix with type t := T.t module Comparisons (T : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) : Comparisons with type t := T.t + [@@@end] + end) : Comparisons with type t := T.t (** Inherit comparability from a component. *) module Inherit (C : sig - type t [@@deriving_inline compare] + type t [@@deriving_inline compare] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) (T : sig - type t [@@deriving_inline sexp_of] + [@@@end] + end) (T : sig + type t [@@deriving_inline sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] + [@@@end] - val component : t -> C.t - end) : S with type t := T.t + val component : t -> C.t + end) : S with type t := T.t module Make (T : sig - type t [@@deriving_inline compare, sexp_of] + type t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] - end) : S with type t := T.t + [@@@end] + end) : S with type t := T.t module Make_using_comparator (T : sig - type t [@@deriving_inline sexp_of] + type t [@@deriving_inline sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] + [@@@end] - include Comparator.S with type t := t - end) : S with type t := T.t with type comparator_witness := T.comparator_witness + include Comparator.S with type t := t + end) : S with type t := T.t with type comparator_witness := T.comparator_witness module Poly (T : sig - type t [@@deriving_inline sexp_of] + type t [@@deriving_inline sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] - end) : S with type t := T.t + [@@@end] + end) : S with type t := T.t module With_zero (T : sig - type t [@@deriving_inline compare, sexp_of] + type t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] + [@@@end] - val zero : t - end) : sig + val zero : t + end) : sig include With_zero with type t := T.t end end diff --git a/src/comparator.ml b/src/comparator.ml index 157f0b6c..6b425ccd 100644 --- a/src/comparator.ml +++ b/src/comparator.ml @@ -51,14 +51,14 @@ module S_to_S1 (S : S) = struct end module Make (M : sig - type t [@@deriving_inline compare, sexp_of] + type t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t - val sexp_of_t : t -> Sexplib0.Sexp.t + val sexp_of_t : t -> Sexplib0.Sexp.t - [@@@end] - end) = + [@@@end] +end) = struct include M @@ -68,11 +68,11 @@ struct end module Make1 (M : sig - type 'a t + type 'a t - val compare : 'a t -> 'a t -> int - val sexp_of_t : 'a t -> Sexp.t - end) = + val compare : 'a t -> 'a t -> int + val sexp_of_t : 'a t -> Sexp.t +end) = struct type comparator_witness @@ -83,11 +83,11 @@ module Poly = struct type 'a t = 'a include Make1 (struct - type 'a t = 'a + type 'a t = 'a - let compare = Poly.compare - let sexp_of_t _ = Sexp.Atom "_" - end) + let compare = Poly.compare + let sexp_of_t _ = Sexp.Atom "_" + end) end module type Derived = sig @@ -98,14 +98,14 @@ module type Derived = sig end module Derived (M : sig - type 'a t [@@deriving_inline compare, sexp_of] + type 'a t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t - val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t - [@@@end] - end) = + [@@@end] +end) = struct type !'cmp comparator_witness @@ -125,18 +125,18 @@ module type Derived2 = sig end module Derived2 (M : sig - type ('a, 'b) t [@@deriving_inline compare, sexp_of] + type ('a, 'b) t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t + include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t - val sexp_of_t - : ('a -> Sexplib0.Sexp.t) - -> ('b -> Sexplib0.Sexp.t) - -> ('a, 'b) t - -> Sexplib0.Sexp.t + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t - [@@@end] - end) = + [@@@end] +end) = struct type (!'cmp_a, !'cmp_b) comparator_witness @@ -157,11 +157,11 @@ module type Derived_phantom = sig end module Derived_phantom (M : sig - type ('a, 'b) t + type ('a, 'b) t - val compare : ('a -> 'a -> int) -> ('a, 'b) t -> ('a, 'b) t -> int - val sexp_of_t : ('a -> Sexp.t) -> ('a, _) t -> Sexp.t - end) = + val compare : ('a -> 'a -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + val sexp_of_t : ('a -> Sexp.t) -> ('a, _) t -> Sexp.t +end) = struct type 'cmp_a comparator_witness @@ -181,17 +181,17 @@ module type Derived2_phantom = sig end module Derived2_phantom (M : sig - type ('a, 'b, 'c) t + type ('a, 'b, 'c) t - val compare - : ('a -> 'a -> int) - -> ('b -> 'b -> int) - -> ('a, 'b, 'c) t - -> ('a, 'b, 'c) t - -> int + val compare + : ('a -> 'a -> int) + -> ('b -> 'b -> int) + -> ('a, 'b, 'c) t + -> ('a, 'b, 'c) t + -> int - val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b, _) t -> Sexp.t - end) = + val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b, _) t -> Sexp.t +end) = struct type (!'cmp_a, !'cmp_b) comparator_witness diff --git a/src/comparator.mli b/src/comparator.mli index 5810ab19..16a2ad20 100644 --- a/src/comparator.mli +++ b/src/comparator.mli @@ -27,7 +27,6 @@ module type S1 = sig val comparator : ('a t, comparator_witness) comparator end - module type S_fc = sig type comparable_t @@ -59,26 +58,25 @@ module S_to_S1 (S : S) : (** [Make] creates a [comparator] value and its phantom [comparator_witness] type for a nullary type. *) module Make (M : sig - type t [@@deriving_inline compare, sexp_of] - - include Ppx_compare_lib.Comparable.S with type t := t + type t [@@deriving_inline compare, sexp_of] - val sexp_of_t : t -> Sexplib0.Sexp.t + include Ppx_compare_lib.Comparable.S with type t := t - [@@@end] - end) : S with type t := M.t + val sexp_of_t : t -> Sexplib0.Sexp.t + [@@@end] +end) : S with type t := M.t (** [Make1] creates a [comparator] value and its phantom [comparator_witness] type for a unary type. It takes a [compare] and [sexp_of_t] that have non-standard types because the [Comparator.t] type doesn't allow passing in additional values for the type argument. *) module Make1 (M : sig - type 'a t + type 'a t - val compare : 'a t -> 'a t -> int - val sexp_of_t : _ t -> Sexp.t - end) : S1 with type 'a t := 'a M.t + val compare : 'a t -> 'a t -> int + val sexp_of_t : _ t -> Sexp.t +end) : S1 with type 'a t := 'a M.t module type Derived = sig type 'a t @@ -90,14 +88,14 @@ end (** [Derived] creates a [comparator] function that constructs a comparator for the type ['a t] given a comparator for the type ['a]. *) module Derived (M : sig - type 'a t [@@deriving_inline compare, sexp_of] + type 'a t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t - val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t + val sexp_of_t : ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t - [@@@end] - end) : Derived with type 'a t := 'a M.t + [@@@end] +end) : Derived with type 'a t := 'a M.t module type Derived2 = sig type ('a, 'b) t @@ -112,18 +110,18 @@ end (** [Derived2] creates a [comparator] function that constructs a comparator for the type [('a, 'b) t] given comparators for the type ['a] and ['b]. *) module Derived2 (M : sig - type ('a, 'b) t [@@deriving_inline compare, sexp_of] + type ('a, 'b) t [@@deriving_inline compare, sexp_of] - include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t + include Ppx_compare_lib.Comparable.S2 with type ('a, 'b) t := ('a, 'b) t - val sexp_of_t - : ('a -> Sexplib0.Sexp.t) - -> ('b -> Sexplib0.Sexp.t) - -> ('a, 'b) t - -> Sexplib0.Sexp.t + val sexp_of_t + : ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t - [@@@end] - end) : Derived2 with type ('a, 'b) t := ('a, 'b) M.t + [@@@end] +end) : Derived2 with type ('a, 'b) t := ('a, 'b) M.t module type Derived_phantom = sig type ('a, 'b) t @@ -137,11 +135,11 @@ end (** [Derived_phantom] creates a [comparator] function that constructs a comparator for the type [('a, 'b) t] given a comparator for the type ['a]. *) module Derived_phantom (M : sig - type ('a, 'b) t + type ('a, 'b) t - val compare : ('a -> 'a -> int) -> ('a, 'b) t -> ('a, 'b) t -> int - val sexp_of_t : ('a -> Sexp.t) -> ('a, _) t -> Sexp.t - end) : Derived_phantom with type ('a, 'b) t := ('a, 'b) M.t + val compare : ('a -> 'a -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + val sexp_of_t : ('a -> Sexp.t) -> ('a, _) t -> Sexp.t +end) : Derived_phantom with type ('a, 'b) t := ('a, 'b) M.t module type Derived2_phantom = sig type ('a, 'b, 'c) t @@ -156,14 +154,14 @@ end (** [Derived2_phantom] creates a [comparator] function that constructs a comparator for the type [('a, 'b, 'c) t] given a comparator for the types ['a] and ['b]. *) module Derived2_phantom (M : sig - type ('a, 'b, 'c) t + type ('a, 'b, 'c) t - val compare - : ('a -> 'a -> int) - -> ('b -> 'b -> int) - -> ('a, 'b, 'c) t - -> ('a, 'b, 'c) t - -> int + val compare + : ('a -> 'a -> int) + -> ('b -> 'b -> int) + -> ('a, 'b, 'c) t + -> ('a, 'b, 'c) t + -> int - val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b, _) t -> Sexp.t - end) : Derived2_phantom with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t + val sexp_of_t : ('a -> Sexp.t) -> ('b -> Sexp.t) -> ('a, 'b, _) t -> Sexp.t +end) : Derived2_phantom with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t diff --git a/src/container.ml b/src/container.ml index f9230755..55e77dc4 100644 --- a/src/container.ml +++ b/src/container.ml @@ -139,29 +139,29 @@ end module Make (T : Make_arg) = struct include Make_gen (struct - include T + include T - type ('a, _) t = 'a T.t - type 'a elt = 'a - end) + type ('a, _) t = 'a T.t + type 'a elt = 'a + end) end module Make0 (T : Make0_arg) = struct include Make_gen (struct - include T + include T - type ('a, _) t = T.t - type 'a elt = T.Elt.t - end) + type ('a, _) t = T.t + type 'a elt = T.Elt.t + end) let mem t x = mem t x ~equal:T.Elt.equal end module Make_gen_with_creators (T : Make_gen_with_creators_arg) : Generic_with_creators - with type ('a, 'phantom) t := ('a, 'phantom) T.t - and type 'a elt := 'a T.elt - and type ('a, 'phantom) concat := ('a, 'phantom) T.concat = struct + with type ('a, 'phantom) t := ('a, 'phantom) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom) concat := ('a, 'phantom) T.concat = struct include Make_gen (T) let of_list = T.of_list @@ -205,26 +205,26 @@ end module Make_with_creators (T : Make_with_creators_arg) = struct include Make_gen_with_creators (struct - include T + include T - type ('a, _) t = 'a T.t - type 'a elt = 'a - type ('a, _) concat = 'a T.t + type ('a, _) t = 'a T.t + type 'a elt = 'a + type ('a, _) concat = 'a T.t - let concat_of_array = of_array - end) + let concat_of_array = of_array + end) end module Make0_with_creators (T : Make0_with_creators_arg) = struct include Make_gen_with_creators (struct - include T + include T - type ('a, _) t = T.t - type 'a elt = T.Elt.t - type ('a, _) concat = 'a list + type ('a, _) t = T.t + type 'a elt = T.Elt.t + type ('a, _) concat = 'a list - let concat_of_array = Array.to_list - end) + let concat_of_array = Array.to_list + end) let mem t x = mem t x ~equal:T.Elt.equal end diff --git a/src/container_intf.ml b/src/container_intf.ml index 4b84014c..29bfb66c 100644 --- a/src/container_intf.ml +++ b/src/container_intf.ml @@ -634,9 +634,9 @@ module type Make_with_creators_arg = sig include Make_common_with_creators_arg - with type ('a, _) t := 'a t - and type 'a elt := 'a - and type ('a, _) concat := 'a t + with type ('a, _) t := 'a t + and type 'a elt := 'a + and type ('a, _) concat := 'a t end module type Make0_with_creators_arg = sig @@ -650,9 +650,9 @@ module type Make0_with_creators_arg = sig include Make_common_with_creators_arg - with type ('a, _) t := t - and type 'a elt := Elt.t - and type ('a, _) concat := 'a list + with type ('a, _) t := t + and type 'a elt := Elt.t + and type ('a, _) concat := 'a list end module type Derived = sig @@ -770,7 +770,7 @@ module type Container = sig module Make_gen_with_creators (T : Make_gen_with_creators_arg) : Generic_with_creators - with type ('a, 'phantom) t := ('a, 'phantom) T.t - and type 'a elt := 'a T.elt - and type ('a, 'phantom) concat := ('a, 'phantom) T.concat + with type ('a, 'phantom) t := ('a, 'phantom) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom) concat := ('a, 'phantom) T.concat end diff --git a/src/dictionary_immutable_intf.ml b/src/dictionary_immutable_intf.ml index 82ebb8ed..8dfc6d94 100644 --- a/src/dictionary_immutable_intf.ml +++ b/src/dictionary_immutable_intf.ml @@ -51,7 +51,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [find]. Raises if there is no value for the given key. *) val find_exn @@ -67,7 +67,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [add]. Raises on duplicates. *) val add_exn @@ -78,7 +78,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds or replaces a key/value pair in the dictionary. *) val set @@ -89,7 +89,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Removes any value for the given key. *) val remove @@ -97,7 +97,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds, replaces, or removes the value for a given key, depending on its current value or lack thereof. *) @@ -109,7 +109,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds or replaces the value for a given key, depending on its current value or lack thereof. *) @@ -121,7 +121,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds [data] to the existing key/value pair for [key]. Interprets a missing key as having an empty list. *) @@ -133,7 +133,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Removes one element from the existing key/value pair for [key]. Removes the key entirely if the new list is empty. *) @@ -142,7 +142,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Produces the list associated with the corresponding key. Interprets a missing key as having an empty list. *) @@ -151,7 +151,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Combines every value in the dictionary. *) val fold @@ -169,7 +169,7 @@ module Definitions = struct -> data:'data -> 'acc -> ('acc, 'final) Container.Continue_or_stop.t) - [@local]) + [@local]) -> finish:(('acc -> 'final)[@local]) -> 'final @@ -299,7 +299,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Splits the [fst] and [snd] components of values associated with keys into separate dictionaries. *) @@ -316,12 +316,12 @@ module Definitions = struct ((key:'key key -> [ `Left of 'data1 | `Right of 'data2 | `Both of 'data1 * 'data2 ] -> 'data3 option) - [@local]) + [@local]) -> ('key, 'data3, 'phantom) t , 'key , 'data , 'phantom ) - accessor + accessor (** Merges two dictionaries by traversing only the smaller of the two. Adds key/value pairs missing from the larger dictionary, and [combine]s duplicate values. *) @@ -333,7 +333,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Computes a sequence of differences between two dictionaries. *) val symmetric_diff @@ -341,11 +341,11 @@ module Definitions = struct -> ('key, 'data, 'phantom) t -> data_equal:('data -> 'data -> bool) -> ('key key * [ `Left of 'data | `Right of 'data | `Unequal of 'data * 'data ]) - Sequence.t + Sequence.t , 'key , 'data , 'phantom ) - accessor + accessor (** Folds over the result of [symmetric_diff]. May be more performant. *) val fold_symmetric_diff @@ -358,12 +358,12 @@ module Definitions = struct -> 'key key * [ `Left of 'data | `Right of 'data | `Unequal of 'data * 'data ] -> 'acc) - [@local]) + [@local]) -> 'acc , 'key , 'data , 'phantom ) - accessor + accessor end module type Accessors1 = sig @@ -373,9 +373,9 @@ module Definitions = struct (** @inline *) include Accessors - with type (_, 'data, _) t := 'data t - and type _ key := key - and type ('fn, _, _, _) accessor := 'fn + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn end module type Accessors2 = sig @@ -385,9 +385,9 @@ module Definitions = struct (** @inline *) include Accessors - with type ('key, 'data, _) t := ('key, 'data) t - and type 'key key := 'key - and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor end module type Accessors3 = sig @@ -397,10 +397,10 @@ module Definitions = struct (** @inline *) include Accessors - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor end module type Creators = sig @@ -431,7 +431,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Returns a [Result.t]. *) val of_alist_or_error @@ -439,7 +439,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Raises on duplicates. *) val of_alist_exn @@ -447,7 +447,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Produces a dictionary mapping each key to a list of associated values. *) val of_alist_multi @@ -455,7 +455,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Produces a dictionary using each key/value pair. Combines all values for a given key with [init] using [f]. *) @@ -467,7 +467,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Produces a dictionary using each key/value pair. Combines multiple values for a given key using [f]. *) @@ -478,7 +478,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Consumes a sequence. *) val of_sequence @@ -487,7 +487,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_or_error]. Consumes a sequence. *) val of_sequence_or_error @@ -495,7 +495,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_exn]. Consumes a sequence. *) val of_sequence_exn @@ -503,7 +503,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_multi]. Consumes a sequence. *) val of_sequence_multi @@ -511,7 +511,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_fold]. Consumes a sequence. *) val of_sequence_fold @@ -522,7 +522,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_reduce]. Consumes a sequence. *) val of_sequence_reduce @@ -532,7 +532,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Consume values for which keys can be computed. *) val of_list_with_key @@ -542,7 +542,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_or_error]. Consume values for which keys can be computed. *) val of_list_with_key_or_error @@ -552,7 +552,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_exn]. Consume values for which keys can be computed. *) val of_list_with_key_exn @@ -560,7 +560,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_multi]. Consume values for which keys can be computed. *) val of_list_with_key_multi @@ -570,7 +570,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Produces a dictionary of all key/value pairs that [iteri] passes to [~f]. Fails if a duplicate key is found. *) @@ -580,7 +580,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_iteri]. Raises on duplicate key. *) val of_iteri_exn @@ -589,7 +589,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator end module type Creators1 = sig @@ -599,9 +599,9 @@ module Definitions = struct (** @inline *) include Creators - with type (_, 'data, _) t := 'data t - and type _ key := key - and type ('fn, _, _, _) creator := 'fn + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) creator := 'fn end module type Creators2 = sig @@ -611,9 +611,9 @@ module Definitions = struct (** @inline *) include Creators - with type ('key, 'data, _) t := ('key, 'data) t - and type 'key key := 'key - and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator end module type Creators3 = sig @@ -623,10 +623,10 @@ module Definitions = struct (** @inline *) include Creators - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end module type S = sig @@ -638,18 +638,18 @@ module Definitions = struct (** @inline *) include Accessors - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key key - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor (** @inline *) include Creators - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key key - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end module type S1 = sig @@ -659,10 +659,10 @@ module Definitions = struct (** @inline *) include S - with type (_, 'data, _) t := 'data t - and type _ key := key - and type ('fn, _, _, _) accessor := 'fn - and type ('fn, _, _, _) creator := 'fn + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn + and type ('fn, _, _, _) creator := 'fn end module type S2 = sig @@ -673,10 +673,10 @@ module Definitions = struct (** @inline *) include S - with type ('key, 'data, _) t := ('key, 'data) t - and type 'key key := 'key - and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor - and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator end module type S3 = sig @@ -687,12 +687,12 @@ module Definitions = struct (** @inline *) include S - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end end diff --git a/src/dictionary_mutable_intf.ml b/src/dictionary_mutable_intf.ml index f0108f68..0517072d 100644 --- a/src/dictionary_mutable_intf.ml +++ b/src/dictionary_mutable_intf.ml @@ -62,7 +62,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [find]. Raises if there is no value for the given key. *) val find_exn @@ -77,7 +77,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [find]. Adds [default key] if no value exists. *) val findi_or_add @@ -88,7 +88,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [find]. Calls [if_found data] if a value exists, or [if_not_found key] otherwise. Avoids allocation [Some]. *) @@ -101,7 +101,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [findi]. Calls [if_found ~key ~data] if a value exists. *) val findi_and_call @@ -113,7 +113,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [find]. Removes the value for [key], if any, from the dictionary before returning it. *) @@ -122,7 +122,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds a key/value pair for a key the dictionary does not contain, or reports a duplicate. *) @@ -131,7 +131,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [add]. Raises on duplicates. *) val add_exn @@ -139,7 +139,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds or replaces a key/value pair in the dictionary. *) val set @@ -147,7 +147,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Removes any value for the given key. *) val remove @@ -163,7 +163,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds or replaces the value for a given key, depending on its current value or lack thereof. *) @@ -175,7 +175,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Like [update]. Returns the new value. *) val update_and_return @@ -195,7 +195,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Subtracts [by] from the value for [key], default 0 if [key] is absent. May remove [key] if the result is [0], depending on [remove_if_zero]. *) @@ -208,7 +208,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Adds [data] to the existing key/value pair for [key]. Interprets a missing key as having an empty list. *) @@ -217,7 +217,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Removes one element from the existing key/value pair for [key]. Removes the key entirely if the new list is empty. *) @@ -231,7 +231,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - accessor + accessor (** Combines every value in the dictionary. *) val fold @@ -410,12 +410,12 @@ module Definitions = struct ((key:'key key -> [ `Left of 'data1 | `Right of 'data2 | `Both of 'data1 * 'data2 ] -> 'data3 option) - [@local]) + [@local]) -> ('key, 'data3, 'phantom) t , 'key , 'data3 , 'phantom ) - accessor + accessor (** Merges two dictionaries by traversing [src] and adding to [dst]. Computes the effect on [dst] of each key/value pair in [src] using [f]. *) @@ -424,12 +424,12 @@ module Definitions = struct -> dst:('key, 'data2, 'phantom) t -> f: ((key:'key key -> 'data1 -> 'data2 option -> 'data2 Merge_into_action.t) - [@local]) + [@local]) -> unit , 'key , 'data , 'phantom ) - accessor + accessor end module type Accessors1 = sig @@ -438,9 +438,9 @@ module Definitions = struct include Accessors - with type (_, 'data, _) t := 'data t - and type _ key := key - and type ('fn, _, _, _) accessor := 'fn + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn end module type Accessors2 = sig @@ -449,9 +449,9 @@ module Definitions = struct include Accessors - with type ('key, 'data, _) t := ('key, 'data) t - and type 'key key := 'key - and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor end module type Accessors3 = sig @@ -460,10 +460,10 @@ module Definitions = struct include Accessors - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor end module type Creators = sig @@ -490,7 +490,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. On failure, provides all duplicate keys instead of a single representative. *) @@ -500,7 +500,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Returns a [Result.t]. *) val of_alist_or_error @@ -508,7 +508,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Raises on duplicates. *) val of_alist_exn @@ -516,7 +516,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Produces a dictionary mapping each key to a list of associated values. *) val of_alist_multi @@ -524,7 +524,7 @@ module Definitions = struct , 'key , 'data list , 'phantom ) - creator + creator (** Like [of_alist]. Consume a list of elements for which key/value pairs can be computed. *) @@ -536,7 +536,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist]. Consume values for which keys can be computed. *) val create_with_key @@ -546,7 +546,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_or_error]. Consume values for which keys can be computed. *) val create_with_key_or_error @@ -556,7 +556,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [of_alist_exn]. Consume values for which keys can be computed. *) val create_with_key_exn @@ -564,7 +564,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator (** Like [create_mapped]. Multiple values for a key are [combine]d rather than producing an error. *) @@ -577,7 +577,7 @@ module Definitions = struct , 'key , 'data , 'phantom ) - creator + creator end module type Creators1 = sig @@ -587,9 +587,9 @@ module Definitions = struct (** @inline *) include Creators - with type (_, 'data, _) t := 'data t - and type _ key := key - and type ('fn, _, _, _) creator := 'fn + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) creator := 'fn end module type Creators2 = sig @@ -599,9 +599,9 @@ module Definitions = struct (** @inline *) include Creators - with type ('key, 'data, _) t := ('key, 'data) t - and type 'key key := 'key - and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator end module type Creators3 = sig @@ -611,10 +611,10 @@ module Definitions = struct (** @inline *) include Creators - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end module type S = sig @@ -626,18 +626,18 @@ module Definitions = struct (** @inline *) include Accessors - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key key - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor (** @inline *) include Creators - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key key - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key key + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end module type S1 = sig @@ -647,10 +647,10 @@ module Definitions = struct (** @inline *) include S - with type (_, 'data, _) t := 'data t - and type _ key := key - and type ('fn, _, _, _) accessor := 'fn - and type ('fn, _, _, _) creator := 'fn + with type (_, 'data, _) t := 'data t + and type _ key := key + and type ('fn, _, _, _) accessor := 'fn + and type ('fn, _, _, _) creator := 'fn end module type S2 = sig @@ -661,10 +661,10 @@ module Definitions = struct (** @inline *) include S - with type ('key, 'data, _) t := ('key, 'data) t - and type 'key key := 'key - and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor - and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + with type ('key, 'data, _) t := ('key, 'data) t + and type 'key key := 'key + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator end module type S3 = sig @@ -675,12 +675,12 @@ module Definitions = struct (** @inline *) include S - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type 'key key := 'key - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type 'key key := 'key + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end end diff --git a/src/discover/discover.ml b/src/discover/discover.ml index f2e0b921..47786c0d 100644 --- a/src/discover/discover.ml +++ b/src/discover/discover.ml @@ -15,6 +15,6 @@ let () = ~name:"discover" ~args:[ "-o", Set_string output, "FILENAME output file" ] (fun c -> - let has_popcnt = c_test c ~c_flags:[ "-mpopcnt" ] program in - Flags.write_sexp !output (if has_popcnt then [ "-mpopcnt" ] else [])) + let has_popcnt = c_test c ~c_flags:[ "-mpopcnt" ] program in + Flags.write_sexp !output (if has_popcnt then [ "-mpopcnt" ] else [])) ;; diff --git a/src/either.ml b/src/either.ml index 455eb5c3..4ce4355f 100644 --- a/src/either.ml +++ b/src/either.ml @@ -63,21 +63,21 @@ module Focus = struct end module Make_focused (M : sig - type (+'a, +'b) t + type (+'a, +'b) t - val return : 'a -> ('a, _) t - val other : 'b -> (_, 'b) t - val focus : ('a, 'b) t -> (('a, 'b) Focus.t[@local]) + val return : 'a -> ('a, _) t + val other : 'b -> (_, 'b) t + val focus : ('a, 'b) t -> (('a, 'b) Focus.t[@local]) - val combine - : ('a, 'd) t - -> ('b, 'd) t - -> f:(('a -> 'b -> 'c)[@local]) - -> other:(('d -> 'd -> 'd)[@local]) - -> ('c, 'd) t + val combine + : ('a, 'd) t + -> ('b, 'd) t + -> f:(('a -> 'b -> 'c)[@local]) + -> other:(('d -> 'd -> 'd)[@local]) + -> ('c, 'd) t - val bind : ('a, 'b) t -> f:(('a -> ('c, 'b) t)[@local]) -> ('c, 'b) t - end) = + val bind : ('a, 'b) t -> f:(('a -> ('c, 'b) t)[@local]) -> ('c, 'b) t +end) = struct include M open With_return @@ -88,24 +88,24 @@ struct ;; include Monad.Make2_local (struct - type nonrec ('a, 'b) t = ('a, 'b) t + type nonrec ('a, 'b) t = ('a, 'b) t - let return = return - let bind = bind - let map = `Custom map - end) + let return = return + let bind = bind + let map = `Custom map + end) module App = Applicative.Make2_using_map2_local (struct - type nonrec ('a, 'b) t = ('a, 'b) t + type nonrec ('a, 'b) t = ('a, 'b) t - let return = return - let map = `Custom map + let return = return + let map = `Custom map - let map2 : ('a, 'x) t -> ('b, 'x) t -> f:(('a -> 'b -> 'c)[@local]) -> ('c, 'x) t = - fun t1 t2 ~f -> - bind t1 ~f:(fun x -> bind t2 ~f:(fun y -> return (f x y)) [@nontail]) [@nontail] - ;; - end) + let map2 : ('a, 'x) t -> ('b, 'x) t -> f:(('a -> 'b -> 'c)[@local]) -> ('c, 'x) t = + fun t1 t2 ~f -> + bind t1 ~f:(fun x -> bind t2 ~f:(fun y -> return (f x y)) [@nontail]) [@nontail] + ;; + end) include App @@ -163,58 +163,58 @@ struct end module First = Make_focused (struct - type nonrec ('a, 'b) t = ('a, 'b) t + type nonrec ('a, 'b) t = ('a, 'b) t - let return = first - let other = second + let return = first + let other = second - let focus t : _ Focus.t = - match t with - | First x -> Focus { value = x } - | Second y -> Other { value = y } - ;; + let focus t : _ Focus.t = + match t with + | First x -> Focus { value = x } + | Second y -> Other { value = y } + ;; - let combine t1 t2 ~f ~other = - match t1, t2 with - | First x, First y -> First (f x y) - | Second x, Second y -> Second (other x y) - | Second x, _ | _, Second x -> Second x - ;; + let combine t1 t2 ~f ~other = + match t1, t2 with + | First x, First y -> First (f x y) + | Second x, Second y -> Second (other x y) + | Second x, _ | _, Second x -> Second x + ;; - let bind t ~f = - match t with - | First x -> f x - (* Reuse the value in order to avoid allocation. *) - | Second _ as y -> y - ;; - end) + let bind t ~f = + match t with + | First x -> f x + (* Reuse the value in order to avoid allocation. *) + | Second _ as y -> y + ;; +end) module Second = Make_focused (struct - type nonrec ('a, 'b) t = ('b, 'a) t + type nonrec ('a, 'b) t = ('b, 'a) t - let return = second - let other = first + let return = second + let other = first - let focus t : _ Focus.t = - match t with - | Second x -> Focus { value = x } - | First y -> Other { value = y } - ;; + let focus t : _ Focus.t = + match t with + | Second x -> Focus { value = x } + | First y -> Other { value = y } + ;; - let combine t1 t2 ~f ~other = - match t1, t2 with - | Second x, Second y -> Second (f x y) - | First x, First y -> First (other x y) - | First x, _ | _, First x -> First x - ;; + let combine t1 t2 ~f ~other = + match t1, t2 with + | Second x, Second y -> Second (f x y) + | First x, First y -> First (other x y) + | First x, _ | _, First x -> First x + ;; - let bind t ~f = - match t with - | Second x -> f x - (* Reuse the value in order to avoid allocation, like [First.bind] above. *) - | First _ as y -> y - ;; - end) + let bind t ~f = + match t with + | Second x -> f x + (* Reuse the value in order to avoid allocation, like [First.bind] above. *) + | First _ as y -> y + ;; +end) module Export = struct type ('f, 's) _either = ('f, 's) t = diff --git a/src/either0.ml b/src/either0.ml index 2275adcd..4aae1f65 100644 --- a/src/either0.ml +++ b/src/either0.ml @@ -6,12 +6,12 @@ type ('f, 's) t = [@@deriving_inline compare ~localize, hash, sexp, sexp_grammar] let compare__local : - 'f 's. - (('f[@ocaml.local]) -> ('f[@ocaml.local]) -> int) - -> (('s[@ocaml.local]) -> ('s[@ocaml.local]) -> int) - -> (('f, 's) t[@ocaml.local]) - -> (('f, 's) t[@ocaml.local]) - -> int + 'f 's. + (('f[@ocaml.local]) -> ('f[@ocaml.local]) -> int) + -> (('s[@ocaml.local]) -> ('s[@ocaml.local]) -> int) + -> (('f, 's) t[@ocaml.local]) + -> (('f, 's) t[@ocaml.local]) + -> int = fun _cmp__f _cmp__s a__007_ b__008_ -> if Stdlib.( == ) a__007_ b__008_ @@ -25,7 +25,7 @@ let compare__local : ;; let compare : - 'f 's. ('f -> 'f -> int) -> ('s -> 's -> int) -> ('f, 's) t -> ('f, 's) t -> int + 'f 's. ('f -> 'f -> int) -> ('s -> 's -> int) -> ('f, 's) t -> ('f, 's) t -> int = fun _cmp__f _cmp__s a__001_ b__002_ -> if Stdlib.( == ) a__001_ b__002_ @@ -59,70 +59,70 @@ let hash_fold_t ;; let t_of_sexp : - 'f 's. - (Sexplib0.Sexp.t -> 'f) -> (Sexplib0.Sexp.t -> 's) -> Sexplib0.Sexp.t -> ('f, 's) t + 'f 's. + (Sexplib0.Sexp.t -> 'f) -> (Sexplib0.Sexp.t -> 's) -> Sexplib0.Sexp.t -> ('f, 's) t = fun (type f__029_ s__030_) - : ((Sexplib0.Sexp.t -> f__029_) -> (Sexplib0.Sexp.t -> s__030_) -> Sexplib0.Sexp.t - -> (f__029_, s__030_) t) -> - let error_source__017_ = "either0.ml.t" in - fun _of_f__013_ _of_s__014_ -> function - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("first" | "First") as _tag__020_) :: sexp_args__021_) as - _sexp__019_ -> - (match sexp_args__021_ with - | arg0__022_ :: [] -> - let res0__023_ = _of_f__013_ arg0__022_ in - First res0__023_ - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__017_ - _tag__020_ - _sexp__019_) - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("second" | "Second") as _tag__025_) :: sexp_args__026_) as - _sexp__024_ -> - (match sexp_args__026_ with - | arg0__027_ :: [] -> - let res0__028_ = _of_s__014_ arg0__027_ in - Second res0__028_ - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__017_ - _tag__025_ - _sexp__024_) - | Sexplib0.Sexp.Atom ("first" | "First") as sexp__018_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__017_ sexp__018_ - | Sexplib0.Sexp.Atom ("second" | "Second") as sexp__018_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__017_ sexp__018_ - | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__016_ -> - Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__017_ sexp__016_ - | Sexplib0.Sexp.List [] as sexp__016_ -> - Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__017_ sexp__016_ - | sexp__016_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__017_ sexp__016_ + : ((Sexplib0.Sexp.t -> f__029_) -> (Sexplib0.Sexp.t -> s__030_) -> Sexplib0.Sexp.t + -> (f__029_, s__030_) t) -> + let error_source__017_ = "either0.ml.t" in + fun _of_f__013_ _of_s__014_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("first" | "First") as _tag__020_) :: sexp_args__021_) as + _sexp__019_ -> + (match sexp_args__021_ with + | arg0__022_ :: [] -> + let res0__023_ = _of_f__013_ arg0__022_ in + First res0__023_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__017_ + _tag__020_ + _sexp__019_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("second" | "Second") as _tag__025_) :: sexp_args__026_) as + _sexp__024_ -> + (match sexp_args__026_ with + | arg0__027_ :: [] -> + let res0__028_ = _of_s__014_ arg0__027_ in + Second res0__028_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__017_ + _tag__025_ + _sexp__024_) + | Sexplib0.Sexp.Atom ("first" | "First") as sexp__018_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__017_ sexp__018_ + | Sexplib0.Sexp.Atom ("second" | "Second") as sexp__018_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__017_ sexp__018_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__016_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__017_ sexp__016_ + | Sexplib0.Sexp.List [] as sexp__016_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__017_ sexp__016_ + | sexp__016_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__017_ sexp__016_ ;; let sexp_of_t : - 'f 's. - ('f -> Sexplib0.Sexp.t) -> ('s -> Sexplib0.Sexp.t) -> ('f, 's) t -> Sexplib0.Sexp.t + 'f 's. + ('f -> Sexplib0.Sexp.t) -> ('s -> Sexplib0.Sexp.t) -> ('f, 's) t -> Sexplib0.Sexp.t = fun (type f__037_ s__038_) - : ((f__037_ -> Sexplib0.Sexp.t) -> (s__038_ -> Sexplib0.Sexp.t) - -> (f__037_, s__038_) t -> Sexplib0.Sexp.t) -> - fun _of_f__031_ _of_s__032_ -> function - | First arg0__033_ -> - let res0__034_ = _of_f__031_ arg0__033_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "First"; res0__034_ ] - | Second arg0__035_ -> - let res0__036_ = _of_s__032_ arg0__035_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Second"; res0__036_ ] + : ((f__037_ -> Sexplib0.Sexp.t) -> (s__038_ -> Sexplib0.Sexp.t) + -> (f__037_, s__038_) t -> Sexplib0.Sexp.t) -> + fun _of_f__031_ _of_s__032_ -> function + | First arg0__033_ -> + let res0__034_ = _of_f__031_ arg0__033_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "First"; res0__034_ ] + | Second arg0__035_ -> + let res0__036_ = _of_s__032_ arg0__035_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Second"; res0__036_ ] ;; let t_sexp_grammar : - 'f 's. - 'f Sexplib0.Sexp_grammar.t - -> 's Sexplib0.Sexp_grammar.t - -> ('f, 's) t Sexplib0.Sexp_grammar.t + 'f 's. + 'f Sexplib0.Sexp_grammar.t + -> 's Sexplib0.Sexp_grammar.t + -> ('f, 's) t Sexplib0.Sexp_grammar.t = fun _'f_sexp_grammar _'s_sexp_grammar -> { untyped = diff --git a/src/error.ml b/src/error.ml index 94e84d9e..e82588ea 100644 --- a/src/error.ml +++ b/src/error.ml @@ -12,8 +12,8 @@ let to_info t = t let of_info t = t include Pretty_printer.Register_pp (struct - type nonrec t = t + type nonrec t = t - let module_name = "Base.Error" - let pp = pp - end) + let module_name = "Base.Error" + let pp = pp +end) diff --git a/src/exn.ml b/src/exn.ml index 3b31f346..794a9bcd 100644 --- a/src/exn.ml +++ b/src/exn.ml @@ -100,16 +100,16 @@ let does_raise (type a) (f : unit -> a) = ;; include Pretty_printer.Register_pp (struct - type t = exn + type t = exn - let pp ppf t = - match sexp_of_exn_opt t with - | Some sexp -> Sexp.pp_hum ppf sexp - | None -> Stdlib.Format.pp_print_string ppf (Stdlib.Printexc.to_string t) - ;; + let pp ppf t = + match sexp_of_exn_opt t with + | Some sexp -> Sexp.pp_hum ppf sexp + | None -> Stdlib.Format.pp_print_string ppf (Stdlib.Printexc.to_string t) + ;; - let module_name = "Base.Exn" - end) + let module_name = "Base.Exn" +end) let print_with_backtrace exc raw_backtrace = Stdlib.Format.eprintf "@[<2>Uncaught exception:@\n@\n@[%a@]@]@\n@." pp exc; diff --git a/src/exn.mli b/src/exn.mli index 47b2b34f..f032c39e 100644 --- a/src/exn.mli +++ b/src/exn.mli @@ -48,7 +48,6 @@ val reraise : t -> string -> _ ]} *) val reraisef : t -> ('a, unit, string, unit -> _) format4 -> 'a - (** Human-readable, multi-line. *) val to_string : t -> string @@ -61,7 +60,6 @@ val protectx : f:(('a -> 'b)[@local]) -> 'a -> finally:(('a -> unit)[@local]) -> val protect : f:((unit -> 'a)[@local]) -> finally:((unit -> unit)[@local]) -> 'a - (** [handle_uncaught ~exit f] catches an exception escaping [f] and prints an error message to stderr. Exits with return code 1 if [exit] is [true], and returns unit otherwise. @@ -86,7 +84,6 @@ val handle_uncaught_and_exit : ((unit -> 'a)[@local]) -> 'a {v : Program died with Reraised("rogue_function", Failure "foo") v} *) val reraise_uncaught : string -> ((unit -> 'a)[@local]) -> 'a - (** [does_raise f] returns [true] iff [f ()] raises, which is often useful in unit tests. *) val does_raise : ((unit -> _)[@local]) -> bool diff --git a/src/float.ml b/src/float.ml index 9f723f8b..283fb5eb 100644 --- a/src/float.ml +++ b/src/float.ml @@ -442,7 +442,7 @@ let round_nearest_half_to_even t = else if diff_floor > diff_ceil then ceil_or_succ else if (* exact tie, pick the even *) - mod_float floor 2. = 0. + mod_float floor 2. = 0. then floor else ceil_or_succ) ;; @@ -566,17 +566,17 @@ module Class = struct Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__007_ sexp__006_ | sexp__006_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__007_ sexp__006_ - : Sexplib0.Sexp.t -> t) + : Sexplib0.Sexp.t -> t) ;; let sexp_of_t = (function - | Infinite -> Sexplib0.Sexp.Atom "Infinite" - | Nan -> Sexplib0.Sexp.Atom "Nan" - | Normal -> Sexplib0.Sexp.Atom "Normal" - | Subnormal -> Sexplib0.Sexp.Atom "Subnormal" - | Zero -> Sexplib0.Sexp.Atom "Zero" - : t -> Sexplib0.Sexp.t) + | Infinite -> Sexplib0.Sexp.Atom "Infinite" + | Nan -> Sexplib0.Sexp.Atom "Nan" + | Normal -> Sexplib0.Sexp.Atom "Normal" + | Subnormal -> Sexplib0.Sexp.Atom "Subnormal" + | Zero -> Sexplib0.Sexp.Atom "Zero" + : t -> Sexplib0.Sexp.t) ;; let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = @@ -677,7 +677,7 @@ let to_padded_compact_string_custom t ?(prefix = "") ~kilo ~mega ~giga ~tera ?pe else if diff_right > diff_left then k else if (* a tie *) - Int_replace_polymorphic_compare.( = ) (k mod 2) 0 + Int_replace_polymorphic_compare.( = ) (k mod 2) 0 then k else k + 1 in @@ -824,7 +824,7 @@ let round_gen x ~how = integers are, but their inverses in most cases are not. *) let abs_dd = Int.abs dd in if abs_dd > 22 || sd >= 16 - (* 10**22 is exactly representable as a float, but 10**23 is not, so use the slow + (* 10**22 is exactly representable as a float, but 10**23 is not, so use the slow path. Similarly, if we need 16 significant digits in the result, then the integer [round_nearest (x order)] might not be exactly representable as a float, since for some ranges we only have 15 digits of precision guaranteed. @@ -967,10 +967,10 @@ module Terse = struct end include Comparable.With_zero (struct - include T + include T - let zero = zero - end) + let zero = zero +end) (* These are partly here as a performance hack to avoid some boxing we're getting with the versions we get from [With_zero]. They also make [Float.is_negative nan] and @@ -982,11 +982,11 @@ let is_negative t = t < 0. let is_non_positive t = t <= 0. include Pretty_printer.Register (struct - include T + include T - let module_name = "Base.Float" - let to_string = to_string - end) + let module_name = "Base.Float" + let to_string = to_string +end) module O = struct let ( + ) = ( + ) diff --git a/src/float.mli b/src/float.mli index 5e768174..3747ac48 100644 --- a/src/float.mli +++ b/src/float.mli @@ -244,7 +244,6 @@ val round_significant : float -> significant_digits:int -> float *) val round_decimal : float -> decimal_digits:int -> float - val is_nan : t -> bool (** A float is infinite when it is either [infinity] or [neg_infinity]. *) @@ -316,7 +315,6 @@ val neg : t -> t val scale : t -> t -> t val abs : t -> t - (** A sub-module designed to be opened to make working with floats more convenient. *) module O : sig val ( + ) : t -> t -> t @@ -365,7 +363,7 @@ val to_string_hum -> ?decimals:int (** defaults to [3] *) -> ?strip_zero:bool (** defaults to [false] *) -> ?explicit_plus:bool - (** Forces a + in front of non-negative values. Defaults + (** Forces a + in front of non-negative values. Defaults to [false] *) -> t -> string @@ -473,109 +471,109 @@ val frexp : t -> t * int (** Base 10 logarithm. *) external log10 : t -> t = "caml_log10_float" "log10" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Base 2 logarithm. *) external log2 : t -> t = "caml_log2_float" "caml_log2" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** [expm1 x] computes [exp x -. 1.0], giving numerically-accurate results even if [x] is close to [0.0]. *) external expm1 : t -> t = "caml_expm1_float" "caml_expm1" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** [log1p x] computes [log(1.0 +. x)] (natural logarithm), giving numerically-accurate results even if [x] is close to [0.0]. *) external log1p : t -> t = "caml_log1p_float" "caml_log1p" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** [copysign x y] returns a float whose absolute value is that of [x] and whose sign is that of [y]. If [x] is [nan], returns [nan]. If [y] is [nan], returns either [x] or [-. x], but it is not specified which. *) external copysign : t -> t -> t = "caml_copysign_float" "caml_copysign" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Cosine. Argument is in radians. *) external cos : t -> t = "caml_cos_float" "cos" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Sine. Argument is in radians. *) external sin : t -> t = "caml_sin_float" "sin" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Tangent. Argument is in radians. *) external tan : t -> t = "caml_tan_float" "tan" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Arc cosine. The argument must fall within the range [[-1.0, 1.0]]. Result is in radians and is between [0.0] and [pi]. *) external acos : t -> t = "caml_acos_float" "acos" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Arc sine. The argument must fall within the range [[-1.0, 1.0]]. Result is in radians and is between [-pi/2] and [pi/2]. *) external asin : t -> t = "caml_asin_float" "asin" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Arc tangent. Result is in radians and is between [-pi/2] and [pi/2]. *) external atan : t -> t = "caml_atan_float" "atan" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** [atan2 y x] returns the arc tangent of [y /. x]. The signs of [x] and [y] are used to determine the quadrant of the result. Result is in radians and is between [-pi] and [pi]. *) external atan2 : t -> t -> t = "caml_atan2_float" "atan2" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** [hypot x y] returns [sqrt(x *. x + y *. y)], that is, the length of the hypotenuse of a right-angled triangle with sides of length [x] and [y], or, equivalently, the distance of the point [(x,y)] to origin. *) external hypot : t -> t -> t = "caml_hypot_float" "caml_hypot" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Hyperbolic cosine. Argument is in radians. *) external cosh : t -> t = "caml_cosh_float" "cosh" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Hyperbolic sine. Argument is in radians. *) external sinh : t -> t = "caml_sinh_float" "sinh" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Hyperbolic tangent. Argument is in radians. *) external tanh : t -> t = "caml_tanh_float" "tanh" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Hyperbolic arc cosine. The argument must fall within the range [[1.0, inf]]. Result is in radians and is between [0.0] and [inf]. *) external acosh : float -> float = "caml_acosh_float" "caml_acosh" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Hyperbolic arc sine. The argument and result range over the entire real line. Result is in radians. *) external asinh : float -> float = "caml_asinh_float" "caml_asinh" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Hyperbolic arc tangent. The argument must fall within the range [[-1.0, 1.0]]. Result is in radians and ranges over the entire real line. *) external atanh : float -> float = "caml_atanh_float" "caml_atanh" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Square root. *) external sqrt : t -> t = "caml_sqrt_float" "sqrt" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Exponential. *) external exp : t -> t = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] (** Natural logarithm. *) external log : t -> t = "caml_log_float" "log" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] (** Excluding nan the floating-point "number line" looks like: {v @@ -615,7 +613,7 @@ val classify : t -> Class.t [Comparable.With_zero]. *) val sign : t -> Sign.t -[@@deprecated "[since 2016-01] Replace [sign] with [robust_sign] or [sign_exn]"] + [@@deprecated "[since 2016-01] Replace [sign] with [robust_sign] or [sign_exn]"] (** The sign of a float. Both [-0.] and [0.] map to [Zero]. Raises on nan. All other values map to [Neg] or [Pos]. *) diff --git a/src/float0.ml b/src/float0.ml index 1ba3a058..012c0a87 100644 --- a/src/float0.ml +++ b/src/float0.ml @@ -33,63 +33,63 @@ let ( %. ) a b = (* The bits of INRIA's [Stdlib] that we just want to expose in [Float]. Most are already deprecated in [Stdlib], and eventually all of them should be. *) include ( -struct - include Stdlib - include Stdlib.Float -end : -sig - external frexp : float -> float * int = "caml_frexp_float" - - external ldexp - : (float[@unboxed]) - -> (int[@untagged]) - -> (float[@unboxed]) - = "caml_ldexp_float" "caml_ldexp_float_unboxed" - [@@noalloc] + struct + include Stdlib + include Stdlib.Float + end : + sig + external frexp : float -> float * int = "caml_frexp_float" + + external ldexp + : (float[@unboxed]) + -> (int[@untagged]) + -> (float[@unboxed]) + = "caml_ldexp_float" "caml_ldexp_float_unboxed" + [@@noalloc] - external log10 : float -> float = "caml_log10_float" "log10" [@@unboxed] [@@noalloc] + external log10 : float -> float = "caml_log10_float" "log10" [@@unboxed] [@@noalloc] - external log2 : float -> float = "caml_log2_float" "caml_log2" - [@@unboxed] [@@noalloc] + external log2 : float -> float = "caml_log2_float" "caml_log2" + [@@unboxed] [@@noalloc] - external expm1 : float -> float = "caml_expm1_float" "caml_expm1" - [@@unboxed] [@@noalloc] + external expm1 : float -> float = "caml_expm1_float" "caml_expm1" + [@@unboxed] [@@noalloc] - external log1p : float -> float = "caml_log1p_float" "caml_log1p" - [@@unboxed] [@@noalloc] + external log1p : float -> float = "caml_log1p_float" "caml_log1p" + [@@unboxed] [@@noalloc] - external copysign : float -> float -> float = "caml_copysign_float" "caml_copysign" - [@@unboxed] [@@noalloc] + external copysign : float -> float -> float = "caml_copysign_float" "caml_copysign" + [@@unboxed] [@@noalloc] - external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc] - external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc] - external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc] - external acos : float -> float = "caml_acos_float" "acos" [@@unboxed] [@@noalloc] - external asin : float -> float = "caml_asin_float" "asin" [@@unboxed] [@@noalloc] - external atan : float -> float = "caml_atan_float" "atan" [@@unboxed] [@@noalloc] + external cos : float -> float = "caml_cos_float" "cos" [@@unboxed] [@@noalloc] + external sin : float -> float = "caml_sin_float" "sin" [@@unboxed] [@@noalloc] + external tan : float -> float = "caml_tan_float" "tan" [@@unboxed] [@@noalloc] + external acos : float -> float = "caml_acos_float" "acos" [@@unboxed] [@@noalloc] + external asin : float -> float = "caml_asin_float" "asin" [@@unboxed] [@@noalloc] + external atan : float -> float = "caml_atan_float" "atan" [@@unboxed] [@@noalloc] - external acosh : float -> float = "caml_acosh_float" "caml_acosh" - [@@unboxed] [@@noalloc] + external acosh : float -> float = "caml_acosh_float" "caml_acosh" + [@@unboxed] [@@noalloc] - external asinh : float -> float = "caml_asinh_float" "caml_asinh" - [@@unboxed] [@@noalloc] + external asinh : float -> float = "caml_asinh_float" "caml_asinh" + [@@unboxed] [@@noalloc] - external atanh : float -> float = "caml_atanh_float" "caml_atanh" - [@@unboxed] [@@noalloc] + external atanh : float -> float = "caml_atanh_float" "caml_atanh" + [@@unboxed] [@@noalloc] - external atan2 : float -> float -> float = "caml_atan2_float" "atan2" - [@@unboxed] [@@noalloc] + external atan2 : float -> float -> float = "caml_atan2_float" "atan2" + [@@unboxed] [@@noalloc] - external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" - [@@unboxed] [@@noalloc] + external hypot : float -> float -> float = "caml_hypot_float" "caml_hypot" + [@@unboxed] [@@noalloc] - external cosh : float -> float = "caml_cosh_float" "cosh" [@@unboxed] [@@noalloc] - external sinh : float -> float = "caml_sinh_float" "sinh" [@@unboxed] [@@noalloc] - external tanh : float -> float = "caml_tanh_float" "tanh" [@@unboxed] [@@noalloc] - external sqrt : float -> float = "caml_sqrt_float" "sqrt" [@@unboxed] [@@noalloc] - external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] - external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc] -end) + external cosh : float -> float = "caml_cosh_float" "cosh" [@@unboxed] [@@noalloc] + external sinh : float -> float = "caml_sinh_float" "sinh" [@@unboxed] [@@noalloc] + external tanh : float -> float = "caml_tanh_float" "tanh" [@@unboxed] [@@noalloc] + external sqrt : float -> float = "caml_sqrt_float" "sqrt" [@@unboxed] [@@noalloc] + external exp : float -> float = "caml_exp_float" "exp" [@@unboxed] [@@noalloc] + external log : float -> float = "caml_log_float" "log" [@@unboxed] [@@noalloc] + end) (* We need this indirection because these are exposed as "val" instead of "external" *) let frexp = frexp @@ -210,7 +210,7 @@ module Intrinsics_with_weird_nan_behavior = struct -> (float[@unboxed]) -> (float[@unboxed]) = "caml_float_min" "caml_float_min_unboxed" - [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] + [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] (** Equivalent to [if x > y then x else y]. @@ -220,13 +220,13 @@ module Intrinsics_with_weird_nan_behavior = struct -> (float[@unboxed]) -> (float[@unboxed]) = "caml_float_max" "caml_float_max_unboxed" - [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] + [@@noalloc] [@@builtin] [@@no_effects] [@@no_coeffects] end let clamp_unchecked - ~(to_clamp_maybe_nan : float) - ~min_which_is_not_nan - ~max_which_is_not_nan + ~(to_clamp_maybe_nan : float) + ~min_which_is_not_nan + ~max_which_is_not_nan = (* We want to propagate nans; as per the x86 docs, this means we have to use them as the _second_ argument. *) diff --git a/src/fn.mli b/src/fn.mli index b58023f2..db821e3f 100644 --- a/src/fn.mli +++ b/src/fn.mli @@ -34,4 +34,3 @@ val compose : ('b -> 'c) -> ('a -> 'b) -> 'a -> 'c (** Reverses the order of arguments for a binary function. *) val flip : ('a -> 'b -> 'c) -> 'b -> 'a -> 'c - diff --git a/src/globalize.mli b/src/globalize.mli index 1f32f755..597af59e 100644 --- a/src/globalize.mli +++ b/src/globalize.mli @@ -20,7 +20,6 @@ val globalize_bytes : (bytes[@local]) -> bytes val globalize_string : (string[@local]) -> string val globalize_unit : (unit[@local]) -> unit val globalize_array : (('a[@local]) -> 'b) -> ('a array[@local]) -> 'a array - val globalize_lazy_t : (('a[@local]) -> 'b) -> ('a lazy_t[@local]) -> 'a lazy_t val globalize_list : (('a[@local]) -> 'b) -> ('a list[@local]) -> 'b list val globalize_option : (('a[@local]) -> 'b) -> ('a option[@local]) -> 'b option diff --git a/src/hash.ml b/src/hash.ml index 54cd42b3..d4792e77 100644 --- a/src/hash.ml +++ b/src/hash.ml @@ -28,8 +28,8 @@ include Hash_intf (** Builtin folding-style hash functions, abstracted over [Hash_intf.S] *) module Folding (Hash : Hash_intf.S) : Hash_intf.Builtin_intf - with type state = Hash.state - and type hash_value = Hash.hash_value = struct + with type state = Hash.state + and type hash_value = Hash.hash_value = struct type state = Hash.state type hash_value = Hash.hash_value type 'a folder = state -> 'a -> state @@ -117,9 +117,9 @@ end module F (Hash : Hash_intf.S) : Hash_intf.Full - with type hash_value = Hash.hash_value - and type state = Hash.state - and type seed = Hash.seed = struct + with type hash_value = Hash.hash_value + and type state = Hash.state + and type seed = Hash.seed = struct include Hash type 'a folder = state -> 'a -> state @@ -137,26 +137,26 @@ end module Internalhash : sig include Hash_intf.S - with type state = Base_internalhash_types.state - (* We give a concrete type for [state], albeit only partially exposed (see + with type state = Base_internalhash_types.state + (* We give a concrete type for [state], albeit only partially exposed (see Base_internalhash_types), so that it unifies with the same type in [Base_boot], and to allow optimizations for the immediate type. *) - and type seed = Base_internalhash_types.seed - and type hash_value = Base_internalhash_types.hash_value + and type seed = Base_internalhash_types.seed + and type hash_value = Base_internalhash_types.hash_value external fold_int64 : state -> int64 -> state = "Base_internalhash_fold_int64" - [@@noalloc] + [@@noalloc] external fold_int : state -> int -> state = "Base_internalhash_fold_int" [@@noalloc] external fold_float : state -> float -> state = "Base_internalhash_fold_float" - [@@noalloc] + [@@noalloc] external fold_string : state -> string -> state = "Base_internalhash_fold_string" - [@@noalloc] + [@@noalloc] external get_hash_value : state -> hash_value = "Base_internalhash_get_hash_value" - [@@noalloc] + [@@noalloc] end = struct let description = "internalhash" diff --git a/src/hash_intf.ml b/src/hash_intf.ml index 704a3c10..7717ee5c 100644 --- a/src/hash_intf.ml +++ b/src/hash_intf.ml @@ -128,9 +128,9 @@ module type Full = sig module Builtin : Builtin_intf - with type state := state - and type 'a folder := 'a folder - and type hash_value := hash_value + with type state := state + and type 'a folder := 'a folder + and type hash_value := hash_value (** [run ?seed folder x] runs [folder] on [x] in a newly allocated hash-state, initialized using optional [seed] or a default-seed. @@ -147,9 +147,9 @@ module type Hash = sig module F (Hash : S) : Full - with type hash_value = Hash.hash_value - and type state = Hash.state - and type seed = Hash.seed + with type hash_value = Hash.hash_value + and type state = Hash.state + and type seed = Hash.seed (** The code of [ppx_hash] is agnostic to the choice of hash algorithm that is used. However, it is not currently possible to mix various choices of hash algorithms @@ -189,7 +189,7 @@ module type Hash = sig (** @open *) include Full - with type state = Base_internalhash_types.state - and type seed = Base_internalhash_types.seed - and type hash_value = Base_internalhash_types.hash_value + with type state = Base_internalhash_types.state + and type seed = Base_internalhash_types.seed + and type hash_value = Base_internalhash_types.hash_value end diff --git a/src/hash_set.ml b/src/hash_set.ml index 3a898257..7c67ec01 100644 --- a/src/hash_set.ml +++ b/src/hash_set.ml @@ -133,18 +133,18 @@ let t_of_sexp m e_of_sexp sexp = ;; module Creators (Elt : sig - type 'a t + type 'a t - val hashable : 'a t Hashable.t - end) : sig + val hashable : 'a t Hashable.t +end) : sig val t_of_sexp : (Sexp.t -> 'a Elt.t) -> Sexp.t -> 'a Elt.t t include Creators_generic - with type 'a t := 'a Elt.t t - with type 'a elt := 'a Elt.t - with type ('elt, 'z) create_options := - ('elt, 'z) create_options_without_first_class_module + with type 'a t := 'a Elt.t t + with type 'a elt := 'a Elt.t + with type ('elt, 'z) create_options := + ('elt, 'z) create_options_without_first_class_module end = struct let create ?growth_allowed ?size () = create ?growth_allowed ?size (Hashable.to_key Elt.hashable) @@ -164,10 +164,10 @@ module Poly = struct let hashable = poly_hashable include Creators (struct - type 'a t = 'a + type 'a t = 'a - let hashable = hashable - end) + let hashable = hashable + end) include Accessors diff --git a/src/hash_set_intf.ml b/src/hash_set_intf.ml index 0989dcae..2fd27348 100644 --- a/src/hash_set_intf.ml +++ b/src/hash_set_intf.ml @@ -180,27 +180,27 @@ module type Hash_set = sig include Creators_generic - with type 'a t := 'a t - with type 'a elt = 'a - with type ('key, 'z) create_options := - ('key, 'z) create_options_without_first_class_module + with type 'a t := 'a t + with type 'a elt = 'a + with type ('key, 'z) create_options := + ('key, 'z) create_options_without_first_class_module include Accessors with type 'a t := 'a t with type 'a elt := 'a elt end module Creators (Elt : sig - type 'a t + type 'a t - val hashable : 'a t Hashable.t - end) : sig + val hashable : 'a t Hashable.t + end) : sig val t_of_sexp : (Sexp.t -> 'a Elt.t) -> Sexp.t -> 'a Elt.t t include Creators_generic - with type 'a t := 'a Elt.t t - with type 'a elt := 'a Elt.t - with type ('elt, 'z) create_options := - ('elt, 'z) create_options_without_first_class_module + with type 'a t := 'a Elt.t t + with type 'a elt := 'a Elt.t + with type ('elt, 'z) create_options := + ('elt, 'z) create_options_without_first_class_module end include For_deriving with type 'a t := 'a t diff --git a/src/hasher.ml b/src/hasher.ml index 35fa053a..205450d5 100644 --- a/src/hasher.ml +++ b/src/hasher.ml @@ -2,7 +2,6 @@ open! Import (** Signatures required of types which can be used in [[@@deriving hash]]. *) - module type S = sig (** The type that is hashed. *) type t diff --git a/src/hashtbl.ml b/src/hashtbl.ml index fee11b4e..cf5253d8 100644 --- a/src/hashtbl.ml +++ b/src/hashtbl.ml @@ -358,7 +358,7 @@ let for_all t ~f = not (existsi t ~f:(fun ~key:_ ~data -> not (f data))) let counti t ~f = fold t ~init:0 ~f:(fun ~key ~data acc -> if f ~key ~data then acc + 1 else acc) [@nontail - ] + ] ;; let count t ~f = @@ -419,7 +419,6 @@ let partitioni_tf t ~f = let partition_tf t ~f = partitioni_tf t ~f:(fun ~key:_ ~data -> f data) [@nontail] - let find_or_add t id ~default:(default [@local]) = find_and_call t @@ -450,7 +449,6 @@ let find_and_remove t id = result ;; - let change t id ~f = match f (find t id) with | None -> remove t id @@ -587,9 +585,9 @@ let t_of_sexp ~hashable k_of_sexp d_of_sexp sexp = ;; let t_sexp_grammar - (type k v) - (k_grammar : k Sexplib0.Sexp_grammar.t) - (v_grammar : v Sexplib0.Sexp_grammar.t) + (type k v) + (k_grammar : k Sexplib0.Sexp_grammar.t) + (v_grammar : v Sexplib0.Sexp_grammar.t) : (k, v) t Sexplib0.Sexp_grammar.t = Sexplib0.Sexp_grammar.coerce (List.Assoc.t_sexp_grammar k_grammar v_grammar) @@ -675,7 +673,7 @@ let merge_into ~src ~dst ~f = (match dst_data with | None -> set dst ~key ~data | Some dst_data -> if not (phys_equal dst_data data) then set dst ~key ~data)) [@nontail - ] + ] ;; let filteri_inplace t ~f = @@ -711,12 +709,12 @@ let map_inplace t ~f = mapi_inplace t ~f:(fun ~key:_ ~data -> f data) [@nontail] let equal equal t t' = length t = length t' && (with_return (fun r -> - without_mutating t' (fun () -> - iteri t ~f:(fun ~key ~data -> - match find t' key with - | None -> r.return false - | Some data' -> if not (equal data data') then r.return false) [@nontail]); - true) [@nontail]) + without_mutating t' (fun () -> + iteri t ~f:(fun ~key ~data -> + match find t' key with + | None -> r.return false + | Some data' -> if not (equal data data') then r.return false) [@nontail]); + true) [@nontail]) ;; let similar = equal @@ -794,20 +792,20 @@ module Accessors = struct end module Creators (Key : sig - type 'a t + type 'a t - val hashable : 'a t Hashable.t - end) : sig + val hashable : 'a t Hashable.t +end) : sig type ('a, 'b) t_ = ('a Key.t, 'b) t val t_of_sexp : (Sexp.t -> 'a Key.t) -> (Sexp.t -> 'b) -> Sexp.t -> ('a, 'b) t_ include Creators_generic - with type ('a, 'b) t := ('a, 'b) t_ - with type 'a key := 'a Key.t - with type ('key, 'data, 'a) create_options := - ('key, 'data, 'a) create_options_without_first_class_module + with type ('a, 'b) t := ('a, 'b) t_ + with type 'a key := 'a Key.t + with type ('key, 'data, 'a) create_options := + ('key, 'data, 'a) create_options_without_first_class_module end = struct let hashable = Key.hashable @@ -863,10 +861,10 @@ module Poly = struct let capacity = capacity include Creators (struct - type 'a t = 'a + type 'a t = 'a - let hashable = hashable - end) + let hashable = hashable + end) include Accessors diff --git a/src/hashtbl_intf.ml b/src/hashtbl_intf.ml index 6f2e234a..15b10473 100644 --- a/src/hashtbl_intf.ml +++ b/src/hashtbl_intf.ml @@ -30,9 +30,9 @@ module type Accessors = sig (** @inline *) include Dictionary_mutable.Accessors - with type 'key key := 'key key - and type ('key, 'data, _) t := ('key, 'data) t - and type ('fn, _, _, _) accessor := 'fn + with type 'key key := 'key key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, _, _, _) accessor := 'fn val sexp_of_key : ('a, _) t -> 'a key -> Sexp.t val clear : (_, _) t -> unit @@ -302,10 +302,9 @@ module type Accessors = sig -> ('k, 'b) t -> f: ((key:'k key -> [ `Left of 'a | `Right of 'b | `Both of 'a * 'b ] -> 'c option) - [@local]) + [@local]) -> ('k, 'c) t - (** Every [key] in [src] will be removed or set in [dst] according to the return value of [f]. *) val merge_into @@ -313,7 +312,7 @@ module type Accessors = sig -> dst:('k, 'b) t -> f: ((key:'k key -> 'a -> 'b option -> 'b Dictionary_mutable.Merge_into_action.t) - [@local]) + [@local]) -> unit (** Returns the list of all keys for given hashtable. *) @@ -352,7 +351,6 @@ module type Accessors = sig (** Returns the list of all (key, data) pairs for given hashtable. *) val to_alist : ('a, 'b) t -> ('a key * 'b) list - (** [remove_if_zero]'s default is [false]. *) val incr : ?by:int -> ?remove_if_zero:bool -> ('a, int) t -> 'a key -> unit @@ -396,24 +394,23 @@ module type Creators_generic = sig (** @inline *) include Dictionary_mutable.Creators - with type 'key key := 'key key - and type ('key, 'data, _) t := ('key, 'data) t - and type ('fn, 'key, 'data, _) creator := ('key key, 'data, 'fn) create_options + with type 'key key := 'key key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) creator := ('key key, 'data, 'fn) create_options val create : ('a key, 'b, unit -> ('a, 'b) t) create_options - val of_alist : ( 'a key , 'b , ('a key * 'b) list -> [ `Ok of ('a, 'b) t | `Duplicate_key of 'a key ] ) - create_options + create_options val of_alist_report_all_dups : ( 'a key , 'b , ('a key * 'b) list -> [ `Ok of ('a, 'b) t | `Duplicate_keys of 'a key list ] ) - create_options + create_options val of_alist_or_error : ('a key, 'b, ('a key * 'b) list -> ('a, 'b) t Or_error.t) create_options @@ -423,7 +420,6 @@ module type Creators_generic = sig val of_alist_multi : ('a key, 'b list, ('a key * 'b) list -> ('a, 'b list) t) create_options - (** {[ create_mapped get_key get_data [x1,...,xn] = of_alist [get_key x1, get_data x1; ...; get_key xn, get_data xn] ]} *) val create_mapped @@ -433,8 +429,7 @@ module type Creators_generic = sig -> get_data:(('r -> 'b)[@local]) -> 'r list -> [ `Ok of ('a, 'b) t | `Duplicate_keys of 'a key list ] ) - create_options - + create_options (** {[ create_with_key ~get_key [x1,...,xn] = of_alist [get_key x1, x1; ...; get_key xn, xn] ]} *) @@ -444,20 +439,19 @@ module type Creators_generic = sig , get_key:(('r -> 'a key)[@local]) -> 'r list -> [ `Ok of ('a, 'r) t | `Duplicate_keys of 'a key list ] ) - create_options + create_options val create_with_key_or_error : ( 'a key , 'r , get_key:(('r -> 'a key)[@local]) -> 'r list -> ('a, 'r) t Or_error.t ) - create_options + create_options val create_with_key_exn : ( 'a key , 'r , get_key:(('r -> 'a key)[@local]) -> 'r list -> ('a, 'r) t ) - create_options - + create_options val group : ( 'a key @@ -467,7 +461,7 @@ module type Creators_generic = sig -> combine:(('b -> 'b -> 'b)[@local]) -> 'r list -> ('a, 'b) t ) - create_options + create_options end module type Creators = sig @@ -660,7 +654,6 @@ module type S_without_submodules = sig include Accessors with type ('a, 'b) t := ('a, 'b) t with type 'a key = 'a (** @inline *) - include Multi with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a key (** @inline *) @@ -687,10 +680,10 @@ module type S_poly = sig include Creators_generic - with type ('a, 'b) t := ('a, 'b) t - with type 'a key = 'a - with type ('key, 'data, 'z) create_options := - ('key, 'data, 'z) create_options_without_first_class_module + with type ('a, 'b) t := ('a, 'b) t + with type 'a key = 'a + with type ('key, 'data, 'z) create_options := + ('key, 'data, 'z) create_options_without_first_class_module include Accessors with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a key include Multi with type ('a, 'b) t := ('a, 'b) t with type 'a key := 'a key @@ -842,20 +835,20 @@ module type Hashtbl = sig type nonrec ('key, 'data, 'z) create_options = ('key, 'data, 'z) create_options module Creators (Key : sig - type 'a t + type 'a t - val hashable : 'a t Hashable.t - end) : sig + val hashable : 'a t Hashable.t + end) : sig type ('a, 'b) t_ = ('a Key.t, 'b) t val t_of_sexp : (Sexp.t -> 'a Key.t) -> (Sexp.t -> 'b) -> Sexp.t -> ('a, 'b) t_ include Creators_generic - with type ('a, 'b) t := ('a, 'b) t_ - with type 'a key := 'a Key.t - with type ('key, 'data, 'a) create_options := - ('key, 'data, 'a) create_options_without_first_class_module + with type ('a, 'b) t := ('a, 'b) t_ + with type 'a key := 'a Key.t + with type ('key, 'data, 'a) create_options := + ('key, 'data, 'a) create_options_without_first_class_module end module Poly : S_poly with type ('a, 'b) t = ('a, 'b) t diff --git a/src/import0.ml b/src/import0.ml index b0cb6f91..792bb552 100644 --- a/src/import0.ml +++ b/src/import0.ml @@ -5,41 +5,41 @@ include ( Shadow_stdlib : module type of struct - include Shadow_stdlib - end - with type 'a ref := 'a ref - with type ('a, 'b, 'c) format := ('a, 'b, 'c) format - with type ('a, 'b, 'c, 'd) format4 := ('a, 'b, 'c, 'd) format4 - with type ('a, 'b, 'c, 'd, 'e, 'f) format6 := ('a, 'b, 'c, 'd, 'e, 'f) format6 - (* These modules are redefined in Base *) - with module Array := Shadow_stdlib.Array - with module Atomic := Shadow_stdlib.Atomic - with module Bool := Shadow_stdlib.Bool - with module Buffer := Shadow_stdlib.Buffer - with module Bytes := Shadow_stdlib.Bytes - with module Char := Shadow_stdlib.Char - with module Either := Shadow_stdlib.Either - with module Float := Shadow_stdlib.Float - with module Hashtbl := Shadow_stdlib.Hashtbl - with module Int := Shadow_stdlib.Int - with module Int32 := Shadow_stdlib.Int32 - with module Int64 := Shadow_stdlib.Int64 - with module Lazy := Shadow_stdlib.Lazy - with module List := Shadow_stdlib.List - with module Map := Shadow_stdlib.Map - with module Nativeint := Shadow_stdlib.Nativeint - with module Option := Shadow_stdlib.Option - with module Printf := Shadow_stdlib.Printf - with module Queue := Shadow_stdlib.Queue - with module Random := Shadow_stdlib.Random - with module Result := Shadow_stdlib.Result - with module Set := Shadow_stdlib.Set - with module Stack := Shadow_stdlib.Stack - with module String := Shadow_stdlib.String - with module Sys := Shadow_stdlib.Sys - with module Uchar := Shadow_stdlib.Uchar - with module Unit := Shadow_stdlib.Unit) - [@ocaml.warning "-3"] + include Shadow_stdlib + end + with type 'a ref := 'a ref + with type ('a, 'b, 'c) format := ('a, 'b, 'c) format + with type ('a, 'b, 'c, 'd) format4 := ('a, 'b, 'c, 'd) format4 + with type ('a, 'b, 'c, 'd, 'e, 'f) format6 := ('a, 'b, 'c, 'd, 'e, 'f) format6 + (* These modules are redefined in Base *) + with module Array := Shadow_stdlib.Array + with module Atomic := Shadow_stdlib.Atomic + with module Bool := Shadow_stdlib.Bool + with module Buffer := Shadow_stdlib.Buffer + with module Bytes := Shadow_stdlib.Bytes + with module Char := Shadow_stdlib.Char + with module Either := Shadow_stdlib.Either + with module Float := Shadow_stdlib.Float + with module Hashtbl := Shadow_stdlib.Hashtbl + with module Int := Shadow_stdlib.Int + with module Int32 := Shadow_stdlib.Int32 + with module Int64 := Shadow_stdlib.Int64 + with module Lazy := Shadow_stdlib.Lazy + with module List := Shadow_stdlib.List + with module Map := Shadow_stdlib.Map + with module Nativeint := Shadow_stdlib.Nativeint + with module Option := Shadow_stdlib.Option + with module Printf := Shadow_stdlib.Printf + with module Queue := Shadow_stdlib.Queue + with module Random := Shadow_stdlib.Random + with module Result := Shadow_stdlib.Result + with module Set := Shadow_stdlib.Set + with module Stack := Shadow_stdlib.Stack + with module String := Shadow_stdlib.String + with module Sys := Shadow_stdlib.Sys + with module Uchar := Shadow_stdlib.Uchar + with module Unit := Shadow_stdlib.Unit) +[@ocaml.warning "-3"] type 'a ref = 'a Stdlib.ref = { mutable contents : 'a } diff --git a/src/indexed_container.ml b/src/indexed_container.ml index bc9de60f..f1aa0c09 100644 --- a/src/indexed_container.ml +++ b/src/indexed_container.ml @@ -9,7 +9,7 @@ let[@inline always] iteri ~fold t ~f = (fold t ~init:0 ~f:(fun i x -> f i x; i + 1) - : int) + : int) ;; let foldi ~fold t ~init ~f = @@ -54,10 +54,10 @@ let findi ~iteri c ~f = (* Allows [Make_gen] to share a [Container.Generic] implementation with, e.g., [Container.Make_gen_with_creators]. *) module Make_gen_with_container - (T : Make_gen_arg) - (C : Container.Generic - with type ('a, 'phantom) t := ('a, 'phantom) T.t - and type 'a elt := 'a T.elt) : + (T : Make_gen_arg) + (C : Container.Generic + with type ('a, 'phantom) t := ('a, 'phantom) T.t + and type 'a elt := 'a T.elt) : Generic with type ('a, 'phantom) t := ('a, 'phantom) T.t and type 'a elt := 'a T.elt = struct include C @@ -93,30 +93,30 @@ end module Make (T : Make_arg) = struct include Make_gen (struct - include T + include T - type ('a, _) t = 'a T.t - type 'a elt = 'a - end) + type ('a, _) t = 'a T.t + type 'a elt = 'a + end) end [@@inline always] module Make0 (T : Make0_arg) = struct include Make_gen (struct - include T + include T - type (_, _) t = T.t - type 'a elt = T.Elt.t - end) + type (_, _) t = T.t + type 'a elt = T.Elt.t + end) let mem t x = mem t x ~equal:T.Elt.equal end module Make_gen_with_creators (T : Make_gen_with_creators_arg) : Generic_with_creators - with type ('a, 'phantom) t := ('a, 'phantom) T.t - and type 'a elt := 'a T.elt - and type ('a, 'phantom) concat := ('a, 'phantom) T.concat = struct + with type ('a, 'phantom) t := ('a, 'phantom) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom) concat := ('a, 'phantom) T.concat = struct module C = Container.Make_gen_with_creators (T) include C include Make_gen_with_container (T) (C) @@ -153,26 +153,26 @@ end module Make_with_creators (T : Make_with_creators_arg) = struct include Make_gen_with_creators (struct - include T + include T - type ('a, _) t = 'a T.t - type 'a elt = 'a - type ('a, _) concat = 'a T.t + type ('a, _) t = 'a T.t + type 'a elt = 'a + type ('a, _) concat = 'a T.t - let concat_of_array = of_array - end) + let concat_of_array = of_array + end) end module Make0_with_creators (T : Make0_with_creators_arg) = struct include Make_gen_with_creators (struct - include T + include T - type (_, _) t = T.t - type 'a elt = T.Elt.t - type ('a, _) concat = 'a list + type (_, _) t = T.t + type 'a elt = T.Elt.t + type ('a, _) concat = 'a list - let concat_of_array = Array.to_list - end) + let concat_of_array = Array.to_list + end) let mem t x = mem t x ~equal:T.Elt.equal end diff --git a/src/indexed_container_intf.ml b/src/indexed_container_intf.ml index 97fa083c..b841d005 100644 --- a/src/indexed_container_intf.ml +++ b/src/indexed_container_intf.ml @@ -1,8 +1,6 @@ - type ('t, 'a, 'accum) fold = 't -> init:'accum -> f:(('accum -> 'a -> 'accum)[@local]) -> 'accum - type ('t, 'a, 'accum) foldi = 't -> init:'accum -> f:((int -> 'accum -> 'a -> 'accum)[@local]) -> 'accum @@ -113,7 +111,6 @@ module type Generic_with_creators = sig -> ('b, 'p) t val concat_mapi : ('a, 'p) t -> f:((int -> 'a elt -> ('b, 'p) t)[@local]) -> ('b, 'p) t - end module type Make_gen_arg = sig @@ -153,9 +150,9 @@ module type Make_gen_with_creators_arg = sig include Make_common_with_creators_arg - with type ('a, 'p) t := ('a, 'p) t - and type 'a elt := 'a elt - and type ('a, 'p) concat := ('a, 'p) concat + with type ('a, 'p) t := ('a, 'p) t + and type 'a elt := 'a elt + and type ('a, 'p) concat := ('a, 'p) concat end module type Make_with_creators_arg = sig @@ -163,9 +160,9 @@ module type Make_with_creators_arg = sig include Make_common_with_creators_arg - with type ('a, _) t := 'a t - and type 'a elt := 'a - and type ('a, _) concat := 'a t + with type ('a, _) t := 'a t + and type 'a elt := 'a + and type ('a, _) concat := 'a t end module type Make0_with_creators_arg = sig @@ -173,9 +170,9 @@ module type Make0_with_creators_arg = sig include Make_common_with_creators_arg - with type ('a, _) t := t - and type 'a elt := Elt.t - and type ('a, _) concat := 'a list + with type ('a, _) t := t + and type 'a elt := Elt.t + and type ('a, _) concat := 'a list end module type Derived = sig @@ -237,7 +234,7 @@ module type Indexed_container = sig module Make_gen_with_creators (T : Make_gen_with_creators_arg) : Generic_with_creators - with type ('a, 'phantom) t := ('a, 'phantom) T.t - and type 'a elt := 'a T.elt - and type ('a, 'phantom) concat := ('a, 'phantom) T.concat + with type ('a, 'phantom) t := ('a, 'phantom) T.t + and type 'a elt := 'a T.elt + and type ('a, 'phantom) concat := ('a, 'phantom) T.concat end diff --git a/src/info.ml b/src/info.ml index a0586acc..36362fc3 100644 --- a/src/info.ml +++ b/src/info.ml @@ -21,43 +21,43 @@ module Message = struct let rec sexp_of_t = (function - | Could_not_construct arg0__001_ -> - let res0__002_ = Sexp.sexp_of_t arg0__001_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Could_not_construct"; res0__002_ ] - | String arg0__003_ -> - let res0__004_ = sexp_of_string arg0__003_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "String"; res0__004_ ] - | Exn arg0__005_ -> - let res0__006_ = sexp_of_exn arg0__005_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Exn"; res0__006_ ] - | Sexp arg0__007_ -> - let res0__008_ = Sexp.sexp_of_t arg0__007_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Sexp"; res0__008_ ] - | Tag_sexp (arg0__009_, arg1__010_, arg2__011_) -> - let res0__012_ = sexp_of_string arg0__009_ - and res1__013_ = Sexp.sexp_of_t arg1__010_ - and res2__014_ = sexp_of_option Source_code_position0.sexp_of_t arg2__011_ in - Sexplib0.Sexp.List - [ Sexplib0.Sexp.Atom "Tag_sexp"; res0__012_; res1__013_; res2__014_ ] - | Tag_t (arg0__015_, arg1__016_) -> - let res0__017_ = sexp_of_string arg0__015_ - and res1__018_ = sexp_of_t arg1__016_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Tag_t"; res0__017_; res1__018_ ] - | Tag_arg (arg0__019_, arg1__020_, arg2__021_) -> - let res0__022_ = sexp_of_string arg0__019_ - and res1__023_ = Sexp.sexp_of_t arg1__020_ - and res2__024_ = sexp_of_t arg2__021_ in - Sexplib0.Sexp.List - [ Sexplib0.Sexp.Atom "Tag_arg"; res0__022_; res1__023_; res2__024_ ] - | Of_list (arg0__025_, arg1__026_) -> - let res0__027_ = sexp_of_option sexp_of_int arg0__025_ - and res1__028_ = sexp_of_list sexp_of_t arg1__026_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Of_list"; res0__027_; res1__028_ ] - | With_backtrace (arg0__029_, arg1__030_) -> - let res0__031_ = sexp_of_t arg0__029_ - and res1__032_ = sexp_of_string arg1__030_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "With_backtrace"; res0__031_; res1__032_ ] - : t -> Sexplib0.Sexp.t) + | Could_not_construct arg0__001_ -> + let res0__002_ = Sexp.sexp_of_t arg0__001_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Could_not_construct"; res0__002_ ] + | String arg0__003_ -> + let res0__004_ = sexp_of_string arg0__003_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "String"; res0__004_ ] + | Exn arg0__005_ -> + let res0__006_ = sexp_of_exn arg0__005_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Exn"; res0__006_ ] + | Sexp arg0__007_ -> + let res0__008_ = Sexp.sexp_of_t arg0__007_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Sexp"; res0__008_ ] + | Tag_sexp (arg0__009_, arg1__010_, arg2__011_) -> + let res0__012_ = sexp_of_string arg0__009_ + and res1__013_ = Sexp.sexp_of_t arg1__010_ + and res2__014_ = sexp_of_option Source_code_position0.sexp_of_t arg2__011_ in + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Tag_sexp"; res0__012_; res1__013_; res2__014_ ] + | Tag_t (arg0__015_, arg1__016_) -> + let res0__017_ = sexp_of_string arg0__015_ + and res1__018_ = sexp_of_t arg1__016_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Tag_t"; res0__017_; res1__018_ ] + | Tag_arg (arg0__019_, arg1__020_, arg2__021_) -> + let res0__022_ = sexp_of_string arg0__019_ + and res1__023_ = Sexp.sexp_of_t arg1__020_ + and res2__024_ = sexp_of_t arg2__021_ in + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Tag_arg"; res0__022_; res1__023_; res2__024_ ] + | Of_list (arg0__025_, arg1__026_) -> + let res0__027_ = sexp_of_option sexp_of_int arg0__025_ + and res1__028_ = sexp_of_list sexp_of_t arg1__026_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Of_list"; res0__027_; res1__028_ ] + | With_backtrace (arg0__029_, arg1__030_) -> + let res0__031_ = sexp_of_t arg0__029_ + and res1__032_ = sexp_of_string arg1__030_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "With_backtrace"; res0__031_; res1__032_ ] + : t -> Sexplib0.Sexp.t) ;; [@@@end] @@ -274,8 +274,7 @@ let of_exn ?backtrace exn = let backtrace = match backtrace with | None -> None - | Some `Get -> - Some (Stdlib.Printexc.get_backtrace ()) + | Some `Get -> Some (Stdlib.Printexc.get_backtrace ()) | Some (`This s) -> Some s in match exn, backtrace with @@ -288,11 +287,11 @@ let of_exn ?backtrace exn = ;; include Pretty_printer.Register_pp (struct - type nonrec t = t + type nonrec t = t - let module_name = "Base.Info" - let pp ppf t = Stdlib.Format.pp_print_string ppf (to_string_hum t) - end) + let module_name = "Base.Info" + let pp ppf t = Stdlib.Format.pp_print_string ppf (to_string_hum t) +end) module Internal_repr = struct include Message diff --git a/src/info_intf.ml b/src/info_intf.ml index 82e3e705..5c0a9106 100644 --- a/src/info_intf.ml +++ b/src/info_intf.ml @@ -67,7 +67,6 @@ module type S = sig (** [to_string_mach t] outputs [t] as a sexp on a single line. *) val to_string_mach : t -> string - val of_string : string -> t (** Be careful that the body of the lazy or thunk does not access mutable data, since it diff --git a/src/int.ml b/src/int.ml index d0070a73..761ae061 100644 --- a/src/int.ml +++ b/src/int.ml @@ -40,7 +40,7 @@ let of_float_unchecked = Stdlib.int_of_float let of_float f = if Float_replace_polymorphic_compare.( >= ) f float_lower_bound - && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound then Stdlib.int_of_float f else Printf.invalid_argf @@ -57,49 +57,49 @@ include T include Comparator.Make (T) include Comparable.With_zero (struct - include T + include T - let zero = zero - end) + let zero = zero +end) module Conv = Int_conversions include Conv.Make (T) include Conv.Make_hex (struct - open Int_replace_polymorphic_compare + open Int_replace_polymorphic_compare - type t = int [@@deriving_inline compare ~localize, hash] + type t = int [@@deriving_inline compare ~localize, hash] - let compare__local = - (compare_int__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) - ;; + let compare__local = + (compare_int__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + ;; - let compare = (fun a b -> compare__local a b : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) - let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = - hash_fold_int + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int - and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = - let func = hash_int in - fun x -> func x - ;; + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int in + fun x -> func x + ;; - [@@@end] + [@@@end] - let zero = zero - let neg = ( ~- ) - let ( < ) = ( < ) - let to_string i = Printf.sprintf "%x" i - let of_string s = Stdlib.Scanf.sscanf s "%x" Fn.id - let module_name = "Base.Int.Hex" - end) + let zero = zero + let neg = ( ~- ) + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%x" i + let of_string s = Stdlib.Scanf.sscanf s "%x" Fn.id + let module_name = "Base.Int.Hex" +end) include Pretty_printer.Register (struct - type nonrec t = t + type nonrec t = t - let to_string = to_string - let module_name = "Base.Int" - end) + let to_string = to_string + let module_name = "Base.Int" +end) (* Open replace_polymorphic_compare after including functor instantiations so they do not shadow its definitions. This is here so that efficient versions @@ -175,7 +175,6 @@ module Pow2 = struct Printf.invalid_argf "argument must be strictly positive" () ;; - (** "ceiling power of 2" - Least power of 2 greater than or equal to x. *) let ceil_pow2 x = if x <= 0 then non_positive_argument (); @@ -214,16 +213,16 @@ module Pow2 = struct external clz : (* Note that we pass the tagged int here. See int_math_stubs.c for details on why this is correct. *) - int + int -> (int[@untagged]) = "Base_int_math_int_clz" "Base_int_math_int_clz_untagged" - [@@noalloc] + [@@noalloc] external ctz : (int[@untagged]) -> (int[@untagged]) = "Base_int_math_int_ctz" "Base_int_math_int_ctz_untagged" - [@@noalloc] + [@@noalloc] (** Hacker's Delight Second Edition p106 *) let floor_log2 i = @@ -267,16 +266,16 @@ module O = struct include Pre_O module F = Int_math.Make (struct - type nonrec t = t + type nonrec t = t - include Pre_O + include Pre_O - let rem = rem - let to_float = to_float - let of_float = of_float - let of_string = T.of_string - let to_string = T.to_string - end) + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) include F diff --git a/src/int32.ml b/src/int32.ml index 5da73b41..91cd703b 100644 --- a/src/int32.ml +++ b/src/int32.ml @@ -59,7 +59,7 @@ let of_float_unchecked = of_float let of_float f = if Float_replace_polymorphic_compare.( >= ) f float_lower_bound - && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound then of_float f else Printf.invalid_argf @@ -69,10 +69,10 @@ let of_float f = ;; include Comparable.With_zero (struct - include T + include T - let zero = zero - end) + let zero = zero +end) module Infix_compare = struct open Poly @@ -202,13 +202,13 @@ module Pow2 = struct : (int32[@unboxed]) -> (int[@untagged]) = "Base_int_math_int32_clz" "Base_int_math_int32_clz_unboxed" - [@@noalloc] + [@@noalloc] external ctz : (int32[@unboxed]) -> (int[@untagged]) = "Base_int_math_int32_ctz" "Base_int_math_int32_ctz_unboxed" - [@@noalloc] + [@@noalloc] (** Hacker's Delight Second Edition p106 *) let floor_log2 i = @@ -235,38 +235,38 @@ include Pow2 include Conv.Make (T) include Conv.Make_hex (struct - type t = int32 [@@deriving_inline compare ~localize, hash] + type t = int32 [@@deriving_inline compare ~localize, hash] - let compare__local = - (compare_int32__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) - ;; + let compare__local = + (compare_int32__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + ;; - let compare = (fun a b -> compare__local a b : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) - let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = - hash_fold_int32 + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int32 - and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = - let func = hash_int32 in - fun x -> func x - ;; + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int32 in + fun x -> func x + ;; - [@@@end] + [@@@end] - let zero = zero - let neg = ( ~- ) - let ( < ) = ( < ) - let to_string i = Printf.sprintf "%lx" i - let of_string s = Stdlib.Scanf.sscanf s "%lx" Fn.id - let module_name = "Base.Int32.Hex" - end) + let zero = zero + let neg = ( ~- ) + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%lx" i + let of_string s = Stdlib.Scanf.sscanf s "%lx" Fn.id + let module_name = "Base.Int32.Hex" +end) include Pretty_printer.Register (struct - type nonrec t = t + type nonrec t = t - let to_string = to_string - let module_name = "Base.Int32" - end) + let to_string = to_string + let module_name = "Base.Int32" +end) module Pre_O = struct let ( + ) = ( + ) @@ -288,16 +288,16 @@ module O = struct include Pre_O include Int_math.Make (struct - type nonrec t = t + type nonrec t = t - include Pre_O + include Pre_O - let rem = rem - let to_float = to_float - let of_float = of_float - let of_string = T.of_string - let to_string = T.to_string - end) + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) let ( land ) = bit_and let ( lor ) = bit_or diff --git a/src/int63.mli b/src/int63.mli index c830cc67..e5425438 100644 --- a/src/int63.mli +++ b/src/int63.mli @@ -10,7 +10,6 @@ open! Import - (** The [@@immediate64] attribute is to indicate that [t] is implemented by a type that is immediate only on 64 bit platforms. It is currently ignored by the compiler, however we are hoping that one day it will be taken into account so that the compiler can omit diff --git a/src/int63_emul.ml b/src/int63_emul.ml index 89ede33e..daadb063 100644 --- a/src/int63_emul.ml +++ b/src/int63_emul.ml @@ -6,7 +6,6 @@ open! Import include Int64_replace_polymorphic_compare - module T0 = struct module T = struct type t = int64 @@ -43,7 +42,6 @@ end module Conv = Int_conversions module W : sig - include module type of struct include T0 end @@ -324,10 +322,10 @@ let of_int64_trunc = of_int64_trunc let to_int64 = to_int64 include Comparable.With_zero (struct - include T + include T - let zero = zero - end) + let zero = zero +end) let between t ~low ~high = low <= t && t <= high let clamp_unchecked t ~min:min_ ~max:max_ = min t max_ |> max min_ @@ -377,40 +375,40 @@ let to_nativeint_trunc x = Conv.int64_to_nativeint_trunc (unwrap x) include Conv.Make (T) include Conv.Make_hex (struct - type t = T.t [@@deriving_inline compare ~localize, hash] + type t = T.t [@@deriving_inline compare ~localize, hash] - let compare__local = (T.compare__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) - let compare = (fun a b -> compare__local a b : t -> t -> int) + let compare__local = (T.compare__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) - let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = - T.hash_fold_t + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + T.hash_fold_t - and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = - let func = T.hash in - fun x -> func x - ;; + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = T.hash in + fun x -> func x + ;; - [@@@end] + [@@@end] - let zero = zero - let neg = ( ~- ) - let ( < ) = ( < ) + let zero = zero + let neg = ( ~- ) + let ( < ) = ( < ) - let to_string i = - (* the use of [unwrap_unsigned] here is important for the case of [min_value] *) - Printf.sprintf "%Lx" (unwrap_unsigned i) - ;; + let to_string i = + (* the use of [unwrap_unsigned] here is important for the case of [min_value] *) + Printf.sprintf "%Lx" (unwrap_unsigned i) + ;; - let of_string s = of_string ("0x" ^ s) - let module_name = "Base.Int63.Hex" - end) + let of_string s = of_string ("0x" ^ s) + let module_name = "Base.Int63.Hex" +end) include Pretty_printer.Register (struct - type nonrec t = t + type nonrec t = t - let to_string x = to_string x - let module_name = "Base.Int63" - end) + let to_string x = to_string x + let module_name = "Base.Int63" +end) module Pre_O = struct let ( + ) = ( + ) @@ -432,16 +430,16 @@ module O = struct include Pre_O include Int_math.Make (struct - type nonrec t = t + type nonrec t = t - include Pre_O + include Pre_O - let rem = rem - let to_float = to_float - let of_float = of_float - let of_string = T.of_string - let to_string = T.to_string - end) + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) let ( land ) = bit_and let ( lor ) = bit_or diff --git a/src/int64.ml b/src/int64.ml index 0f7674d1..2d2a0231 100644 --- a/src/int64.ml +++ b/src/int64.ml @@ -21,7 +21,6 @@ module T = struct [@@@end] let hashable : t Hashable.t = { hash; compare; sexp_of_t } - let compare = Int64_replace_polymorphic_compare.compare let to_string = to_string let of_string = of_string @@ -40,7 +39,7 @@ external bits_of_float : (float[@local_opt]) -> (int64[@local_opt]) = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] let shift_right_logical = shift_right_logical let shift_right = shift_right @@ -65,7 +64,7 @@ let of_float_unchecked = Stdlib.Int64.of_float let of_float f = if Float_replace_polymorphic_compare.( >= ) f float_lower_bound - && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound then Stdlib.Int64.of_float f else Printf.invalid_argf @@ -91,10 +90,10 @@ let[@inline always] bswap32 x = let[@inline always] bswap48 x = Stdlib.Int64.shift_right_logical (bswap64 x) 16 include Comparable.With_zero (struct - include T + include T - let zero = zero - end) + let zero = zero +end) (* Open replace_polymorphic_compare after including functor instantiations so they do not shadow its definitions. This is here so that efficient versions of the comparison @@ -204,13 +203,13 @@ module Pow2 = struct : (int64[@unboxed]) -> (int[@untagged]) = "Base_int_math_int64_clz" "Base_int_math_int64_clz_unboxed" - [@@noalloc] + [@@noalloc] external ctz : (int64[@unboxed]) -> (int[@untagged]) = "Base_int_math_int64_ctz" "Base_int_math_int64_ctz_unboxed" - [@@noalloc] + [@@noalloc] (** Hacker's Delight Second Edition p106 *) let floor_log2 i = @@ -236,38 +235,38 @@ include Pow2 include Conv.Make (T) include Conv.Make_hex (struct - type t = int64 [@@deriving_inline compare ~localize, hash] + type t = int64 [@@deriving_inline compare ~localize, hash] - let compare__local = - (compare_int64__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) - ;; + let compare__local = + (compare_int64__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + ;; - let compare = (fun a b -> compare__local a b : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) - let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = - hash_fold_int64 + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_int64 - and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = - let func = hash_int64 in - fun x -> func x - ;; + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_int64 in + fun x -> func x + ;; - [@@@end] + [@@@end] - let zero = zero - let neg = neg - let ( < ) = ( < ) - let to_string i = Printf.sprintf "%Lx" i - let of_string s = Stdlib.Scanf.sscanf s "%Lx" Fn.id - let module_name = "Base.Int64.Hex" - end) + let zero = zero + let neg = neg + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%Lx" i + let of_string s = Stdlib.Scanf.sscanf s "%Lx" Fn.id + let module_name = "Base.Int64.Hex" +end) include Pretty_printer.Register (struct - type nonrec t = t + type nonrec t = t - let to_string = to_string - let module_name = "Base.Int64" - end) + let to_string = to_string + let module_name = "Base.Int64" +end) module Pre_O = struct external ( + ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_add" @@ -292,16 +291,16 @@ module O = struct include Pre_O include Int_math.Make (struct - type nonrec t = t + type nonrec t = t - include Pre_O + include Pre_O - let rem = rem - let to_float = to_float - let of_float = of_float - let of_string = T.of_string - let to_string = T.to_string - end) + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) external ( land ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_and" external ( lor ) : (t[@local_opt]) -> (t[@local_opt]) -> (t[@local_opt]) = "%int64_or" diff --git a/src/int64.mli b/src/int64.mli index cfa22440..27269d96 100644 --- a/src/int64.mli +++ b/src/int64.mli @@ -91,7 +91,7 @@ external bits_of_float : (float[@local_opt]) -> (int64[@local_opt]) = "caml_int64_bits_of_float" "caml_int64_bits_of_float_unboxed" -[@@unboxed] [@@noalloc] + [@@unboxed] [@@noalloc] val float_of_bits : t -> float diff --git a/src/int_conversions.ml b/src/int_conversions.ml index 7af0c76f..14e6566d 100644 --- a/src/int_conversions.ml +++ b/src/int_conversions.ml @@ -9,7 +9,7 @@ let convert_failure x a b to_string = b (to_string x) () -[@@cold] [@@inline never] [@@local never] [@@specialise never] + [@@cold] [@@inline never] [@@local never] [@@specialise never] ;; let num_bits_int = Sys.int_size_in_bits @@ -262,10 +262,10 @@ let insert_underscores input = insert_delimiter input ~delimiter:'_' let sexp_of_int_style = Sexp.of_int_style module Make (I : sig - type t + type t - val to_string : t -> string - end) = + val to_string : t -> string +end) = struct open I @@ -285,21 +285,21 @@ struct end module Make_hex (I : sig - type t [@@deriving_inline compare ~localize, hash] + type t [@@deriving_inline compare ~localize, hash] - include Ppx_compare_lib.Comparable.S with type t := t - include Ppx_compare_lib.Comparable.S_local with type t := t - include Ppx_hash_lib.Hashable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t - [@@@end] + [@@@end] - val to_string : t -> string - val of_string : string -> t - val zero : t - val ( < ) : t -> t -> bool - val neg : t -> t - val module_name : string - end) = + val to_string : t -> string + val of_string : string -> t + val zero : t + val ( < ) : t -> t -> bool + val neg : t -> t + val module_name : string +end) = struct module T_hex = struct type t = I.t [@@deriving_inline compare ~localize, hash] diff --git a/src/int_conversions.mli b/src/int_conversions.mli index 2dac0cfc..47f77ceb 100644 --- a/src/int_conversions.mli +++ b/src/int_conversions.mli @@ -70,10 +70,10 @@ val num_bits_nativeint : int (** human-friendly string (and possibly sexp) conversions *) module Make (I : sig - type t + type t - val to_string : t -> string - end) : sig + val to_string : t -> string +end) : sig val to_string_hum : ?delimiter:char (** defaults to ['_'] *) -> I.t -> string val sexp_of_t : I.t -> Sexp.t end @@ -81,28 +81,27 @@ end (** in the output, [to_string], [of_string], [sexp_of_t], and [t_of_sexp] convert between [t] and signed hexadecimal with an optional "0x" or "0X" prefix. *) module Make_hex (I : sig - type t [@@deriving_inline compare ~localize, hash] + type t [@@deriving_inline compare ~localize, hash] - include Ppx_compare_lib.Comparable.S with type t := t - include Ppx_compare_lib.Comparable.S_local with type t := t - include Ppx_hash_lib.Hashable.S with type t := t + include Ppx_compare_lib.Comparable.S with type t := t + include Ppx_compare_lib.Comparable.S_local with type t := t + include Ppx_hash_lib.Hashable.S with type t := t - [@@@end] + [@@@end] - - (** [to_string] and [of_string] convert between [t] and unsigned, + (** [to_string] and [of_string] convert between [t] and unsigned, unprefixed hexadecimal. They must be able to handle all non-negative values and also [min_value]. [to_string min_value] must write a positive hex representation. *) - val to_string : t -> string - - val of_string : string -> t - val zero : t - val ( < ) : t -> t -> bool - val neg : t -> t - val module_name : string - end) : Int_intf.Hexable with type t := I.t + val to_string : t -> string + + val of_string : string -> t + val zero : t + val ( < ) : t -> t -> bool + val neg : t -> t + val module_name : string +end) : Int_intf.Hexable with type t := I.t (** global ref affecting whether the [sexp_of_t] returned by [Make] is consistent with the [to_string] input or the [to_string_hum] output *) diff --git a/src/int_math.ml b/src/int_math.ml index b8b4b9ea..cf39fcad 100644 --- a/src/int_math.ml +++ b/src/int_math.ml @@ -11,8 +11,8 @@ external int_math_int64_pow : int64 -> int64 -> int64 = "Base_int_math_int64_pow let int_pow base exponent = if exponent < 0 then negative_exponent (); if abs base > 1 - && (exponent > 63 - || abs base > Pow_overflow_bounds.int_positive_overflow_bounds.(exponent)) + && (exponent > 63 + || abs base > Pow_overflow_bounds.int_positive_overflow_bounds.(exponent)) then overflow (); int_math_int_pow base exponent ;; @@ -30,13 +30,13 @@ let int64_pow base exponent = let open Int64_with_comparisons in if exponent < 0L then negative_exponent (); if (base > 1L || base < -1L) - && (exponent > 63L - || (base >= 0L - && base - > Pow_overflow_bounds.int64_positive_overflow_bounds.(to_int exponent)) - || (base < 0L - && base - < Pow_overflow_bounds.int64_negative_overflow_bounds.(to_int exponent))) + && (exponent > 63L + || (base >= 0L + && base + > Pow_overflow_bounds.int64_positive_overflow_bounds.(to_int exponent)) + || (base < 0L + && base + < Pow_overflow_bounds.int64_negative_overflow_bounds.(to_int exponent))) then overflow (); int_math_int64_pow base exponent ;; @@ -45,10 +45,10 @@ let int63_pow_on_int64 base exponent = let open Int64_with_comparisons in if exponent < 0L then negative_exponent (); if abs base > 1L - && (exponent > 63L - || abs base - > Pow_overflow_bounds.int63_on_int64_positive_overflow_bounds.(to_int exponent) - ) + && (exponent > 63L + || abs base + > Pow_overflow_bounds.int63_on_int64_positive_overflow_bounds.(to_int exponent) + ) then overflow (); int_math_int64_pow base exponent ;; diff --git a/src/intable.ml b/src/intable.ml index 23005037..9cb95eac 100644 --- a/src/intable.ml +++ b/src/intable.ml @@ -8,4 +8,3 @@ module type S = sig val of_int_exn : int -> t val to_int_exn : t -> int end - diff --git a/src/lazy.ml b/src/lazy.ml index f5c1e9d7..8d244cdb 100644 --- a/src/lazy.ml +++ b/src/lazy.ml @@ -32,13 +32,13 @@ let hash_fold_t = Hash.Builtin.hash_fold_lazy_t let peek t = if is_val t then Some (force t) else None include Monad.Make (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return x = from_val x - let bind t ~f = lazy (force (f (force t))) - let map = map - let map = `Custom map - end) + let return x = from_val x + let bind t ~f = lazy (force (f (force t))) + let map = map + let map = `Custom map +end) module T_unforcing = struct type nonrec 'a t = 'a t diff --git a/src/lazy.mli b/src/lazy.mli index 46a472d3..19922627 100644 --- a/src/lazy.mli +++ b/src/lazy.mli @@ -1,4 +1,3 @@ - (** A value of type ['a Lazy.t] is a deferred computation, called a suspension, that has a result of type ['a]. diff --git a/src/linked_queue.ml b/src/linked_queue.ml index e5ee0d0c..f3ba30df 100644 --- a/src/linked_queue.ml +++ b/src/linked_queue.ml @@ -15,14 +15,14 @@ let drain t ~f ~while_ = ;; module C = Indexed_container.Make (struct - type nonrec 'a t = 'a t - - let fold = fold - let iter = `Custom iter - let length = `Custom length - let foldi = `Define_using_fold - let iteri = `Define_using_fold - end) + type nonrec 'a t = 'a t + + let fold = fold + let iter = `Custom iter + let length = `Custom length + let foldi = `Define_using_fold + let iteri = `Define_using_fold +end) let count = C.count let exists = C.exists diff --git a/src/list.ml b/src/list.ml index 7273ad45..6c02a150 100644 --- a/src/list.ml +++ b/src/list.ml @@ -1,8 +1,6 @@ open! Import module Array = Array0 module Either = Either0 - - include List1 (* This itself includes [List0]. *) @@ -14,8 +12,8 @@ module T = struct let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = fun (type a__001_) - : (((a__001_[@ocaml.local]) -> a__001_) -> (a__001_ t[@ocaml.local]) -> a__001_ t) -> - globalize_list + : (((a__001_[@ocaml.local]) -> a__001_) -> (a__001_ t[@ocaml.local]) -> a__001_ t) -> + globalize_list ;; let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = list_of_sexp @@ -35,11 +33,11 @@ module Or_unequal_lengths = struct [@@deriving_inline compare ~localize, sexp_of] let compare__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> int = fun _cmp__a a__014_ b__015_ -> if Stdlib.( == ) a__014_ b__015_ @@ -67,10 +65,10 @@ module Or_unequal_lengths = struct let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = fun (type a__021_) : ((a__021_ -> Sexplib0.Sexp.t) -> a__021_ t -> Sexplib0.Sexp.t) -> fun _of_a__018_ -> function - | Ok arg0__019_ -> - let res0__020_ = _of_a__018_ arg0__019_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; res0__020_ ] - | Unequal_lengths -> Sexplib0.Sexp.Atom "Unequal_lengths" + | Ok arg0__019_ -> + let res0__020_ = _of_a__018_ arg0__019_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; res0__020_ ] + | Unequal_lengths -> Sexplib0.Sexp.Atom "Unequal_lengths" ;; [@@@end] @@ -557,7 +555,7 @@ let iteri l ~f = (fold l ~init:0 ~f:(fun i x -> f i x; i + 1) - : int) + : int) ;; let foldi t ~init ~f = @@ -903,20 +901,20 @@ module Cartesian_product = struct open struct module Applicative = Applicative.Make_using_map2 (struct - type 'a t = 'a list + type 'a t = 'a list - let return = return - let map = `Custom map - let map2 = map2 - end) + let return = return + let map = `Custom map + let map2 = map2 + end) module Monad = Monad.Make (struct - type 'a t = 'a list + type 'a t = 'a list - let return = return - let map = `Custom map - let bind = bind - end) + let return = return + let map = `Custom map + let bind = bind + end) end let all = Monad.all @@ -1172,7 +1170,7 @@ module Assoc = struct ;; let value_sexp_grammar : - 'a. 'a Sexplib0.Sexp_grammar.t -> 'a value Sexplib0.Sexp_grammar.t + 'a. 'a Sexplib0.Sexp_grammar.t -> 'a value Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar -> { untyped = @@ -1191,49 +1189,49 @@ module Assoc = struct [@@deriving_inline sexp, sexp_grammar] let t_of_sexp : - 'a 'b. - (Sexplib0.Sexp.t -> 'a) - -> (Sexplib0.Sexp.t -> 'b) - -> Sexplib0.Sexp.t - -> ('a, 'b) t + 'a 'b. + (Sexplib0.Sexp.t -> 'a) + -> (Sexplib0.Sexp.t -> 'b) + -> Sexplib0.Sexp.t + -> ('a, 'b) t = let error_source__036_ = "list.ml.Assoc.t" in fun _of_a__028_ _of_b__029_ x__037_ -> list_of_sexp (function - | Sexplib0.Sexp.List [ arg0__031_; arg1__032_ ] -> - let res0__033_ = key_of_sexp _of_a__028_ arg0__031_ - and res1__034_ = value_of_sexp _of_b__029_ arg1__032_ in - res0__033_, res1__034_ - | sexp__035_ -> - Sexplib0.Sexp_conv_error.tuple_of_size_n_expected - error_source__036_ - 2 - sexp__035_) + | Sexplib0.Sexp.List [ arg0__031_; arg1__032_ ] -> + let res0__033_ = key_of_sexp _of_a__028_ arg0__031_ + and res1__034_ = value_of_sexp _of_b__029_ arg1__032_ in + res0__033_, res1__034_ + | sexp__035_ -> + Sexplib0.Sexp_conv_error.tuple_of_size_n_expected + error_source__036_ + 2 + sexp__035_) x__037_ ;; let sexp_of_t : - 'a 'b. - ('a -> Sexplib0.Sexp.t) - -> ('b -> Sexplib0.Sexp.t) - -> ('a, 'b) t - -> Sexplib0.Sexp.t + 'a 'b. + ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t = fun _of_a__038_ _of_b__039_ x__044_ -> sexp_of_list (fun (arg0__040_, arg1__041_) -> - let res0__042_ = sexp_of_key _of_a__038_ arg0__040_ - and res1__043_ = sexp_of_value _of_b__039_ arg1__041_ in - Sexplib0.Sexp.List [ res0__042_; res1__043_ ]) + let res0__042_ = sexp_of_key _of_a__038_ arg0__040_ + and res1__043_ = sexp_of_value _of_b__039_ arg1__041_ in + Sexplib0.Sexp.List [ res0__042_; res1__043_ ]) x__044_ ;; let t_sexp_grammar : - 'a 'b. - 'a Sexplib0.Sexp_grammar.t - -> 'b Sexplib0.Sexp_grammar.t - -> ('a, 'b) t Sexplib0.Sexp_grammar.t + 'a 'b. + 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar _'b_sexp_grammar -> { untyped = @@ -1248,7 +1246,7 @@ module Assoc = struct ( (key_sexp_grammar _'a_sexp_grammar).untyped , Cons ((value_sexp_grammar _'b_sexp_grammar).untyped, Empty) )) }) - .untyped + .untyped } } ;; @@ -1524,13 +1522,13 @@ let () = Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Transpose_got_lists_of_different_lengths] (function - | Transpose_got_lists_of_different_lengths arg0__045_ -> - let res0__046_ = sexp_of_list sexp_of_int arg0__045_ in - Sexplib0.Sexp.List - [ Sexplib0.Sexp.Atom "list.ml.Transpose_got_lists_of_different_lengths" - ; res0__046_ - ] - | _ -> assert false) + | Transpose_got_lists_of_different_lengths arg0__045_ -> + let res0__046_ = sexp_of_list sexp_of_int arg0__045_ in + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "list.ml.Transpose_got_lists_of_different_lengths" + ; res0__046_ + ] + | _ -> assert false) ;; [@@@end] diff --git a/src/list.mli b/src/list.mli index ee487840..6af2571a 100644 --- a/src/list.mli +++ b/src/list.mli @@ -134,7 +134,6 @@ val exists2 : 'a t -> 'b t -> f:(('a -> 'b -> bool)[@local]) -> bool Or_unequal_ (** Like [filter], but reverses the order of the input list. *) val rev_filter : 'a t -> f:(('a -> bool)[@local]) -> 'a t - val partition3_map : 'a t -> f:(('a -> [ `Fst of 'b | `Snd of 'c | `Trd of 'd ])[@local]) @@ -254,7 +253,6 @@ val map3 result to the front of [l2]. *) val rev_map_append : 'a t -> 'b t -> f:(('a -> 'b)[@local]) -> 'b t - (** [fold_right [a1; ...; an] ~f ~init:b] is [f a1 (f a2 (... (f an b) ...))]. *) val fold_right : 'a t -> f:(('a -> 'acc -> 'acc)[@local]) -> init:'acc -> 'acc @@ -337,7 +335,6 @@ val is_prefix : 'a t -> prefix:'a t -> equal:(('a -> 'a -> bool)[@local]) -> boo (** [is_suffix xs ~suffix] returns [true] if [xs] ends with [suffix]. *) val is_suffix : 'a t -> suffix:'a t -> equal:(('a -> 'a -> bool)[@local]) -> bool - (** [find_consecutive_duplicate t ~equal] returns the first pair of consecutive elements [(a1, a2)] in [t] such that [equal a1 a2]. They are returned in the same order as they appear in [t]. [equal] need not be an equivalence relation; it is simply used as diff --git a/src/list0.ml b/src/list0.ml index 3b5c0a55..43f3361e 100644 --- a/src/list0.ml +++ b/src/list0.ml @@ -6,7 +6,6 @@ [module List = List0]. Defining [module List = List0] is also necessary because it prevents ocamldep from mistakenly causing a file to depend on [Base.List]. *) - open! Import0 let hd_exn = Stdlib.List.hd diff --git a/src/map.ml b/src/map.ml index c2361435..456b2413 100644 --- a/src/map.ml +++ b/src/map.ml @@ -73,8 +73,7 @@ let () = keeping the tree global. This saves up to O(log n) blocks of heap allocation. *) module With_length : sig type 'a t = private - { tree : 'a - [@global] + { tree : 'a [@global] ; length : int [@global] } @@ -268,13 +267,13 @@ module Tree0 = struct end let rec find_and_add_or_set - t - ~length - ~key:x - ~data - ~compare_key - ~sexp_of_key - ~(add_or_set : Add_or_set.t) + t + ~length + ~key:x + ~data + ~compare_key + ~sexp_of_key + ~(add_or_set : Add_or_set.t) = match t with | Empty -> (with_length (Leaf (x, data)) (length + 1)) @@ -437,7 +436,6 @@ module Tree0 = struct ;; end - let of_increasing_sequence seq ~compare_key = with_return (fun { return } -> let { tree = builder; length } = @@ -445,13 +443,13 @@ module Tree0 = struct seq ~init:(with_length_global Build_increasing.empty 0) ~f:(fun { tree = builder; length } (key, data) -> - match Build_increasing.max_key builder with - | Some prev_key when compare_key prev_key key >= 0 -> - return (Or_error.error_string "of_increasing_sequence: non-increasing key") - | _ -> - with_length_global - (Build_increasing.add_unchecked builder ~key ~data) - (length + 1)) + match Build_increasing.max_key builder with + | Some prev_key when compare_key prev_key key >= 0 -> + return (Or_error.error_string "of_increasing_sequence: non-increasing key") + | _ -> + with_length_global + (Build_increasing.add_unchecked builder ~key ~data) + (length + 1)) in Ok (with_length_global (Build_increasing.to_tree_unchecked builder) length)) ;; @@ -468,7 +466,7 @@ module Tree0 = struct | Node (ll, lk, ld, lr, lh), Node (rl, rk, rd, rr, rh) -> (* [bal] requires height difference <= 3. *) if lh > rh + 3 - (* [height lr >= height r], + (* [height lr >= height r], therefore [height (join lr k d r ...)] is [height rl + 1] or [height rl] therefore the height difference with [ll] will be <= 3 *) then bal ll lk ld (join lr k d r) @@ -527,10 +525,10 @@ module Tree0 = struct ;; let split_range - t - ~(lower_bound : 'a Maybe_bound.t) - ~(upper_bound : 'a Maybe_bound.t) - ~compare_key + t + ~(lower_bound : 'a Maybe_bound.t) + ~(upper_bound : 'a Maybe_bound.t) + ~compare_key = if Maybe_bound.bounds_crossed ~compare:compare_key @@ -605,9 +603,9 @@ module Tree0 = struct Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Map_min_elt_exn_of_empty_map] (function - | Map_min_elt_exn_of_empty_map -> - Sexplib0.Sexp.Atom "map.ml.Tree0.Map_min_elt_exn_of_empty_map" - | _ -> assert false) + | Map_min_elt_exn_of_empty_map -> + Sexplib0.Sexp.Atom "map.ml.Tree0.Map_min_elt_exn_of_empty_map" + | _ -> assert false) ;; [@@@end] @@ -618,9 +616,9 @@ module Tree0 = struct Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Map_max_elt_exn_of_empty_map] (function - | Map_max_elt_exn_of_empty_map -> - Sexplib0.Sexp.Atom "map.ml.Tree0.Map_max_elt_exn_of_empty_map" - | _ -> assert false) + | Map_max_elt_exn_of_empty_map -> + Sexplib0.Sexp.Atom "map.ml.Tree0.Map_max_elt_exn_of_empty_map" + | _ -> assert false) ;; [@@@end] @@ -841,8 +839,8 @@ module Tree0 = struct let remove_multi t key ~length ~compare_key = (change t key ~length ~compare_key ~f:(function - | None | Some ([] | [ _ ]) -> None - | Some (_ :: (_ :: _ as non_empty_tail)) -> Some non_empty_tail)) + | None | Some ([] | [ _ ]) -> None + | Some (_ :: (_ :: _ as non_empty_tail)) -> Some non_empty_tail)) ;; let rec iter_keys t ~f = @@ -999,9 +997,9 @@ module Tree0 = struct t ~init:(Build_increasing.empty, Build_increasing.empty) ~f:(fun ~key ~data (t1, t2) -> - match (f ~key ~data : _ Either.t) with - | First x -> Build_increasing.add_unchecked t1 ~key ~data:x, t2 - | Second y -> t1, Build_increasing.add_unchecked t2 ~key ~data:y) + match (f ~key ~data : _ Either.t) with + | First x -> Build_increasing.add_unchecked t1 ~key ~data:x, t2 + | Second y -> t1, Build_increasing.add_unchecked t2 ~key ~data:y) in Build_increasing.to_tree_unchecked t1, Build_increasing.to_tree_unchecked t2 ;; @@ -1165,10 +1163,10 @@ module Tree0 = struct | End, End -> curr | End, _ -> fold t2 ~init:curr ~f:(fun ~key ~data acc -> f ~key ~data:(`Right data) acc) [@nontail - ] + ] | _, End -> fold t1 ~init:curr ~f:(fun ~key ~data acc -> f ~key ~data:(`Left data) acc) [@nontail - ] + ] | More (k1, v1, tree1, enum1), More (k2, v2, tree2, enum2) -> let compare_result = compare_key k1 k2 in if compare_result = 0 @@ -1271,11 +1269,11 @@ module Tree0 = struct ;; let to_sequence - comparator - ?(order = `Increasing_key) - ?keys_greater_or_equal_to - ?keys_less_or_equal_to - t + comparator + ?(order = `Increasing_key) + ?keys_greater_or_equal_to + ?keys_less_or_equal_to + t = let inclusive_bound side t bound = let compare_key = comparator.Comparator.compare in @@ -1389,13 +1387,13 @@ module Tree0 = struct foldable ~init:(with_length_global empty 0) ~f:(fun { tree = accum; length } (key, data) -> - let prev_data = - match find accum key ~compare_key with - | None -> init - | Some prev -> prev - in - let data = f prev_data data in - (set accum ~length ~key ~data ~compare_key |> globalize) [@nontail]) [@nontail] + let prev_data = + match find accum key ~compare_key with + | None -> init + | Some prev -> prev + in + let data = f prev_data data in + (set accum ~length ~key ~data ~compare_key |> globalize) [@nontail]) [@nontail] ;; module Of_foldable (M : Foldable) = struct @@ -1408,13 +1406,13 @@ module Tree0 = struct foldable ~init:(with_length_global empty 0) ~f:(fun { tree = accum; length } (key, data) -> - let new_data = - match find accum key ~compare_key with - | None -> data - | Some prev -> f prev data - in - (set accum ~length ~key ~data:new_data ~compare_key |> globalize) [@nontail]) [@nontail - ] + let new_data = + match find accum key ~compare_key with + | None -> data + | Some prev -> f prev data + in + (set accum ~length ~key ~data:new_data ~compare_key |> globalize) [@nontail]) [@nontail + ] ;; let of_foldable foldable ~compare_key = @@ -1424,12 +1422,12 @@ module Tree0 = struct foldable ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } (key, data) -> - let ({ tree = _; length = length' } as acc) = - set ~length ~key ~data t ~compare_key - in - if length = length' - then r.return (`Duplicate_key key) - else globalize acc [@nontail]) + let ({ tree = _; length = length' } as acc) = + set ~length ~key ~data t ~compare_key + in + if length = length' + then r.return (`Duplicate_key key) + else globalize acc [@nontail]) in `Ok map) ;; @@ -1462,12 +1460,12 @@ module Tree0 = struct end module Of_alist = Of_foldable (struct - let name = "alist" + let name = "alist" - type 'a t = 'a list + type 'a t = 'a list - let fold = List.fold - end) + let fold = List.fold + end) let of_alist_fold = Of_alist.of_foldable_fold let of_alist_reduce = Of_alist.of_foldable_reduce @@ -1477,12 +1475,12 @@ module Tree0 = struct let of_alist_multi = Of_alist.of_foldable_multi module Of_sequence = Of_foldable (struct - let name = "sequence" + let name = "sequence" - type 'a t = 'a Sequence.t + type 'a t = 'a Sequence.t - let fold = Sequence.fold - end) + let fold = Sequence.fold + end) let of_sequence_fold = Of_sequence.of_foldable_fold let of_sequence_reduce = Of_sequence.of_foldable_reduce @@ -1498,13 +1496,13 @@ module Tree0 = struct list ~init:(with_length_global empty 0) ~f:(fun { tree = t; length } data -> - let key = get_key data in - let ({ tree = _; length = new_length } as acc) = - set ~length ~key ~data t ~compare_key - in - if length = new_length - then r.return (`Duplicate_key key) - else globalize acc [@nontail]) + let key = get_key data in + let ({ tree = _; length = new_length } as acc) = + set ~length ~key ~data t ~compare_key + in + if length = new_length + then r.return (`Duplicate_key key) + else globalize acc [@nontail]) in `Ok map) [@nontail] ;; @@ -1567,7 +1565,7 @@ module Tree0 = struct let counti t ~f = fold t ~init:0 ~f:(fun ~key ~data acc -> if f ~key ~data then acc + 1 else acc) [@nontail - ] + ] ;; let to_alist ?(key_order = `Increasing) t = @@ -1597,10 +1595,10 @@ module Tree0 = struct t_small ~init:(with_length_global t_large length_large) ~f:(fun ~key ~data:data' { tree = t; length } -> - (update t key ~length ~compare_key ~f:(function - | None -> data' - | Some data -> call combine ~key data data') - |> globalize) [@nontail]) [@nontail] + (update t key ~length ~compare_key ~f:(function + | None -> data' + | Some data -> call combine ~key data data') + |> globalize) [@nontail]) [@nontail] in let call f ~key x y = f ~key x y in let swap f ~key x y = f ~key y x in @@ -1620,10 +1618,10 @@ module Tree0 = struct | Found : ('k, 'v, 'k, 'v) marker let repackage - (type k v k_opt v_opt) - (marker : (k, v, k_opt, v_opt) marker) - (k : k_opt) - (v : v_opt) + (type k v k_opt v_opt) + (marker : (k, v, k_opt, v_opt) marker) + (k : k_opt) + (v : v_opt) : (k * v) option = match marker with @@ -1633,15 +1631,15 @@ module Tree0 = struct (* The type signature is explicit here to allow polymorphic recursion. *) let rec loop : - 'k 'v 'k_opt 'v_opt. - ('k, 'v) tree - -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] - -> 'k - -> compare_key:('k -> 'k -> int) - -> ('k, 'v, 'k_opt, 'v_opt) marker - -> 'k_opt - -> 'v_opt - -> ('k * 'v) option + 'k 'v 'k_opt 'v_opt. + ('k, 'v) tree + -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] + -> 'k + -> compare_key:('k -> 'k -> int) + -> ('k, 'v, 'k_opt, 'v_opt) marker + -> 'k_opt + -> 'v_opt + -> ('k * 'v) option = fun t dir k ~compare_key found_marker found_key found_value -> match t with @@ -1649,10 +1647,10 @@ module Tree0 = struct | Leaf (k', v') -> let c = compare_key k' k in if match dir with - | `Greater_or_equal_to -> c >= 0 - | `Greater_than -> c > 0 - | `Less_or_equal_to -> c <= 0 - | `Less_than -> c < 0 + | `Greater_or_equal_to -> c >= 0 + | `Greater_than -> c > 0 + | `Less_or_equal_to -> c <= 0 + | `Less_than -> c < 0 then Some (k', v') else repackage found_marker found_key found_value | Node (l, k', v', r, _) -> @@ -1721,7 +1719,6 @@ module Tree0 = struct let nth t n = nth' (ref n) t - let rec find_first_satisfying t ~f = match t with | Empty -> None @@ -1822,7 +1819,6 @@ module Tree0 = struct | Some upper_bound -> Some (lower_bound, upper_bound)) ;; - type ('k, 'v) acc = { mutable bad_key : 'k option ; mutable map_length : ('k, 'v) t With_length.t @@ -1887,9 +1883,9 @@ module Tree0 = struct let unzip t = map t ~f:fst, map t ~f:snd let map_keys - t1 - ~f - ~comparator:({ compare = compare_key; sexp_of_t = sexp_of_key } : _ Comparator.t) + t1 + ~f + ~comparator:({ compare = compare_key; sexp_of_t = sexp_of_key } : _ Comparator.t) = with_return (fun { return } -> `Ok @@ -1897,11 +1893,11 @@ module Tree0 = struct t1 ~init:(with_length_global empty 0) ~f:(fun ~key ~data { tree = t2; length } -> - let key = f key in - try - add_exn_internal t2 ~length ~key ~data ~compare_key ~sexp_of_key |> globalize - with - | Duplicate -> return (`Duplicate_key key)))) [@nontail] + let key = f key in + try + add_exn_internal t2 ~length ~key ~data ~compare_key ~sexp_of_key |> globalize + with + | Duplicate -> return (`Duplicate_key key)))) [@nontail] ;; let map_keys_exn t ~f ~comparator = @@ -1918,26 +1914,26 @@ module Tree0 = struct outer_t ~init:(with_length_global empty 0) ~f:(fun ~key:outer_key ~data:inner_t acc -> - fold - inner_t - ~init:acc - ~f:(fun ~key:inner_key ~data { tree = acc; length = acc_len } -> - (update - acc - inner_key - ~length:acc_len - ~compare_key:inner_comparator.Comparator.compare - ~f:(function - | None -> with_length_global (singleton outer_key data) 1 - | Some { tree = elt; length = elt_len } -> - (set - elt - ~key:outer_key - ~data - ~length:elt_len - ~compare_key:outer_comparator.Comparator.compare - |> globalize) [@nontail]) - |> globalize) [@nontail])) + fold + inner_t + ~init:acc + ~f:(fun ~key:inner_key ~data { tree = acc; length = acc_len } -> + (update + acc + inner_key + ~length:acc_len + ~compare_key:inner_comparator.Comparator.compare + ~f:(function + | None -> with_length_global (singleton outer_key data) 1 + | Some { tree = elt; length = elt_len } -> + (set + elt + ~key:outer_key + ~data + ~length:elt_len + ~compare_key:outer_comparator.Comparator.compare + |> globalize) [@nontail]) + |> globalize) [@nontail])) ;; module Make_applicative_traversals (A : Applicative.Lazy_applicative) = struct @@ -1972,11 +1968,11 @@ module Tree0 = struct ~f: (fun { tree = l'; length = l_len } new_data { tree = r'; length = r_len } -> - match new_data with - | Some new_data -> - with_length_global (join l' v new_data r') (l_len + r_len + 1) - | None -> - with_length_global (concat_and_balance_unchecked l' r') (l_len + r_len)) + match new_data with + | Some new_data -> + with_length_global (join l' v new_data r') (l_len + r_len + 1) + | None -> + with_length_global (concat_and_balance_unchecked l' r') (l_len + r_len)) in tree_filter_mapi t ~f ;; @@ -1997,14 +1993,13 @@ type ('k, 'v, 'comparator) tree = ('k, 'v) Tree0.t let compare_key t = t.comparator.Comparator.compare - let like { tree = _; length = _; comparator } ({ tree; length } : _ With_length.t) = { tree; length; comparator } ;; let like_maybe_no_op - ({ tree = old_tree; length = _; comparator } as old_t) - ({ tree; length } : _ With_length.t) + ({ tree = old_tree; length = _; comparator } as old_t) + ({ tree; length } : _ With_length.t) = if phys_equal old_tree tree then old_t else { tree; length; comparator } ;; @@ -2373,7 +2368,7 @@ module Tree = struct let of_sorted_array_unchecked ~comparator array = (Tree0.of_sorted_array_unchecked array ~compare_key:comparator.Comparator.compare) - .tree + .tree ;; let of_sorted_array ~comparator array = @@ -2471,7 +2466,7 @@ module Tree = struct list ~get_key ~compare_key:comparator.Comparator.compare) - .tree + .tree ;; let to_tree t = t @@ -2495,7 +2490,7 @@ module Tree = struct ~length:0 ~compare_key:comparator.Comparator.compare ~sexp_of_key:comparator.sexp_of_t) - .tree + .tree ;; let add_exn_internal ~comparator t ~key ~data = @@ -2506,7 +2501,7 @@ module Tree = struct ~length:0 ~compare_key:comparator.Comparator.compare ~sexp_of_key:comparator.sexp_of_t) - .tree + .tree ;; let add ~comparator t ~key ~data = @@ -2516,7 +2511,7 @@ module Tree = struct let add_multi ~comparator t ~key ~data = (Tree0.add_multi t ~key ~data ~length:0 ~compare_key:comparator.Comparator.compare) - .tree + .tree ;; let remove_multi ~comparator t key = @@ -2625,7 +2620,7 @@ module Tree = struct ~length2:(length t2) ~combine ~compare_key:comparator.Comparator.compare) - .tree + .tree ;; let min_elt t = Tree0.min_elt t @@ -3030,9 +3025,9 @@ let map_keys_exn m t ~f = Using_comparator.map_keys_exn ~comparator:(to_comparat let transpose_keys m t = Using_comparator.transpose_keys ~comparator:(to_comparator m) t module M (K : sig - type t - type comparator_witness - end) = + type t + type comparator_witness +end) = struct type nonrec 'v t = (K.t, 'v, K.comparator_witness) t end @@ -3072,18 +3067,18 @@ let sexp_of_m__t (type k) (module K : Sexp_of_m with type t = k) sexp_of_v t = ;; let m__t_of_sexp - (type k cmp) - (module K : M_of_sexp with type t = k and type comparator_witness = cmp) - v_of_sexp - sexp + (type k cmp) + (module K : M_of_sexp with type t = k and type comparator_witness = cmp) + v_of_sexp + sexp = Using_comparator.t_of_sexp_direct ~comparator:K.comparator K.t_of_sexp v_of_sexp sexp ;; let m__t_sexp_grammar - (type k) - (module K : M_sexp_grammar with type t = k) - (v_grammar : _ Sexplib0.Sexp_grammar.t) + (type k) + (module K : M_sexp_grammar with type t = k) + (v_grammar : _ Sexplib0.Sexp_grammar.t) : _ Sexplib0.Sexp_grammar.t = { untyped = diff --git a/src/map_intf.ml b/src/map_intf.ml index 45a86703..89db88d9 100644 --- a/src/map_intf.ml +++ b/src/map_intf.ml @@ -32,8 +32,8 @@ module Or_duplicate = struct let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = fun _of_a__009_ -> function - | `Ok v__010_ -> Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; _of_a__009_ v__010_ ] - | `Duplicate -> Sexplib0.Sexp.Atom "Duplicate" + | `Ok v__010_ -> Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; _of_a__009_ v__010_ ] + | `Duplicate -> Sexplib0.Sexp.Atom "Duplicate" ;; [@@@end] @@ -56,7 +56,7 @@ module Symmetric_diff_element = struct [@@deriving_inline compare, equal, sexp, sexp_grammar] let compare : - 'k 'v. ('k -> 'k -> int) -> ('v -> 'v -> int) -> ('k, 'v) t -> ('k, 'v) t -> int + 'k 'v. ('k -> 'k -> int) -> ('v -> 'v -> int) -> ('k, 'v) t -> ('k, 'v) t -> int = fun _cmp__k _cmp__v a__011_ b__012_ -> let t__013_, t__014_ = a__011_ in @@ -80,8 +80,8 @@ module Symmetric_diff_element = struct ;; let equal : - 'k 'v. - ('k -> 'k -> bool) -> ('v -> 'v -> bool) -> ('k, 'v) t -> ('k, 'v) t -> bool + 'k 'v. + ('k -> 'k -> bool) -> ('v -> 'v -> bool) -> ('k, 'v) t -> ('k, 'v) t -> bool = fun _cmp__k _cmp__v a__027_ b__028_ -> let t__029_, t__030_ = a__027_ in @@ -102,11 +102,11 @@ module Symmetric_diff_element = struct ;; let t_of_sexp : - 'k 'v. - (Sexplib0.Sexp.t -> 'k) - -> (Sexplib0.Sexp.t -> 'v) - -> Sexplib0.Sexp.t - -> ('k, 'v) t + 'k 'v. + (Sexplib0.Sexp.t -> 'k) + -> (Sexplib0.Sexp.t -> 'v) + -> Sexplib0.Sexp.t + -> ('k, 'v) t = let error_source__057_ = "map_intf.ml.Symmetric_diff_element.t" in fun _of_k__043_ _of_v__044_ -> function @@ -190,11 +190,11 @@ module Symmetric_diff_element = struct ;; let sexp_of_t : - 'k 'v. - ('k -> Sexplib0.Sexp.t) - -> ('v -> Sexplib0.Sexp.t) - -> ('k, 'v) t - -> Sexplib0.Sexp.t + 'k 'v. + ('k -> Sexplib0.Sexp.t) + -> ('v -> Sexplib0.Sexp.t) + -> ('k, 'v) t + -> Sexplib0.Sexp.t = fun _of_k__072_ _of_v__073_ (arg0__081_, arg1__082_) -> let res0__083_ = _of_k__072_ arg0__081_ @@ -217,10 +217,10 @@ module Symmetric_diff_element = struct ;; let t_sexp_grammar : - 'k 'v. - 'k Sexplib0.Sexp_grammar.t - -> 'v Sexplib0.Sexp_grammar.t - -> ('k, 'v) t Sexplib0.Sexp_grammar.t + 'k 'v. + 'k Sexplib0.Sexp_grammar.t + -> 'v Sexplib0.Sexp_grammar.t + -> ('k, 'v) t Sexplib0.Sexp_grammar.t = fun _'k_sexp_grammar _'v_sexp_grammar -> { untyped = @@ -275,12 +275,12 @@ module Merge_element = struct [@@deriving_inline compare, equal, sexp_of] let compare : - 'left 'right. - ('left -> 'left -> int) - -> ('right -> 'right -> int) - -> ('left, 'right) t - -> ('left, 'right) t - -> int + 'left 'right. + ('left -> 'left -> int) + -> ('right -> 'right -> int) + -> ('left, 'right) t + -> ('left, 'right) t + -> int = fun _cmp__left _cmp__right a__085_ b__086_ -> if Stdlib.( == ) a__085_ b__086_ @@ -299,12 +299,12 @@ module Merge_element = struct ;; let equal : - 'left 'right. - ('left -> 'left -> bool) - -> ('right -> 'right -> bool) - -> ('left, 'right) t - -> ('left, 'right) t - -> bool + 'left 'right. + ('left -> 'left -> bool) + -> ('right -> 'right -> bool) + -> ('left, 'right) t + -> ('left, 'right) t + -> bool = fun _cmp__left _cmp__right a__097_ b__098_ -> if Stdlib.( == ) a__097_ b__098_ @@ -321,25 +321,25 @@ module Merge_element = struct ;; let sexp_of_t : - 'left 'right. - ('left -> Sexplib0.Sexp.t) - -> ('right -> Sexplib0.Sexp.t) - -> ('left, 'right) t - -> Sexplib0.Sexp.t + 'left 'right. + ('left -> Sexplib0.Sexp.t) + -> ('right -> Sexplib0.Sexp.t) + -> ('left, 'right) t + -> Sexplib0.Sexp.t = fun _of_left__109_ _of_right__110_ -> function - | `Left v__111_ -> - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; _of_left__109_ v__111_ ] - | `Right v__112_ -> - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; _of_right__110_ v__112_ ] - | `Both v__113_ -> - Sexplib0.Sexp.List - [ Sexplib0.Sexp.Atom "Both" - ; (let arg0__114_, arg1__115_ = v__113_ in - let res0__116_ = _of_left__109_ arg0__114_ - and res1__117_ = _of_right__110_ arg1__115_ in - Sexplib0.Sexp.List [ res0__116_; res1__117_ ]) - ] + | `Left v__111_ -> + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; _of_left__109_ v__111_ ] + | `Right v__112_ -> + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; _of_right__110_ v__112_ ] + | `Both v__113_ -> + Sexplib0.Sexp.List + [ Sexplib0.Sexp.Atom "Both" + ; (let arg0__114_, arg1__115_ = v__113_ in + let res0__116_ = _of_left__109_ arg0__114_ + and res1__117_ = _of_right__110_ arg1__115_ in + Sexplib0.Sexp.List [ res0__116_; res1__117_ ]) + ] ;; [@@@end] @@ -358,9 +358,9 @@ module Continue_or_stop = struct let sexp_of_t = (function - | Continue -> Sexplib0.Sexp.Atom "Continue" - | Stop -> Sexplib0.Sexp.Atom "Stop" - : t -> Sexplib0.Sexp.t) + | Continue -> Sexplib0.Sexp.Atom "Continue" + | Stop -> Sexplib0.Sexp.Atom "Stop" + : t -> Sexplib0.Sexp.t) ;; [@@@end] @@ -379,9 +379,9 @@ module Finished_or_unfinished = struct let sexp_of_t = (function - | Finished -> Sexplib0.Sexp.Atom "Finished" - | Unfinished -> Sexplib0.Sexp.Atom "Unfinished" - : t -> Sexplib0.Sexp.t) + | Finished -> Sexplib0.Sexp.Atom "Finished" + | Unfinished -> Sexplib0.Sexp.Atom "Unfinished" + : t -> Sexplib0.Sexp.t) ;; [@@@end] @@ -397,9 +397,9 @@ module type Accessors_generic = sig (** @inline *) include Dictionary_immutable.Accessors - with type 'key key := 'key key - and type ('key, 'data, 'cmp) t := ('key, 'data, 'cmp) t - and type ('fn, 'key, _, 'cmp) accessor := ('key, 'cmp, 'fn) access_options + with type 'key key := 'key key + and type ('key, 'data, 'cmp) t := ('key, 'data, 'cmp) t + and type ('fn, 'key, _, 'cmp) accessor := ('key, 'cmp, 'fn) access_options val invariants : ('k, 'cmp, ('k, 'v, 'cmp) t -> bool) access_options val is_empty : (_, _, _) t -> bool @@ -409,25 +409,25 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v, 'cmp) t Or_duplicate.t ) - access_options + access_options val add_exn : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v, 'cmp) t ) - access_options + access_options val set : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v, 'cmp) t ) - access_options + access_options val add_multi : ( 'k , 'cmp , ('k, 'v list, 'cmp) t -> key:'k key -> data:'v -> ('k, 'v list, 'cmp) t ) - access_options + access_options val remove_multi : ('k, 'cmp, ('k, 'v list, 'cmp) t -> 'k key -> ('k, 'v list, 'cmp) t) access_options @@ -438,17 +438,17 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> 'k key - -> f:(('v option -> 'v option)[@local]) - -> ('k, 'v, 'cmp) t ) - access_options + -> 'k key + -> f:(('v option -> 'v option)[@local]) + -> ('k, 'v, 'cmp) t ) + access_options val update : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> 'k key -> f:(('v option -> 'v)[@local]) -> ('k, 'v, 'cmp) t ) - access_options + access_options val find : ('k, 'cmp, ('k, 'v, 'cmp) t -> 'k key -> 'v option) access_options val find_exn : ('k, 'cmp, ('k, 'v, 'cmp) t -> 'k key -> 'v) access_options @@ -467,10 +467,10 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v1, 'cmp) t - -> ('k, 'v2, 'cmp) t - -> f:((key:'k key -> data:('v1, 'v2) Merge_element.t -> unit)[@local]) - -> unit ) - access_options + -> ('k, 'v2, 'cmp) t + -> f:((key:'k key -> data:('v1, 'v2) Merge_element.t -> unit)[@local]) + -> unit ) + access_options val map : ('k, 'v1, 'cmp) t -> f:(('v1 -> 'v2)[@local]) -> ('k, 'v2, 'cmp) t @@ -490,7 +490,7 @@ module type Accessors_generic = sig -> init:'acc -> f: ((key:'k key -> data:'v -> 'acc -> ('acc, 'final) Container.Continue_or_stop.t) - [@local]) + [@local]) -> finish:(('acc -> 'final)[@local]) -> 'final @@ -504,11 +504,11 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v1, 'cmp) t - -> ('k, 'v2, 'cmp) t - -> init:'acc - -> f:((key:'k key -> data:('v1, 'v2) Merge_element.t -> 'acc -> 'acc)[@local]) - -> 'acc ) - access_options + -> ('k, 'v2, 'cmp) t + -> init:'acc + -> f:((key:'k key -> data:('v1, 'v2) Merge_element.t -> 'acc -> 'acc)[@local]) + -> 'acc ) + access_options val filter_keys : ('k, 'v, 'cmp) t -> f:(('k key -> bool)[@local]) -> ('k, 'v, 'cmp) t val filter : ('k, 'v, 'cmp) t -> f:(('v -> bool)[@local]) -> ('k, 'v, 'cmp) t @@ -552,7 +552,7 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v Or_error.t, 'cmp) t -> ('k, 'v, 'cmp) t Or_error.t ) - access_options + access_options val unzip : ('k, 'v1 * 'v2, 'cmp) t -> ('k, 'v1, 'cmp) t * ('k, 'v2, 'cmp) t @@ -560,13 +560,13 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('v -> 'v -> int) -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> int ) - access_options + access_options val equal : ( 'k , 'cmp , ('v -> 'v -> bool) -> ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) t -> bool ) - access_options + access_options val keys : ('k, _, _) t -> 'k key list val data : (_, 'v, _) t -> 'v list @@ -580,39 +580,39 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v1, 'cmp) t - -> ('k, 'v2, 'cmp) t - -> f:((key:'k key -> ('v1, 'v2) Merge_element.t -> 'v3 option)[@local]) - -> ('k, 'v3, 'cmp) t ) - access_options + -> ('k, 'v2, 'cmp) t + -> f:((key:'k key -> ('v1, 'v2) Merge_element.t -> 'v3 option)[@local]) + -> ('k, 'v3, 'cmp) t ) + access_options val merge_skewed : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> ('k, 'v, 'cmp) t - -> combine:((key:'k key -> 'v -> 'v -> 'v)[@local]) - -> ('k, 'v, 'cmp) t ) - access_options + -> ('k, 'v, 'cmp) t + -> combine:((key:'k key -> 'v -> 'v -> 'v)[@local]) + -> ('k, 'v, 'cmp) t ) + access_options val symmetric_diff : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> ('k, 'v, 'cmp) t - -> data_equal:('v -> 'v -> bool) - -> ('k key, 'v) Symmetric_diff_element.t Sequence.t ) - access_options + -> ('k, 'v, 'cmp) t + -> data_equal:('v -> 'v -> bool) + -> ('k key, 'v) Symmetric_diff_element.t Sequence.t ) + access_options val fold_symmetric_diff : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> ('k, 'v, 'cmp) t - -> data_equal:(('v -> 'v -> bool)[@local]) - -> init:'acc - -> f:(('acc -> ('k key, 'v) Symmetric_diff_element.t -> 'acc)[@local]) - -> 'acc ) - access_options + -> ('k, 'v, 'cmp) t + -> data_equal:(('v -> 'v -> bool)[@local]) + -> init:'acc + -> f:(('acc -> ('k key, 'v) Symmetric_diff_element.t -> 'acc)[@local]) + -> 'acc ) + access_options val min_elt : ('k, 'v, _) t -> ('k key * 'v) option val min_elt_exn : ('k, 'v, _) t -> 'k key * 'v @@ -629,64 +629,64 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> 'k key - -> ('k, 'v, 'cmp) t * ('k key * 'v) option * ('k, 'v, 'cmp) t ) - access_options + -> 'k key + -> ('k, 'v, 'cmp) t * ('k key * 'v) option * ('k, 'v, 'cmp) t ) + access_options val split_le_gt : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> 'k key -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t ) - access_options + access_options val split_lt_ge : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> 'k key -> ('k, 'v, 'cmp) t * ('k, 'v, 'cmp) t ) - access_options + access_options val append : ( 'k , 'cmp , lower_part:('k, 'v, 'cmp) t - -> upper_part:('k, 'v, 'cmp) t - -> [ `Ok of ('k, 'v, 'cmp) t | `Overlapping_key_ranges ] ) - access_options + -> upper_part:('k, 'v, 'cmp) t + -> [ `Ok of ('k, 'v, 'cmp) t | `Overlapping_key_ranges ] ) + access_options val subrange : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> lower_bound:'k key Maybe_bound.t - -> upper_bound:'k key Maybe_bound.t - -> ('k, 'v, 'cmp) t ) - access_options + -> lower_bound:'k key Maybe_bound.t + -> upper_bound:'k key Maybe_bound.t + -> ('k, 'v, 'cmp) t ) + access_options val fold_range_inclusive : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> min:'k key - -> max:'k key - -> init:'acc - -> f:((key:'k key -> data:'v -> 'acc -> 'acc)[@local]) - -> 'acc ) - access_options + -> min:'k key + -> max:'k key + -> init:'acc + -> f:((key:'k key -> data:'v -> 'acc -> 'acc)[@local]) + -> 'acc ) + access_options val range_to_alist : ( 'k , 'cmp , ('k, 'v, 'cmp) t -> min:'k key -> max:'k key -> ('k key * 'v) list ) - access_options + access_options val closest_key : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] - -> 'k key - -> ('k key * 'v) option ) - access_options + -> [ `Greater_or_equal_to | `Greater_than | `Less_or_equal_to | `Less_than ] + -> 'k key + -> ('k key * 'v) option ) + access_options val nth : ('k, 'v, 'cmp) t -> int -> ('k key * 'v) option val nth_exn : ('k, 'v, 'cmp) t -> int -> 'k key * 'v @@ -697,40 +697,40 @@ module type Accessors_generic = sig : ( 'k , 'cmp , ?order:[ `Increasing_key | `Decreasing_key ] - -> ?keys_greater_or_equal_to:'k key - -> ?keys_less_or_equal_to:'k key - -> ('k, 'v, 'cmp) t - -> ('k key * 'v) Sequence.t ) - access_options + -> ?keys_greater_or_equal_to:'k key + -> ?keys_less_or_equal_to:'k key + -> ('k, 'v, 'cmp) t + -> ('k key * 'v) Sequence.t ) + access_options val binary_search : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> compare:((key:'k key -> data:'v -> 'key -> int)[@local]) - -> Binary_searchable.Which_target_by_key.t - -> 'key - -> ('k key * 'v) option ) - access_options + -> compare:((key:'k key -> data:'v -> 'key -> int)[@local]) + -> Binary_searchable.Which_target_by_key.t + -> 'key + -> ('k key * 'v) option ) + access_options val binary_search_segmented : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> segment_of:((key:'k key -> data:'v -> [ `Left | `Right ])[@local]) - -> Binary_searchable.Which_target_by_segment.t - -> ('k key * 'v) option ) - access_options + -> segment_of:((key:'k key -> data:'v -> [ `Left | `Right ])[@local]) + -> Binary_searchable.Which_target_by_segment.t + -> ('k key * 'v) option ) + access_options val binary_search_subrange : ( 'k , 'cmp , ('k, 'v, 'cmp) t - -> compare:((key:'k key -> data:'v -> 'bound -> int)[@local]) - -> lower_bound:'bound Maybe_bound.t - -> upper_bound:'bound Maybe_bound.t - -> ('k, 'v, 'cmp) t ) - access_options + -> compare:((key:'k key -> data:'v -> 'bound -> int)[@local]) + -> lower_bound:'bound Maybe_bound.t + -> upper_bound:'bound Maybe_bound.t + -> ('k, 'v, 'cmp) t ) + access_options module Make_applicative_traversals (A : Applicative.Lazy_applicative) : sig val mapi @@ -756,9 +756,9 @@ module type Creators_generic = sig (** @inline *) include Dictionary_immutable.Creators - with type 'key key := 'key key - and type ('key, 'data, 'cmp) t := ('key, 'data, 'cmp) t - and type ('fn, 'key, _, 'cmp) creator := ('key, 'cmp, 'fn) create_options + with type 'key key := 'key key + and type ('key, 'data, 'cmp) t := ('key, 'data, 'cmp) t + and type ('fn, 'key, _, 'cmp) creator := ('key, 'cmp, 'fn) create_options val empty : ('k, 'cmp, ('k, _, 'cmp) t) create_options val singleton : ('k, 'cmp, 'k key -> 'v -> ('k, 'v, 'cmp) t) create_options @@ -767,15 +767,15 @@ module type Creators_generic = sig : ( 'k2 , 'cmp2 , ('k1, 'v, 'cmp1) t - -> f:(('k1 key -> 'k2 key)[@local]) - -> [ `Ok of ('k2, 'v, 'cmp2) t | `Duplicate_key of 'k2 key ] ) - create_options + -> f:(('k1 key -> 'k2 key)[@local]) + -> [ `Ok of ('k2, 'v, 'cmp2) t | `Duplicate_key of 'k2 key ] ) + create_options val map_keys_exn : ( 'k2 , 'cmp2 , ('k1, 'v, 'cmp1) t -> f:(('k1 key -> 'k2 key)[@local]) -> ('k2, 'v, 'cmp2) t ) - create_options + create_options val transpose_keys : ( 'k1 @@ -783,8 +783,8 @@ module type Creators_generic = sig , ( 'k2 , 'cmp2 , ('k1, ('k2, 'a, 'cmp2) t, 'cmp1) t -> ('k2, ('k1, 'a, 'cmp1) t, 'cmp2) t ) - create_options ) - access_options + create_options ) + access_options val of_sorted_array : ('k, 'cmp, ('k key * 'v) array -> ('k, 'v, 'cmp) t Or_error.t) create_options @@ -796,13 +796,13 @@ module type Creators_generic = sig : ( 'k , 'cmp , len:int -> f:((int -> 'k key * 'v)[@local]) -> ('k, 'v, 'cmp) t ) - create_options + create_options val of_alist : ( 'k , 'cmp , ('k key * 'v) list -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) - create_options + create_options val of_alist_or_error : ('k, 'cmp, ('k key * 'v) list -> ('k, 'v, 'cmp) t Or_error.t) create_options @@ -816,16 +816,16 @@ module type Creators_generic = sig : ( 'k , 'cmp , ('k key * 'v1) list - -> init:'v2 - -> f:(('v2 -> 'v1 -> 'v2)[@local]) - -> ('k, 'v2, 'cmp) t ) - create_options + -> init:'v2 + -> f:(('v2 -> 'v1 -> 'v2)[@local]) + -> ('k, 'v2, 'cmp) t ) + create_options val of_alist_reduce : ( 'k , 'cmp , ('k key * 'v) list -> f:(('v -> 'v -> 'v)[@local]) -> ('k, 'v, 'cmp) t ) - create_options + create_options val of_increasing_sequence : ('k, 'cmp, ('k key * 'v) Sequence.t -> ('k, 'v, 'cmp) t Or_error.t) create_options @@ -835,7 +835,7 @@ module type Creators_generic = sig , 'cmp , ('k key * 'v) Sequence.t -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) - create_options + create_options val of_sequence_or_error : ('k, 'cmp, ('k key * 'v) Sequence.t -> ('k, 'v, 'cmp) t Or_error.t) create_options @@ -850,56 +850,56 @@ module type Creators_generic = sig : ( 'k , 'cmp , ('k key * 'v1) Sequence.t - -> init:'v2 - -> f:(('v2 -> 'v1 -> 'v2)[@local]) - -> ('k, 'v2, 'cmp) t ) - create_options + -> init:'v2 + -> f:(('v2 -> 'v1 -> 'v2)[@local]) + -> ('k, 'v2, 'cmp) t ) + create_options val of_sequence_reduce : ( 'k , 'cmp , ('k key * 'v) Sequence.t -> f:(('v -> 'v -> 'v)[@local]) -> ('k, 'v, 'cmp) t ) - create_options + create_options val of_list_with_key : ( 'k , 'cmp , 'v list - -> get_key:(('v -> 'k key)[@local]) - -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) - create_options + -> get_key:(('v -> 'k key)[@local]) + -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) + create_options val of_list_with_key_or_error : ( 'k , 'cmp , 'v list -> get_key:(('v -> 'k key)[@local]) -> ('k, 'v, 'cmp) t Or_error.t ) - create_options + create_options val of_list_with_key_exn : ( 'k , 'cmp , 'v list -> get_key:(('v -> 'k key)[@local]) -> ('k, 'v, 'cmp) t ) - create_options + create_options val of_list_with_key_multi : ( 'k , 'cmp , 'v list -> get_key:(('v -> 'k key)[@local]) -> ('k, 'v list, 'cmp) t ) - create_options + create_options val of_iteri : ( 'k , 'cmp , iteri:((f:((key:'k key -> data:'v -> unit)[@local]) -> unit)[@local]) - -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) - create_options + -> [ `Ok of ('k, 'v, 'cmp) t | `Duplicate_key of 'k key ] ) + create_options val of_iteri_exn : ( 'k , 'cmp , iteri:((f:((key:'k key -> data:'v -> unit)[@local]) -> unit)[@local]) - -> ('k, 'v, 'cmp) t ) - create_options + -> ('k, 'v, 'cmp) t ) + create_options val of_tree : ('k, 'cmp, ('k key, 'v, 'cmp) tree -> ('k, 'v, 'cmp) t) create_options end @@ -914,20 +914,20 @@ module type Creators_and_accessors_generic = sig include Creators_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) tree - with type 'a key := 'a key - with type 'a cmp := 'a cmp - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) create_options - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) access_options + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) tree + with type 'a key := 'a key + with type 'a cmp := 'a cmp + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) create_options + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) access_options include Accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) tree - with type 'a key := 'a key - with type 'a cmp := 'a cmp - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) access_options + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) tree + with type 'a key := 'a key + with type 'a cmp := 'a cmp + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) access_options end module type S_poly = sig @@ -937,12 +937,12 @@ module type S_poly = sig include Creators_and_accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b) t - with type ('a, 'b, 'c) tree := ('a, 'b) tree - with type 'k key := 'k - with type 'c cmp := comparator_witness - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Without_comparator.t - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) t := ('a, 'b) t + with type ('a, 'b, 'c) tree := ('a, 'b) tree + with type 'k key := 'k + with type 'c cmp := comparator_witness + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t end module type For_deriving = sig @@ -1354,7 +1354,6 @@ module type Map = sig (** [update t key ~f] is [change t key ~f:(fun o -> Some (f o))]. *) val update : ('k, 'v, 'cmp) t -> 'k -> f:(('v option -> 'v)[@local]) -> ('k, 'v, 'cmp) t - (** Returns [Some value] bound to the given key, or [None] if none exists. *) val find : ('k, 'v, 'cmp) t -> 'k -> 'v option @@ -1427,7 +1426,7 @@ module type Map = sig -> init:'acc -> f: ((key:'k -> data:'v -> 'acc -> ('acc, 'final) Container.Continue_or_stop.t) - [@local]) + [@local]) -> finish:(('acc -> 'final)[@local]) -> 'final @@ -1641,7 +1640,6 @@ module type Map = sig val count : ('k, 'v, _) t -> f:(('v -> bool)[@local]) -> int val counti : ('k, 'v, _) t -> f:((key:'k -> data:'v -> bool)[@local]) -> int - (** [split t key] returns a map of keys strictly less than [key], the mapping of [key] if any, and a map of keys strictly greater than [key]. @@ -1743,8 +1741,6 @@ module type Map = sig [t], and [None] otherwise. *) val rank : ('k, 'v, 'cmp) t -> 'k -> int option - - (** [to_sequence ?order ?keys_greater_or_equal_to ?keys_less_or_equal_to t] gives a sequence of key-value pairs between [keys_less_or_equal_to] and [keys_greater_or_equal_to] inclusive, presented in [order]. If @@ -1878,9 +1874,9 @@ module type Map = sig - a comparator witness - a [hash_fold_t] function with the right type *) module M (K : sig - type t - type comparator_witness - end) : sig + type t + type comparator_witness + end) : sig type nonrec 'v t = (K.t, 'v, K.comparator_witness) t end @@ -1929,12 +1925,12 @@ module type Map = sig include Creators_and_accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) t - with type 'k key := 'k - with type 'c cmp := 'c - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) t + with type 'k key := 'k + with type 'c cmp := 'c + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t val empty_without_value_restriction : (_, _, _) t @@ -1969,12 +1965,12 @@ module type Map = sig include Creators_and_accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Tree.t - with type 'k key := 'k - with type 'c cmp := 'c - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Tree.t + with type 'k key := 'k + with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t val comparator : ('a, _, 'cmp) t -> ('a, 'cmp) Comparator.t @@ -1993,10 +1989,10 @@ module type Map = sig (** A polymorphic Map. *) module Poly : S_poly - with type ('key, +'value) t = ('key, 'value, Comparator.Poly.comparator_witness) t - and type ('key, +'value) tree = - ('key, 'value, Comparator.Poly.comparator_witness) Using_comparator.Tree.t - and type comparator_witness = Comparator.Poly.comparator_witness + with type ('key, +'value) t = ('key, 'value, Comparator.Poly.comparator_witness) t + and type ('key, +'value) tree = + ('key, 'value, Comparator.Poly.comparator_witness) Using_comparator.Tree.t + and type comparator_witness = Comparator.Poly.comparator_witness (** Create a map from a tree using the given comparator. *) val of_tree @@ -2007,7 +2003,6 @@ module type Map = sig (** Extract a tree from a map. *) val to_tree : ('k, 'v, 'cmp) t -> ('k, 'v, 'cmp) Using_comparator.Tree.t - (** {2 Modules and module types for extending [Map]} For use in extensions of Base, like [Core]. *) diff --git a/src/maybe_bound.ml b/src/maybe_bound.ml index a721aaa5..feee38c0 100644 --- a/src/maybe_bound.ml +++ b/src/maybe_bound.ml @@ -70,13 +70,13 @@ let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = fun (type a__024_) : ((a__024_ -> Sexplib0.Sexp.t) -> a__024_ t -> Sexplib0.Sexp.t) -> fun _of_a__019_ -> function - | Incl arg0__020_ -> - let res0__021_ = _of_a__019_ arg0__020_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Incl"; res0__021_ ] - | Excl arg0__022_ -> - let res0__023_ = _of_a__019_ arg0__022_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Excl"; res0__023_ ] - | Unbounded -> Sexplib0.Sexp.Atom "Unbounded" + | Incl arg0__020_ -> + let res0__021_ = _of_a__019_ arg0__020_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Incl"; res0__021_ ] + | Excl arg0__022_ -> + let res0__023_ = _of_a__019_ arg0__022_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Excl"; res0__023_ ] + | Unbounded -> Sexplib0.Sexp.Atom "Unbounded" ;; let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = @@ -103,12 +103,12 @@ let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_gramma let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = fun (type a__025_) - : (((a__025_[@ocaml.local]) -> a__025_) -> (a__025_ t[@ocaml.local]) -> a__025_ t) -> - fun _globalize_a__026_ x__027_ -> - match x__027_ with - | Unbounded as x__028_ -> x__028_ - | Incl arg__029_ -> Incl (_globalize_a__026_ arg__029_) - | Excl arg__030_ -> Excl (_globalize_a__026_ arg__030_) + : (((a__025_[@ocaml.local]) -> a__025_) -> (a__025_ t[@ocaml.local]) -> a__025_ t) -> + fun _globalize_a__026_ x__027_ -> + match x__027_ with + | Unbounded as x__028_ -> x__028_ + | Incl arg__029_ -> Incl (_globalize_a__026_ arg__029_) + | Excl arg__030_ -> Excl (_globalize_a__026_ arg__030_) ;; [@@@end] @@ -138,15 +138,15 @@ let interval_comparison_of_sexp = | Sexplib0.Sexp.List [] as sexp__032_ -> Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__033_ sexp__032_ | sexp__032_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__033_ sexp__032_ - : Sexplib0.Sexp.t -> interval_comparison) + : Sexplib0.Sexp.t -> interval_comparison) ;; let sexp_of_interval_comparison = (function - | Below_lower_bound -> Sexplib0.Sexp.Atom "Below_lower_bound" - | In_range -> Sexplib0.Sexp.Atom "In_range" - | Above_upper_bound -> Sexplib0.Sexp.Atom "Above_upper_bound" - : interval_comparison -> Sexplib0.Sexp.t) + | Below_lower_bound -> Sexplib0.Sexp.Atom "Below_lower_bound" + | In_range -> Sexplib0.Sexp.Atom "In_range" + | Above_upper_bound -> Sexplib0.Sexp.Atom "Above_upper_bound" + : interval_comparison -> Sexplib0.Sexp.t) ;; let (interval_comparison_sexp_grammar : interval_comparison Sexplib0.Sexp_grammar.t) = @@ -164,23 +164,23 @@ let (interval_comparison_sexp_grammar : interval_comparison Sexplib0.Sexp_gramma let compare_interval_comparison__local = (Stdlib.compare - : (interval_comparison[@ocaml.local]) -> (interval_comparison[@ocaml.local]) -> int) + : (interval_comparison[@ocaml.local]) -> (interval_comparison[@ocaml.local]) -> int) ;; let compare_interval_comparison = (fun a b -> compare_interval_comparison__local a b - : interval_comparison -> interval_comparison -> int) + : interval_comparison -> interval_comparison -> int) ;; let (hash_fold_interval_comparison : - Ppx_hash_lib.Std.Hash.state -> interval_comparison -> Ppx_hash_lib.Std.Hash.state) + Ppx_hash_lib.Std.Hash.state -> interval_comparison -> Ppx_hash_lib.Std.Hash.state) = (fun hsv arg -> match arg with | Below_lower_bound -> Ppx_hash_lib.Std.Hash.fold_int hsv 0 | In_range -> Ppx_hash_lib.Std.Hash.fold_int hsv 1 | Above_upper_bound -> Ppx_hash_lib.Std.Hash.fold_int hsv 2 - : Ppx_hash_lib.Std.Hash.state -> interval_comparison -> Ppx_hash_lib.Std.Hash.state) + : Ppx_hash_lib.Std.Hash.state -> interval_comparison -> Ppx_hash_lib.Std.Hash.state) ;; let (hash_interval_comparison : interval_comparison -> Ppx_hash_lib.Std.Hash.hash_value) = diff --git a/src/monad.ml b/src/monad.ml index f0c3f668..d01f3b5d 100644 --- a/src/monad.ml +++ b/src/monad.ml @@ -70,29 +70,29 @@ end module Make_indexed (M : Basic_indexed) : S_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) M.t = Make_general (struct - include M + include M - type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j) M.t - end) + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j) M.t +end) module Make3 (M : Basic3) : S3 with type ('a, 'd, 'e) t := ('a, 'd, 'e) M.t = - Make_general (struct - include M +Make_general (struct + include M - type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd, 'e) M.t - end) + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd, 'e) M.t +end) module Make2 (M : Basic2) : S2 with type ('a, 'd) t := ('a, 'd) M.t = Make_general (struct - include M + include M - type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd) M.t - end) + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'd) M.t +end) module Make (M : Basic) : S with type 'a t := 'a M.t = Make_general (struct - include M + include M - type ('a, 'i, 'j, 'd, 'e) t = 'a M.t - end) + type ('a, 'i, 'j, 'd, 'e) t = 'a M.t +end) module Make2_local (M : Basic2_local) = struct let bind = M.bind @@ -161,43 +161,43 @@ module Make2_local (M : Basic2_local) = struct end module Make_local (M : Basic_local) : S_local with type 'a t := 'a M.t = - Make2_local (struct - include M +Make2_local (struct + include M - type ('a, 'e) t = 'a M.t - end) + type ('a, 'e) t = 'a M.t +end) module Of_monad_general (Monad : sig - type ('a, 'i, 'j, 'd, 'e) t + type ('a, 'i, 'j, 'd, 'e) t - val bind - : ('a, 'i, 'j, 'd, 'e) t - -> f:('a -> ('b, 'j, 'k, 'd, 'e) t) - -> ('b, 'i, 'k, 'd, 'e) t + val bind + : ('a, 'i, 'j, 'd, 'e) t + -> f:('a -> ('b, 'j, 'k, 'd, 'e) t) + -> ('b, 'i, 'k, 'd, 'e) t - val map : ('a, 'i, 'j, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'i, 'j, 'd, 'e) t - val return : 'a -> ('a, 'i, 'i, 'd, 'e) t - end) (M : sig - type ('a, 'i, 'j, 'd, 'e) t + val map : ('a, 'i, 'j, 'd, 'e) t -> f:('a -> 'b) -> ('b, 'i, 'j, 'd, 'e) t + val return : 'a -> ('a, 'i, 'i, 'd, 'e) t +end) (M : sig + type ('a, 'i, 'j, 'd, 'e) t - val to_monad : ('a, 'i, 'j, 'd, 'e) t -> ('a, 'i, 'j, 'd, 'e) Monad.t - val of_monad : ('a, 'i, 'j, 'd, 'e) Monad.t -> ('a, 'i, 'j, 'd, 'e) t - end) = - Make_general (struct - type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j, 'd, 'e) M.t + val to_monad : ('a, 'i, 'j, 'd, 'e) t -> ('a, 'i, 'j, 'd, 'e) Monad.t + val of_monad : ('a, 'i, 'j, 'd, 'e) Monad.t -> ('a, 'i, 'j, 'd, 'e) t +end) = +Make_general (struct + type ('a, 'i, 'j, 'd, 'e) t = ('a, 'i, 'j, 'd, 'e) M.t - let return a = M.of_monad (Monad.return a) - let bind t ~f = M.of_monad (Monad.bind (M.to_monad t) ~f:(fun a -> M.to_monad (f a))) - let map = `Custom (fun t ~f -> M.of_monad (Monad.map (M.to_monad t) ~f)) - end) + let return a = M.of_monad (Monad.return a) + let bind t ~f = M.of_monad (Monad.bind (M.to_monad t) ~f:(fun a -> M.to_monad (f a))) + let map = `Custom (fun t ~f -> M.of_monad (Monad.map (M.to_monad t) ~f)) +end) module Of_monad_indexed - (Monad : S_indexed) (M : sig - type ('a, 'i, 'j) t + (Monad : S_indexed) (M : sig + type ('a, 'i, 'j) t - val to_monad : ('a, 'i, 'j) t -> ('a, 'i, 'j) Monad.t - val of_monad : ('a, 'i, 'j) Monad.t -> ('a, 'i, 'j) t - end) = + val to_monad : ('a, 'i, 'j) t -> ('a, 'i, 'j) Monad.t + val of_monad : ('a, 'i, 'j) Monad.t -> ('a, 'i, 'j) t + end) = Of_monad_general (struct include Monad @@ -211,12 +211,12 @@ module Of_monad_indexed end) module Of_monad3 - (Monad : S3) (M : sig - type ('a, 'b, 'c) t + (Monad : S3) (M : sig + type ('a, 'b, 'c) t - val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) Monad.t - val of_monad : ('a, 'b, 'c) Monad.t -> ('a, 'b, 'c) t - end) = + val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) Monad.t + val of_monad : ('a, 'b, 'c) Monad.t -> ('a, 'b, 'c) t + end) = Of_monad_general (struct include Monad @@ -230,12 +230,12 @@ module Of_monad3 end) module Of_monad2 - (Monad : S2) (M : sig - type ('a, 'b) t + (Monad : S2) (M : sig + type ('a, 'b) t - val to_monad : ('a, 'b) t -> ('a, 'b) Monad.t - val of_monad : ('a, 'b) Monad.t -> ('a, 'b) t - end) = + val to_monad : ('a, 'b) t -> ('a, 'b) Monad.t + val of_monad : ('a, 'b) Monad.t -> ('a, 'b) t + end) = Of_monad_general (struct include Monad @@ -249,12 +249,12 @@ module Of_monad2 end) module Of_monad - (Monad : S) (M : sig - type 'a t + (Monad : S) (M : sig + type 'a t - val to_monad : 'a t -> 'a Monad.t - val of_monad : 'a Monad.t -> 'a t - end) = + val to_monad : 'a t -> 'a Monad.t + val of_monad : 'a Monad.t -> 'a t + end) = Of_monad_general (struct include Monad diff --git a/src/monad_intf.ml b/src/monad_intf.ml index 23bdb700..0fda5f41 100644 --- a/src/monad_intf.ml +++ b/src/monad_intf.ml @@ -74,13 +74,13 @@ end module type Syntax = Syntax_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b module type Syntax_local = Syntax_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b module type S_without_syntax_gen = sig type 'a t @@ -119,13 +119,13 @@ end module type S_without_syntax = S_without_syntax_gen - with type ('a, 'b) f_labeled_fn := f:'a -> 'b - and type ('a, 'b) fn := 'a -> 'b + with type ('a, 'b) f_labeled_fn := f:'a -> 'b + and type ('a, 'b) fn := 'a -> 'b module type S_without_syntax_local = S_without_syntax_gen - with type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b - and type ('a, 'b) fn := ('a[@local]) -> 'b + with type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + and type ('a, 'b) fn := ('a[@local]) -> 'b module type S = sig type 'a t @@ -202,13 +202,13 @@ end module type Syntax2 = Syntax2_gen - with type ('a, 'b) fn := 'a -> 'b - and type ('a, 'b) f_labeled_fn := f:'a -> 'b + with type ('a, 'b) fn := 'a -> 'b + and type ('a, 'b) f_labeled_fn := f:'a -> 'b module type Syntax2_local = Syntax2_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b module type S2_gen = sig (** The same as {!S} except the monad type has two arguments. The second is always just @@ -223,9 +223,9 @@ module type S2_gen = sig include Syntax2_gen - with type ('a, 'e) t := ('a, 'e) t - and type ('a, 'b) fn := ('a, 'b) fn - and type ('a, 'b) f_labeled_fn := ('a, 'b) f_labeled_fn + with type ('a, 'e) t := ('a, 'e) t + and type ('a, 'b) fn := ('a, 'b) fn + and type ('a, 'b) f_labeled_fn := ('a, 'b) f_labeled_fn module Monad_infix : Infix2_gen with type ('a, 'e) t := ('a, 'e) t and type ('a, 'b) fn := ('a, 'b) fn @@ -244,8 +244,8 @@ module type S2 = module type S2_local = S2_gen - with type ('a, 'b) fn := ('a[@local]) -> 'b - and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b + with type ('a, 'b) fn := ('a[@local]) -> 'b + and type ('a, 'b) f_labeled_fn := f:('a[@local]) -> 'b module type Basic3 = sig (** Multi parameter monad. The second and third parameters get unified across all the @@ -481,36 +481,36 @@ module type Monad = sig end) ]} *) module Of_monad - (Monad : S) (M : sig - type 'a t + (Monad : S) (M : sig + type 'a t - val to_monad : 'a t -> 'a Monad.t - val of_monad : 'a Monad.t -> 'a t - end) : S with type 'a t := 'a M.t + val to_monad : 'a t -> 'a Monad.t + val of_monad : 'a Monad.t -> 'a t + end) : S with type 'a t := 'a M.t module Of_monad2 - (Monad : S2) (M : sig - type ('a, 'b) t + (Monad : S2) (M : sig + type ('a, 'b) t - val to_monad : ('a, 'b) t -> ('a, 'b) Monad.t - val of_monad : ('a, 'b) Monad.t -> ('a, 'b) t - end) : S2 with type ('a, 'b) t := ('a, 'b) M.t + val to_monad : ('a, 'b) t -> ('a, 'b) Monad.t + val of_monad : ('a, 'b) Monad.t -> ('a, 'b) t + end) : S2 with type ('a, 'b) t := ('a, 'b) M.t module Of_monad3 - (Monad : S3) (M : sig - type ('a, 'b, 'c) t + (Monad : S3) (M : sig + type ('a, 'b, 'c) t - val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) Monad.t - val of_monad : ('a, 'b, 'c) Monad.t -> ('a, 'b, 'c) t - end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t + val to_monad : ('a, 'b, 'c) t -> ('a, 'b, 'c) Monad.t + val of_monad : ('a, 'b, 'c) Monad.t -> ('a, 'b, 'c) t + end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t module Of_monad_indexed - (Monad : S_indexed) (M : sig - type ('a, 'i, 'j) t + (Monad : S_indexed) (M : sig + type ('a, 'i, 'j) t - val to_monad : ('a, 'i, 'j) t -> ('a, 'i, 'j) Monad.t - val of_monad : ('a, 'i, 'j) Monad.t -> ('a, 'i, 'j) t - end) : S_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) M.t + val to_monad : ('a, 'i, 'j) t -> ('a, 'i, 'j) Monad.t + val of_monad : ('a, 'i, 'j) Monad.t -> ('a, 'i, 'j) t + end) : S_indexed with type ('a, 'i, 'j) t := ('a, 'i, 'j) M.t (** An eager identity monad with functions heavily annotated with [@inlined] or [@inline hint]. diff --git a/src/nativeint.ml b/src/nativeint.ml index b6923c00..bb27eb33 100644 --- a/src/nativeint.ml +++ b/src/nativeint.ml @@ -34,49 +34,49 @@ include T include Comparator.Make (T) include Comparable.With_zero (struct - include T + include T - let zero = zero - end) + let zero = zero +end) module Conv = Int_conversions include Conv.Make (T) include Conv.Make_hex (struct - open Nativeint_replace_polymorphic_compare + open Nativeint_replace_polymorphic_compare - type t = nativeint [@@deriving_inline compare ~localize, hash] + type t = nativeint [@@deriving_inline compare ~localize, hash] - let compare__local = - (compare_nativeint__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) - ;; + let compare__local = + (compare_nativeint__local : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + ;; - let compare = (fun a b -> compare__local a b : t -> t -> int) + let compare = (fun a b -> compare__local a b : t -> t -> int) - let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = - hash_fold_nativeint + let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) = + hash_fold_nativeint - and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = - let func = hash_nativeint in - fun x -> func x - ;; + and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = + let func = hash_nativeint in + fun x -> func x + ;; - [@@@end] + [@@@end] - let zero = zero - let neg = neg - let ( < ) = ( < ) - let to_string i = Printf.sprintf "%nx" i - let of_string s = Stdlib.Scanf.sscanf s "%nx" Fn.id - let module_name = "Base.Nativeint.Hex" - end) + let zero = zero + let neg = neg + let ( < ) = ( < ) + let to_string i = Printf.sprintf "%nx" i + let of_string s = Stdlib.Scanf.sscanf s "%nx" Fn.id + let module_name = "Base.Nativeint.Hex" +end) include Pretty_printer.Register (struct - type nonrec t = t + type nonrec t = t - let to_string = to_string - let module_name = "Base.Nativeint" - end) + let to_string = to_string + let module_name = "Base.Nativeint" +end) (* Open replace_polymorphic_compare after including functor instantiations so they do not shadow its definitions. This is here so that efficient versions of the comparison @@ -109,7 +109,7 @@ let of_float_unchecked = of_float let of_float f = if Float_replace_polymorphic_compare.( >= ) f float_lower_bound - && Float_replace_polymorphic_compare.( <= ) f float_upper_bound + && Float_replace_polymorphic_compare.( <= ) f float_upper_bound then of_float f else Printf.invalid_argf @@ -169,13 +169,13 @@ module Pow2 = struct : (nativeint[@unboxed]) -> (int[@untagged]) = "Base_int_math_nativeint_clz" "Base_int_math_nativeint_clz_unboxed" - [@@noalloc] + [@@noalloc] external ctz : (nativeint[@unboxed]) -> (int[@untagged]) = "Base_int_math_nativeint_ctz" "Base_int_math_nativeint_ctz_unboxed" - [@@noalloc] + [@@noalloc] (** Hacker's Delight Second Edition p106 *) let floor_log2 i = @@ -276,16 +276,16 @@ module O = struct include Pre_O include Int_math.Make (struct - type nonrec t = t + type nonrec t = t - include Pre_O + include Pre_O - let rem = rem - let to_float = to_float - let of_float = of_float - let of_string = T.of_string - let to_string = T.to_string - end) + let rem = rem + let to_float = to_float + let of_float = of_float + let of_string = T.of_string + let to_string = T.to_string + end) let ( land ) = bit_and let ( lor ) = bit_or diff --git a/src/nothing.ml b/src/nothing.ml index 5c04425c..a3109509 100644 --- a/src/nothing.ml +++ b/src/nothing.ml @@ -24,7 +24,7 @@ end include T include Identifiable.Make (struct - include T + include T - let module_name = "Base.Nothing" - end) + let module_name = "Base.Nothing" +end) diff --git a/src/obj_array.ml b/src/obj_array.ml index e30a3c28..e0f0b786 100644 --- a/src/obj_array.ml +++ b/src/obj_array.ml @@ -42,7 +42,7 @@ let get t i = (* [Sys.opaque_identity] is required on the array because this code breaks the usual assumptions about array kinds that the Flambda 2 optimiser can see. *) ((Sys.opaque_identity (Stdlib.Obj.magic (t : t) : not_a_float array)).(i) - : not_a_float) + : not_a_float) ;; let[@inline always] unsafe_get t i = @@ -52,7 +52,7 @@ let[@inline always] unsafe_get t i = (Array.unsafe_get (Sys.opaque_identity (Obj_local.magic (t : t) : not_a_float array)) i - : not_a_float) + : not_a_float) ;; let[@inline always] unsafe_set_with_caml_modify t i obj = @@ -70,7 +70,7 @@ let[@inline always] unsafe_set_with_caml_modify t i obj = let[@inline always] set_with_caml_modify t i obj = (* same as unsafe_set_with_caml_modify but safe *) (Sys.opaque_identity (Stdlib.Obj.magic (t : t) : not_a_float array)).(i) - <- (Stdlib.Obj.obj (Sys.opaque_identity obj) : not_a_float) + <- (Stdlib.Obj.obj (Sys.opaque_identity obj) : not_a_float) ;; let[@inline always] unsafe_set_int_assuming_currently_int t i int = @@ -181,12 +181,12 @@ let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len = ;; include Blit.Make (struct - type nonrec t = t + type nonrec t = t - let create = create_zero - let length = length - let unsafe_blit = unsafe_blit - end) + let create = create_zero + let length = length + let unsafe_blit = unsafe_blit +end) let copy src = let dst = create_zero ~len:(length src) in diff --git a/src/obj_array.mli b/src/obj_array.mli index b90e5f09..b04e368b 100644 --- a/src/obj_array.mli +++ b/src/obj_array.mli @@ -55,7 +55,6 @@ val set_with_caml_modify : t -> int -> Stdlib.Obj.t -> unit [unsafe_set_int] is similar but does not assume anything about the target. *) val unsafe_set_assuming_currently_int : (t[@local]) -> int -> Stdlib.Obj.t -> unit - val unsafe_set_int_assuming_currently_int : (t[@local]) -> int -> int -> unit val unsafe_set_int : t -> int -> int -> unit diff --git a/src/option.ml b/src/option.ml index 673dd9f6..0b6c002f 100644 --- a/src/option.ml +++ b/src/option.ml @@ -1,68 +1,68 @@ open! Import include ( -struct - type 'a t = 'a option - [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] - - let compare__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> int - = - compare_option__local - ;; - - let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_option - - let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = - fun (type a__009_) + struct + type 'a t = 'a option + [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] + + let compare__local : + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> int + = + compare_option__local + ;; + + let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_option + + let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = + fun (type a__009_) : (((a__009_[@ocaml.local]) -> a__009_) -> (a__009_ t[@ocaml.local]) -> a__009_ t) -> globalize_option - ;; + ;; - let hash_fold_t : - 'a. - (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) - -> Ppx_hash_lib.Std.Hash.state - -> 'a t - -> Ppx_hash_lib.Std.Hash.state - = - hash_fold_option - ;; + let hash_fold_t : + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a t + -> Ppx_hash_lib.Std.Hash.state + = + hash_fold_option + ;; - let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = - option_of_sexp - ;; + let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = + option_of_sexp + ;; - let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = - sexp_of_option - ;; + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = + sexp_of_option + ;; - let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = - fun _'a_sexp_grammar -> option_sexp_grammar _'a_sexp_grammar - ;; + let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> option_sexp_grammar _'a_sexp_grammar + ;; - [@@@end] -end : -sig - type 'a t = 'a option - [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] + [@@@end] + end : + sig + type 'a t = 'a option + [@@deriving_inline compare ~localize, globalize, hash, sexp, sexp_grammar] - include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t - include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t - val globalize : (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t + val globalize : (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t - include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t - include Sexplib0.Sexpable.S1 with type 'a t := 'a t + include Ppx_hash_lib.Hashable.S1 with type 'a t := 'a t + include Sexplib0.Sexpable.S1 with type 'a t := 'a t - val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t - [@@@end] -end) + [@@@end] + end) type 'a t = 'a option = | None diff --git a/src/option.mli b/src/option.mli index 12ffedea..811db672 100644 --- a/src/option.mli +++ b/src/option.mli @@ -88,7 +88,6 @@ val value_map : 'a t -> default:'b -> f:(('a -> 'b)[@local]) -> 'b [default]. [default] is only executed if the underlying value is absent. *) val value_or_thunk : 'a t -> default:((unit -> 'a)[@local]) -> 'a - (** On [None], returns [init]. On [Some x], returns [f init x]. *) val fold : 'a t -> init:'acc -> f:(('acc -> 'a -> 'acc)[@local]) -> 'acc @@ -163,7 +162,7 @@ val fold_result -> init:'acc -> f:(('acc -> 'a -> ('acc, 'e) Result.t)[@local]) -> ('acc, 'e) Result.t -[@@deprecated "[since 2019-07] It is not a useful function"] + [@@deprecated "[since 2019-07] It is not a useful function"] val fold_until : 'a t @@ -171,20 +170,20 @@ val fold_until -> f:(('acc -> 'a -> ('acc, 'final) Container.Continue_or_stop.t)[@local]) -> finish:(('acc -> 'final)[@local]) -> 'final -[@@deprecated "[since 2019-07] It is not a useful function"] + [@@deprecated "[since 2019-07] It is not a useful function"] val min_elt : 'a t -> compare:(('a -> 'a -> int)[@local]) -> 'a option -[@@deprecated "[since 2019-07] Use [Fn.id] instead"] + [@@deprecated "[since 2019-07] Use [Fn.id] instead"] val max_elt : 'a t -> compare:(('a -> 'a -> int)[@local]) -> 'a option -[@@deprecated "[since 2019-07] Use [Fn.id] instead"] + [@@deprecated "[since 2019-07] Use [Fn.id] instead"] val count : 'a t -> f:(('a -> bool)[@local]) -> int -[@@deprecated "[since 2019-07] Use pattern matching instead"] + [@@deprecated "[since 2019-07] Use pattern matching instead"] val sum : (module Container.Summable with type t = 'sum) -> 'a t -> f:(('a -> 'sum)[@local]) -> 'sum -[@@deprecated "[since 2019-07] Use [value_map ~default:Summable.zero ~f] instead"] + [@@deprecated "[since 2019-07] Use [value_map ~default:Summable.zero ~f] instead"] diff --git a/src/option_array.ml b/src/option_array.ml index b9098a41..53e49b95 100644 --- a/src/option_array.ml +++ b/src/option_array.ml @@ -171,15 +171,15 @@ let foldi input ~init ~f = let fold input ~init ~f = foldi input ~init ~f:(fun (_ : int) acc x -> f acc x) [@nontail] include Indexed_container.Make_gen (struct - type nonrec ('a, _) t = 'a t - type 'a elt = 'a option + type nonrec ('a, _) t = 'a t + type 'a elt = 'a option - let fold = fold - let foldi = `Custom foldi - let iter = `Custom iter - let iteri = `Custom iteri - let length = `Custom length - end) + let fold = fold + let foldi = `Custom foldi + let iter = `Custom iter + let iteri = `Custom iteri + let length = `Custom length +end) let length = Uniform_array.length @@ -212,12 +212,12 @@ let of_array_some array = let to_array t = Array.init (length t) ~f:(fun i -> unsafe_get t i) include Blit.Make1_generic (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let length = length - let create_like ~len _ = create ~len - let unsafe_blit = Uniform_array.unsafe_blit - end) + let length = length + let create_like ~len _ = create ~len + let unsafe_blit = Uniform_array.unsafe_blit +end) let copy = Uniform_array.copy diff --git a/src/or_error.ml b/src/or_error.ml index a18d8580..93bebbb9 100644 --- a/src/or_error.ml +++ b/src/or_error.ml @@ -5,11 +5,11 @@ type 'a t = ('a, Error.t) Result.t compare ~localize, equal ~localize, globalize, hash, sexp, sexp_grammar] let compare__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> int + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> int = fun _cmp__a a__007_ b__008_ -> Result.compare__local _cmp__a Error.compare__local a__007_ b__008_ @@ -20,11 +20,11 @@ let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = ;; let equal__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> bool + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> bool = fun _cmp__a a__019_ b__020_ -> Result.equal__local _cmp__a Error.equal__local a__019_ b__020_ @@ -36,17 +36,17 @@ let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = fun (type a__025_) - : (((a__025_[@ocaml.local]) -> a__025_) -> (a__025_ t[@ocaml.local]) -> a__025_ t) -> - fun _globalize_a__026_ x__027_ -> - Result.globalize _globalize_a__026_ Error.globalize x__027_ + : (((a__025_[@ocaml.local]) -> a__025_) -> (a__025_ t[@ocaml.local]) -> a__025_ t) -> + fun _globalize_a__026_ x__027_ -> + Result.globalize _globalize_a__026_ Error.globalize x__027_ ;; let hash_fold_t : - 'a. - (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) - -> Ppx_hash_lib.Std.Hash.state - -> 'a t - -> Ppx_hash_lib.Std.Hash.state + 'a. + (Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state) + -> Ppx_hash_lib.Std.Hash.state + -> 'a t + -> Ppx_hash_lib.Std.Hash.state = fun _hash_fold_a hsv arg -> Result.hash_fold_t _hash_fold_a Error.hash_fold_t hsv arg ;; @@ -89,12 +89,12 @@ let map2 a b ~f = ;; module For_applicative = Applicative.Make_using_map2_local (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return = return - let map = `Custom map - let map2 = map2 - end) + let return = return + let map = `Custom map + let map2 = map2 +end) let ( *> ) = For_applicative.( *> ) let ( <* ) = For_applicative.( <* ) @@ -163,7 +163,6 @@ let tag_arg t message a sexp_of_a = let unimplemented s = error "unimplemented" s sexp_of_string - let combine_internal list ~on_ok ~on_error = match Result.combine_errors list with | Ok x -> Ok (on_ok x) @@ -203,8 +202,8 @@ let find_ok l = Error (Error.of_list (List.map l ~f:(function - | Ok _ -> assert false - | Error err -> err))) + | Ok _ -> assert false + | Error err -> err))) ;; let find_map_ok l ~f = diff --git a/src/ordered_collection_common0.ml b/src/ordered_collection_common0.ml index 48fe0e09..3b930f17 100644 --- a/src/ordered_collection_common0.ml +++ b/src/ordered_collection_common0.ml @@ -11,7 +11,7 @@ let slow_check_pos_len_exn ~pos ~len ~total_length = possibility of overflow. *) if pos > total_length - len then invalid_argf "pos + len past end: %d + %d > %d" pos len total_length () -[@@cold] [@@inline never] [@@local never] [@@specialise never] + [@@cold] [@@inline never] [@@local never] [@@specialise never] ;; let check_pos_len_exn ~pos ~len ~total_length = @@ -29,7 +29,7 @@ let check_pos_len_exn ~pos ~len ~total_length = let stop = pos + len in if pos lor len lor stop lor (total_length - stop) < 0 then slow_check_pos_len_exn ~pos ~len ~total_length -[@@inline always] + [@@inline always] ;; let get_pos_len_exn ?(pos = 0) ?len () ~total_length = diff --git a/src/ordering.ml b/src/ordering.ml index 769e0c9e..26139a4b 100644 --- a/src/ordering.ml +++ b/src/ordering.ml @@ -15,7 +15,7 @@ let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.sta | Less -> Ppx_hash_lib.Std.Hash.fold_int hsv 0 | Equal -> Ppx_hash_lib.Std.Hash.fold_int hsv 1 | Greater -> Ppx_hash_lib.Std.Hash.fold_int hsv 2 - : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) ;; let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = @@ -46,15 +46,15 @@ let t_of_sexp = | Sexplib0.Sexp.List [] as sexp__004_ -> Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__005_ sexp__004_ | sexp__004_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__005_ sexp__004_ - : Sexplib0.Sexp.t -> t) + : Sexplib0.Sexp.t -> t) ;; let sexp_of_t = (function - | Less -> Sexplib0.Sexp.Atom "Less" - | Equal -> Sexplib0.Sexp.Atom "Equal" - | Greater -> Sexplib0.Sexp.Atom "Greater" - : t -> Sexplib0.Sexp.t) + | Less -> Sexplib0.Sexp.Atom "Less" + | Equal -> Sexplib0.Sexp.Atom "Equal" + | Greater -> Sexplib0.Sexp.Atom "Greater" + : t -> Sexplib0.Sexp.t) ;; let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = diff --git a/src/popcount.mli b/src/popcount.mli index f506bdc8..39e57467 100644 --- a/src/popcount.mli +++ b/src/popcount.mli @@ -3,7 +3,6 @@ Functions are exposed in their respective modules. *) - open! Import val int_popcount : int -> int diff --git a/src/pow_overflow_bounds.ml b/src/pow_overflow_bounds.ml index aaf9f0ae..13cd8466 100644 --- a/src/pow_overflow_bounds.ml +++ b/src/pow_overflow_bounds.ml @@ -1,425 +1,425 @@ (* This file was autogenerated by ../generate/generate_pow_overflow_bounds.exe *) open! Import - module Array = Array0 (* We have to use Int64.to_int_exn instead of int constants to make sure that file can be preprocessed on 32-bit machines. *) -let overflow_bound_max_int32_value : int32 = - 2147483647l +let overflow_bound_max_int32_value : int32 = 2147483647l let int32_positive_overflow_bounds : int32 array = [| 2147483647l - ; 2147483647l - ; 46340l - ; 1290l - ; 215l - ; 73l - ; 35l - ; 21l - ; 14l - ; 10l - ; 8l - ; 7l - ; 5l - ; 5l - ; 4l - ; 4l - ; 3l - ; 3l - ; 3l - ; 3l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 2l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l - ; 1l + ; 2147483647l + ; 46340l + ; 1290l + ; 215l + ; 73l + ; 35l + ; 21l + ; 14l + ; 10l + ; 8l + ; 7l + ; 5l + ; 5l + ; 4l + ; 4l + ; 3l + ; 3l + ; 3l + ; 3l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 2l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l + ; 1l |] +;; -let overflow_bound_max_int_value : int = - (-1) lsr 1 +let overflow_bound_max_int_value : int = -1 lsr 1 let int_positive_overflow_bounds : int array = match Int_conversions.num_bits_int with | 32 -> Array.map int32_positive_overflow_bounds ~f:Stdlib.Int32.to_int | 63 -> [| Stdlib.Int64.to_int 4611686018427387903L - ; Stdlib.Int64.to_int 4611686018427387903L - ; Stdlib.Int64.to_int 2147483647L - ; 1664510 - ; 46340 - ; 5404 - ; 1290 - ; 463 - ; 215 - ; 118 - ; 73 - ; 49 - ; 35 - ; 27 - ; 21 - ; 17 - ; 14 - ; 12 - ; 10 - ; 9 - ; 8 - ; 7 - ; 7 - ; 6 - ; 5 - ; 5 - ; 5 - ; 4 - ; 4 - ; 4 - ; 4 - ; 3 - ; 3 - ; 3 - ; 3 - ; 3 - ; 3 - ; 3 - ; 3 - ; 3 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 1 - ; 1 + ; Stdlib.Int64.to_int 4611686018427387903L + ; Stdlib.Int64.to_int 2147483647L + ; 1664510 + ; 46340 + ; 5404 + ; 1290 + ; 463 + ; 215 + ; 118 + ; 73 + ; 49 + ; 35 + ; 27 + ; 21 + ; 17 + ; 14 + ; 12 + ; 10 + ; 9 + ; 8 + ; 7 + ; 7 + ; 6 + ; 5 + ; 5 + ; 5 + ; 4 + ; 4 + ; 4 + ; 4 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 3 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 1 + ; 1 |] | 31 -> [| 1073741823 - ; 1073741823 - ; 32767 - ; 1023 - ; 181 - ; 63 - ; 31 - ; 19 - ; 13 - ; 10 - ; 7 - ; 6 - ; 5 - ; 4 - ; 4 - ; 3 - ; 3 - ; 3 - ; 3 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 2 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 - ; 1 + ; 1073741823 + ; 32767 + ; 1023 + ; 181 + ; 63 + ; 31 + ; 19 + ; 13 + ; 10 + ; 7 + ; 6 + ; 5 + ; 4 + ; 4 + ; 3 + ; 3 + ; 3 + ; 3 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 2 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 + ; 1 |] | _ -> assert false +;; -let overflow_bound_max_int63_on_int64_value : int64 = - 4611686018427387903L +let overflow_bound_max_int63_on_int64_value : int64 = 4611686018427387903L let int63_on_int64_positive_overflow_bounds : int64 array = [| 4611686018427387903L - ; 4611686018427387903L - ; 2147483647L - ; 1664510L - ; 46340L - ; 5404L - ; 1290L - ; 463L - ; 215L - ; 118L - ; 73L - ; 49L - ; 35L - ; 27L - ; 21L - ; 17L - ; 14L - ; 12L - ; 10L - ; 9L - ; 8L - ; 7L - ; 7L - ; 6L - ; 5L - ; 5L - ; 5L - ; 4L - ; 4L - ; 4L - ; 4L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 1L - ; 1L + ; 4611686018427387903L + ; 2147483647L + ; 1664510L + ; 46340L + ; 5404L + ; 1290L + ; 463L + ; 215L + ; 118L + ; 73L + ; 49L + ; 35L + ; 27L + ; 21L + ; 17L + ; 14L + ; 12L + ; 10L + ; 9L + ; 8L + ; 7L + ; 7L + ; 6L + ; 5L + ; 5L + ; 5L + ; 4L + ; 4L + ; 4L + ; 4L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 1L + ; 1L |] +;; -let overflow_bound_max_int64_value : int64 = - 9223372036854775807L +let overflow_bound_max_int64_value : int64 = 9223372036854775807L let int64_positive_overflow_bounds : int64 array = [| 9223372036854775807L - ; 9223372036854775807L - ; 3037000499L - ; 2097151L - ; 55108L - ; 6208L - ; 1448L - ; 511L - ; 234L - ; 127L - ; 78L - ; 52L - ; 38L - ; 28L - ; 22L - ; 18L - ; 15L - ; 13L - ; 11L - ; 9L - ; 8L - ; 7L - ; 7L - ; 6L - ; 6L - ; 5L - ; 5L - ; 5L - ; 4L - ; 4L - ; 4L - ; 4L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 3L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 2L - ; 1L + ; 9223372036854775807L + ; 3037000499L + ; 2097151L + ; 55108L + ; 6208L + ; 1448L + ; 511L + ; 234L + ; 127L + ; 78L + ; 52L + ; 38L + ; 28L + ; 22L + ; 18L + ; 15L + ; 13L + ; 11L + ; 9L + ; 8L + ; 7L + ; 7L + ; 6L + ; 6L + ; 5L + ; 5L + ; 5L + ; 4L + ; 4L + ; 4L + ; 4L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 3L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 2L + ; 1L |] +;; let int64_negative_overflow_bounds : int64 array = [| -9223372036854775807L - ; -9223372036854775807L - ; -3037000499L - ; -2097151L - ; -55108L - ; -6208L - ; -1448L - ; -511L - ; -234L - ; -127L - ; -78L - ; -52L - ; -38L - ; -28L - ; -22L - ; -18L - ; -15L - ; -13L - ; -11L - ; -9L - ; -8L - ; -7L - ; -7L - ; -6L - ; -6L - ; -5L - ; -5L - ; -5L - ; -4L - ; -4L - ; -4L - ; -4L - ; -3L - ; -3L - ; -3L - ; -3L - ; -3L - ; -3L - ; -3L - ; -3L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -2L - ; -1L + ; -9223372036854775807L + ; -3037000499L + ; -2097151L + ; -55108L + ; -6208L + ; -1448L + ; -511L + ; -234L + ; -127L + ; -78L + ; -52L + ; -38L + ; -28L + ; -22L + ; -18L + ; -15L + ; -13L + ; -11L + ; -9L + ; -8L + ; -7L + ; -7L + ; -6L + ; -6L + ; -5L + ; -5L + ; -5L + ; -4L + ; -4L + ; -4L + ; -4L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -3L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -2L + ; -1L |] +;; diff --git a/src/pretty_printer.ml b/src/pretty_printer.ml index 14649879..4007f788 100644 --- a/src/pretty_printer.ml +++ b/src/pretty_printer.ml @@ -11,10 +11,10 @@ module type S = sig end module Register_pp (M : sig - include S + include S - val module_name : string - end) = + val module_name : string +end) = struct include M @@ -22,13 +22,13 @@ struct end module Register (M : sig - type t + type t - val module_name : string - val to_string : t -> string - end) = - Register_pp (struct - include M + val module_name : string + val to_string : t -> string +end) = +Register_pp (struct + include M - let pp formatter t = Stdlib.Format.pp_print_string formatter (M.to_string t) - end) + let pp formatter t = Stdlib.Format.pp_print_string formatter (M.to_string t) +end) diff --git a/src/pretty_printer.mli b/src/pretty_printer.mli index 69b14d08..e8247a67 100644 --- a/src/pretty_printer.mli +++ b/src/pretty_printer.mli @@ -23,7 +23,6 @@ open! Import (** [all ()] returns all pretty printers that have been [register]ed. *) val all : unit -> string list - (** Modules that provide a pretty printer will match [S]. *) module type S = sig type t @@ -36,19 +35,19 @@ end guarantee that one has the desired [pp] function at the same point where the [name] is added. *) module Register (M : sig - type t + type t - val module_name : string - val to_string : t -> string - end) : S with type t := M.t + val module_name : string + val to_string : t -> string +end) : S with type t := M.t (** [Register_pp] is like [Register], but allows a custom [pp] function rather than using [to_string]. *) module Register_pp (M : sig - include S + include S - val module_name : string - end) : S with type t := M.t + val module_name : string +end) : S with type t := M.t (** [register name] adds [name] to the list of pretty printers. Use the [Register] functor if possible. *) diff --git a/src/printf.mli b/src/printf.mli index 15f8ac70..27601fe6 100644 --- a/src/printf.mli +++ b/src/printf.mli @@ -128,7 +128,6 @@ val kbprintf in a useful way) so they serve as an effective signpost for "end of formatting arguments". *) - (** Raises [Failure]. *) val failwithf : ('r, unit, string, unit -> _) format4 -> 'r diff --git a/src/queue.ml b/src/queue.ml index 11b0a754..8b898920 100644 --- a/src/queue.ml +++ b/src/queue.ml @@ -1,6 +1,5 @@ open! Import - (* [t] stores the [t.length] queue elements at consecutive increasing indices of [t.elts], mod the capacity of [t], which is [Option_array.length t.elts]. The capacity is required to be a power of two (user-requested capacities are rounded up to the nearest @@ -19,39 +18,39 @@ type 'a t = let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = fun _of_a__001_ - { num_mutations = num_mutations__003_ - ; front = front__005_ - ; mask = mask__007_ - ; length = length__009_ - ; elts = elts__011_ - } -> - let bnds__002_ = ([] : _ Stdlib.List.t) in - let bnds__002_ = - let arg__012_ = Option_array.sexp_of_t _of_a__001_ elts__011_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "elts"; arg__012_ ] :: bnds__002_ - : _ Stdlib.List.t) - in - let bnds__002_ = - let arg__010_ = sexp_of_int length__009_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "length"; arg__010_ ] :: bnds__002_ - : _ Stdlib.List.t) - in - let bnds__002_ = - let arg__008_ = sexp_of_int mask__007_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "mask"; arg__008_ ] :: bnds__002_ - : _ Stdlib.List.t) - in - let bnds__002_ = - let arg__006_ = sexp_of_int front__005_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "front"; arg__006_ ] :: bnds__002_ - : _ Stdlib.List.t) - in - let bnds__002_ = - let arg__004_ = sexp_of_int num_mutations__003_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "num_mutations"; arg__004_ ] :: bnds__002_ - : _ Stdlib.List.t) - in - Sexplib0.Sexp.List bnds__002_ + { num_mutations = num_mutations__003_ + ; front = front__005_ + ; mask = mask__007_ + ; length = length__009_ + ; elts = elts__011_ + } -> + let bnds__002_ = ([] : _ Stdlib.List.t) in + let bnds__002_ = + let arg__012_ = Option_array.sexp_of_t _of_a__001_ elts__011_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "elts"; arg__012_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__010_ = sexp_of_int length__009_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "length"; arg__010_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__008_ = sexp_of_int mask__007_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "mask"; arg__008_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__006_ = sexp_of_int front__005_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "front"; arg__006_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + let bnds__002_ = + let arg__004_ = sexp_of_int num_mutations__003_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "num_mutations"; arg__004_ ] :: bnds__002_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__002_ ;; [@@@end] @@ -370,7 +369,6 @@ let foldi t ~init ~f = acc) [@nontail] ;; - (* [iter] is implemented directly because implementing it in terms of [fold] is slower. *) let iter t ~f = @@ -398,14 +396,14 @@ let to_list t = ;; module C = Indexed_container.Make (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let fold = fold - let iter = `Custom iter - let length = `Custom length - let foldi = `Custom foldi - let iteri = `Custom iteri - end) + let fold = fold + let iter = `Custom iter + let length = `Custom length + let foldi = `Custom foldi + let iteri = `Custom iteri +end) let count = C.count let exists = C.exists @@ -424,7 +422,6 @@ let find_mapi = C.find_mapi let findi = C.findi let for_alli = C.for_alli - (* For [concat_map], [filter_map], and [filter], we don't create [t_result] with [t]'s capacity because we have no idea how many elements [t_result] will ultimately hold. *) let concat_map t ~f = diff --git a/src/random.ml b/src/random.ml index cf04d03a..e217f83c 100644 --- a/src/random.ml +++ b/src/random.ml @@ -142,7 +142,7 @@ module State = struct (string_of_bound lower_bound) (string_of_bound upper_bound) () - [@@cold] [@@inline never] [@@local never] [@@specialise never] + [@@cold] [@@inline never] [@@local never] [@@specialise never] ;; let int_incl = diff --git a/src/ref.ml b/src/ref.ml index 56a7f741..2ac730e7 100644 --- a/src/ref.ml +++ b/src/ref.ml @@ -1,67 +1,67 @@ open! Import include ( -struct - type 'a t = 'a ref - [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] - - let compare__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> int - = - compare_ref__local - ;; - - let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_ref - - let equal__local : - 'a. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> ('a t[@ocaml.local]) - -> ('a t[@ocaml.local]) - -> bool - = - equal_ref__local - ;; - - let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = equal_ref - - let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = - fun (type a__017_) + struct + type 'a t = 'a ref + [@@deriving_inline compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + + let compare__local : + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> int + = + compare_ref__local + ;; + + let compare : 'a. ('a -> 'a -> int) -> 'a t -> 'a t -> int = compare_ref + + let equal__local : + 'a. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> ('a t[@ocaml.local]) + -> ('a t[@ocaml.local]) + -> bool + = + equal_ref__local + ;; + + let equal : 'a. ('a -> 'a -> bool) -> 'a t -> 'a t -> bool = equal_ref + + let globalize : 'a. (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t = + fun (type a__017_) : (((a__017_[@ocaml.local]) -> a__017_) -> (a__017_ t[@ocaml.local]) -> a__017_ t) -> globalize_ref - ;; + ;; - let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = ref_of_sexp - let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = sexp_of_ref + let t_of_sexp : 'a. (Sexplib0.Sexp.t -> 'a) -> Sexplib0.Sexp.t -> 'a t = ref_of_sexp + let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = sexp_of_ref - let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = - fun _'a_sexp_grammar -> ref_sexp_grammar _'a_sexp_grammar - ;; + let t_sexp_grammar : 'a. 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t = + fun _'a_sexp_grammar -> ref_sexp_grammar _'a_sexp_grammar + ;; - [@@@end] -end : -sig - type 'a t = 'a ref - [@@deriving_inline - compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] + [@@@end] + end : + sig + type 'a t = 'a ref + [@@deriving_inline + compare ~localize, equal ~localize, globalize, sexp, sexp_grammar] - include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t - include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t - include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t - include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S1 with type 'a t := 'a t + include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t + include Ppx_compare_lib.Equal.S1 with type 'a t := 'a t + include Ppx_compare_lib.Equal.S_local1 with type 'a t := 'a t - val globalize : (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t + val globalize : (('a[@ocaml.local]) -> 'a) -> ('a t[@ocaml.local]) -> 'a t - include Sexplib0.Sexpable.S1 with type 'a t := 'a t + include Sexplib0.Sexpable.S1 with type 'a t := 'a t - val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t + val t_sexp_grammar : 'a Sexplib0.Sexp_grammar.t -> 'a t Sexplib0.Sexp_grammar.t - [@@@end] -end) + [@@@end] + end) (* In the definition of [t], we do not have [[@@deriving compare, sexp]] because in general, syntax extensions tend to use the implementation when available rather than diff --git a/src/result.ml b/src/result.ml index f8e46952..376f2483 100644 --- a/src/result.ml +++ b/src/result.ml @@ -7,70 +7,70 @@ type ('a, 'b) t = ('a, 'b) Stdlib.result = [@@deriving_inline sexp, sexp_grammar, compare ~localize, equal ~localize, hash] let t_of_sexp : - 'a 'b. - (Sexplib0.Sexp.t -> 'a) -> (Sexplib0.Sexp.t -> 'b) -> Sexplib0.Sexp.t -> ('a, 'b) t + 'a 'b. + (Sexplib0.Sexp.t -> 'a) -> (Sexplib0.Sexp.t -> 'b) -> Sexplib0.Sexp.t -> ('a, 'b) t = fun (type a__017_ b__018_) - : ((Sexplib0.Sexp.t -> a__017_) -> (Sexplib0.Sexp.t -> b__018_) -> Sexplib0.Sexp.t - -> (a__017_, b__018_) t) -> - let error_source__005_ = "result.ml.t" in - fun _of_a__001_ _of_b__002_ -> function - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("ok" | "Ok") as _tag__008_) :: sexp_args__009_) as - _sexp__007_ -> - (match sexp_args__009_ with - | [ arg0__010_ ] -> - let res0__011_ = _of_a__001_ arg0__010_ in - Ok res0__011_ - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__005_ - _tag__008_ - _sexp__007_) - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("error" | "Error") as _tag__013_) :: sexp_args__014_) as - _sexp__012_ -> - (match sexp_args__014_ with - | [ arg0__015_ ] -> - let res0__016_ = _of_b__002_ arg0__015_ in - Error res0__016_ - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__005_ - _tag__013_ - _sexp__012_) - | Sexplib0.Sexp.Atom ("ok" | "Ok") as sexp__006_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__005_ sexp__006_ - | Sexplib0.Sexp.Atom ("error" | "Error") as sexp__006_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__005_ sexp__006_ - | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__004_ -> - Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__005_ sexp__004_ - | Sexplib0.Sexp.List [] as sexp__004_ -> - Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__005_ sexp__004_ - | sexp__004_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__005_ sexp__004_ + : ((Sexplib0.Sexp.t -> a__017_) -> (Sexplib0.Sexp.t -> b__018_) -> Sexplib0.Sexp.t + -> (a__017_, b__018_) t) -> + let error_source__005_ = "result.ml.t" in + fun _of_a__001_ _of_b__002_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("ok" | "Ok") as _tag__008_) :: sexp_args__009_) as + _sexp__007_ -> + (match sexp_args__009_ with + | [ arg0__010_ ] -> + let res0__011_ = _of_a__001_ arg0__010_ in + Ok res0__011_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__005_ + _tag__008_ + _sexp__007_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("error" | "Error") as _tag__013_) :: sexp_args__014_) as + _sexp__012_ -> + (match sexp_args__014_ with + | [ arg0__015_ ] -> + let res0__016_ = _of_b__002_ arg0__015_ in + Error res0__016_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__005_ + _tag__013_ + _sexp__012_) + | Sexplib0.Sexp.Atom ("ok" | "Ok") as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.Atom ("error" | "Error") as sexp__006_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__005_ sexp__006_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__004_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__005_ sexp__004_ + | Sexplib0.Sexp.List [] as sexp__004_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__005_ sexp__004_ + | sexp__004_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__005_ sexp__004_ ;; let sexp_of_t : - 'a 'b. - ('a -> Sexplib0.Sexp.t) -> ('b -> Sexplib0.Sexp.t) -> ('a, 'b) t -> Sexplib0.Sexp.t + 'a 'b. + ('a -> Sexplib0.Sexp.t) -> ('b -> Sexplib0.Sexp.t) -> ('a, 'b) t -> Sexplib0.Sexp.t = fun (type a__025_ b__026_) - : ((a__025_ -> Sexplib0.Sexp.t) -> (b__026_ -> Sexplib0.Sexp.t) - -> (a__025_, b__026_) t -> Sexplib0.Sexp.t) -> - fun _of_a__019_ _of_b__020_ -> function - | Ok arg0__021_ -> - let res0__022_ = _of_a__019_ arg0__021_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; res0__022_ ] - | Error arg0__023_ -> - let res0__024_ = _of_b__020_ arg0__023_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Error"; res0__024_ ] + : ((a__025_ -> Sexplib0.Sexp.t) -> (b__026_ -> Sexplib0.Sexp.t) + -> (a__025_, b__026_) t -> Sexplib0.Sexp.t) -> + fun _of_a__019_ _of_b__020_ -> function + | Ok arg0__021_ -> + let res0__022_ = _of_a__019_ arg0__021_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Ok"; res0__022_ ] + | Error arg0__023_ -> + let res0__024_ = _of_b__020_ arg0__023_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Error"; res0__024_ ] ;; let t_sexp_grammar : - 'a 'b. - 'a Sexplib0.Sexp_grammar.t - -> 'b Sexplib0.Sexp_grammar.t - -> ('a, 'b) t Sexplib0.Sexp_grammar.t + 'a 'b. + 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar _'b_sexp_grammar -> { untyped = @@ -93,12 +93,12 @@ let t_sexp_grammar : ;; let compare__local : - 'a 'b. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> (('b[@ocaml.local]) -> ('b[@ocaml.local]) -> int) - -> (('a, 'b) t[@ocaml.local]) - -> (('a, 'b) t[@ocaml.local]) - -> int + 'a 'b. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> (('b[@ocaml.local]) -> ('b[@ocaml.local]) -> int) + -> (('a, 'b) t[@ocaml.local]) + -> (('a, 'b) t[@ocaml.local]) + -> int = fun _cmp__a _cmp__b a__033_ b__034_ -> if Stdlib.( == ) a__033_ b__034_ @@ -112,7 +112,7 @@ let compare__local : ;; let compare : - 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int = fun _cmp__a _cmp__b a__027_ b__028_ -> if Stdlib.( == ) a__027_ b__028_ @@ -126,12 +126,12 @@ let compare : ;; let equal__local : - 'a 'b. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) - -> (('b[@ocaml.local]) -> ('b[@ocaml.local]) -> bool) - -> (('a, 'b) t[@ocaml.local]) - -> (('a, 'b) t[@ocaml.local]) - -> bool + 'a 'b. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> bool) + -> (('b[@ocaml.local]) -> ('b[@ocaml.local]) -> bool) + -> (('a, 'b) t[@ocaml.local]) + -> (('a, 'b) t[@ocaml.local]) + -> bool = fun _cmp__a _cmp__b a__045_ b__046_ -> if Stdlib.( == ) a__045_ b__046_ @@ -145,7 +145,7 @@ let equal__local : ;; let equal : - 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool + 'a 'b. ('a -> 'a -> bool) -> ('b -> 'b -> bool) -> ('a, 'b) t -> ('a, 'b) t -> bool = fun _cmp__a _cmp__b a__039_ b__040_ -> if Stdlib.( == ) a__039_ b__040_ @@ -183,23 +183,23 @@ let hash_fold_t let globalize = globalize_result include Monad.Make2_local (struct - type nonrec ('a, 'b) t = ('a, 'b) t + type nonrec ('a, 'b) t = ('a, 'b) t - let bind x ~f = - match x with - | Error _ as x -> x - | Ok x -> f x - ;; + let bind x ~f = + match x with + | Error _ as x -> x + | Ok x -> f x + ;; - let map x ~f = - match x with - | Error _ as x -> x - | Ok x -> Ok (f x) - ;; + let map x ~f = + match x with + | Error _ as x -> x + | Ok x -> Ok (f x) + ;; - let map = `Custom map - let return x = Ok x - end) + let map = `Custom map + let return x = Ok x +end) let invariant check_ok check_error t = match t with @@ -217,17 +217,17 @@ let map_error t ~f = ;; module Error = Monad.Make2_local (struct - type nonrec ('a, 'b) t = ('b, 'a) t + type nonrec ('a, 'b) t = ('b, 'a) t - let bind x ~f = - match x with - | Ok _ as ok -> ok - | Error e -> f e - ;; + let bind x ~f = + match x with + | Ok _ as ok -> ok + | Error e -> f e + ;; - let map = `Custom map_error - let return e = Error e - end) + let map = `Custom map_error + let return e = Error e +end) let is_ok = function | Ok _ -> true diff --git a/src/result.mli b/src/result.mli index ab1c70cb..8c086803 100644 --- a/src/result.mli +++ b/src/result.mli @@ -43,10 +43,8 @@ val globalize include Monad.S2_local with type ('a, 'err) t := ('a, 'err) t module Error : Monad.S2_local with type ('err, 'a) t := ('a, 'err) t - include Invariant_intf.S2 with type ('ok, 'err) t := ('ok, 'err) t - val fail : 'err -> (_, 'err) t (** e.g., [failf "Couldn't find bloogle %s" (Bloogle.to_string b)]. *) @@ -95,7 +93,7 @@ val to_either : ('ok, 'err) t -> ('ok, 'err) Either0.t val of_either : ('ok, 'err) Either0.t -> ('ok, 'err) t val ok_fst : ('ok, 'err) t -> ('ok, 'err) Either0.t -[@@deprecated "[since 2020-01] Use [to_either] instead."] + [@@deprecated "[since 2020-01] Use [to_either] instead."] (** [ok_if_true] returns [Ok ()] if [bool] is true, and [Error error] if it is false. *) val ok_if_true : bool -> error:'err -> (unit, 'err) t diff --git a/src/sequence.ml b/src/sequence.ml index 47f07540..8c8a28d2 100644 --- a/src/sequence.ml +++ b/src/sequence.ml @@ -16,38 +16,38 @@ module Step = struct [@@deriving_inline sexp_of] let sexp_of_t : - 'a 's. - ('a -> Sexplib0.Sexp.t) - -> ('s -> Sexplib0.Sexp.t) - -> ('a, 's) t - -> Sexplib0.Sexp.t + 'a 's. + ('a -> Sexplib0.Sexp.t) + -> ('s -> Sexplib0.Sexp.t) + -> ('a, 's) t + -> Sexplib0.Sexp.t = fun (type a__011_ s__012_) - : ((a__011_ -> Sexplib0.Sexp.t) -> (s__012_ -> Sexplib0.Sexp.t) - -> (a__011_, s__012_) t -> Sexplib0.Sexp.t) -> - fun _of_a__001_ _of_s__002_ -> function - | Done -> Sexplib0.Sexp.Atom "Done" - | Skip { state = state__004_ } -> - let bnds__003_ = ([] : _ Stdlib.List.t) in - let bnds__003_ = - let arg__005_ = _of_s__002_ state__004_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "state"; arg__005_ ] :: bnds__003_ - : _ Stdlib.List.t) - in - Sexplib0.Sexp.List (Sexplib0.Sexp.Atom "Skip" :: bnds__003_) - | Yield { value = value__007_; state = state__009_ } -> - let bnds__006_ = ([] : _ Stdlib.List.t) in - let bnds__006_ = - let arg__010_ = _of_s__002_ state__009_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "state"; arg__010_ ] :: bnds__006_ - : _ Stdlib.List.t) - in - let bnds__006_ = - let arg__008_ = _of_a__001_ value__007_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "value"; arg__008_ ] :: bnds__006_ - : _ Stdlib.List.t) - in - Sexplib0.Sexp.List (Sexplib0.Sexp.Atom "Yield" :: bnds__006_) + : ((a__011_ -> Sexplib0.Sexp.t) -> (s__012_ -> Sexplib0.Sexp.t) + -> (a__011_, s__012_) t -> Sexplib0.Sexp.t) -> + fun _of_a__001_ _of_s__002_ -> function + | Done -> Sexplib0.Sexp.Atom "Done" + | Skip { state = state__004_ } -> + let bnds__003_ = ([] : _ Stdlib.List.t) in + let bnds__003_ = + let arg__005_ = _of_s__002_ state__004_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "state"; arg__005_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List (Sexplib0.Sexp.Atom "Skip" :: bnds__003_) + | Yield { value = value__007_; state = state__009_ } -> + let bnds__006_ = ([] : _ Stdlib.List.t) in + let bnds__006_ = + let arg__010_ = _of_s__002_ state__009_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "state"; arg__010_ ] :: bnds__006_ + : _ Stdlib.List.t) + in + let bnds__006_ = + let arg__008_ = _of_a__001_ value__007_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "value"; arg__008_ ] :: bnds__006_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List (Sexplib0.Sexp.Atom "Yield" :: bnds__006_) ;; [@@@end] @@ -103,14 +103,14 @@ let unfold_with s ~init ~f = { state = init, s ; next = (fun (seed, s) -> - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = seed, s } - | Yield { value = a; state = s } -> - (match f seed a with - | Done -> Done - | Skip { state = seed } -> Skip { state = seed, s } - | Yield { value = a; state = seed } -> Yield { value = a; state = seed, s })) + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = seed, s } + | Yield { value = a; state = s } -> + (match f seed a with + | Done -> Done + | Skip { state = seed } -> Skip { state = seed, s } + | Yield { value = a; state = seed } -> Yield { value = a; state = seed, s })) } ;; @@ -121,24 +121,24 @@ let unfold_with_and_finish s ~init ~running_step ~inner_finished ~finishing_step { state = `Inner_running (init, s) ; next = (fun state -> - match state with - | `Inner_running (state, inner_state) -> - (match next inner_state with - | Done -> Skip { state = `Inner_finished (inner_finished state) } - | Skip { state = inner_state } -> - Skip { state = `Inner_running (state, inner_state) } - | Yield { value = x; state = inner_state } -> - (match running_step state x with - | Done -> Done - | Skip { state } -> Skip { state = `Inner_running (state, inner_state) } - | Yield { value = y; state } -> - Yield { value = y; state = `Inner_running (state, inner_state) })) - | `Inner_finished state -> - (match finishing_step state with - | Done -> Done - | Skip { state } -> Skip { state = `Inner_finished state } - | Yield { value = y; state } -> - Yield { value = y; state = `Inner_finished state })) + match state with + | `Inner_running (state, inner_state) -> + (match next inner_state with + | Done -> Skip { state = `Inner_finished (inner_finished state) } + | Skip { state = inner_state } -> + Skip { state = `Inner_running (state, inner_state) } + | Yield { value = x; state = inner_state } -> + (match running_step state x with + | Done -> Done + | Skip { state } -> Skip { state = `Inner_running (state, inner_state) } + | Yield { value = y; state } -> + Yield { value = y; state = `Inner_running (state, inner_state) })) + | `Inner_finished state -> + (match finishing_step state with + | Done -> Done + | Skip { state } -> Skip { state = `Inner_finished state } + | Yield { value = y; state } -> + Yield { value = y; state = `Inner_finished state })) } ;; @@ -161,7 +161,6 @@ let fold t ~init ~f = let to_list_rev t = fold t ~init:[] ~f:(fun l x -> x :: l) - let to_list (Sequence { state = s; next }) = let safe_to_list t = List.rev (to_list_rev t) in let rec to_list s next i = @@ -225,10 +224,10 @@ let map t ~f = { state = seed ; next = (fun seed -> - match next seed with - | Done -> Done - | Skip { state = s } -> Skip { state = s } - | Yield { value = a; state = s } -> Yield { value = f a; state = s }) + match next seed with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = a; state = s } -> Yield { value = f a; state = s }) } ;; @@ -239,10 +238,10 @@ let mapi t ~f = { state = 0, s ; next = (fun (i, s) -> - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = i, s } - | Yield { value = a; state = s } -> Yield { value = f i a; state = i + 1, s }) + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } -> Yield { value = f i a; state = i + 1, s }) } ;; @@ -265,11 +264,11 @@ let filter t ~f = { state = seed ; next = (fun seed -> - match next seed with - | Done -> Done - | Skip { state = s } -> Skip { state = s } - | Yield { value = a; state = s } when f a -> Yield { value = a; state = s } - | Yield { value = _; state = s } -> Skip { state = s }) + match next seed with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = a; state = s } when f a -> Yield { value = a; state = s } + | Yield { value = _; state = s } -> Skip { state = s }) } ;; @@ -332,7 +331,6 @@ let find_map t ~f = | Sequence { state = seed; next } -> loop seed next f ;; - let find_mapi t ~f = let rec loop s next f i = match next s with @@ -457,12 +455,12 @@ let return x = ;; include Monad.Make (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let map = `Custom map - let bind = bind - let return = return - end) + let map = `Custom map + let bind = bind + let return = return +end) let nth s n = if n < 0 @@ -496,12 +494,12 @@ module Merge_with_duplicates_element = struct [@@deriving_inline compare ~localize, hash, sexp, sexp_grammar] let compare__local : - 'a 'b. - (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) - -> (('b[@ocaml.local]) -> ('b[@ocaml.local]) -> int) - -> (('a, 'b) t[@ocaml.local]) - -> (('a, 'b) t[@ocaml.local]) - -> int + 'a 'b. + (('a[@ocaml.local]) -> ('a[@ocaml.local]) -> int) + -> (('b[@ocaml.local]) -> ('b[@ocaml.local]) -> int) + -> (('a, 'b) t[@ocaml.local]) + -> (('a, 'b) t[@ocaml.local]) + -> int = fun _cmp__a _cmp__b a__023_ b__024_ -> if Stdlib.( == ) a__023_ b__024_ @@ -521,7 +519,7 @@ module Merge_with_duplicates_element = struct ;; let compare : - 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int + 'a 'b. ('a -> 'a -> int) -> ('b -> 'b -> int) -> ('a, 'b) t -> ('a, 'b) t -> int = fun _cmp__a _cmp__b a__013_ b__014_ -> if Stdlib.( == ) a__013_ b__014_ @@ -568,96 +566,96 @@ module Merge_with_duplicates_element = struct ;; let t_of_sexp : - 'a 'b. - (Sexplib0.Sexp.t -> 'a) - -> (Sexplib0.Sexp.t -> 'b) - -> Sexplib0.Sexp.t - -> ('a, 'b) t + 'a 'b. + (Sexplib0.Sexp.t -> 'a) + -> (Sexplib0.Sexp.t -> 'b) + -> Sexplib0.Sexp.t + -> ('a, 'b) t = fun (type a__056_ b__057_) - : ((Sexplib0.Sexp.t -> a__056_) -> (Sexplib0.Sexp.t -> b__057_) -> Sexplib0.Sexp.t - -> (a__056_, b__057_) t) -> - let error_source__037_ = "sequence.ml.Merge_with_duplicates_element.t" in - fun _of_a__033_ _of_b__034_ -> function - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("left" | "Left") as _tag__040_) :: sexp_args__041_) as - _sexp__039_ -> - (match sexp_args__041_ with - | arg0__042_ :: [] -> - let res0__043_ = _of_a__033_ arg0__042_ in - Left res0__043_ - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__037_ - _tag__040_ - _sexp__039_) - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("right" | "Right") as _tag__045_) :: sexp_args__046_) as - _sexp__044_ -> - (match sexp_args__046_ with - | arg0__047_ :: [] -> - let res0__048_ = _of_b__034_ arg0__047_ in - Right res0__048_ - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__037_ - _tag__045_ - _sexp__044_) - | Sexplib0.Sexp.List - (Sexplib0.Sexp.Atom (("both" | "Both") as _tag__050_) :: sexp_args__051_) as - _sexp__049_ -> - (match sexp_args__051_ with - | [ arg0__052_; arg1__053_ ] -> - let res0__054_ = _of_a__033_ arg0__052_ - and res1__055_ = _of_b__034_ arg1__053_ in - Both (res0__054_, res1__055_) - | _ -> - Sexplib0.Sexp_conv_error.stag_incorrect_n_args - error_source__037_ - _tag__050_ - _sexp__049_) - | Sexplib0.Sexp.Atom ("left" | "Left") as sexp__038_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__037_ sexp__038_ - | Sexplib0.Sexp.Atom ("right" | "Right") as sexp__038_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__037_ sexp__038_ - | Sexplib0.Sexp.Atom ("both" | "Both") as sexp__038_ -> - Sexplib0.Sexp_conv_error.stag_takes_args error_source__037_ sexp__038_ - | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__036_ -> - Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__037_ sexp__036_ - | Sexplib0.Sexp.List [] as sexp__036_ -> - Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__037_ sexp__036_ - | sexp__036_ -> - Sexplib0.Sexp_conv_error.unexpected_stag error_source__037_ sexp__036_ + : ((Sexplib0.Sexp.t -> a__056_) -> (Sexplib0.Sexp.t -> b__057_) -> Sexplib0.Sexp.t + -> (a__056_, b__057_) t) -> + let error_source__037_ = "sequence.ml.Merge_with_duplicates_element.t" in + fun _of_a__033_ _of_b__034_ -> function + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("left" | "Left") as _tag__040_) :: sexp_args__041_) as + _sexp__039_ -> + (match sexp_args__041_ with + | arg0__042_ :: [] -> + let res0__043_ = _of_a__033_ arg0__042_ in + Left res0__043_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__037_ + _tag__040_ + _sexp__039_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("right" | "Right") as _tag__045_) :: sexp_args__046_) as + _sexp__044_ -> + (match sexp_args__046_ with + | arg0__047_ :: [] -> + let res0__048_ = _of_b__034_ arg0__047_ in + Right res0__048_ + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__037_ + _tag__045_ + _sexp__044_) + | Sexplib0.Sexp.List + (Sexplib0.Sexp.Atom (("both" | "Both") as _tag__050_) :: sexp_args__051_) as + _sexp__049_ -> + (match sexp_args__051_ with + | [ arg0__052_; arg1__053_ ] -> + let res0__054_ = _of_a__033_ arg0__052_ + and res1__055_ = _of_b__034_ arg1__053_ in + Both (res0__054_, res1__055_) + | _ -> + Sexplib0.Sexp_conv_error.stag_incorrect_n_args + error_source__037_ + _tag__050_ + _sexp__049_) + | Sexplib0.Sexp.Atom ("left" | "Left") as sexp__038_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__037_ sexp__038_ + | Sexplib0.Sexp.Atom ("right" | "Right") as sexp__038_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__037_ sexp__038_ + | Sexplib0.Sexp.Atom ("both" | "Both") as sexp__038_ -> + Sexplib0.Sexp_conv_error.stag_takes_args error_source__037_ sexp__038_ + | Sexplib0.Sexp.List (Sexplib0.Sexp.List _ :: _) as sexp__036_ -> + Sexplib0.Sexp_conv_error.nested_list_invalid_sum error_source__037_ sexp__036_ + | Sexplib0.Sexp.List [] as sexp__036_ -> + Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__037_ sexp__036_ + | sexp__036_ -> + Sexplib0.Sexp_conv_error.unexpected_stag error_source__037_ sexp__036_ ;; let sexp_of_t : - 'a 'b. - ('a -> Sexplib0.Sexp.t) - -> ('b -> Sexplib0.Sexp.t) - -> ('a, 'b) t - -> Sexplib0.Sexp.t + 'a 'b. + ('a -> Sexplib0.Sexp.t) + -> ('b -> Sexplib0.Sexp.t) + -> ('a, 'b) t + -> Sexplib0.Sexp.t = fun (type a__068_ b__069_) - : ((a__068_ -> Sexplib0.Sexp.t) -> (b__069_ -> Sexplib0.Sexp.t) - -> (a__068_, b__069_) t -> Sexplib0.Sexp.t) -> - fun _of_a__058_ _of_b__059_ -> function - | Left arg0__060_ -> - let res0__061_ = _of_a__058_ arg0__060_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; res0__061_ ] - | Right arg0__062_ -> - let res0__063_ = _of_b__059_ arg0__062_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; res0__063_ ] - | Both (arg0__064_, arg1__065_) -> - let res0__066_ = _of_a__058_ arg0__064_ - and res1__067_ = _of_b__059_ arg1__065_ in - Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Both"; res0__066_; res1__067_ ] + : ((a__068_ -> Sexplib0.Sexp.t) -> (b__069_ -> Sexplib0.Sexp.t) + -> (a__068_, b__069_) t -> Sexplib0.Sexp.t) -> + fun _of_a__058_ _of_b__059_ -> function + | Left arg0__060_ -> + let res0__061_ = _of_a__058_ arg0__060_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Left"; res0__061_ ] + | Right arg0__062_ -> + let res0__063_ = _of_b__059_ arg0__062_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Right"; res0__063_ ] + | Both (arg0__064_, arg1__065_) -> + let res0__066_ = _of_a__058_ arg0__064_ + and res1__067_ = _of_b__059_ arg1__065_ in + Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "Both"; res0__066_; res1__067_ ] ;; let t_sexp_grammar : - 'a 'b. - 'a Sexplib0.Sexp_grammar.t - -> 'b Sexplib0.Sexp_grammar.t - -> ('a, 'b) t Sexplib0.Sexp_grammar.t + 'a 'b. + 'a Sexplib0.Sexp_grammar.t + -> 'b Sexplib0.Sexp_grammar.t + -> ('a, 'b) t Sexplib0.Sexp_grammar.t = fun _'a_sexp_grammar _'b_sexp_grammar -> { untyped = @@ -693,9 +691,9 @@ module Merge_with_duplicates_element = struct end let merge_with_duplicates - (Sequence { state = s1; next = next1 }) - (Sequence { state = s2; next = next2 }) - ~compare + (Sequence { state = s1; next = next1 }) + (Sequence { state = s2; next = next2 }) + ~compare = let unshadowed_compare = compare in let open Merge_with_duplicates_element in @@ -726,17 +724,17 @@ let merge_deduped_and_sorted s1 s2 ~compare = ;; let (merge [@deprecated - "[since 2021-07] For identical behavior, use \ - [Sequence.merge_deduped_and_sorted], but consider using \ - [Sequence.merge_sorted] instead."]) + "[since 2021-07] For identical behavior, use \ + [Sequence.merge_deduped_and_sorted], but consider using \ + [Sequence.merge_sorted] instead."]) = merge_deduped_and_sorted ;; let merge_sorted - (Sequence { state = s1; next = next1 }) - (Sequence { state = s2; next = next2 }) - ~compare + (Sequence { state = s1; next = next1 }) + (Sequence { state = s2; next = next2 }) + ~compare = let next = function | Skip { state = s1 }, s2 -> Skip { state = next1 s1, s2 } @@ -818,11 +816,11 @@ let filter_opt s = { state = s ; next = (fun s -> - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = s } - | Yield { value = None; state = s } -> Skip { state = s } - | Yield { value = Some a; state = s } -> Yield { value = a; state = s }) + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = None; state = s } -> Skip { state = s } + | Yield { value = Some a; state = s } -> Yield { value = a; state = s }) } ;; @@ -878,18 +876,18 @@ let append s1 s2 = { state = `First_list s1 ; next = (function - | `First_list s1 -> - (match next1 s1 with - | Done -> Skip { state = `Second_list s2 } - | Skip { state = s1 } -> Skip { state = `First_list s1 } - | Yield { value = a; state = s1 } -> - Yield { value = a; state = `First_list s1 }) - | `Second_list s2 -> - (match next2 s2 with - | Done -> Done - | Skip { state = s2 } -> Skip { state = `Second_list s2 } - | Yield { value = a; state = s2 } -> - Yield { value = a; state = `Second_list s2 })) + | `First_list s1 -> + (match next1 s1 with + | Done -> Skip { state = `Second_list s2 } + | Skip { state = s1 } -> Skip { state = `First_list s1 } + | Yield { value = a; state = s1 } -> + Yield { value = a; state = `First_list s1 }) + | `Second_list s2 -> + (match next2 s2 with + | Done -> Done + | Skip { state = s2 } -> Skip { state = `Second_list s2 } + | Yield { value = a; state = s2 } -> + Yield { value = a; state = `Second_list s2 })) } ;; @@ -909,8 +907,8 @@ let zip (Sequence { state = s1; next = next1 }) (Sequence { state = s2; next = n ;; let zip_full - (Sequence { state = s1; next = next1 }) - (Sequence { state = s2; next = next2 }) + (Sequence { state = s1; next = next1 }) + (Sequence { state = s2; next = next2 }) = let next = function | Yield { value = a; state = s1 }, Yield { value = b; state = s2 } -> @@ -1038,15 +1036,15 @@ let sub s ~pos ~len = { state = 0, s ; next = (fun (i, s) -> - if i - pos >= len - then Done - else ( - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = i, s } - | Yield { value = a; state = s } when i >= pos -> - Yield { value = a; state = i + 1, s } - | Yield { value = _; state = s } -> Skip { state = i + 1, s })) + if i - pos >= len + then Done + else ( + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } when i >= pos -> + Yield { value = a; state = i + 1, s } + | Yield { value = _; state = s } -> Skip { state = i + 1, s })) } ;; @@ -1058,13 +1056,13 @@ let take s len = { state = 0, s ; next = (fun (i, s) -> - if i >= len - then Done - else ( - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = i, s } - | Yield { value = a; state = s } -> Yield { value = a; state = i + 1, s })) + if i >= len + then Done + else ( + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } -> Yield { value = a; state = i + 1, s })) } ;; @@ -1076,12 +1074,12 @@ let drop s len = { state = 0, s ; next = (fun (i, s) -> - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = i, s } - | Yield { value = a; state = s } when i >= len -> - Yield { value = a; state = i + 1, s } - | Yield { value = _; state = s } -> Skip { state = i + 1, s }) + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = i, s } + | Yield { value = a; state = s } when i >= len -> + Yield { value = a; state = i + 1, s } + | Yield { value = _; state = s } -> Skip { state = i + 1, s }) } ;; @@ -1092,11 +1090,11 @@ let take_while s ~f = { state = s ; next = (fun s -> - match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = s } - | Yield { value = a; state = s } when f a -> Yield { value = a; state = s } - | Yield { value = _; state = _ } -> Done) + match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = s } + | Yield { value = a; state = s } when f a -> Yield { value = a; state = s } + | Yield { value = _; state = _ } -> Done) } ;; @@ -1107,13 +1105,13 @@ let drop_while s ~f = { state = `Dropping s ; next = (function - | `Dropping s -> - (match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = `Dropping s } - | Yield { value = a; state = s } when f a -> Skip { state = `Dropping s } - | Yield { value = a; state = s } -> Yield { value = a; state = `Identity s }) - | `Identity s -> lift_identity next s) + | `Dropping s -> + (match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Dropping s } + | Yield { value = a; state = s } when f a -> Skip { state = `Dropping s } + | Yield { value = a; state = s } -> Yield { value = a; state = `Identity s }) + | `Identity s -> lift_identity next s) } ;; @@ -1124,8 +1122,8 @@ let shift_right s x = { state = `Consing (seed, x) ; next = (function - | `Consing (seed, x) -> Yield { value = x; state = `Identity seed } - | `Identity s -> lift_identity next s) + | `Consing (seed, x) -> Yield { value = x; state = `Identity seed } + | `Identity s -> lift_identity next s) } ;; @@ -1143,18 +1141,18 @@ let intersperse s ~sep = { state = `Init s ; next = (function - | `Init s -> - (match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = `Init s } - | Yield { value = a; state = s } -> Yield { value = a; state = `Running s }) - | `Running s -> - (match next s with - | Done -> Done - | Skip { state = s } -> Skip { state = `Running s } - | Yield { value = a; state = s } -> - Yield { value = sep; state = `Putting (a, s) }) - | `Putting (a, s) -> Yield { value = a; state = `Running s }) + | `Init s -> + (match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Init s } + | Yield { value = a; state = s } -> Yield { value = a; state = `Running s }) + | `Running s -> + (match next s with + | Done -> Done + | Skip { state = s } -> Skip { state = `Running s } + | Yield { value = a; state = s } -> + Yield { value = sep; state = `Putting (a, s) }) + | `Putting (a, s) -> Yield { value = a; state = `Running s }) } ;; diff --git a/src/sequence.mli b/src/sequence.mli index d57e3bae..6b9f0008 100644 --- a/src/sequence.mli +++ b/src/sequence.mli @@ -128,9 +128,9 @@ val filter : 'a t -> f:('a -> bool) -> 'a t val merge_deduped_and_sorted : 'a t -> 'a t -> compare:('a -> 'a -> int) -> 'a t val merge : 'a t -> 'a t -> compare:('a -> 'a -> int) -> 'a t -[@@deprecated - "[since 2021-07] For identical behavior, use [Sequence.merge_deduped_and_sorted], \ - but consider using [Sequence.merge_sorted] instead."] + [@@deprecated + "[since 2021-07] For identical behavior, use [Sequence.merge_deduped_and_sorted], \ + but consider using [Sequence.merge_sorted] instead."] (** If [t1] and [t2] are each sorted, [merge_sorted t1 t2 ~compare] merges [t1] and [t2] into a sorted sequence. Whenever identical elements are found in both [t1] and [t2], @@ -322,7 +322,6 @@ val split_n : 'a t -> int -> 'a list * 'a t is not positive, it raises. *) val chunks_exn : 'a t -> int -> 'a list t - (** [shift_right t a] produces [a] and then produces each element of [t]. *) val shift_right : 'a t -> 'a -> 'a t diff --git a/src/set.ml b/src/set.ml index 72aa8c66..30958f43 100644 --- a/src/set.ml +++ b/src/set.ml @@ -18,7 +18,6 @@ include Set_intf let with_return = With_return.with_return - module Tree0 = struct type 'a t = | Empty @@ -310,9 +309,9 @@ module Tree0 = struct Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Set_min_elt_exn_of_empty_set] (function - | Set_min_elt_exn_of_empty_set -> - Sexplib0.Sexp.Atom "set.ml.Tree0.Set_min_elt_exn_of_empty_set" - | _ -> assert false) + | Set_min_elt_exn_of_empty_set -> + Sexplib0.Sexp.Atom "set.ml.Tree0.Set_min_elt_exn_of_empty_set" + | _ -> assert false) ;; [@@@end] @@ -323,9 +322,9 @@ module Tree0 = struct Sexplib0.Sexp_conv.Exn_converter.add [%extension_constructor Set_max_elt_exn_of_empty_set] (function - | Set_max_elt_exn_of_empty_set -> - Sexplib0.Sexp.Atom "set.ml.Tree0.Set_max_elt_exn_of_empty_set" - | _ -> assert false) + | Set_max_elt_exn_of_empty_set -> + Sexplib0.Sexp.Atom "set.ml.Tree0.Set_max_elt_exn_of_empty_set" + | _ -> assert false) ;; [@@@end] @@ -715,11 +714,11 @@ module Tree0 = struct ;; let to_sequence - comparator - ?(order = `Increasing) - ?greater_or_equal_to - ?less_or_equal_to - t + comparator + ?(order = `Increasing) + ?greater_or_equal_to + ?less_or_equal_to + t = let inclusive_bound side t bound = let compare_elt = comparator.Comparator.compare in @@ -738,7 +737,6 @@ module Tree0 = struct to_sequence_decreasing comparator ~from_elt:less_or_equal_to t ;; - let rec find_first_satisfying t ~f = match t with | Empty -> None @@ -798,12 +796,12 @@ module Tree0 = struct ;; let merge_to_sequence - comparator - ?(order = `Increasing) - ?greater_or_equal_to - ?less_or_equal_to - t - t' + comparator + ?(order = `Increasing) + ?greater_or_equal_to + ?less_or_equal_to + t + t' = Sequence.merge_with_duplicates (to_sequence comparator ~order ?greater_or_equal_to ?less_or_equal_to t) @@ -1054,7 +1052,6 @@ module Tree0 = struct loop set [] [@nontail] ;; - let rec find t ~f = match t with | Empty -> None @@ -1135,10 +1132,10 @@ module Tree0 = struct module Named = struct let is_subset - (subset : _ Named.t) - ~of_:(superset : _ Named.t) - ~sexp_of_elt - ~compare_elt + (subset : _ Named.t) + ~of_:(superset : _ Named.t) + ~sexp_of_elt + ~compare_elt = let invalid_elements = diff subset.set superset.set ~compare_elt in if is_empty invalid_elements @@ -1536,9 +1533,9 @@ let to_tree = Using_comparator.to_tree let of_tree m t = Using_comparator.of_tree ~comparator:(to_comparator m) t module M (Elt : sig - type t - type comparator_witness - end) = + type t + type comparator_witness +end) = struct type nonrec t = (Elt.t, Elt.comparator_witness) t end @@ -1578,9 +1575,9 @@ let sexp_of_m__t (type elt) (module Elt : Sexp_of_m with type t = elt) t = ;; let m__t_of_sexp - (type elt cmp) - (module Elt : M_of_sexp with type t = elt and type comparator_witness = cmp) - sexp + (type elt cmp) + (module Elt : M_of_sexp with type t = elt and type comparator_witness = cmp) + sexp = Using_comparator.t_of_sexp_direct ~comparator:Elt.comparator Elt.t_of_sexp sexp ;; diff --git a/src/set_intf.ml b/src/set_intf.ml index b38fdee0..90abd6e6 100644 --- a/src/set_intf.ml +++ b/src/set_intf.ml @@ -49,7 +49,7 @@ module type Accessors_generic = sig : ( 'a , 'cmp , ('a, 'cmp) t -> ('a, 'cmp) t -> ('a elt, 'a elt) Either.t Sequence.t ) - access_options + access_options val compare_direct : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> int) access_options val equal : ('a, 'cmp, ('a, 'cmp) t -> ('a, 'cmp) t -> bool) access_options @@ -61,13 +61,13 @@ module type Accessors_generic = sig : ( 'a , 'cmp , ('a, 'cmp) t Named.t -> of_:('a, 'cmp) t Named.t -> unit Or_error.t ) - access_options + access_options val equal : ( 'a , 'cmp , ('a, 'cmp) t Named.t -> ('a, 'cmp) t Named.t -> unit Or_error.t ) - access_options + access_options end val fold_until @@ -83,12 +83,12 @@ module type Accessors_generic = sig : ( 'a , 'cmp , ('a, 'cmp) t - -> ('a, 'cmp) t - -> f: - (([ `Left of 'a elt | `Right of 'a elt | `Both of 'a elt * 'a elt ] -> unit) - [@local]) - -> unit ) - access_options + -> ('a, 'cmp) t + -> f: + (([ `Left of 'a elt | `Right of 'a elt | `Both of 'a elt * 'a elt ] -> unit) + [@local]) + -> unit ) + access_options val filter : ('a, 'cmp) t -> f:(('a elt -> bool)[@local]) -> ('a, 'cmp) t @@ -109,7 +109,7 @@ module type Accessors_generic = sig : ( 'a , 'cmp , ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t * 'a elt option * ('a, 'cmp) t ) - access_options + access_options val split_le_gt : ('a, 'cmp, ('a, 'cmp) t -> 'a elt -> ('a, 'cmp) t * ('a, 'cmp) t) access_options @@ -131,41 +131,41 @@ module type Accessors_generic = sig : ( 'a , 'cmp , ?order:[ `Increasing | `Decreasing ] - -> ?greater_or_equal_to:'a elt - -> ?less_or_equal_to:'a elt - -> ('a, 'cmp) t - -> 'a elt Sequence.t ) - access_options + -> ?greater_or_equal_to:'a elt + -> ?less_or_equal_to:'a elt + -> ('a, 'cmp) t + -> 'a elt Sequence.t ) + access_options val binary_search : ( 'a , 'cmp , ('a, 'cmp) t - -> compare:(('a elt -> 'key -> int)[@local]) - -> Binary_searchable.Which_target_by_key.t - -> 'key - -> 'a elt option ) - access_options + -> compare:(('a elt -> 'key -> int)[@local]) + -> Binary_searchable.Which_target_by_key.t + -> 'key + -> 'a elt option ) + access_options val binary_search_segmented : ( 'a , 'cmp , ('a, 'cmp) t - -> segment_of:(('a elt -> [ `Left | `Right ])[@local]) - -> Binary_searchable.Which_target_by_segment.t - -> 'a elt option ) - access_options + -> segment_of:(('a elt -> [ `Left | `Right ])[@local]) + -> Binary_searchable.Which_target_by_segment.t + -> 'a elt option ) + access_options val merge_to_sequence : ( 'a , 'cmp , ?order:[ `Increasing | `Decreasing ] - -> ?greater_or_equal_to:'a elt - -> ?less_or_equal_to:'a elt - -> ('a, 'cmp) t - -> ('a, 'cmp) t - -> ('a elt, 'a elt) Merge_to_sequence_element.t Sequence.t ) - access_options + -> ?greater_or_equal_to:'a elt + -> ?less_or_equal_to:'a elt + -> ('a, 'cmp) t + -> ('a, 'cmp) t + -> ('a elt, 'a elt) Merge_to_sequence_element.t Sequence.t ) + access_options end module type Creators_generic = sig @@ -189,7 +189,7 @@ module type Creators_generic = sig : ('a, 'cmp, len:int -> f:((int -> 'a elt)[@local]) -> ('a, 'cmp) t) create_options val stable_dedup_list : ('a, _, 'a elt list -> 'a elt list) create_options - [@@deprecated "[since 2023-04] Use [List.stable_dedup] instead."] + [@@deprecated "[since 2023-04] Use [List.stable_dedup] instead."] (** The types of [map] and [filter_map] are subtle. The input set, [('a, _) set], reflects the fact that these functions take a set of *any* type, with any @@ -207,7 +207,7 @@ module type Creators_generic = sig : ( 'b , 'cmp , ('a, _) set -> f:(('a -> 'b elt option)[@local]) -> ('b, 'cmp) t ) - create_options + create_options val of_tree : ('a, 'cmp, ('a elt, 'cmp cmp) tree -> ('a, 'cmp) t) create_options end @@ -220,17 +220,17 @@ module type Creators_and_accessors_generic = sig include Accessors_generic - with type ('a, 'b) t := ('a, 'b) t - with type ('a, 'b) tree := ('a, 'b) tree - with type 'a elt := 'a elt - with type 'cmp cmp := 'cmp cmp + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) tree + with type 'a elt := 'a elt + with type 'cmp cmp := 'cmp cmp include Creators_generic - with type ('a, 'b) t := ('a, 'b) t - with type ('a, 'b) tree := ('a, 'b) tree - with type 'a elt := 'a elt - with type 'cmp cmp := 'cmp cmp + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) tree + with type 'a elt := 'a elt + with type 'cmp cmp := 'cmp cmp end module type S_poly = sig @@ -240,12 +240,12 @@ module type S_poly = sig include Creators_and_accessors_generic - with type ('elt, 'cmp) t := 'elt t - with type ('elt, 'cmp) tree := 'elt tree - with type 'a elt := 'a - with type 'c cmp := comparator_witness - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Without_comparator.t - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('elt, 'cmp) t := 'elt t + with type ('elt, 'cmp) tree := 'elt tree + with type 'a elt := 'a + with type 'c cmp := comparator_witness + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t end module type For_deriving = sig @@ -519,7 +519,7 @@ module type Set = sig of polymorphic comparison by instantiating the functor at a different implementation of [Comparator] and using the resulting [stable_dedup_list]. *) val stable_dedup_list : ('a, _) Comparator.Module.t -> 'a list -> 'a list - [@@deprecated "[since 2023-04] Use [List.stable_dedup] instead."] + [@@deprecated "[since 2023-04] Use [List.stable_dedup] instead."] (** [map c t ~f] returns a new set created by applying [f] to every element in [t]. The returned set is based on the provided [comparator]. [O(n log n)]. *) @@ -561,7 +561,6 @@ module type Set = sig -> finish:(('acc -> 'final)[@local]) -> 'final - (** Like {!fold}, except that it goes from the largest to the smallest element. *) val fold_right : ('a, _) t -> init:'acc -> f:(('a -> 'acc -> 'acc)[@local]) -> 'acc @@ -747,9 +746,9 @@ module type Set = sig doesn't (because there is no such thing as, say, String.sexp_of_comparator_witness, instead you would want to pass the comparator directly). *) module M (Elt : sig - type t - type comparator_witness - end) : sig + type t + type comparator_witness + end) : sig type nonrec t = (Elt.t, Elt.comparator_witness) t end @@ -800,26 +799,26 @@ module type Set = sig include Creators_and_accessors_generic - with type ('a, 'b) set := ('a, 'b) t - with type ('a, 'b) t := ('a, 'b) t - with type ('a, 'b) tree := ('a, 'b) t - with type 'a elt := 'a - with type 'c cmp := 'c - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b) set := ('a, 'b) t + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) t + with type 'a elt := 'a + with type 'c cmp := 'c + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) With_comparator.t val empty_without_value_restriction : (_, _) t end include Creators_and_accessors_generic - with type ('a, 'b) t := ('a, 'b) t - with type ('a, 'b) tree := ('a, 'b) Tree.t - with type ('a, 'b) set := ('a, 'b) t - with type 'a elt := 'a - with type 'c cmp := 'c - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) Tree.t + with type ('a, 'b) set := ('a, 'b) t + with type 'a elt := 'a + with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_comparator.t val comparator_s : ('a, 'cmp) t -> ('a, 'cmp) Comparator.Module.t val comparator : ('a, 'cmp) t -> ('a, 'cmp) Comparator.t diff --git a/src/sexp.ml b/src/sexp.ml index 84594b72..e53d6ffe 100644 --- a/src/sexp.ml +++ b/src/sexp.ml @@ -19,7 +19,7 @@ let rec compare__local = | _, Atom _ -> 1 | List _a__005_, List _b__006_ -> compare_list__local compare__local _a__005_ _b__006_) - : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) ;; let compare = (fun a b -> compare__local a b : t -> t -> int) @@ -35,7 +35,7 @@ let rec (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash let hsv = Ppx_hash_lib.Std.Hash.fold_int hsv 1 in let hsv = hsv in hash_fold_list hash_fold_t hsv _a0 - : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) and (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = let func arg = diff --git a/src/sexp.mli b/src/sexp.mli index 681be4ee..e8011364 100644 --- a/src/sexp.mli +++ b/src/sexp.mli @@ -13,11 +13,10 @@ include Ppx_compare_lib.Equal.S_local with type t := t include Ppx_compare_lib.Comparable.S_local with type t := t val t_sexp_grammar : t Sexplib0.Sexp_grammar.t - val invariant : t -> unit (** Base has never had an [of_string] function. We expose a deprecated [of_string] here so that people can find it (e.g. with merlin), and learn what we recommend. This [of_string] has type [unit] because we don't want it to be accidentally used. *) val of_string : unit -[@@deprecated "[since 2018-02] Use [Parsexp.Single.parse_string_exn]"] + [@@deprecated "[since 2018-02] Use [Parsexp.Single.parse_string_exn]"] diff --git a/src/sexpable.ml b/src/sexpable.ml index dd58a59c..0ca3433c 100644 --- a/src/sexpable.ml +++ b/src/sexpable.ml @@ -2,12 +2,12 @@ open! Import include Sexplib0.Sexpable module Of_sexpable - (Sexpable : S) (M : sig - type t + (Sexpable : S) (M : sig + type t - val to_sexpable : t -> Sexpable.t - val of_sexpable : Sexpable.t -> t - end) : S with type t := M.t = struct + val to_sexpable : t -> Sexpable.t + val of_sexpable : Sexpable.t -> t + end) : S with type t := M.t = struct let t_of_sexp sexp = let s = Sexpable.t_of_sexp sexp in try M.of_sexpable s with @@ -18,12 +18,12 @@ module Of_sexpable end module Of_sexpable1 - (Sexpable : S1) (M : sig - type 'a t + (Sexpable : S1) (M : sig + type 'a t - val to_sexpable : 'a t -> 'a Sexpable.t - val of_sexpable : 'a Sexpable.t -> 'a t - end) : S1 with type 'a t := 'a M.t = struct + val to_sexpable : 'a t -> 'a Sexpable.t + val of_sexpable : 'a Sexpable.t -> 'a t + end) : S1 with type 'a t := 'a M.t = struct let t_of_sexp a_of_sexp sexp = let s = Sexpable.t_of_sexp a_of_sexp sexp in try M.of_sexpable s with @@ -34,12 +34,12 @@ module Of_sexpable1 end module Of_sexpable2 - (Sexpable : S2) (M : sig - type ('a, 'b) t + (Sexpable : S2) (M : sig + type ('a, 'b) t - val to_sexpable : ('a, 'b) t -> ('a, 'b) Sexpable.t - val of_sexpable : ('a, 'b) Sexpable.t -> ('a, 'b) t - end) : S2 with type ('a, 'b) t := ('a, 'b) M.t = struct + val to_sexpable : ('a, 'b) t -> ('a, 'b) Sexpable.t + val of_sexpable : ('a, 'b) Sexpable.t -> ('a, 'b) t + end) : S2 with type ('a, 'b) t := ('a, 'b) M.t = struct let t_of_sexp a_of_sexp b_of_sexp sexp = let s = Sexpable.t_of_sexp a_of_sexp b_of_sexp sexp in try M.of_sexpable s with @@ -52,12 +52,12 @@ module Of_sexpable2 end module Of_sexpable3 - (Sexpable : S3) (M : sig - type ('a, 'b, 'c) t + (Sexpable : S3) (M : sig + type ('a, 'b, 'c) t - val to_sexpable : ('a, 'b, 'c) t -> ('a, 'b, 'c) Sexpable.t - val of_sexpable : ('a, 'b, 'c) Sexpable.t -> ('a, 'b, 'c) t - end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t = struct + val to_sexpable : ('a, 'b, 'c) t -> ('a, 'b, 'c) Sexpable.t + val of_sexpable : ('a, 'b, 'c) Sexpable.t -> ('a, 'b, 'c) t + end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t = struct let t_of_sexp a_of_sexp b_of_sexp c_of_sexp sexp = let s = Sexpable.t_of_sexp a_of_sexp b_of_sexp c_of_sexp sexp in try M.of_sexpable s with diff --git a/src/sexpable.mli b/src/sexpable.mli index 149af25a..7e73dc7d 100644 --- a/src/sexpable.mli +++ b/src/sexpable.mli @@ -5,36 +5,36 @@ open! Import open! Sexplib0.Sexpable module Of_sexpable - (Sexpable : S) (M : sig - type t + (Sexpable : S) (M : sig + type t - val to_sexpable : t -> Sexpable.t - val of_sexpable : Sexpable.t -> t - end) : S with type t := M.t + val to_sexpable : t -> Sexpable.t + val of_sexpable : Sexpable.t -> t + end) : S with type t := M.t module Of_sexpable1 - (Sexpable : S1) (M : sig - type 'a t + (Sexpable : S1) (M : sig + type 'a t - val to_sexpable : 'a t -> 'a Sexpable.t - val of_sexpable : 'a Sexpable.t -> 'a t - end) : S1 with type 'a t := 'a M.t + val to_sexpable : 'a t -> 'a Sexpable.t + val of_sexpable : 'a Sexpable.t -> 'a t + end) : S1 with type 'a t := 'a M.t module Of_sexpable2 - (Sexpable : S2) (M : sig - type ('a, 'b) t + (Sexpable : S2) (M : sig + type ('a, 'b) t - val to_sexpable : ('a, 'b) t -> ('a, 'b) Sexpable.t - val of_sexpable : ('a, 'b) Sexpable.t -> ('a, 'b) t - end) : S2 with type ('a, 'b) t := ('a, 'b) M.t + val to_sexpable : ('a, 'b) t -> ('a, 'b) Sexpable.t + val of_sexpable : ('a, 'b) Sexpable.t -> ('a, 'b) t + end) : S2 with type ('a, 'b) t := ('a, 'b) M.t module Of_sexpable3 - (Sexpable : S3) (M : sig - type ('a, 'b, 'c) t + (Sexpable : S3) (M : sig + type ('a, 'b, 'c) t - val to_sexpable : ('a, 'b, 'c) t -> ('a, 'b, 'c) Sexpable.t - val of_sexpable : ('a, 'b, 'c) Sexpable.t -> ('a, 'b, 'c) t - end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t + val to_sexpable : ('a, 'b, 'c) t -> ('a, 'b, 'c) Sexpable.t + val of_sexpable : ('a, 'b, 'c) Sexpable.t -> ('a, 'b, 'c) t + end) : S3 with type ('a, 'b, 'c) t := ('a, 'b, 'c) M.t module Of_stringable (M : Stringable.S) : sig type t [@@deriving_inline sexp_grammar] diff --git a/src/sign0.ml b/src/sign0.ml index 6c78079b..526c291f 100644 --- a/src/sign0.ml +++ b/src/sign0.ml @@ -25,15 +25,15 @@ let t_of_sexp = | Sexplib0.Sexp.List [] as sexp__002_ -> Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__003_ sexp__002_ | sexp__002_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__003_ sexp__002_ - : Sexplib0.Sexp.t -> t) + : Sexplib0.Sexp.t -> t) ;; let sexp_of_t = (function - | Neg -> Sexplib0.Sexp.Atom "Neg" - | Zero -> Sexplib0.Sexp.Atom "Zero" - | Pos -> Sexplib0.Sexp.Atom "Pos" - : t -> Sexplib0.Sexp.t) + | Neg -> Sexplib0.Sexp.Atom "Neg" + | Zero -> Sexplib0.Sexp.Atom "Zero" + | Pos -> Sexplib0.Sexp.Atom "Pos" + : t -> Sexplib0.Sexp.t) ;; let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = @@ -58,7 +58,7 @@ let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.sta | Neg -> Ppx_hash_lib.Std.Hash.fold_int hsv 0 | Zero -> Ppx_hash_lib.Std.Hash.fold_int hsv 1 | Pos -> Ppx_hash_lib.Std.Hash.fold_int hsv 2 - : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) ;; let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = diff --git a/src/sign_or_nan.ml b/src/sign_or_nan.ml index 9ea456d0..c107b149 100644 --- a/src/sign_or_nan.ml +++ b/src/sign_or_nan.ml @@ -29,16 +29,16 @@ module T = struct Sexplib0.Sexp_conv_error.empty_list_invalid_sum error_source__003_ sexp__002_ | sexp__002_ -> Sexplib0.Sexp_conv_error.unexpected_stag error_source__003_ sexp__002_ - : Sexplib0.Sexp.t -> t) + : Sexplib0.Sexp.t -> t) ;; let sexp_of_t = (function - | Neg -> Sexplib0.Sexp.Atom "Neg" - | Zero -> Sexplib0.Sexp.Atom "Zero" - | Pos -> Sexplib0.Sexp.Atom "Pos" - | Nan -> Sexplib0.Sexp.Atom "Nan" - : t -> Sexplib0.Sexp.t) + | Neg -> Sexplib0.Sexp.Atom "Neg" + | Zero -> Sexplib0.Sexp.Atom "Zero" + | Pos -> Sexplib0.Sexp.Atom "Pos" + | Nan -> Sexplib0.Sexp.Atom "Nan" + : t -> Sexplib0.Sexp.t) ;; let (t_sexp_grammar : t Sexplib0.Sexp_grammar.t) = @@ -64,7 +64,7 @@ module T = struct | Zero -> Ppx_hash_lib.Std.Hash.fold_int hsv 1 | Pos -> Ppx_hash_lib.Std.Hash.fold_int hsv 2 | Nan -> Ppx_hash_lib.Std.Hash.fold_int hsv 3 - : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) + : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) ;; let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) = diff --git a/src/source_code_position.mli b/src/source_code_position.mli index c3e833be..63728592 100644 --- a/src/source_code_position.mli +++ b/src/source_code_position.mli @@ -30,4 +30,3 @@ val to_string : t -> string (** [of_pos Stdlib.__POS__] is like [[%here]] but without using ppx. *) val of_pos : string * int * int * int -> t - diff --git a/src/source_code_position0.ml b/src/source_code_position0.ml index e58b2264..6250c0a2 100644 --- a/src/source_code_position0.ml +++ b/src/source_code_position0.ml @@ -25,7 +25,7 @@ module T = struct | n -> n) | n -> n) | n -> n) - : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) + : (t[@ocaml.local]) -> (t[@ocaml.local]) -> int) ;; let compare = (fun a b -> compare__local a b : t -> t -> int) @@ -60,28 +60,28 @@ module T = struct ; pos_bol = pos_bol__008_ ; pos_cnum = pos_cnum__010_ } -> - let bnds__003_ = ([] : _ Stdlib.List.t) in - let bnds__003_ = - let arg__011_ = sexp_of_int pos_cnum__010_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_cnum"; arg__011_ ] :: bnds__003_ - : _ Stdlib.List.t) - in - let bnds__003_ = - let arg__009_ = sexp_of_int pos_bol__008_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_bol"; arg__009_ ] :: bnds__003_ - : _ Stdlib.List.t) - in - let bnds__003_ = - let arg__007_ = sexp_of_int pos_lnum__006_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_lnum"; arg__007_ ] :: bnds__003_ - : _ Stdlib.List.t) - in - let bnds__003_ = - let arg__005_ = sexp_of_string pos_fname__004_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_fname"; arg__005_ ] :: bnds__003_ - : _ Stdlib.List.t) - in - Sexplib0.Sexp.List bnds__003_ + let bnds__003_ = ([] : _ Stdlib.List.t) in + let bnds__003_ = + let arg__011_ = sexp_of_int pos_cnum__010_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_cnum"; arg__011_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + let bnds__003_ = + let arg__009_ = sexp_of_int pos_bol__008_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_bol"; arg__009_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + let bnds__003_ = + let arg__007_ = sexp_of_int pos_lnum__006_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_lnum"; arg__007_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + let bnds__003_ = + let arg__005_ = sexp_of_string pos_fname__004_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pos_fname"; arg__005_ ] :: bnds__003_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__003_ : t -> Sexplib0.Sexp.t) ;; diff --git a/src/stack.ml b/src/stack.ml index d71f3c12..d27a24c2 100644 --- a/src/stack.ml +++ b/src/stack.ml @@ -19,12 +19,12 @@ let sexp_of_t : 'a. ('a -> Sexplib0.Sexp.t) -> 'a t -> Sexplib0.Sexp.t = let bnds__002_ = let arg__006_ = Option_array.sexp_of_t _of_a__001_ elts__005_ in (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "elts"; arg__006_ ] :: bnds__002_ - : _ Stdlib.List.t) + : _ Stdlib.List.t) in let bnds__002_ = let arg__004_ = sexp_of_int length__003_ in (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "length"; arg__004_ ] :: bnds__002_ - : _ Stdlib.List.t) + : _ Stdlib.List.t) in Sexplib0.Sexp.List bnds__002_ ;; @@ -76,12 +76,12 @@ let iter t ~f = ;; module C = Container.Make (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let fold = fold - let iter = `Custom iter - let length = `Custom length - end) + let fold = fold + let iter = `Custom iter + let length = `Custom length +end) let mem = C.mem let exists = C.exists diff --git a/src/stack_intf.ml b/src/stack_intf.ml index e224dbf7..cfa11ab8 100644 --- a/src/stack_intf.ml +++ b/src/stack_intf.ml @@ -14,7 +14,6 @@ module type S = sig include Invariant.S1 with type 'a t := 'a t - (** [fold], [iter], [find], and [find_map] visit the elements in order from the top of the stack to the bottom. [to_list] and [to_array] return the elements in order from the top of the stack to the bottom. diff --git a/src/string.ml b/src/string.ml index eb95dd87..dff86c7c 100644 --- a/src/string.ml +++ b/src/string.ml @@ -218,12 +218,12 @@ module Search_pattern0 = struct let matched_chars = ref 0 in for i = 1 to n - 1 do matched_chars - := kmp_internal_loop - ~matched_chars:!matched_chars - ~next_text_char:(unsafe_get pattern i) - ~pattern - ~kmp_array - ~char_equal; + := kmp_internal_loop + ~matched_chars:!matched_chars + ~next_text_char:(unsafe_get pattern i) + ~pattern + ~kmp_array + ~char_equal; Array.unsafe_set kmp_array i !matched_chars done); { pattern; case_sensitive; kmp_array } @@ -243,12 +243,12 @@ module Search_pattern0 = struct while !j < n && !matched_chars < k do let next_text_char = unsafe_get text !j in matched_chars - := kmp_internal_loop - ~matched_chars:!matched_chars - ~next_text_char - ~pattern - ~kmp_array - ~char_equal; + := kmp_internal_loop + ~matched_chars:!matched_chars + ~next_text_char + ~pattern + ~kmp_array + ~char_equal; j := !j + 1 done; if !matched_chars = k then !j - k else -1) @@ -291,12 +291,12 @@ module Search_pattern0 = struct then ( let next_text_char = unsafe_get text j in matched_chars - := kmp_internal_loop - ~matched_chars:!matched_chars - ~next_text_char - ~pattern - ~kmp_array - ~char_equal) + := kmp_internal_loop + ~matched_chars:!matched_chars + ~next_text_char + ~pattern + ~kmp_array + ~char_equal) done; List.rev !found) ;; @@ -320,7 +320,6 @@ module Search_pattern0 = struct Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst ;; - let replace_all t ~in_:s ~with_ = let matches = index_all t ~may_overlap:false ~in_:s in match matches with @@ -382,7 +381,7 @@ module Search_pattern0 = struct (Stdlib.( && ) (equal_bool__local a__003_.case_sensitive b__004_.case_sensitive) (equal_array__local equal_int__local a__003_.kmp_array b__004_.kmp_array)) - : (t[@ocaml.local]) -> (t[@ocaml.local]) -> bool) + : (t[@ocaml.local]) -> (t[@ocaml.local]) -> bool) ;; let equal = (fun a b -> equal__local a b : t -> t -> bool) @@ -392,24 +391,24 @@ module Search_pattern0 = struct ; case_sensitive = case_sensitive__010_ ; kmp_array = kmp_array__012_ } -> - let bnds__007_ = ([] : _ Stdlib.List.t) in - let bnds__007_ = - let arg__013_ = sexp_of_array sexp_of_int kmp_array__012_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "kmp_array"; arg__013_ ] :: bnds__007_ - : _ Stdlib.List.t) - in - let bnds__007_ = - let arg__011_ = sexp_of_bool case_sensitive__010_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "case_sensitive"; arg__011_ ] - :: bnds__007_ - : _ Stdlib.List.t) - in - let bnds__007_ = - let arg__009_ = sexp_of_string pattern__008_ in - (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pattern"; arg__009_ ] :: bnds__007_ - : _ Stdlib.List.t) - in - Sexplib0.Sexp.List bnds__007_ + let bnds__007_ = ([] : _ Stdlib.List.t) in + let bnds__007_ = + let arg__013_ = sexp_of_array sexp_of_int kmp_array__012_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "kmp_array"; arg__013_ ] :: bnds__007_ + : _ Stdlib.List.t) + in + let bnds__007_ = + let arg__011_ = sexp_of_bool case_sensitive__010_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "case_sensitive"; arg__011_ ] + :: bnds__007_ + : _ Stdlib.List.t) + in + let bnds__007_ = + let arg__009_ = sexp_of_string pattern__008_ in + (Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "pattern"; arg__009_ ] :: bnds__007_ + : _ Stdlib.List.t) + in + Sexplib0.Sexp.List bnds__007_ : t -> Sexplib0.Sexp.t) ;; @@ -1359,7 +1358,7 @@ include struct let partition_tf t ~f = partition_map t ~f:(fun c -> if f c then (First c) else (Second c)) [@nontail - ] + ] ;; end @@ -1437,22 +1436,22 @@ module Escaping = struct | Ok escapeworthy -> Ok (fun src -> - (* calculate a list of (index of char to escape * escaped char) first, the order + (* calculate a list of (index of char to escape * escaped char) first, the order is from tail to head *) - let to_escape_len = ref 0 in - let to_escape = - foldi src ~init:[] ~f:(fun i acc c -> - match escapeworthy.(Char.to_int c) with - | -1 -> acc - | n -> - (* (index of char to escape * escaped char) *) - incr to_escape_len; - (i, Char.unsafe_of_int n) :: acc) - in - match to_escape with - | [] -> src - | _ -> - (* [to_escape] divide [src] to [List.length to_escape + 1] pieces separated by + let to_escape_len = ref 0 in + let to_escape = + foldi src ~init:[] ~f:(fun i acc c -> + match escapeworthy.(Char.to_int c) with + | -1 -> acc + | n -> + (* (index of char to escape * escaped char) *) + incr to_escape_len; + (i, Char.unsafe_of_int n) :: acc) + in + match to_escape with + | [] -> src + | _ -> + (* [to_escape] divide [src] to [List.length to_escape + 1] pieces separated by the chars to escape. Lets take @@ -1474,31 +1473,31 @@ module Escaping = struct Finally the result will be "000_A111_B222_C333" *) - let src_len = length src in - let dst_len = src_len + !to_escape_len in - let dst = Bytes.create dst_len in - let rec loop last_idx last_dst_pos = function - | [] -> - (* copy "000" at last *) - Bytes.blit_string ~src ~src_pos:0 ~dst ~dst_pos:0 ~len:last_idx - | (idx, escaped_char) :: to_escape -> - (*[idx] = the char to escape*) - (* take first iteration for example *) - (* calculate length of "333", minus 1 because we don't copy 'c' *) - let len = last_idx - idx - 1 in - (* set the dst_pos to copy to *) - let dst_pos = last_dst_pos - len in - (* copy "333", set [src_pos] to [idx + 1] to skip 'c' *) - Bytes.blit_string ~src ~src_pos:(idx + 1) ~dst ~dst_pos ~len; - (* backoff [dst_pos] by 2 to copy '_' and 'C' *) - let dst_pos = dst_pos - 2 in - Bytes.set dst dst_pos escape_char; - Bytes.set dst (dst_pos + 1) escaped_char; - loop idx dst_pos to_escape - in - (* set [last_dst_pos] and [last_idx] to length of [dst] and [src] first *) - loop src_len dst_len to_escape; - Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) + let src_len = length src in + let dst_len = src_len + !to_escape_len in + let dst = Bytes.create dst_len in + let rec loop last_idx last_dst_pos = function + | [] -> + (* copy "000" at last *) + Bytes.blit_string ~src ~src_pos:0 ~dst ~dst_pos:0 ~len:last_idx + | (idx, escaped_char) :: to_escape -> + (*[idx] = the char to escape*) + (* take first iteration for example *) + (* calculate length of "333", minus 1 because we don't copy 'c' *) + let len = last_idx - idx - 1 in + (* set the dst_pos to copy to *) + let dst_pos = last_dst_pos - len in + (* copy "333", set [src_pos] to [idx + 1] to skip 'c' *) + Bytes.blit_string ~src ~src_pos:(idx + 1) ~dst ~dst_pos ~len; + (* backoff [dst_pos] by 2 to copy '_' and 'C' *) + let dst_pos = dst_pos - 2 in + Bytes.set dst dst_pos escape_char; + Bytes.set dst (dst_pos + 1) escaped_char; + loop idx dst_pos to_escape + in + (* set [last_dst_pos] and [last_idx] to length of [dst] and [src] first *) + loop src_len dst_len to_escape; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) ;; let escape_gen_exn ~escapeworthy_map ~escape_char = @@ -1541,7 +1540,7 @@ module Escaping = struct | Ok escapeworthy -> Ok (fun src -> - (* Continue the example in [escape_gen_exn], now we unescape + (* Continue the example in [escape_gen_exn], now we unescape "000_A111_B222_C333" @@ -1554,59 +1553,59 @@ module Escaping = struct Then we create a string [dst] to store the result, copy "333" to it, then copy 'c', then move on to next iteration. After 3 iterations copy "000" and we are done. *) - (* indexes of escape chars *) - let to_unescape = - let rec loop i status acc = - if i >= length src - then acc - else ( - let status = update_escape_status src ~escape_char i status in - loop - (i + 1) - status - (match status with - | `Escaping -> i :: acc - | `Escaped | `Literal -> acc)) - in - loop 0 `Literal [] - in - match to_unescape with - | [] -> src - | idx :: to_unescape' -> - let dst = Bytes.create (length src - List.length to_unescape) in - let rec loop last_idx last_dst_pos = function - | [] -> - (* copy "000" at last *) - Bytes.blit_string ~src ~src_pos:0 ~dst ~dst_pos:0 ~len:last_idx - | idx :: to_unescape -> - (* [idx] = index of escaping char *) - (* take 1st iteration as example, calculate the length of "333", minus 2 to + (* indexes of escape chars *) + let to_unescape = + let rec loop i status acc = + if i >= length src + then acc + else ( + let status = update_escape_status src ~escape_char i status in + loop + (i + 1) + status + (match status with + | `Escaping -> i :: acc + | `Escaped | `Literal -> acc)) + in + loop 0 `Literal [] + in + match to_unescape with + | [] -> src + | idx :: to_unescape' -> + let dst = Bytes.create (length src - List.length to_unescape) in + let rec loop last_idx last_dst_pos = function + | [] -> + (* copy "000" at last *) + Bytes.blit_string ~src ~src_pos:0 ~dst ~dst_pos:0 ~len:last_idx + | idx :: to_unescape -> + (* [idx] = index of escaping char *) + (* take 1st iteration as example, calculate the length of "333", minus 2 to skip '_C' *) - let len = last_idx - idx - 2 in - (* point [dst_pos] to the position to copy "333" to *) - let dst_pos = last_dst_pos - len in - (* copy "333" *) - Bytes.blit_string ~src ~src_pos:(idx + 2) ~dst ~dst_pos ~len; - (* backoff [dst_pos] by 1 to copy 'c' *) - let dst_pos = dst_pos - 1 in - Bytes.set - dst - dst_pos - (match escapeworthy.(Char.to_int src.[idx + 1]) with - | -1 -> src.[idx + 1] - | n -> Char.unsafe_of_int n); - (* update [last_dst_pos] and [last_idx] *) - loop idx dst_pos to_unescape - in - if idx < length src - 1 - then - (* set [last_dst_pos] and [last_idx] to length of [dst] and [src] *) - loop (length src) (Bytes.length dst) to_unescape - else - (* for escaped string ending with an escaping char like "000_", just ignore + let len = last_idx - idx - 2 in + (* point [dst_pos] to the position to copy "333" to *) + let dst_pos = last_dst_pos - len in + (* copy "333" *) + Bytes.blit_string ~src ~src_pos:(idx + 2) ~dst ~dst_pos ~len; + (* backoff [dst_pos] by 1 to copy 'c' *) + let dst_pos = dst_pos - 1 in + Bytes.set + dst + dst_pos + (match escapeworthy.(Char.to_int src.[idx + 1]) with + | -1 -> src.[idx + 1] + | n -> Char.unsafe_of_int n); + (* update [last_dst_pos] and [last_idx] *) + loop idx dst_pos to_unescape + in + if idx < length src - 1 + then + (* set [last_dst_pos] and [last_idx] to length of [dst] and [src] *) + loop (length src) (Bytes.length dst) to_unescape + else + (* for escaped string ending with an escaping char like "000_", just ignore the last escaping char *) - loop (length src - 1) (Bytes.length dst) to_unescape'; - Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) + loop (length src - 1) (Bytes.length dst) to_unescape'; + Bytes.unsafe_to_string ~no_mutation_while_string_reachable:dst) ;; let unescape_gen_exn ~escapeworthy_map ~escape_char = @@ -1676,10 +1675,10 @@ module Escaping = struct check_bound str pos "index_from"; let rec loop i status = if i >= pos - && (match status with - | `Literal -> true - | `Escaped | `Escaping -> false) - && Char.equal str.[i] char + && (match status with + | `Literal -> true + | `Escaped | `Escaping -> false) + && Char.equal str.[i] char then Some i else ( let i = i + 1 in @@ -1763,9 +1762,9 @@ module Escaping = struct else ( let status = update_escape_status str ~escape_char pos status in if (match status with - | `Literal -> true - | `Escaped | `Escaping -> false) - && is_delim str.[pos] + | `Literal -> true + | `Escaped | `Escaping -> false) + && is_delim str.[pos] then ( let sub_str = sub str ~pos:last_pos ~len:(pos - last_pos) in loop (sub_str :: acc) status (pos + 1) (pos + 1)) diff --git a/src/string.mli b/src/string.mli index c81f784e..3a249d79 100644 --- a/src/string.mli +++ b/src/string.mli @@ -117,8 +117,6 @@ val index : t -> char -> int option val index_exn : t -> char -> int val index_from : t -> int -> char -> int option val index_from_exn : t -> int -> char -> int - - val rindex : t -> char -> int option val rindex_exn : t -> char -> int val rindex_from : t -> int -> char -> int option @@ -395,14 +393,13 @@ val concat_lines : ?crlf:bool (** default [false] *) -> string list -> string (** Slightly faster hash function on strings. *) external hash : t -> int = "Base_hash_string" -[@@noalloc] + [@@noalloc] (** Fast equality function on strings, doesn't use [compare_val]. *) val equal : t -> t -> bool val equal__local : (t[@local]) -> (t[@local]) -> bool val of_char : char -> t - val of_char_list : char list -> t (** [pad_left ?char s ~len] returns [s] padded to the length [len] by adding characters @@ -500,7 +497,6 @@ module Escaping : sig val rindex_exn : string -> escape_char:char -> char -> int - (** [index_from s ~escape_char pos char] finds the first literal (not escaped) instance of [char] in [s] starting from [pos] and proceeding towards the end of [s]. *) val index_from : string -> escape_char:char -> int -> char -> int option @@ -529,7 +525,6 @@ module Escaping : sig ["foo_|bar"; "baz"; "0"]]. *) val split_on_chars : string -> on:char list -> escape_char:char -> string list - (** [lsplit2 s ~on ~escape_char] splits s into a pair on the first literal instance of [on] (meaning the first unescaped instance) starting from the left. *) val lsplit2 : string -> on:char -> escape_char:char -> (string * string) option diff --git a/src/sys.mli b/src/sys.mli index 1f6ca925..d2fc75ce 100644 --- a/src/sys.mli +++ b/src/sys.mli @@ -13,9 +13,9 @@ val get_argv : unit -> string array (** A single result from [get_argv ()]. This value is indefinitely deprecated. It is kept for compatibility with {!Stdlib.Sys}. *) val argv : string array -[@@deprecated - "[since 2019-08] Use [Sys.get_argv] instead, which has the correct behavior when \ - [caml_sys_modify_argv] is called."] + [@@deprecated + "[since 2019-08] Use [Sys.get_argv] instead, which has the correct behavior when \ + [caml_sys_modify_argv] is called."] (** [interactive] is set to [true] when being executed in the [ocaml] REPL, and [false] otherwise. *) @@ -108,7 +108,6 @@ val getenv : string -> string option val getenv_exn : string -> string - (** For the purposes of optimization, [opaque_identity] behaves like an unknown (and thus possibly side-effecting) function. At runtime, [opaque_identity] disappears altogether. A typical use of this function is to prevent pure computations from being diff --git a/src/type_equal.ml b/src/type_equal.ml index 53c92d2a..4ed747ff 100644 --- a/src/type_equal.ml +++ b/src/type_equal.ml @@ -3,13 +3,13 @@ open! Import type ('a, 'b) t = T : ('a, 'a) t [@@deriving_inline sexp_of] let sexp_of_t : - 'a 'b. - ('a -> Sexplib0.Sexp.t) -> ('b -> Sexplib0.Sexp.t) -> ('a, 'b) t -> Sexplib0.Sexp.t + 'a 'b. + ('a -> Sexplib0.Sexp.t) -> ('b -> Sexplib0.Sexp.t) -> ('a, 'b) t -> Sexplib0.Sexp.t = fun (type a__003_ b__004_) - : ((a__003_ -> Sexplib0.Sexp.t) -> (b__004_ -> Sexplib0.Sexp.t) - -> (a__003_, b__004_) t -> Sexplib0.Sexp.t) -> - fun _of_a__001_ _of_b__002_ T -> Sexplib0.Sexp.Atom "T" + : ((a__003_ -> Sexplib0.Sexp.t) -> (b__004_ -> Sexplib0.Sexp.t) + -> (a__003_, b__004_) t -> Sexplib0.Sexp.t) -> + fun _of_a__001_ _of_b__002_ T -> Sexplib0.Sexp.Atom "T" ;; [@@@end] @@ -17,8 +17,8 @@ let sexp_of_t : type ('a, 'b) equal = ('a, 'b) t include Type_equal_intf.Definitions (struct - type ('a, 'b) t = ('a, 'b) equal - end) + type ('a, 'b) t = ('a, 'b) equal +end) let refl = T let sym (type a b) (T : (a, b) t) : (b, a) t = T @@ -26,15 +26,15 @@ let trans (type a b c) (T : (a, b) t) (T : (b, c) t) : (a, c) t = T let conv (type a b) (T : (a, b) t) (a : a) : b = a module Lift (X : sig - type 'a t - end) = + type 'a t +end) = struct let lift (type a b) (T : (a, b) t) : (a X.t, b X.t) t = T end module Lift2 (X : sig - type ('a1, 'a2) t - end) = + type ('a1, 'a2) t +end) = struct let lift (type a1 b1 a2 b2) (T : (a1, b1) t) (T : (a2, b2) t) : ((a1, a2) X.t, (b1, b2) X.t) t @@ -44,8 +44,8 @@ struct end module Lift3 (X : sig - type ('a1, 'a2, 'a3) t - end) = + type ('a1, 'a2, 'a3) t +end) = struct let lift (type a1 b1 a2 b2 a3 b3) (T : (a1, b1) t) (T : (a2, b2) t) (T : (a3, b3) t) : ((a1, a2, a3) X.t, (b1, b2, b3) X.t) t @@ -71,7 +71,7 @@ module Id = struct let sexp_of_type_witness_int = (fun (`type_witness v__005_) -> Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "type_witness"; sexp_of_int v__005_ ] - : type_witness_int -> Sexplib0.Sexp.t) + : type_witness_int -> Sexplib0.Sexp.t) ;; [@@@end] @@ -123,7 +123,6 @@ module Id = struct ;; end - type 'a t = { witness : 'a Witness.t ; name : string diff --git a/src/type_equal_intf.ml b/src/type_equal_intf.ml index f7d96f58..b52deccb 100644 --- a/src/type_equal_intf.ml +++ b/src/type_equal_intf.ml @@ -169,8 +169,8 @@ module type Type_equal = sig (** @inline *) include module type of Definitions (struct - type ('a, 'b) t = ('a, 'b) equal - end) + type ('a, 'b) t = ('a, 'b) equal + end) (** [refl], [sym], and [trans] construct proofs that type equality is reflexive, symmetric, and transitive. *) diff --git a/src/uniform_array.ml b/src/uniform_array.ml index 0361ac75..6f7f6cb4 100644 --- a/src/uniform_array.ml +++ b/src/uniform_array.ml @@ -220,7 +220,7 @@ let concat ts = set res (so_far + i) (get t i) done; so_far + len) - : int); + : int); res ;; @@ -309,20 +309,20 @@ include end) include Blit.Make1 (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let length = length + let length = length - let create_like ~len t = - if len = 0 - then empty - else ( - assert (length t > 0); - create ~len (get t 0)) - ;; + let create_like ~len t = + if len = 0 + then empty + else ( + assert (length t > 0); + create ~len (get t 0)) + ;; - let unsafe_blit = unsafe_blit - end) + let unsafe_blit = unsafe_blit +end) let min_elt t ~compare = Container.min_elt ~fold t ~compare let max_elt t ~compare = Container.max_elt ~fold t ~compare @@ -353,18 +353,18 @@ let compare__local compare_elt a b = let compare compare_elt a b = compare__local compare_elt a b module Sort = Array.Private.Sorter (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let length = length - let get = unsafe_get - let set = unsafe_set - end) + let length = length + let get = unsafe_get + let set = unsafe_set +end) let sort = Sort.sort include Binary_searchable.Make1 (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let length = length - let get = unsafe_get - end) + let length = length + let get = unsafe_get +end) diff --git a/src/uniform_array.mli b/src/uniform_array.mli index aa7b42af..6103e2f8 100644 --- a/src/uniform_array.mli +++ b/src/uniform_array.mli @@ -6,7 +6,6 @@ It can often be faster than [Array] if you use it with non-floats. *) - open! Import (** See [Base.Array] for comments. *) @@ -22,8 +21,6 @@ include Ppx_compare_lib.Comparable.S_local1 with type 'a t := 'a t [@@@end] val invariant : _ t -> unit - - val empty : _ t val create : len:int -> 'a -> 'a t val singleton : 'a -> 'a t @@ -132,7 +129,6 @@ val unsafe_set_assuming_currently_int : Stdlib.Obj.t t -> int -> Stdlib.Obj.t -> val unsafe_set_int_assuming_currently_int : Stdlib.Obj.t t -> int -> int -> unit val unsafe_set_int : Stdlib.Obj.t t -> int -> int -> unit - (** [unsafe_clear_if_pointer t i] prevents [t.(i)] from pointing to anything to prevent space leaks. It does this by setting [t.(i)] to [Stdlib.Obj.repr 0]. As a performance hack, it only does this when [not (Stdlib.Obj.is_int t.(i))]. It is an error to access diff --git a/src/variant.mli b/src/variant.mli index 6f772f89..ba0e7e2b 100644 --- a/src/variant.mli +++ b/src/variant.mli @@ -3,7 +3,7 @@ type 'constructor t = { name : string - (** The position of the constructor in the type definition, starting from 0 *) + (** The position of the constructor in the type definition, starting from 0 *) ; rank : int ; constructor : 'constructor } diff --git a/src/with_return.mli b/src/with_return.mli index 6623a93f..83bc57d0 100644 --- a/src/with_return.mli +++ b/src/with_return.mli @@ -1,4 +1,3 @@ - (** [with_return f] allows for something like the return statement in C within [f]. There are three ways [f] can terminate: diff --git a/src/word_size.ml b/src/word_size.ml index c828842b..91e80579 100644 --- a/src/word_size.ml +++ b/src/word_size.ml @@ -8,9 +8,9 @@ type t = let sexp_of_t = (function - | W32 -> Sexplib0.Sexp.Atom "W32" - | W64 -> Sexplib0.Sexp.Atom "W64" - : t -> Sexplib0.Sexp.t) + | W32 -> Sexplib0.Sexp.Atom "W32" + | W64 -> Sexplib0.Sexp.Atom "W64" + : t -> Sexplib0.Sexp.t) ;; [@@@end] diff --git a/test/allocation/test_string_allocation.ml b/test/allocation/test_string_allocation.ml index e3e09a19..119163ae 100644 --- a/test/allocation/test_string_allocation.ml +++ b/test/allocation/test_string_allocation.ml @@ -93,10 +93,10 @@ let%test_module "common prefix and suffix" = Option.iter (get_shortest_and_longest list) ~f:(fun (shortest, longest) -> ignore (require_no_allocation [%here] (fun () -> get_common2 shortest longest) - : string); + : string); ignore (require_no_allocation [%here] (fun () -> get_common2 longest shortest) - : string)))) + : string)))) ;; let test_prefix = diff --git a/test/avltree_unit_tests.ml b/test/avltree_unit_tests.ml index bcb0ead3..d132df53 100644 --- a/test/avltree_unit_tests.ml +++ b/test/avltree_unit_tests.ml @@ -2,428 +2,428 @@ open! Import let%test_module _ = (module ( - struct - open Avltree - - type ('k, 'v) t = ('k, 'v) Avltree.t = private - | Empty - | Node of - { mutable left : ('k, 'v) t - ; key : 'k - ; mutable value : 'v - ; mutable height : int - ; mutable right : ('k, 'v) t - } - | Leaf of - { key : 'k - ; mutable value : 'v - } - - module For_quickcheck = struct - module Key = struct - include Int - - type t = int [@@deriving quickcheck] - - let quickcheck_generator = - Base_quickcheck.Generator.small_positive_or_zero_int - ;; - end - - module Data = struct - include String - - type t = string [@@deriving quickcheck] - - let quickcheck_generator = - Base_quickcheck.Generator.string_of - Base_quickcheck.Generator.char_lowercase - ;; - end - - let compare = Key.compare - - module Constructor = struct - type t = - | Add of Key.t * Data.t - | Replace of Key.t * Data.t - | Remove of Key.t - [@@deriving quickcheck, sexp_of] - - let apply_to_tree t tree = - match t with - | Add (key, data) -> - add tree ~key ~data ~compare ~added:(ref false) ~replace:false - | Replace (key, data) -> - add tree ~key ~data ~compare ~added:(ref false) ~replace:true - | Remove key -> remove tree key ~compare ~removed:(ref false) - ;; - - let apply_to_map t map = - match t with - | Add (key, data) -> - if Map.mem map key then map else Map.set map ~key ~data - | Replace (key, data) -> Map.set map ~key ~data - | Remove key -> Map.remove map key - ;; - end - - module Constructors = struct - type t = Constructor.t list [@@deriving quickcheck, sexp_of] - end - - let reify constructors = - List.fold - constructors - ~init:(empty, Map.empty (module Key)) - ~f:(fun (t, map) constructor -> - ( Constructor.apply_to_tree constructor t - , Constructor.apply_to_map constructor map )) - ;; - - let merge map1 map2 = - Map.merge map1 map2 ~f:(fun ~key variant -> - match variant with - | `Left data | `Right data -> Some data - | `Both (data1, data2) -> - Error.raise_s - [%message - "duplicate data for key" - (key : Key.t) - (data1 : Data.t) - (data2 : Data.t)]) - ;; - - let rec to_map = function - | Empty -> Map.empty (module Key) - | Leaf { key; value = data } -> Map.singleton (module Key) key data - | Node { left; key; value = data; height = _; right } -> - merge - (Map.singleton (module Key) key data) - (merge (to_map left) (to_map right)) - ;; - end - - open For_quickcheck - - let empty = empty - - let%test_unit _ = - match empty with - | Empty -> () - | _ -> assert false - ;; - - let is_empty = is_empty - let%test _ = is_empty empty - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: bool] (is_empty t) ~expect:(Map.is_empty map)) - ;; - - let invariant = invariant - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - invariant t ~compare; - [%test_result: Data.t Map.M(Key).t] (to_map t) ~expect:map) - ;; - - let add = add - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructor.t list * Key.t * Data.t * bool - [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key, data, replace) -> - let t, map = reify constructors in - (* test [added], other aspects of [add] are tested via [reify] in the + struct + open Avltree + + type ('k, 'v) t = ('k, 'v) Avltree.t = private + | Empty + | Node of + { mutable left : ('k, 'v) t + ; key : 'k + ; mutable value : 'v + ; mutable height : int + ; mutable right : ('k, 'v) t + } + | Leaf of + { key : 'k + ; mutable value : 'v + } + + module For_quickcheck = struct + module Key = struct + include Int + + type t = int [@@deriving quickcheck] + + let quickcheck_generator = + Base_quickcheck.Generator.small_positive_or_zero_int + ;; + end + + module Data = struct + include String + + type t = string [@@deriving quickcheck] + + let quickcheck_generator = + Base_quickcheck.Generator.string_of + Base_quickcheck.Generator.char_lowercase + ;; + end + + let compare = Key.compare + + module Constructor = struct + type t = + | Add of Key.t * Data.t + | Replace of Key.t * Data.t + | Remove of Key.t + [@@deriving quickcheck, sexp_of] + + let apply_to_tree t tree = + match t with + | Add (key, data) -> + add tree ~key ~data ~compare ~added:(ref false) ~replace:false + | Replace (key, data) -> + add tree ~key ~data ~compare ~added:(ref false) ~replace:true + | Remove key -> remove tree key ~compare ~removed:(ref false) + ;; + + let apply_to_map t map = + match t with + | Add (key, data) -> + if Map.mem map key then map else Map.set map ~key ~data + | Replace (key, data) -> Map.set map ~key ~data + | Remove key -> Map.remove map key + ;; + end + + module Constructors = struct + type t = Constructor.t list [@@deriving quickcheck, sexp_of] + end + + let reify constructors = + List.fold + constructors + ~init:(empty, Map.empty (module Key)) + ~f:(fun (t, map) constructor -> + ( Constructor.apply_to_tree constructor t + , Constructor.apply_to_map constructor map )) + ;; + + let merge map1 map2 = + Map.merge map1 map2 ~f:(fun ~key variant -> + match variant with + | `Left data | `Right data -> Some data + | `Both (data1, data2) -> + Error.raise_s + [%message + "duplicate data for key" + (key : Key.t) + (data1 : Data.t) + (data2 : Data.t)]) + ;; + + let rec to_map = function + | Empty -> Map.empty (module Key) + | Leaf { key; value = data } -> Map.singleton (module Key) key data + | Node { left; key; value = data; height = _; right } -> + merge + (Map.singleton (module Key) key data) + (merge (to_map left) (to_map right)) + ;; + end + + open For_quickcheck + + let empty = empty + + let%test_unit _ = + match empty with + | Empty -> () + | _ -> assert false + ;; + + let is_empty = is_empty + let%test _ = is_empty empty + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: bool] (is_empty t) ~expect:(Map.is_empty map)) + ;; + + let invariant = invariant + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + invariant t ~compare; + [%test_result: Data.t Map.M(Key).t] (to_map t) ~expect:map) + ;; + + let add = add + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructor.t list * Key.t * Data.t * bool + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, data, replace) -> + let t, map = reify constructors in + (* test [added], other aspects of [add] are tested via [reify] in the [invariant] test above *) - let added = ref false in - let (_ : (Key.t, Data.t) t) = - add t ~key ~data ~compare ~added ~replace - in - [%test_result: bool] !added ~expect:(not (Map.mem map key))) - ;; - - let remove = remove - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key) -> - let t, map = reify constructors in - (* test [removed], other aspects of [remove] are tested via [reify] in the + let added = ref false in + let (_ : (Key.t, Data.t) t) = + add t ~key ~data ~compare ~added ~replace + in + [%test_result: bool] !added ~expect:(not (Map.mem map key))) + ;; + + let remove = remove + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + (* test [removed], other aspects of [remove] are tested via [reify] in the [invariant] test above *) - let removed = ref false in - let (_ : (Key.t, Data.t) t) = remove t key ~compare ~removed in - [%test_result: bool] !removed ~expect:(Map.mem map key)) - ;; - - let find = find - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key) -> - let t, map = reify constructors in - [%test_result: Data.t option] - (find t key ~compare) - ~expect:(Map.find map key)) - ;; - - let mem = mem - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key) -> - let t, map = reify constructors in - [%test_result: bool] (mem t key ~compare) ~expect:(Map.mem map key)) - ;; - - let first = first - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: (Key.t * Data.t) option] - (first t) - ~expect:(Map.min_elt map)) - ;; - - let last = last - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: (Key.t * Data.t) option] - (last t) - ~expect:(Map.max_elt map)) - ;; - - let find_and_call = find_and_call - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key) -> - let t, map = reify constructors in - [%test_result: [ `Found of Data.t | `Not_found of Key.t ]] - (find_and_call - t - key - ~compare - ~if_found:(fun data -> `Found data) - ~if_not_found:(fun key -> `Not_found key)) - ~expect: - (match Map.find map key with - | None -> `Not_found key - | Some data -> `Found data)) - ;; - - let findi_and_call = findi_and_call - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key) -> - let t, map = reify constructors in - [%test_result: [ `Found of Key.t * Data.t | `Not_found of Key.t ]] - (findi_and_call - t - key - ~compare - ~if_found:(fun ~key ~data -> `Found (key, data)) - ~if_not_found:(fun key -> `Not_found key)) - ~expect: - (match Map.find map key with - | None -> `Not_found key - | Some data -> `Found (key, data))) - ;; - - let find_and_call1 = find_and_call1 - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t * int - [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key, a) -> - let t, map = reify constructors in - [%test_result: - [ `Found of Data.t * int | `Not_found of Key.t * int ]] - (find_and_call1 - t - key - ~compare - ~a - ~if_found:(fun data a -> `Found (data, a)) - ~if_not_found:(fun key a -> `Not_found (key, a))) - ~expect: - (match Map.find map key with - | None -> `Not_found (key, a) - | Some data -> `Found (data, a))) - ;; - - let findi_and_call1 = findi_and_call1 - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t * int - [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key, a) -> - let t, map = reify constructors in - [%test_result: - [ `Found of Key.t * Data.t * int | `Not_found of Key.t * int ]] - (findi_and_call1 - t - key - ~compare - ~a - ~if_found:(fun ~key ~data a -> `Found (key, data, a)) - ~if_not_found:(fun key a -> `Not_found (key, a))) - ~expect: - (match Map.find map key with - | None -> `Not_found (key, a) - | Some data -> `Found (key, data, a))) - ;; - - let find_and_call2 = find_and_call2 - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t * int * string - [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key, a, b) -> - let t, map = reify constructors in - [%test_result: - [ `Found of Data.t * int * string - | `Not_found of Key.t * int * string - ]] - (find_and_call2 - t - key - ~compare - ~a - ~b - ~if_found:(fun data a b -> `Found (data, a, b)) - ~if_not_found:(fun key a b -> `Not_found (key, a, b))) - ~expect: - (match Map.find map key with - | None -> `Not_found (key, a, b) - | Some data -> `Found (data, a, b))) - ;; - - let findi_and_call2 = findi_and_call2 - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module struct - type t = Constructors.t * Key.t * int * string - [@@deriving quickcheck, sexp_of] - end) - ~f:(fun (constructors, key, a, b) -> - let t, map = reify constructors in - [%test_result: - [ `Found of Key.t * Data.t * int * string - | `Not_found of Key.t * int * string - ]] - (findi_and_call2 - t - key - ~compare - ~a - ~b - ~if_found:(fun ~key ~data a b -> `Found (key, data, a, b)) - ~if_not_found:(fun key a b -> `Not_found (key, a, b))) - ~expect: - (match Map.find map key with - | None -> `Not_found (key, a, b) - | Some data -> `Found (key, data, a, b))) - ;; - - let iter = iter - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: (Key.t * Data.t) list] - (let q = Queue.create () in - iter t ~f:(fun ~key ~data -> Queue.enqueue q (key, data)); - Queue.to_list q) - ~expect:(Map.to_alist map)) - ;; - - let mapi_inplace = mapi_inplace - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: (Key.t * Data.t) list] - (mapi_inplace t ~f:(fun ~key:_ ~data -> data ^ data); - fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc)) - ~expect: - (Map.map map ~f:(fun data -> data ^ data) - |> Map.to_alist - |> List.rev)) - ;; - - let fold = fold - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: (Key.t * Data.t) list] - (fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc)) - ~expect:(Map.to_alist map |> List.rev)) - ;; - - let choose_exn = choose_exn - - let%test_unit _ = - Base_quickcheck.Test.run_exn - (module Constructors) - ~f:(fun constructors -> - let t, map = reify constructors in - [%test_result: bool] - (is_some (Option.try_with (fun () -> choose_exn t))) - ~expect:(not (Map.is_empty map))) - ;; - end : - module type of Avltree)) + let removed = ref false in + let (_ : (Key.t, Data.t) t) = remove t key ~compare ~removed in + [%test_result: bool] !removed ~expect:(Map.mem map key)) + ;; + + let find = find + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: Data.t option] + (find t key ~compare) + ~expect:(Map.find map key)) + ;; + + let mem = mem + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: bool] (mem t key ~compare) ~expect:(Map.mem map key)) + ;; + + let first = first + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) option] + (first t) + ~expect:(Map.min_elt map)) + ;; + + let last = last + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) option] + (last t) + ~expect:(Map.max_elt map)) + ;; + + let find_and_call = find_and_call + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: [ `Found of Data.t | `Not_found of Key.t ]] + (find_and_call + t + key + ~compare + ~if_found:(fun data -> `Found data) + ~if_not_found:(fun key -> `Not_found key)) + ~expect: + (match Map.find map key with + | None -> `Not_found key + | Some data -> `Found data)) + ;; + + let findi_and_call = findi_and_call + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key) -> + let t, map = reify constructors in + [%test_result: [ `Found of Key.t * Data.t | `Not_found of Key.t ]] + (findi_and_call + t + key + ~compare + ~if_found:(fun ~key ~data -> `Found (key, data)) + ~if_not_found:(fun key -> `Not_found key)) + ~expect: + (match Map.find map key with + | None -> `Not_found key + | Some data -> `Found (key, data))) + ;; + + let find_and_call1 = find_and_call1 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Data.t * int | `Not_found of Key.t * int ]] + (find_and_call1 + t + key + ~compare + ~a + ~if_found:(fun data a -> `Found (data, a)) + ~if_not_found:(fun key a -> `Not_found (key, a))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a) + | Some data -> `Found (data, a))) + ;; + + let findi_and_call1 = findi_and_call1 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Key.t * Data.t * int | `Not_found of Key.t * int ]] + (findi_and_call1 + t + key + ~compare + ~a + ~if_found:(fun ~key ~data a -> `Found (key, data, a)) + ~if_not_found:(fun key a -> `Not_found (key, a))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a) + | Some data -> `Found (key, data, a))) + ;; + + let find_and_call2 = find_and_call2 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int * string + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a, b) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Data.t * int * string + | `Not_found of Key.t * int * string + ]] + (find_and_call2 + t + key + ~compare + ~a + ~b + ~if_found:(fun data a b -> `Found (data, a, b)) + ~if_not_found:(fun key a b -> `Not_found (key, a, b))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a, b) + | Some data -> `Found (data, a, b))) + ;; + + let findi_and_call2 = findi_and_call2 + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module struct + type t = Constructors.t * Key.t * int * string + [@@deriving quickcheck, sexp_of] + end) + ~f:(fun (constructors, key, a, b) -> + let t, map = reify constructors in + [%test_result: + [ `Found of Key.t * Data.t * int * string + | `Not_found of Key.t * int * string + ]] + (findi_and_call2 + t + key + ~compare + ~a + ~b + ~if_found:(fun ~key ~data a b -> `Found (key, data, a, b)) + ~if_not_found:(fun key a b -> `Not_found (key, a, b))) + ~expect: + (match Map.find map key with + | None -> `Not_found (key, a, b) + | Some data -> `Found (key, data, a, b))) + ;; + + let iter = iter + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) list] + (let q = Queue.create () in + iter t ~f:(fun ~key ~data -> Queue.enqueue q (key, data)); + Queue.to_list q) + ~expect:(Map.to_alist map)) + ;; + + let mapi_inplace = mapi_inplace + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) list] + (mapi_inplace t ~f:(fun ~key:_ ~data -> data ^ data); + fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc)) + ~expect: + (Map.map map ~f:(fun data -> data ^ data) + |> Map.to_alist + |> List.rev)) + ;; + + let fold = fold + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: (Key.t * Data.t) list] + (fold t ~init:[] ~f:(fun ~key ~data acc -> (key, data) :: acc)) + ~expect:(Map.to_alist map |> List.rev)) + ;; + + let choose_exn = choose_exn + + let%test_unit _ = + Base_quickcheck.Test.run_exn + (module Constructors) + ~f:(fun constructors -> + let t, map = reify constructors in + [%test_result: bool] + (is_some (Option.try_with (fun () -> choose_exn t))) + ~expect:(not (Map.is_empty map))) + ;; + end : + module type of Avltree)) ;; diff --git a/test/hashtbl_tests.ml b/test/hashtbl_tests.ml index f292039f..f8a39289 100644 --- a/test/hashtbl_tests.ml +++ b/test/hashtbl_tests.ml @@ -345,13 +345,13 @@ end [Creators_generic]. *) module _ : sig end = struct module Make_creators_check - (Type : T.T2) - (Key : T.T1) - (Options : T.T3) - (_ : Hashtbl.Private.Creators_generic - with type ('a, 'b) t := ('a, 'b) Type.t - with type 'a key := 'a Key.t - with type ('a, 'b, 'z) create_options := ('a, 'b, 'z) Options.t) = + (Type : T.T2) + (Key : T.T1) + (Options : T.T3) + (_ : Hashtbl.Private.Creators_generic + with type ('a, 'b) t := ('a, 'b) Type.t + with type 'a key := 'a Key.t + with type ('a, 'b, 'z) create_options := ('a, 'b, 'z) Options.t) = struct end module _ (M : Hashtbl.Creators) = diff --git a/test/helpers/test_container.ml b/test/helpers/test_container.ml index c63c73dc..53cc99d4 100644 --- a/test/helpers/test_container.ml +++ b/test/helpers/test_container.ml @@ -2,18 +2,18 @@ open! Base open! Container module Test_generic (Elt : sig - type 'a t + type 'a t - val of_int : int -> int t - val to_int : int t -> int - end) (Container : sig - type 'a t [@@deriving sexp] + val of_int : int -> int t + val to_int : int t -> int +end) (Container : sig + type 'a t [@@deriving sexp] - include Generic with type ('a, _) t := 'a t with type 'a elt := 'a Elt.t + include Generic with type ('a, _) t := 'a t with type 'a elt := 'a Elt.t - val mem : 'a t -> 'a Elt.t -> equal:(('a Elt.t -> 'a Elt.t -> bool)[@local]) -> bool - val of_list : 'a Elt.t list -> [ `Ok of 'a t | `Skip_test ] - end) : sig + val mem : 'a t -> 'a Elt.t -> equal:(('a Elt.t -> 'a Elt.t -> bool)[@local]) -> bool + val of_list : 'a Elt.t list -> [ `Ok of 'a t | `Skip_test ] +end) : sig type 'a t [@@deriving sexp] include Generic with type ('a, _) t := 'a t @@ -142,12 +142,12 @@ struct end module Test_S1_allow_skipping_tests (Container : sig - type 'a t [@@deriving sexp] + type 'a t [@@deriving sexp] - include Container.S1 with type 'a t := 'a t + include Container.S1 with type 'a t := 'a t - val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ] - end) = + val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ] +end) = struct include Test_generic @@ -161,32 +161,32 @@ struct end module Test_S1 (Container : sig - type 'a t [@@deriving sexp] + type 'a t [@@deriving sexp] - include Container.S1 with type 'a t := 'a t + include Container.S1 with type 'a t := 'a t - val of_list : 'a list -> 'a t - end) = - Test_S1_allow_skipping_tests (struct - include Container + val of_list : 'a list -> 'a t +end) = +Test_S1_allow_skipping_tests (struct + include Container - let of_list l = `Ok (of_list l) - end) + let of_list l = `Ok (of_list l) +end) module Test_S0 (Container : sig - module Elt : sig - type t [@@deriving sexp] + module Elt : sig + type t [@@deriving sexp] - val of_int : int -> t - val to_int : t -> int - end + val of_int : int -> t + val to_int : t -> int + end - type t [@@deriving sexp] + type t [@@deriving sexp] - include Container.S0 with type t := t and type elt := Elt.t + include Container.S0 with type t := t and type elt := Elt.t - val of_list : Elt.t list -> t - end) = + val of_list : Elt.t list -> t +end) = struct include Test_generic diff --git a/test/helpers/test_container.mli b/test/helpers/test_container.mli index c33f2dda..6dbab817 100644 --- a/test/helpers/test_container.mli +++ b/test/helpers/test_container.mli @@ -2,12 +2,12 @@ open! Base open! Container module Test_S1_allow_skipping_tests (Container : sig - type 'a t [@@deriving sexp] + type 'a t [@@deriving sexp] - include Container.S1 with type 'a t := 'a t + include Container.S1 with type 'a t := 'a t - val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ] - end) : sig + val of_list : 'a list -> [ `Ok of 'a t | `Skip_test ] +end) : sig type 'a t [@@deriving sexp] include Generic with type ('a, _) t := 'a t @@ -18,12 +18,12 @@ with type 'a t := 'a Container.t with type 'a elt := 'a module Test_S1 (Container : sig - type 'a t [@@deriving sexp] + type 'a t [@@deriving sexp] - include Container.S1 with type 'a t := 'a t + include Container.S1 with type 'a t := 'a t - val of_list : 'a list -> 'a t - end) : sig + val of_list : 'a list -> 'a t +end) : sig type 'a t [@@deriving sexp] include Generic with type ('a, _) t := 'a t @@ -34,19 +34,19 @@ with type 'a t := 'a Container.t with type 'a elt := 'a module Test_S0 (Container : sig - module Elt : sig - type t [@@deriving sexp] + module Elt : sig + type t [@@deriving sexp] - val of_int : int -> t - val to_int : t -> int - end + val of_int : int -> t + val to_int : t -> int + end - type t [@@deriving sexp] + type t [@@deriving sexp] - include Container.S0 with type t := t and type elt := Elt.t + include Container.S0 with type t := t and type elt := Elt.t - val of_list : Elt.t list -> t - end) : sig + val of_list : Elt.t list -> t +end) : sig type 'a t [@@deriving sexp] include Generic with type ('a, _) t := 'a t diff --git a/test/test_applicative.ml b/test/test_applicative.ml index 457bb183..45d4ba6e 100644 --- a/test/test_applicative.ml +++ b/test/test_applicative.ml @@ -197,32 +197,32 @@ end let%test_module "Make" = (module Test_applicative_s (Applicative.Make (struct - type 'a t = 'a Or_error.t + type 'a t = 'a Or_error.t - let return = Or_error.return - let apply = Or_error.apply - let map = `Define_using_apply - end))) + let return = Or_error.return + let apply = Or_error.apply + let map = `Define_using_apply + end))) ;; let%test_module "Make" = (module Test_applicative_s (Applicative.Make_using_map2 (struct - type 'a t = 'a Or_error.t + type 'a t = 'a Or_error.t - let return = Or_error.return - let map2 = Or_error.map2 - let map = `Define_using_map2 - end))) + let return = Or_error.return + let map2 = Or_error.map2 + let map = `Define_using_map2 + end))) ;; let%test_module "Make" = (module Test_applicative_s (Applicative.Make_using_map2_local (struct - type 'a t = 'a Or_error.t + type 'a t = 'a Or_error.t - let return x = Ok x - let map2 = Or_error.map2 - let map = `Define_using_map2 - end))) + let return x = Ok x + let map2 = Or_error.map2 + let map = `Define_using_map2 + end))) ;; (* While law-abiding applicatives shouldn't be relying functions being called @@ -243,12 +243,12 @@ let%expect_test _ = | Map2 : ('a -> 'b -> 'c) * 'a t * 'b t -> 'c t include Applicative.Make_using_map2 (struct - type nonrec 'a t = 'a t + type nonrec 'a t = 'a t - let return x = Return x - let map2 a b ~f = Map2 (f, a, b) - let map = `Custom (fun a ~f -> Map (f, a)) - end) + let return x = Return x + let map2 a b ~f = Map2 (f, a, b) + let map = `Custom (fun a ~f -> Map (f, a)) + end) let rec sexp_of_t : type a. a t -> Sexp.t = function | Other x -> Atom x diff --git a/test/test_array.ml b/test/test_array.ml index c7a96506..8a959c94 100644 --- a/test/test_array.ml +++ b/test/test_array.ml @@ -3,24 +3,24 @@ open! Array let%test_module "Binary_searchable" = (module Test_binary_searchable.Test1 (struct - include Array + include Array - module For_test = struct - let of_array = Fn.id - end - end)) + module For_test = struct + let of_array = Fn.id + end + end)) ;; let%test_module "Blit" = (module Test_blit.Test1 - (struct - type 'a z = 'a + (struct + type 'a z = 'a - include Array + include Array - let create_bool ~len = create ~len false - end) - (Array)) + let create_bool ~len = create ~len false + end) + (Array)) ;; module List_helpers = struct @@ -489,11 +489,11 @@ let%test_module "permute" = raise_s [%sexp "invalid permutation" - , { array_length = (List.length initial_contents : int) - ; permutation : int list - ; pos : int option - ; len : int option - }]; + , { array_length = (List.length initial_contents : int) + ; permutation : int list + ; pos : int option + ; len : int option + }]; not_yet_seen := Set.remove !not_yet_seen permutation done ;; diff --git a/test/test_base_containers.ml b/test/test_base_containers.ml index 48da18ae..6233519c 100644 --- a/test/test_base_containers.ml +++ b/test/test_base_containers.ml @@ -19,7 +19,7 @@ include ( let of_list = of_char_list end) : - sig end) + sig end) (* Quickcheck-based expect tests *) diff --git a/test/test_blit.ml b/test/test_blit.ml index 88ba4a39..10540751 100644 --- a/test/test_blit.ml +++ b/test/test_blit.ml @@ -9,41 +9,41 @@ let%test_module _ = let slices_are_valid = ref (Ok ()) module B = Make (struct - type t = bool array + type t = bool array - let create ~len = Array.create false ~len - let length = Array.length + let create ~len = Array.create false ~len + let length = Array.length - let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len = - blit_was_called := true; - slices_are_valid + let unsafe_blit ~src ~src_pos ~dst ~dst_pos ~len = + blit_was_called := true; + slices_are_valid := Or_error.try_with (fun () -> - assert (len >= 0); - assert (src_pos >= 0); - assert (src_pos + len <= Array.length src); - assert (dst_pos >= 0); - assert (dst_pos + len <= Array.length dst)); - Array.blit ~src ~src_pos ~dst ~dst_pos ~len - ;; - end) + assert (len >= 0); + assert (src_pos >= 0); + assert (src_pos + len <= Array.length src); + assert (dst_pos >= 0); + assert (dst_pos + len <= Array.length dst)); + Array.blit ~src ~src_pos ~dst ~dst_pos ~len + ;; + end) let%test_module "Bool" = (module Test_blit.Test - (struct - type t = bool + (struct + type t = bool - let equal = Bool.equal - let of_bool = Fn.id - end) - (struct - type t = bool array [@@deriving sexp_of] + let equal = Bool.equal + let of_bool = Fn.id + end) + (struct + type t = bool array [@@deriving sexp_of] - let create ~len = Array.create false ~len - let length = Array.length - let get = Array.get - let set = Array.set - end) - (B)) + let create ~len = Array.create false ~len + let length = Array.length + let get = Array.get + let set = Array.set + end) + (B)) ;; let%test_unit _ = @@ -72,7 +72,7 @@ let%test_module _ = check (fun () -> ignore (B.subo (Array.create ~len:src false) ?pos:src_pos ?len:src_len - : bool array)) + : bool array)) with | exn -> raise_s diff --git a/test/test_bytes.ml b/test/test_bytes.ml index 78ad2497..acac6177 100644 --- a/test/test_bytes.ml +++ b/test/test_bytes.ml @@ -3,17 +3,17 @@ open! Bytes let%test_module "Blit" = (module Test_blit.Test - (struct - include Char + (struct + include Char - let of_bool b = if b then 'a' else 'b' - end) - (struct - include Bytes + let of_bool b = if b then 'a' else 'b' + end) + (struct + include Bytes - let create ~len = create len - end) - (Bytes)) + let create ~len = create len + end) + (Bytes)) ;; let%expect_test "local" = diff --git a/test/test_clz_ctz.ml b/test/test_clz_ctz.ml index 89f3c395..cc858134 100644 --- a/test/test_clz_ctz.ml +++ b/test/test_clz_ctz.ml @@ -34,16 +34,16 @@ include Make (Int63) include Make (Int63.Private.Emul) include Make (struct - include Int + include Int - let%expect_test "zero" = - (* [clz 0] is guaranteed to be num_bits for int. We compute clz on the tagged + let%expect_test "zero" = + (* [clz 0] is guaranteed to be num_bits for int. We compute clz on the tagged representation of int's, and the binary representation of the int [0] is num_bits 0's followed by a 1 (the tag bit). *) - [%test_result: int] ~expect:num_bits (clz 0) - ;; + [%test_result: int] ~expect:num_bits (clz 0) + ;; - (* [ctz 0] is unspecified. On linux it seems to be stable and equal to the system + (* [ctz 0] is unspecified. On linux it seems to be stable and equal to the system word size (which is num_bits + 1). ran 2019-02-11 on linux: {v @@ -57,57 +57,57 @@ include Make (struct v} *) - end) +end) include Make (struct - include Int32 - - let clz_and_ctz i32 = { E.clz = clz i32; ctz = ctz i32 } - - let%expect_test "extra examples" = - [%test_result: E.t] ~expect:{ clz = 31; ctz = 0 } (clz_and_ctz 0b1l); - [%test_result: E.t] ~expect:{ clz = 30; ctz = 1 } (clz_and_ctz 0b10l); - [%test_result: E.t] ~expect:{ clz = 30; ctz = 0 } (clz_and_ctz 0b11l); - [%test_result: E.t] ~expect:{ clz = 25; ctz = 1 } (clz_and_ctz 0b1000010l); - [%test_result: E.t] - ~expect:{ clz = 8; ctz = 6 } - (clz_and_ctz 0b100000010000001001000000l); - [%test_result: E.t] - ~expect:{ clz = 0; ctz = 31 } - (clz_and_ctz 0b10000000000000000000000000000000l); - [%test_result: E.t] - ~expect:{ clz = 9; ctz = 6 } - (clz_and_ctz 0b00000000010000000100000001000000l); - [%test_result: E.t] - ~expect:{ clz = 0; ctz = 6 } - (clz_and_ctz 0b10000000010000000100000001000000l) - ;; - end) + include Int32 + + let clz_and_ctz i32 = { E.clz = clz i32; ctz = ctz i32 } + + let%expect_test "extra examples" = + [%test_result: E.t] ~expect:{ clz = 31; ctz = 0 } (clz_and_ctz 0b1l); + [%test_result: E.t] ~expect:{ clz = 30; ctz = 1 } (clz_and_ctz 0b10l); + [%test_result: E.t] ~expect:{ clz = 30; ctz = 0 } (clz_and_ctz 0b11l); + [%test_result: E.t] ~expect:{ clz = 25; ctz = 1 } (clz_and_ctz 0b1000010l); + [%test_result: E.t] + ~expect:{ clz = 8; ctz = 6 } + (clz_and_ctz 0b100000010000001001000000l); + [%test_result: E.t] + ~expect:{ clz = 0; ctz = 31 } + (clz_and_ctz 0b10000000000000000000000000000000l); + [%test_result: E.t] + ~expect:{ clz = 9; ctz = 6 } + (clz_and_ctz 0b00000000010000000100000001000000l); + [%test_result: E.t] + ~expect:{ clz = 0; ctz = 6 } + (clz_and_ctz 0b10000000010000000100000001000000l) + ;; +end) include Make (struct - include Int64 - - let clz_and_ctz i64 = { E.clz = clz i64; ctz = ctz i64 } - - let%expect_test "extra examples" = - [%test_result: E.t] ~expect:{ clz = 63; ctz = 0 } (clz_and_ctz 0b1L); - [%test_result: E.t] ~expect:{ clz = 62; ctz = 1 } (clz_and_ctz 0b10L); - [%test_result: E.t] ~expect:{ clz = 62; ctz = 0 } (clz_and_ctz 0b11L); - [%test_result: E.t] ~expect:{ clz = 57; ctz = 1 } (clz_and_ctz 0b1000010L); - [%test_result: E.t] - ~expect:{ clz = 40; ctz = 6 } - (clz_and_ctz 0b100000010000001001000000L); - [%test_result: E.t] - ~expect:{ clz = 0; ctz = 63 } - (clz_and_ctz 0b1000000000000000000000000000000000000000000000000000000000000000L); - [%test_result: E.t] - ~expect:{ clz = 32; ctz = 31 } - (clz_and_ctz 0b0000000000000000000000000000000010000000000000000000000000000000L); - [%test_result: E.t] - ~expect:{ clz = 32; ctz = 6 } - (clz_and_ctz 0b0000000000000000000000000000000010000000010000000100000001000000L); - [%test_result: E.t] - ~expect:{ clz = 33; ctz = 6 } - (clz_and_ctz 0b0000000000000000000000000000000001000000010000000100000001000000L) - ;; - end) + include Int64 + + let clz_and_ctz i64 = { E.clz = clz i64; ctz = ctz i64 } + + let%expect_test "extra examples" = + [%test_result: E.t] ~expect:{ clz = 63; ctz = 0 } (clz_and_ctz 0b1L); + [%test_result: E.t] ~expect:{ clz = 62; ctz = 1 } (clz_and_ctz 0b10L); + [%test_result: E.t] ~expect:{ clz = 62; ctz = 0 } (clz_and_ctz 0b11L); + [%test_result: E.t] ~expect:{ clz = 57; ctz = 1 } (clz_and_ctz 0b1000010L); + [%test_result: E.t] + ~expect:{ clz = 40; ctz = 6 } + (clz_and_ctz 0b100000010000001001000000L); + [%test_result: E.t] + ~expect:{ clz = 0; ctz = 63 } + (clz_and_ctz 0b1000000000000000000000000000000000000000000000000000000000000000L); + [%test_result: E.t] + ~expect:{ clz = 32; ctz = 31 } + (clz_and_ctz 0b0000000000000000000000000000000010000000000000000000000000000000L); + [%test_result: E.t] + ~expect:{ clz = 32; ctz = 6 } + (clz_and_ctz 0b0000000000000000000000000000000010000000010000000100000001000000L); + [%test_result: E.t] + ~expect:{ clz = 33; ctz = 6 } + (clz_and_ctz 0b0000000000000000000000000000000001000000010000000100000001000000L) + ;; +end) diff --git a/test/test_container_module_types.ml b/test/test_container_module_types.ml index 7361b6b4..66d0a794 100644 --- a/test/test_container_module_types.ml +++ b/test/test_container_module_types.ml @@ -33,7 +33,6 @@ module _ : module type of Container = struct module _ (M : S0) : Generic0 = M module _ (M : Generic0) : S0 = M - (* Ensure that S0_phantom is Generic with a fixed element type. *) module type S0_phantom = Container.S0_phantom @@ -61,9 +60,9 @@ module _ : module type of Container = struct include Generic_with_creators - with type _ elt := elt - and type (_, _) t := t - and type ('a, _) concat := 'a list + with type _ elt := elt + and type (_, _) t := t + and type ('a, _) concat := 'a list val mem : t -> elt -> bool end @@ -109,9 +108,9 @@ module _ : module type of Container = struct include Generic_with_creators - with type 'a elt := 'a - and type ('a, _) t := 'a t - and type ('a, _) concat := 'a t + with type 'a elt := 'a + and type ('a, _) t := 'a t + and type ('a, _) concat := 'a t end end @@ -184,9 +183,9 @@ module _ : module type of Indexed_container = struct include Generic_with_creators - with type _ elt := elt - and type (_, _) t := t - and type ('a, _) concat := 'a list + with type _ elt := elt + and type (_, _) t := t + and type ('a, _) concat := 'a list val mem : t -> elt -> bool end @@ -204,9 +203,9 @@ module _ : module type of Indexed_container = struct include Generic_with_creators - with type 'a elt := 'a - and type ('a, _) t := 'a t - and type ('a, _) concat := 'a t + with type 'a elt := 'a + and type ('a, _) t := 'a t + and type ('a, _) concat := 'a t end end diff --git a/test/test_dictionary_module_types.ml b/test/test_dictionary_module_types.ml index 3c9bf113..934601d2 100644 --- a/test/test_dictionary_module_types.ml +++ b/test/test_dictionary_module_types.ml @@ -21,9 +21,9 @@ module _ : module type of Dictionary_immutable = struct include Accessors - with type _ key := key - and type (_, 'data, _) t := 'data t - and type ('fn, _, _, _) accessor := 'fn + with type _ key := key + and type (_, 'data, _) t := 'data t + and type ('fn, _, _, _) accessor := 'fn end end @@ -40,9 +40,9 @@ module _ : module type of Dictionary_immutable = struct include Accessors - with type 'key key := 'key - and type ('key, 'data, _) t := ('key, 'data) t - and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + with type 'key key := 'key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor end end @@ -59,10 +59,10 @@ module _ : module type of Dictionary_immutable = struct include Accessors - with type 'key key := 'key - and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor + with type 'key key := 'key + and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor end end @@ -82,9 +82,9 @@ module _ : module type of Dictionary_immutable = struct include Creators - with type _ key := key - and type (_, 'data, _) t := 'data t - and type ('fn, _, _, _) creator := 'fn + with type _ key := key + and type (_, 'data, _) t := 'data t + and type ('fn, _, _, _) creator := 'fn end end @@ -101,9 +101,9 @@ module _ : module type of Dictionary_immutable = struct include Creators - with type 'key key := 'key - and type ('key, 'data, _) t := ('key, 'data) t - and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + with type 'key key := 'key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator end end @@ -120,10 +120,10 @@ module _ : module type of Dictionary_immutable = struct include Creators - with type 'key key := 'key - and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type 'key key := 'key + and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end end @@ -142,17 +142,17 @@ module _ : module type of Dictionary_immutable = struct include Accessors - with type 'key key := 'key key - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - with type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor + with type 'key key := 'key key + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + with type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor include Creators - with type 'key key := 'key key - with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - with type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type 'key key := 'key key + with type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + with type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end end @@ -169,10 +169,10 @@ module _ : module type of Dictionary_immutable = struct include S - with type _ key := key - and type (_, 'data, _) t := 'data t - and type ('fn, _, _, _) accessor := 'fn - and type ('fn, _, _, _) creator := 'fn + with type _ key := key + and type (_, 'data, _) t := 'data t + and type ('fn, _, _, _) accessor := 'fn + and type ('fn, _, _, _) creator := 'fn end end @@ -190,10 +190,10 @@ module _ : module type of Dictionary_immutable = struct include S - with type 'key key := 'key - and type ('key, 'data, _) t := ('key, 'data) t - and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor - and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator + with type 'key key := 'key + and type ('key, 'data, _) t := ('key, 'data) t + and type ('fn, 'key, 'data, _) accessor := ('fn, 'key, 'data) accessor + and type ('fn, 'key, 'data, _) creator := ('fn, 'key, 'data) creator end end @@ -211,12 +211,12 @@ module _ : module type of Dictionary_immutable = struct include S - with type 'key key := 'key - and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t - and type ('fn, 'key, 'data, 'phantom) accessor := - ('fn, 'key, 'data, 'phantom) accessor - and type ('fn, 'key, 'data, 'phantom) creator := - ('fn, 'key, 'data, 'phantom) creator + with type 'key key := 'key + and type ('key, 'data, 'phantom) t := ('key, 'data, 'phantom) t + and type ('fn, 'key, 'data, 'phantom) accessor := + ('fn, 'key, 'data, 'phantom) accessor + and type ('fn, 'key, 'data, 'phantom) creator := + ('fn, 'key, 'data, 'phantom) creator end end diff --git a/test/test_exported_int_conversions.ml b/test/test_exported_int_conversions.ml index 241f317c..49f062af 100644 --- a/test/test_exported_int_conversions.ml +++ b/test/test_exported_int_conversions.ml @@ -61,11 +61,11 @@ let try_with f x = Option.try_with (fun () -> f x) (* Checks that a conversion from [A.t] to [B.t] is total using [of] and [to]. *) let test_total - (type a b) - (module A : S with type t = a) - (module B : S with type t = b) - ~of_:b_of_a - ~to_:a_to_b + (type a b) + (module A : S with type t = a) + (module B : S with type t = b) + ~of_:b_of_a + ~to_:a_to_b = iter (module A) @@ -83,15 +83,15 @@ let truncate int64 ~num_bits = converted to an [Int64.t] is outside the representable range of [B.t] converted to an [Int64.t] as well. *) let test_partial - (type a b) - (module A : S with type t = a) - (module B : S with type t = b) - ~of_:b_of_a - ~of_exn:b_of_a_exn - ~of_trunc:b_of_a_trunc - ~to_:a_to_b - ~to_exn:a_to_b_exn - ~to_trunc:a_to_b_trunc + (type a b) + (module A : S with type t = a) + (module B : S with type t = b) + ~of_:b_of_a + ~of_exn:b_of_a_exn + ~of_trunc:b_of_a_trunc + ~to_:a_to_b + ~to_exn:a_to_b_exn + ~to_trunc:a_to_b_trunc = let module B_option = struct type t = B.t option [@@deriving compare, sexp_of] @@ -228,7 +228,6 @@ let%expect_test "int32 <-> int64" = [%expect {| |}] ;; - let%expect_test "int <-> int63" = test_total (module I) (module I63) ~of_:Int63.of_int ~to_:Int63.of_int; [%expect {| |}]; diff --git a/test/test_float.ml b/test/test_float.ml index e06070f4..85e5440f 100644 --- a/test/test_float.ml +++ b/test/test_float.ml @@ -460,12 +460,12 @@ let%test_module _ = ;; let test_all_six - x - ~specialized_iround - ~specialized_iround_exn - ~float_rounding - ~dir - ~validate + x + ~specialized_iround + ~specialized_iround_exn + ~float_rounding + ~dir + ~validate = let result1 = iround x ~dir in let result2 = Option.try_with (fun () -> iround_exn x ~dir) in @@ -475,10 +475,10 @@ let%test_module _ = let result6 = Option.try_with (fun () -> Int.of_float (round ~dir x)) in let ( = ) = Stdlib.( = ) in if result1 = result2 - && result2 = result3 - && result3 = result4 - && result4 = result5 - && result5 = result6 + && result2 = result3 + && result3 = result4 + && result4 = result5 + && result5 = result6 then validate result1 else false ;; @@ -492,10 +492,10 @@ let%test_module _ = ~float_rounding:round_nearest ~dir:`Nearest ~validate:(function - | None -> true - | Some y -> - let y = of_int y in - -0.5 < y -. x && y -. x <= 0.5) + | None -> true + | Some y -> + let y = of_int y in + -0.5 < y -. x && y -. x <= 0.5) ;; (* iround_down: @@ -512,10 +512,10 @@ let%test_module _ = ~float_rounding:round_down ~dir:`Down ~validate:(function - | None -> true - | Some y -> - let y = of_int y in - 0. <= x -. y && x -. y < 1.) + | None -> true + | Some y -> + let y = of_int y in + 0. <= x -. y && x -. y < 1.) ;; (* iround_up: @@ -532,10 +532,10 @@ let%test_module _ = ~float_rounding:round_up ~dir:`Up ~validate:(function - | None -> true - | Some y -> - let y = of_int y in - 0. <= y -. x && y -. x < 1.) + | None -> true + | Some y -> + let y = of_int y in + 0. <= y -. x && y -. x < 1.) ;; (* iround_towards_zero: @@ -552,11 +552,11 @@ let%test_module _ = ~float_rounding:round_towards_zero ~dir:`Zero ~validate:(function - | None -> true - | Some y -> - let x = abs x in - let y = abs (of_int y) in - 0. <= x -. y && x -. y < 1. && (Sign.(sign_exn x = sign_exn y) || y = 0.0)) + | None -> true + | Some y -> + let x = abs x in + let y = abs (of_int y) in + 0. <= x -. y && x -. y < 1. && (Sign.(sign_exn x = sign_exn y) || y = 0.0)) ;; (* Easy cases that used to live inline with the code above. *) @@ -830,14 +830,14 @@ let%test_module _ = ;; module Test_bounds (I : sig - type t - - val num_bits : int - val of_float : float -> t - val to_int64 : t -> Int64.t - val max_value : t - val min_value : t - end) = + type t + + val num_bits : int + val of_float : float -> t + val to_int64 : t -> Int64.t + val max_value : t + val min_value : t +end) = struct open I @@ -865,7 +865,7 @@ struct in let min_value = to_int64 min_value in if Int.( = ) num_bits 64 - (* We cannot detect overflow because on Intel overflow results in min_value. *) + (* We cannot detect overflow because on Intel overflow results in min_value. *) then true else ( assert (Int64.( <= ) lower_bound_minus_epsilon lower_bound); @@ -880,7 +880,7 @@ struct in let max_value = to_int64 max_value in if Int.( = ) num_bits 64 - (* upper_bound_plus_epsilon is not representable as a Int64.t, it has overflowed *) + (* upper_bound_plus_epsilon is not representable as a Int64.t, it has overflowed *) then Int64.( < ) upper_bound_plus_epsilon upper_bound else ( assert (Int64.( >= ) upper_bound_plus_epsilon upper_bound); @@ -991,7 +991,6 @@ let%test_module _ = let%test _ = round_nearest 3.6 = 4. && round_nearest (-3.6) = -4. - (* The redefinition of [sexp_of_t] in float.ml assumes sexp conversion uses E rather than e. *) let%test_unit "e vs E" = diff --git a/test/test_globalize_lib.ml b/test/test_globalize_lib.ml index 677a4c3a..93b3e680 100644 --- a/test/test_globalize_lib.ml +++ b/test/test_globalize_lib.ml @@ -1,7 +1,6 @@ open! Core open! Import - let%expect_test "bool_true" = printf "%b" (globalize_bool true); [%expect {| true |}] diff --git a/test/test_hash_set.ml b/test/test_hash_set.ml index f35e9bb5..f678a236 100644 --- a/test/test_hash_set.ml +++ b/test/test_hash_set.ml @@ -91,9 +91,9 @@ let%expect_test "deriving equal" = [Creators_generic]. *) module _ (M : Creators) : Creators_generic - with type 'a t := 'a M.t - with type 'a elt := 'a - with type ('a, 'z) create_options := ('a, 'z) create_options = struct + with type 'a t := 'a M.t + with type 'a elt := 'a + with type ('a, 'z) create_options := ('a, 'z) create_options = struct include M let create ?growth_allowed ?size m () = create ?growth_allowed ?size m diff --git a/test/test_hashtbl.ml b/test/test_hashtbl.ml index b243e8c6..3ef691e9 100644 --- a/test/test_hashtbl.ml +++ b/test/test_hashtbl.ml @@ -18,12 +18,12 @@ let%test "Hashtbl.merge succeeds with first-class-module interface" = let%test_module _ = (module Hashtbl_tests.Make (struct - include Hashtbl + include Hashtbl - let create_poly ?size () = Poly.create ?size () - let of_alist_poly_exn l = Poly.of_alist_exn l - let of_alist_poly_or_error l = Poly.of_alist_or_error l - end)) + let create_poly ?size () = Poly.create ?size () + let of_alist_poly_exn l = Poly.of_alist_exn l + let of_alist_poly_or_error l = Poly.of_alist_or_error l + end)) ;; let%expect_test "Hashtbl.find_exn" = @@ -69,7 +69,7 @@ let%expect_test "[choose], [choose_exn], [choose_randomly], [choose_randomly_exn ~choose_randomly:(Hashtbl.choose_randomly t : (_ * _) option) ~choose_randomly_exn: (Or_error.try_with (fun () -> Hashtbl.choose_randomly_exn t) - : (_ * _) Or_error.t)] + : (_ * _) Or_error.t)] in test []; [%expect diff --git a/test/test_identifiable.ml b/test/test_identifiable.ml index 304bc3bc..d65af34b 100644 --- a/test/test_identifiable.ml +++ b/test/test_identifiable.ml @@ -5,10 +5,10 @@ module T = struct type t = string include Make (struct - let module_name = "test" + let module_name = "test" - include String - end) + include String + end) end let%expect_test ("hash coherence" [@tags "64-bits-only"]) = diff --git a/test/test_indexed_container.ml b/test/test_indexed_container.ml index 45b556cc..469320f3 100644 --- a/test/test_indexed_container.ml +++ b/test/test_indexed_container.ml @@ -6,14 +6,14 @@ module This_list : S = struct include List include Indexed_container.Make (struct - type 'a t = 'a list - - let fold = List.fold - let iter = `Custom List.iter - let length = `Custom List.length - let foldi = `Define_using_fold - let iteri = `Define_using_fold - end) + type 'a t = 'a list + + let fold = List.fold + let iter = `Custom List.iter + let length = `Custom List.length + let foldi = `Define_using_fold + let iteri = `Define_using_fold + end) end module That_list : S = List diff --git a/test/test_int.ml b/test/test_int.ml index 1cb81a93..c0477c40 100644 --- a/test/test_int.ml +++ b/test/test_int.ml @@ -86,16 +86,16 @@ let%test_module "Hex" = ; -1_000_000, "-0xf_4240" ; ( max_value , match num_bits with - | 31 -> "0x3fff_ffff" - | 32 -> "0x7fff_ffff" - | 63 -> "0x3fff_ffff_ffff_ffff" - | _ -> assert false ) + | 31 -> "0x3fff_ffff" + | 32 -> "0x7fff_ffff" + | 63 -> "0x3fff_ffff_ffff_ffff" + | _ -> assert false ) ; ( min_value , match num_bits with - | 31 -> "-0x4000_0000" - | 32 -> "-0x8000_0000" - | 63 -> "-0x4000_0000_0000_0000" - | _ -> assert false ) + | 31 -> "-0x4000_0000" + | 32 -> "-0x8000_0000" + | 63 -> "-0x4000_0000_0000_0000" + | _ -> assert false ) ] ;; @@ -161,7 +161,7 @@ let%expect_test "% and /%" = type t = int * (int - [@quickcheck.generator Base_quickcheck.Generator.small_strictly_positive_int]) + [@quickcheck.generator Base_quickcheck.Generator.small_strictly_positive_int]) [@@deriving quickcheck, sexp_of] end) ~f:(fun (a, b) -> @@ -172,17 +172,17 @@ let%expect_test "% and /%" = ;; include ( -struct - (** Various functors whose type-correctness ensures desired relationships between + struct + (** Various functors whose type-correctness ensures desired relationships between interfaces. *) - (* O contained in S *) - module _ (M : S) : module type of M.O = M + (* O contained in S *) + module _ (M : S) : module type of M.O = M - (* O contained in S_unbounded *) - module _ (M : S_unbounded) : module type of M.O = M + (* O contained in S_unbounded *) + module _ (M : S_unbounded) : module type of M.O = M - (* S_unbounded in S *) - module _ (M : S) : S_unbounded = M -end : -sig end) + (* S_unbounded in S *) + module _ (M : S) : S_unbounded = M + end : + sig end) diff --git a/test/test_int_conversions.ml b/test/test_int_conversions.ml index 565fcabf..908dbeb3 100644 --- a/test/test_int_conversions.ml +++ b/test/test_int_conversions.ml @@ -234,15 +234,15 @@ let%test_module "Make_hex" = type t = int [@@deriving quickcheck] module M = Make_hex (struct - type nonrec t = int [@@deriving sexp, compare ~localize, hash, quickcheck] - - let to_string = Int.Hex.to_string - let of_string = Int.Hex.of_string - let zero = 0 - let ( < ) = ( < ) - let neg = Int.neg - let module_name = "Hex_int" - end) + type nonrec t = int [@@deriving sexp, compare ~localize, hash, quickcheck] + + let to_string = Int.Hex.to_string + let of_string = Int.Hex.of_string + let zero = 0 + let ( < ) = ( < ) + let neg = Int.neg + let module_name = "Hex_int" + end) include (M.Hex : module type of M.Hex with type t := t) end diff --git a/test/test_int_math.ml b/test/test_int_math.ml index 33e52133..6234cec3 100644 --- a/test/test_int_math.ml +++ b/test/test_int_math.ml @@ -275,14 +275,14 @@ let%test_module "int rounding quickcheck tests" = raise_s [%sexp "test bug: did not find correctly rounded value" - , { rounded : Integer.t }] + , { rounded : Integer.t }] | Some rounded_correctly -> if rounded <> rounded_correctly then raise_s [%sexp "rounding failed" - , { rounded : Integer.t; rounded_correctly : Integer.t }])) + , { rounded : Integer.t; rounded_correctly : Integer.t }])) ;; let test m = diff --git a/test/test_list.ml b/test/test_list.ml index 053363c6..ae94807b 100644 --- a/test/test_list.ml +++ b/test/test_list.ml @@ -1461,11 +1461,11 @@ let%expect_test "list sort, dedup" = let prev char = Char.of_int_exn (Int.pred (Char.to_int char)) in Shrinker.list (Shrinker.create (function - | 'a' -> Sequence.empty - | 'b' .. 'z' as char -> Sequence.singleton (prev char) - | 'A' -> Sequence.singleton 'a' - | 'B' .. 'Z' as char -> Sequence.of_list [ Char.lowercase char; prev char ] - | _ -> Sequence.empty)) + | 'a' -> Sequence.empty + | 'b' .. 'z' as char -> Sequence.singleton (prev char) + | 'A' -> Sequence.singleton 'a' + | 'B' .. 'Z' as char -> Sequence.of_list [ Char.lowercase char; prev char ] + | _ -> Sequence.empty)) ;; end in diff --git a/test/test_map.ml b/test/test_map.ml index 0d720f69..04529429 100644 --- a/test/test_map.ml +++ b/test/test_map.ml @@ -55,7 +55,7 @@ let%expect_test "[Map.of_alist_multi] preserves value ordering" = print_s [%sexp (Map.of_alist_multi (module String) [ "a", 1; "a", 2; "b", 1; "b", 3 ] - : int list Map.M(String).t)]; + : int list Map.M(String).t)]; [%expect {| ((a (1 2)) (b (1 3))) |}] @@ -253,13 +253,13 @@ let%test_module "[symmetric_diff]" = List.map map_pairs ~f:(fun (m, m') -> measure_comparisons (fun () -> diffs - := !diffs - + Map.fold_symmetric_diff - ~init:0 - ~f:(fun n _ -> n + 1) - ~data_equal:(fun () () -> true) - (m : unit Map.M(Key).t) - m')) + := !diffs + + Map.fold_symmetric_diff + ~init:0 + ~f:(fun n _ -> n + 1) + ~data_equal:(fun () () -> true) + (m : unit Map.M(Key).t) + m')) in let worst_counts = List.sort counts ~compare:[%compare: int] |> List.rev |> fun l -> List.take l 20 @@ -359,7 +359,7 @@ let%expect_test "[map_keys]" = print_s [%sexp (Map.map_keys c ~f m - : [ `Duplicate_key of string | `Ok of string Map.M(String).t ])] + : [ `Duplicate_key of string | `Ok of string Map.M(String).t ])] in let map = Map.of_alist_exn (module Int) [ 1, "one"; 2, "two"; 3, "three" ] in test map (module String) ~f:Int.to_string; @@ -381,7 +381,7 @@ let%expect_test "[fold_until]" = ~init:0 ~f:(fun ~key ~data acc -> if key > 2 then Stop data else Continue (acc + key)) ~finish:Int.to_string - : string)] + : string)] in let map = Map.of_alist_exn (module Int) [ 1, "one"; 2, "two"; 3, "three" ] in test map; diff --git a/test/test_map_comprehensive.ml b/test/test_map_comprehensive.ml index 5a325698..9c3a8fce 100644 --- a/test/test_map_comprehensive.ml +++ b/test/test_map_comprehensive.ml @@ -44,12 +44,12 @@ module type S = sig include Map.Creators_and_accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) Types.t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Types.tree - with type 'a key := 'a Types.key - with type 'a cmp := 'a Types.cmp - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Types.create_options - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Types.access_options + with type ('a, 'b, 'c) t := ('a, 'b, 'c) Types.t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Types.tree + with type 'a key := 'a Types.key + with type 'a cmp := 'a Types.cmp + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) Types.create_options + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Types.access_options end (** Helpers for testing a tree or map type that is an instance of [S]. *) @@ -85,10 +85,10 @@ end (** A functor to generate all of [Instance] but [create] and [access] for a map type. *) module Instance (Cmp : sig - type comparator_witness + type comparator_witness - val comparator : (int, comparator_witness) Comparator.t - end) = + val comparator : (int, comparator_witness) Comparator.t +end) = struct module Key = struct type t = int [@@deriving quickcheck, sexp_of] @@ -100,10 +100,10 @@ struct let quickcheck_generator = Base_quickcheck.Generator.small_strictly_positive_int include Comparable.Infix (struct - type nonrec t = t + type nonrec t = t - let compare = compare - end) + let compare = compare + end) end type 'a t = 'a Map.M(Key).t [@@deriving equal, sexp_of] @@ -137,10 +137,10 @@ end (** A functor like [Instance], but for tree types. *) module Instance_tree (Cmp : sig - type comparator_witness + type comparator_witness - val comparator : (int, comparator_witness) Comparator.t - end) = + val comparator : (int, comparator_witness) Comparator.t +end) = struct module M = Instance (Cmp) include M @@ -168,24 +168,24 @@ end (** Functor for [List.t] *) module Lst (T : sig - type t [@@deriving equal, sexp_of] - end) = + type t [@@deriving equal, sexp_of] +end) = struct type t = T.t list [@@deriving equal, sexp_of] end (** Functor for [Or_error], ignoring error contents when comparing. *) module Ok (T : sig - type t [@@deriving equal, sexp_of] - end) = + type t [@@deriving equal, sexp_of] +end) = struct type t = (T.t, (Error.t[@equal.ignore])) Result.t [@@deriving equal, sexp_of] end (** Functor for [Option.t] *) module Opt (T : sig - type t [@@deriving equal, sexp_of] - end) = + type t [@@deriving equal, sexp_of] +end) = struct type t = T.t option [@@deriving equal, sexp_of] end @@ -193,8 +193,8 @@ end (** Functor for pairs of a single type. Random generation frequently generates pairs of identical values. *) module Pair (T : sig - type t [@@deriving equal, quickcheck, sexp_of] - end) = + type t [@@deriving equal, quickcheck, sexp_of] +end) = struct type t = T.t * T.t [@@deriving equal, quickcheck, sexp_of] @@ -210,9 +210,9 @@ end (** Expect tests for everything exported from [Map.Creators_and_accessors_generic]. *) module Test_creators_and_accessors - (Types : Types) - (Impl : S with module Types := Types) - (Instance : Instance with module Types := Types) : S with module Types := Types = struct + (Types : Types) + (Impl : S with module Types := Types) + (Instance : Instance with module Types := Types) : S with module Types := Types = struct open Instance open Impl @@ -455,7 +455,7 @@ module Test_creators_and_accessors let actual = create of_increasing_sequence seq in let expect = if List.is_sorted alist ~compare:(fun a b -> - Comparable.lift Key.compare ~f:fst a b) + Comparable.lift Key.compare ~f:fst a b) then create of_alist_or_error alist else Or_error.error_string "decreasing keys" in @@ -474,7 +474,7 @@ module Test_creators_and_accessors let expect = let compare a b = Comparable.lift Key.compare ~f:fst a b in if List.is_sorted_strictly ~compare alist - || List.is_sorted_strictly ~compare (List.rev alist) + || List.is_sorted_strictly ~compare (List.rev alist) then create of_alist_or_error alist else Or_error.error_string "unsorted" in @@ -756,8 +756,8 @@ module Test_creators_and_accessors (module Inst_multi) (access remove_multi t key) (access change t key ~f:(function - | None | Some ([] | [ _ ]) -> None - | Some (_ :: (_ :: _ as rest)) -> Some rest))); + | None | Some ([] | [ _ ]) -> None + | Some (_ :: (_ :: _ as rest)) -> Some rest))); [%expect {| |}] ;; @@ -819,8 +819,8 @@ module Test_creators_and_accessors let filteri = filteri module Physical_equality (T : sig - type t [@@deriving sexp_of] - end) = + type t [@@deriving sexp_of] + end) = struct type t = T.t [@@deriving sexp_of] @@ -1006,7 +1006,7 @@ module Test_creators_and_accessors (access combine_errors t) (to_alist t |> List.map ~f:(fun (key, result) -> - Or_error.map result ~f:(fun data -> key, data)) + Or_error.map result ~f:(fun data -> key, data)) |> Or_error.combine_errors |> Or_error.map ~f:(create of_alist_exn))); [%expect {| |}] @@ -1166,14 +1166,14 @@ module Test_creators_and_accessors |> List.concat_map ~f:to_alist |> List.Assoc.sort_and_group ~compare:Key.compare |> List.filter_map ~f:(fun (key, list) -> - let elt = - match (list : _ Either.t list) with - | [ First x ] -> `Left x - | [ Second y ] -> `Right y - | [ First x; Second y ] -> `Both (x, y) - | _ -> assert false - in - Option.some_if (Key.( > ) key k) (key, elt)) + let elt = + match (list : _ Either.t list) with + | [ First x ] -> `Left x + | [ Second y ] -> `Right y + | [ First x; Second y ] -> `Both (x, y) + | _ -> assert false + in + Option.some_if (Key.( > ) key k) (key, elt)) in require_equal [%here] (module Alist_merge) merge_alist expect; require_equal [%here] (module Alist_merge) iter2_alist expect; @@ -1972,8 +1972,8 @@ end [@ocaml.remove_aliases] = struct (module struct type t = ((int[@generator Base_quickcheck.Generator.small_strictly_positive_int]) - * int) - list + * int) + list [@@deriving quickcheck, sexp_of] end) ~f:(fun alist -> diff --git a/test/test_map_interface.ml b/test/test_map_interface.ml index 2336b070..77974b58 100644 --- a/test/test_map_interface.ml +++ b/test/test_map_interface.ml @@ -10,11 +10,11 @@ module _ : sig include Creators_and_accessors_generic - with type ('a, 'b, 'c) t := ('a, 'b, 'c) t - with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Map.Using_comparator.Tree.t - with type 'k key := 'k - with type 'c cmp := 'c - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_first_class_module.t + with type ('a, 'b, 'c) t := ('a, 'b, 'c) t + with type ('a, 'b, 'c) tree := ('a, 'b, 'c) Map.Using_comparator.Tree.t + with type 'k key := 'k + with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_first_class_module.t end = Map diff --git a/test/test_map_traversal.ml b/test/test_map_traversal.ml index 52722cb6..62675982 100644 --- a/test/test_map_traversal.ml +++ b/test/test_map_traversal.ml @@ -65,9 +65,9 @@ module Step_applicative = struct let rec fn t = { compute = (fun ~steps -> - match t.compute ~steps with - | First (x, steps) -> First (f x, steps) - | Second t -> Second (fn t)) + match t.compute ~steps with + | First (x, steps) -> First (f x, steps) + | Second t -> Second (fn t)) } in fn x @@ -77,9 +77,9 @@ module Step_applicative = struct let rec fn a = { compute = (fun ~steps -> - match a.compute ~steps with - | First (x, steps) -> (internal_map b ~f:(fun y -> f x y)).compute ~steps - | Second t -> Second (fn t)) + match a.compute ~steps with + | First (x, steps) -> (internal_map b ~f:(fun y -> f x y)).compute ~steps + | Second t -> Second (fn t)) } in fn a @@ -90,8 +90,8 @@ module Step_applicative = struct let of_thunk f = { compute = (fun ~steps -> - let t = f () in - t.compute ~steps) + let t = f () in + t.compute ~steps) } ;; end diff --git a/test/test_or_error.ml b/test/test_or_error.ml index 6f70b9a3..6c376815 100644 --- a/test/test_or_error.ml +++ b/test/test_or_error.ml @@ -70,9 +70,7 @@ let%expect_test "behavior and performance on lists of or_error's" = (* Show behavior on short lists. *) List.iter short_lists ~f:(fun list -> print_endline (to_string (f list))); (* Test for timeout / stack overflow on a long list. *) - match - to_string (f long_list) - with + match to_string (f long_list) with | (_ : string) -> () | exception Stack_overflow -> print_cr [%here] [%message "stack overflow"] in diff --git a/test/test_popcount.ml b/test/test_popcount.ml index 3958bd4c..c408d436 100644 --- a/test/test_popcount.ml +++ b/test/test_popcount.ml @@ -33,25 +33,25 @@ module Make (Int : T) = struct end include Make (struct - include Int + include Int - type t = int [@@deriving quickcheck] - end) + type t = int [@@deriving quickcheck] +end) include Make (struct - include Int32 + include Int32 - type t = int32 [@@deriving quickcheck] - end) + type t = int32 [@@deriving quickcheck] +end) include Make (struct - include Int64 + include Int64 - type t = int64 [@@deriving quickcheck] - end) + type t = int64 [@@deriving quickcheck] +end) include Make (struct - include Nativeint + include Nativeint - type t = nativeint [@@deriving quickcheck] - end) + type t = nativeint [@@deriving quickcheck] +end) diff --git a/test/test_queue.ml b/test/test_queue.ml index b86e92a6..b986171e 100644 --- a/test/test_queue.ml +++ b/test/test_queue.ml @@ -3,1145 +3,1143 @@ open Base_test_helpers let%test_module _ = (module ( - struct - open Queue - - module type S = S - - let does_raise = Exn.does_raise - - type nonrec 'a t = 'a t [@@deriving sexp, sexp_grammar] - - let globalize = globalize - - let%expect_test _ = - let open Expect_test_helpers_base in - let check t = - require_does_not_raise [%here] (fun () -> - invariant ignore t; - print_s [%sexp (t : int t)]) - in - let a = of_list [ 1; 2; 3 ] in - check a; - [%expect {| (1 2 3) |}]; - let b = globalize globalize_int a in - check b; - [%expect {| (1 2 3) |}]; - enqueue b 4; - print_s [%sexp (dequeue a : int option)]; - [%expect {| (1) |}]; - check a; - [%expect {| (2 3) |}]; - check b; - [%expect {| (1 2 3 4) |}] - ;; - - let capacity = capacity - let set_capacity = set_capacity - - let%test_unit _ = - let t = create () in - [%test_result: int] (capacity t) ~expect:2; - enqueue t 1; - [%test_result: int] (capacity t) ~expect:2; - enqueue t 2; - [%test_result: int] (capacity t) ~expect:2; - enqueue t 3; - [%test_result: int] (capacity t) ~expect:4; - set_capacity t 0; - [%test_result: int] (capacity t) ~expect:4; - set_capacity t 3; - [%test_result: int] (capacity t) ~expect:4; - set_capacity t 100; - [%test_result: int] (capacity t) ~expect:128; - enqueue t 4; - enqueue t 5; - set_capacity t 0; - [%test_result: int] (capacity t) ~expect:8; - set_capacity t (-1); - [%test_result: int] (capacity t) ~expect:8 - ;; - - - let round_trip_sexp t = - let sexp = sexp_of_t Int.sexp_of_t t in - let t' = t_of_sexp Int.t_of_sexp sexp in - [%test_result: int list] ~expect:(to_list t) (to_list t') - ;; - - let%test_unit _ = round_trip_sexp (of_list [ 1; 2; 3; 4 ]) - let%test_unit _ = round_trip_sexp (create ()) - let%test_unit _ = round_trip_sexp (of_list []) - let invariant = invariant - let create = create - - let%test_unit _ = - let t = create () in - [%test_result: int] (length t) ~expect:0; - [%test_result: int] (capacity t) ~expect:2 - ;; - - let%test_unit _ = - let t = create ~capacity:0 () in - [%test_result: int] (length t) ~expect:0; - [%test_result: int] (capacity t) ~expect:1 - ;; - - let%test_unit _ = - let t = create ~capacity:6 () in - [%test_result: int] (length t) ~expect:0; - [%test_result: int] (capacity t) ~expect:8 - ;; - - let%test_unit _ = - assert (does_raise (fun () : _ Queue.t -> create ~capacity:(-1) ())) - ;; - - let singleton = singleton - - let%test_unit _ = - let t = singleton 7 in - [%test_result: int] (length t) ~expect:1; - [%test_result: int] (capacity t) ~expect:1; - [%test_result: int option] (dequeue t) ~expect:(Some 7); - [%test_result: int option] (dequeue t) ~expect:None - ;; - - let init = init - - let%test_unit _ = - let t = init 0 ~f:(fun _ -> assert false) in - [%test_result: int] (length t) ~expect:0; - [%test_result: int] (capacity t) ~expect:1; - [%test_result: int option] (dequeue t) ~expect:None - ;; - - let%test_unit _ = - let t = init 3 ~f:(fun i -> i * 2) in - [%test_result: int] (length t) ~expect:3; - [%test_result: int] (capacity t) ~expect:4; - [%test_result: int option] (dequeue t) ~expect:(Some 0); - [%test_result: int option] (dequeue t) ~expect:(Some 2); - [%test_result: int option] (dequeue t) ~expect:(Some 4); - [%test_result: int option] (dequeue t) ~expect:None - ;; - - let%test_unit _ = - assert (does_raise (fun () : unit Queue.t -> init (-1) ~f:(fun _ -> ()))) - ;; - - let get = get - let set = set - - let%test_unit _ = - let t = create () in - let get_opt t i = Option.try_with (fun () -> get t i) in - [%test_result: int option] (get_opt t 0) ~expect:None; - [%test_result: int option] (get_opt t (-1)) ~expect:None; - [%test_result: int option] (get_opt t 10) ~expect:None; - List.iter [ -1; 0; 1 ] ~f:(fun i -> - assert (does_raise (fun () -> set t i 0))); - enqueue t 0; - enqueue t 1; - enqueue t 2; - [%test_result: int option] (get_opt t 0) ~expect:(Some 0); - [%test_result: int option] (get_opt t 1) ~expect:(Some 1); - [%test_result: int option] (get_opt t 2) ~expect:(Some 2); - [%test_result: int option] (get_opt t 3) ~expect:None; - ignore (dequeue_exn t : int); - [%test_result: int option] (get_opt t 0) ~expect:(Some 1); - [%test_result: int option] (get_opt t 1) ~expect:(Some 2); - [%test_result: int option] (get_opt t 2) ~expect:None; - set t 0 3; - [%test_result: int option] (get_opt t 0) ~expect:(Some 3); - [%test_result: int option] (get_opt t 1) ~expect:(Some 2); - List.iter [ -1; 2 ] ~f:(fun i -> - assert (does_raise (fun () -> set t i 0))) - ;; - - let map = map - - let%test_unit _ = - for i = 0 to 5 do - let l = List.init i ~f:Fn.id in - let t = of_list l in - let f x = x * 2 in - let t' = map t ~f in - [%test_result: int list] (to_list t') ~expect:(List.map l ~f) - done - ;; - - let%test_unit _ = - let t = create () in - let t' = map t ~f:(fun x -> x * 2) in - [%test_result: int] (length t') ~expect:(length t); - [%test_result: int] (length t') ~expect:0; - [%test_result: int list] (to_list t') ~expect:[] - ;; - - let mapi = mapi - - let%test_unit _ = - for i = 0 to 5 do - let l = List.init i ~f:Fn.id in - let t = of_list l in - let f i x = i, x * 2 in - let t' = mapi t ~f in - [%test_result: (int * int) list] (to_list t') ~expect:(List.mapi l ~f) - done - ;; - - let%test_unit _ = - let t = create () in - let t' = mapi t ~f:(fun i x -> i, x * 2) in - [%test_result: int] (length t') ~expect:(length t); - [%test_result: int] (length t') ~expect:0; - [%test_result: (int * int) list] (to_list t') ~expect:[] - ;; - - include Test_container.Test_S1 (Queue) - - let dequeue_exn = dequeue_exn - let enqueue = enqueue - let enqueue_front = enqueue_front - let dequeue_back = dequeue_back - let dequeue_back_exn = dequeue_back_exn - let peek = peek - let peek_exn = peek_exn - let peek_back = peek_back - let peek_back_exn = peek_back_exn - let last = last - let last_exn = last_exn - - let%test_unit _ = - let t = create () in - [%test_result: int option] (peek t) ~expect:None; - [%test_result: int option] (last t) ~expect:None; - enqueue t 1; - enqueue t 2; - [%test_result: int option] (peek t) ~expect:(Some 1); - [%test_result: int] (peek_exn t) ~expect:1; - [%test_result: int option] (last t) ~expect:(Some 2); - [%test_result: int] (last_exn t) ~expect:2; - [%test_result: int] (dequeue_exn t) ~expect:1; - [%test_result: int] (dequeue_exn t) ~expect:2; - assert (does_raise (fun () -> dequeue_exn t)); - assert (does_raise (fun () -> peek_exn t)); - assert (does_raise (fun () -> peek_back_exn t)); - assert (does_raise (fun () -> last_exn t)); - enqueue_front t 1; - enqueue t 2; - enqueue_front t 0; - enqueue t 3; - enqueue t 4; - enqueue t 5; - [%test_result: int option] (peek_back t) ~expect:(Some 5); - [%test_result: int] (peek_back_exn t) ~expect:5; - [%test_result: int] (dequeue_exn t) ~expect:0; - [%test_result: int] (dequeue_exn t) ~expect:1; - [%test_result: int] (dequeue_exn t) ~expect:2; - [%test_result: int] (dequeue_back_exn t) ~expect:5; - [%test_result: int] (dequeue_back_exn t) ~expect:4; - [%test_result: int] (dequeue_back_exn t) ~expect:3 - ;; - - let dequeue_and_ignore_exn = dequeue_and_ignore_exn - - let%test_unit _ = - let t = create () in - enqueue t 1; - enqueue t 2; - enqueue t 3; - [%test_result: int] (peek_exn t) ~expect:1; - dequeue_and_ignore_exn t; - [%test_result: int] (peek_exn t) ~expect:2; - dequeue_and_ignore_exn t; - [%test_result: int] (peek_exn t) ~expect:3; - dequeue_and_ignore_exn t; - [%test_result: int option] (peek t) ~expect:None; - assert (does_raise (fun () -> dequeue_and_ignore_exn t)); - assert (does_raise (fun () -> dequeue_and_ignore_exn t)); - [%test_result: int option] (peek t) ~expect:None - ;; - - let drain = drain - - let%test_unit _ = - let t = create () in - for i = 0 to 10 do - enqueue t i - done; - [%test_result: int] (peek_exn t) ~expect:0; - [%test_result: int] (length t) ~expect:11; - let r = ref 0 in - let add i = r := !r + i in - drain t ~f:add ~while_:(fun i -> i < 7); - [%test_result: int] (peek_exn t) ~expect:7; - [%test_result: int] (length t) ~expect:4; - [%test_result: int] !r ~expect:21; - drain t ~f:add ~while_:(fun i -> i > 7); - [%test_result: int] (peek_exn t) ~expect:7; - [%test_result: int] (length t) ~expect:4; - [%test_result: int] !r ~expect:21; - drain t ~f:add ~while_:(fun i -> i > 0); - [%test_result: int option] (peek t) ~expect:None; - [%test_result: int] (length t) ~expect:0; - [%test_result: int] !r ~expect:55 - ;; - - let enqueue_all = enqueue_all - - let%test_unit _ = - let t = create () in - enqueue_all t [ 1; 2; 3 ]; - [%test_result: int] (dequeue_exn t) ~expect:1; - [%test_result: int] (dequeue_exn t) ~expect:2; - [%test_result: int option] (last t) ~expect:(Some 3); - enqueue_all t [ 4; 5 ]; - [%test_result: int option] (last t) ~expect:(Some 5); - [%test_result: int] (dequeue_exn t) ~expect:3; - [%test_result: int] (dequeue_exn t) ~expect:4; - [%test_result: int] (dequeue_exn t) ~expect:5; - assert (does_raise (fun () -> dequeue_exn t)); - enqueue_all t []; - assert (does_raise (fun () -> dequeue_exn t)) - ;; - - let of_list = of_list - let to_list = to_list - - let%test_unit _ = - for i = 0 to 4 do - let list = List.init i ~f:Fn.id in - [%test_result: int list] (to_list (of_list list)) ~expect:list - done - ;; - - let%test _ = - let t = create () in - for i = 1 to 5 do - enqueue t i - done; - [%equal: int list] (to_list t) [ 1; 2; 3; 4; 5 ] - ;; - - let of_array = of_array - let to_array = to_array - - let%test_unit _ = - for len = 0 to 4 do - let array = Array.init len ~f:Fn.id in - [%test_result: int array] (to_array (of_array array)) ~expect:array - done - ;; - - let compare = compare - let compare__local = compare__local - let equal = equal - let equal__local = equal__local - - let%test_module "comparisons" = - (module struct - let sign x = if x < 0 then ~-1 else if x > 0 then 1 else 0 - - let test t1 t2 = - [%test_result: bool] - (equal Int.equal t1 t2) - ~expect:(List.equal Int.equal (to_list t1) (to_list t2)); - [%test_result: int] - (sign (compare Int.compare t1 t2)) - ~expect:(sign (List.compare Int.compare (to_list t1) (to_list t2))); - [%test_result: bool] - (equal__local Int.equal__local t1 t2) - ~expect: - (List.equal__local Int.equal__local (to_list t1) (to_list t2)); - [%test_result: int] - (sign (compare__local Int.compare__local t1 t2)) - ~expect: - (sign - (List.compare__local - Int.compare__local - (to_list t1) - (to_list t2))) - ;; - - let lists = - [ [] - ; [ 1 ] - ; [ 2 ] - ; [ 1; 1 ] - ; [ 1; 2 ] - ; [ 2; 1 ] - ; [ 1; 1; 1 ] - ; [ 1; 2; 3 ] - ; [ 1; 2; 4 ] - ; [ 1; 2; 4; 8 ] - ; [ 1; 2; 3; 4; 5 ] - ] - ;; - - let%test_unit _ = - (* [phys_equal] inputs *) - List.iter lists ~f:(fun list -> - let t = of_list list in - test t t) - ;; - - let%test_unit _ = - List.iter lists ~f:(fun list1 -> - List.iter lists ~f:(fun list2 -> - test (of_list list1) (of_list list2))) - ;; - end) - ;; - - let clear = clear - - let%test_unit "clear" = - let q = of_list [ 1; 2; 3; 4 ] in - [%test_result: int] (length q) ~expect:4; - clear q; - [%test_result: int] (length q) ~expect:0 - ;; - - let blit_transfer = blit_transfer - - let%test_unit _ = - let q_list = [ 1; 2; 3; 4 ] in - let q = of_list q_list in - let q' = create () in - blit_transfer ~src:q ~dst:q' (); - [%test_result: int list] (to_list q') ~expect:q_list; - [%test_result: int list] (to_list q) ~expect:[] - ;; - - let%test_unit _ = - let q = of_list [ 1; 2; 3; 4 ] in - let q' = create () in - blit_transfer ~src:q ~dst:q' ~len:2 (); - [%test_result: int list] (to_list q') ~expect:[ 1; 2 ]; - [%test_result: int list] (to_list q) ~expect:[ 3; 4 ] - ;; - - let%test_unit "blit_transfer on wrapped queues" = - let list = [ 1; 2; 3; 4 ] in - let q = of_list list in - let q' = copy q in - ignore (dequeue_exn q : int); - ignore (dequeue_exn q : int); - ignore (dequeue_exn q' : int); - ignore (dequeue_exn q' : int); - ignore (dequeue_exn q' : int); - enqueue q 5; - enqueue q 6; - blit_transfer ~src:q ~dst:q' ~len:3 (); - [%test_result: int list] (to_list q') ~expect:[ 4; 3; 4; 5 ]; - [%test_result: int list] (to_list q) ~expect:[ 6 ] - ;; - - let copy = copy - - let%test_unit "copies behave independently" = - let q = of_list [ 1; 2; 3; 4 ] in - let q' = copy q in - enqueue q 5; - ignore (dequeue_exn q' : int); - [%test_result: int list] (to_list q) ~expect:[ 1; 2; 3; 4; 5 ]; - [%test_result: int list] (to_list q') ~expect:[ 2; 3; 4 ] - ;; - - let dequeue = dequeue - let filter = filter - let filteri = filteri - let filter_inplace = filter_inplace - let filteri_inplace = filteri_inplace - let concat_map = concat_map - let concat_mapi = concat_mapi - let filter_map = filter_map - let filter_mapi = filter_mapi - let counti = counti - let existsi = existsi - let for_alli = for_alli - let iter = iter - let iteri = iteri - let foldi = foldi - let findi = findi - let find_mapi = find_mapi - - let%test_module "Linked_queue bisimulation" = - (module struct - module type Queue_intf = sig - type 'a t [@@deriving sexp_of] - - val create : unit -> 'a t - val enqueue : 'a t -> 'a -> unit - val dequeue : 'a t -> 'a option - - val drain - : 'a t - -> f:(('a -> unit)[@local]) - -> while_:(('a -> bool)[@local]) - -> unit - - val to_array : 'a t -> 'a array - val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b - val foldi : 'a t -> init:'b -> f:(int -> 'b -> 'a -> 'b) -> 'b - val iter : 'a t -> f:('a -> unit) -> unit - val iteri : 'a t -> f:(int -> 'a -> unit) -> unit - val length : 'a t -> int - val clear : 'a t -> unit - val concat_map : 'a t -> f:('a -> 'b list) -> 'b t - val concat_mapi : 'a t -> f:(int -> 'a -> 'b list) -> 'b t - val filter_map : 'a t -> f:('a -> 'b option) -> 'b t - val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t - val filter : 'a t -> f:('a -> bool) -> 'a t - val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t - val filter_inplace : 'a t -> f:('a -> bool) -> unit - val filteri_inplace : 'a t -> f:(int -> 'a -> bool) -> unit - val map : 'a t -> f:('a -> 'b) -> 'b t - val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t - val counti : 'a t -> f:(int -> 'a -> bool) -> int - val existsi : 'a t -> f:(int -> 'a -> bool) -> bool - val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool - val findi : 'a t -> f:(int -> 'a -> bool) -> (int * 'a) option - val find_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b option - val transfer : src:'a t -> dst:'a t -> unit - val copy : 'a t -> 'a t - end - - module That_queue : Queue_intf = Linked_queue - - module This_queue : Queue_intf = struct - include Queue - - let create () = create () - let transfer ~src ~dst = blit_transfer ~src ~dst () - end - - let this_to_string this_t = - Sexp.to_string (this_t |> [%sexp_of: int This_queue.t]) - ;; - - let that_to_string that_t = - Sexp.to_string (that_t |> [%sexp_of: int That_queue.t]) - ;; - - let array_string arr = Sexp.to_string (arr |> [%sexp_of: int array]) - let create () = This_queue.create (), That_queue.create () - - - let enqueue (t_a, t_b) v = - let start_a = This_queue.to_array t_a in - let start_b = That_queue.to_array t_b in - This_queue.enqueue t_a v; - That_queue.enqueue t_b v; - let end_a = This_queue.to_array t_a in - let end_b = That_queue.to_array t_b in - if not ([%equal: int array] end_a end_b) - then - Printf.failwithf - "enqueue transition failure of: %s -> %s vs. %s -> %s" - (array_string start_a) - (array_string end_a) - (array_string start_b) - (array_string end_b) - () - ;; - - let iter (t_a, t_b) = - let r_a, r_b = ref 0, ref 0 in - This_queue.iter t_a ~f:(fun x -> r_a := !r_a + x); - That_queue.iter t_b ~f:(fun x -> r_b := !r_b + x); - if !r_a <> !r_b - then - Printf.failwithf - "error in iter: %s (from %s) <> %s (from %s)" - (Int.to_string !r_a) - (this_to_string t_a) - (Int.to_string !r_b) - (that_to_string t_b) - () - ;; - - let iteri (t_a, t_b) = - let r_a, r_b = ref 0, ref 0 in - This_queue.iteri t_a ~f:(fun i x -> r_a := !r_a + (x lxor i)); - That_queue.iteri t_b ~f:(fun i x -> r_b := !r_b + (x lxor i)); - if !r_a <> !r_b - then - Printf.failwithf - "error in iteri: %s (from %s) <> %s (from %s)" - (Int.to_string !r_a) - (this_to_string t_a) - (Int.to_string !r_b) - (that_to_string t_b) - () - ;; - - let dequeue (t_a, t_b) = - let start_a = This_queue.to_array t_a in - let start_b = That_queue.to_array t_b in - let a, b = This_queue.dequeue t_a, That_queue.dequeue t_b in - let end_a = This_queue.to_array t_a in - let end_b = That_queue.to_array t_b in - if (not ([%equal: int option] a b)) - || not ([%equal: int array] end_a end_b) - then - Printf.failwithf - "error in dequeue: %s (%s -> %s) <> %s (%s -> %s)" - (Option.value ~default:"None" (Option.map a ~f:Int.to_string)) - (array_string start_a) - (array_string end_a) - (Option.value ~default:"None" (Option.map b ~f:Int.to_string)) - (array_string start_b) - (array_string end_b) - () - ;; - - let is_even x = x land 1 = 0 - - let drain (t_a, t_b) = - let orig_a = This_queue.to_array t_a in - let orig_b = That_queue.to_array t_b in - let r_a = ref 0 in - let r_b = ref 0 in - let add r i = r := !r + i in - This_queue.drain t_a ~f:(fun i -> add r_a i) ~while_:is_even; - That_queue.drain t_b ~f:(fun i -> add r_b i) ~while_:is_even; - if not - ([%equal: int array] - (This_queue.to_array t_a) - (That_queue.to_array t_b) - && !r_a = !r_b) - then - Printf.failwithf - "error in drain: %s -> %s, %d vs. %s -> %s, %d" - (array_string orig_a) - (this_to_string t_a) - !r_a - (array_string orig_b) - (that_to_string t_b) - !r_b - () - ;; - - let clear (t_a, t_b) = - This_queue.clear t_a; - That_queue.clear t_b - ;; - - let filter (t_a, t_b) = - let t_a' = This_queue.filter t_a ~f:is_even in - let t_b' = That_queue.filter t_b ~f:is_even in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in filter: %s -> %s vs. %s -> %s" - (this_to_string t_a) - (this_to_string t_a') - (that_to_string t_b) - (that_to_string t_b') - () - ;; - - let filteri (t_a, t_b) = - let t_a' = - This_queue.filteri t_a ~f:(fun i j -> - [%equal: bool] (is_even i) (is_even j)) - in - let t_b' = - That_queue.filteri t_b ~f:(fun i j -> - [%equal: bool] (is_even i) (is_even j)) - in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in filteri: %s -> %s vs. %s -> %s" - (this_to_string t_a) - (this_to_string t_a') - (that_to_string t_b) - (that_to_string t_b') - () - ;; - - let filter_inplace (t_a, t_b) = - let start_a = This_queue.to_array t_a in - let start_b = That_queue.to_array t_b in - This_queue.filter_inplace t_a ~f:is_even; - That_queue.filter_inplace t_b ~f:is_even; - let end_a = This_queue.to_array t_a in - let end_b = That_queue.to_array t_b in - if not ([%equal: int array] end_a end_b) - then - Printf.failwithf - "error in filter_inplace: %s -> %s vs. %s -> %s" - (array_string start_a) - (array_string end_a) - (array_string start_b) - (array_string end_b) - () - ;; - - let filteri_inplace (t_a, t_b) = - let start_a = This_queue.to_array t_a in - let start_b = That_queue.to_array t_b in - let f i x = [%equal: bool] (is_even i) (is_even x) in - This_queue.filteri_inplace t_a ~f; - That_queue.filteri_inplace t_b ~f; - let end_a = This_queue.to_array t_a in - let end_b = That_queue.to_array t_b in - if not ([%equal: int array] end_a end_b) - then - Printf.failwithf - "error in filteri_inplace: %s -> %s vs. %s -> %s" - (array_string start_a) - (array_string end_a) - (array_string start_b) - (array_string end_b) - () - ;; - - let concat_map (t_a, t_b) = - let f x = [ x; x + 1; x + 2 ] in - let t_a' = This_queue.concat_map t_a ~f in - let t_b' = That_queue.concat_map t_b ~f in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in concat_map: %s (for %s) <> %s (for %s)" - (this_to_string t_a') - (this_to_string t_a) - (that_to_string t_b') - (that_to_string t_b) - () - ;; - - let concat_mapi (t_a, t_b) = - let f i x = [ x; x + 1; x + 2; x + i ] in - let t_a' = This_queue.concat_mapi t_a ~f in - let t_b' = That_queue.concat_mapi t_b ~f in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in concat_mapi: %s (for %s) <> %s (for %s)" - (this_to_string t_a') - (this_to_string t_a) - (that_to_string t_b') - (that_to_string t_b) - () - ;; - - let filter_map (t_a, t_b) = - let f x = if is_even x then None else Some (x + 1) in - let t_a' = This_queue.filter_map t_a ~f in - let t_b' = That_queue.filter_map t_b ~f in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in filter_map: %s (for %s) <> %s (for %s)" - (this_to_string t_a') - (this_to_string t_a) - (that_to_string t_b') - (that_to_string t_b) - () - ;; - - let filter_mapi (t_a, t_b) = - let f i x = - if [%equal: bool] (is_even i) (is_even x) - then None - else Some (x + 1 + i) - in - let t_a' = This_queue.filter_mapi t_a ~f in - let t_b' = That_queue.filter_mapi t_b ~f in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in filter_mapi: %s (for %s) <> %s (for %s)" - (this_to_string t_a') - (this_to_string t_a) - (that_to_string t_b') - (that_to_string t_b) - () - ;; - - let map (t_a, t_b) = - let f x = x * 7 in - let t_a' = This_queue.map t_a ~f in - let t_b' = That_queue.map t_b ~f in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in map: %s (for %s) <> %s (for %s)" - (this_to_string t_a') - (this_to_string t_a) - (that_to_string t_b') - (that_to_string t_b) - () - ;; - - let mapi (t_a, t_b) = - let f i x = (x + 3) lxor i in - let t_a' = This_queue.mapi t_a ~f in - let t_b' = That_queue.mapi t_b ~f in - if not - ([%equal: int array] - (This_queue.to_array t_a') - (That_queue.to_array t_b')) - then - Printf.failwithf - "error in mapi: %s (for %s) <> %s (for %s)" - (this_to_string t_a') - (this_to_string t_a) - (that_to_string t_b') - (that_to_string t_b) - () - ;; - - let counti (t_a, t_b) = - let f i x = i < 7 && i % 7 = x % 7 in - let a' = This_queue.counti t_a ~f in - let b' = That_queue.counti t_b ~f in - if a' <> b' - then - Printf.failwithf - "error in counti: %d (for %s) <> %d (for %s)" - a' - (this_to_string t_a) - b' - (that_to_string t_b) - () - ;; - - let existsi (t_a, t_b) = - let f i x = i < 7 && i % 7 = x % 7 in - let a' = This_queue.existsi t_a ~f in - let b' = That_queue.existsi t_b ~f in - if not ([%equal: bool] a' b') - then - Printf.failwithf - "error in existsi: %b (for %s) <> %b (for %s)" - a' - (this_to_string t_a) - b' - (that_to_string t_b) - () - ;; - - let for_alli (t_a, t_b) = - let f i x = i >= 7 || i % 7 <> x % 7 in - let a' = This_queue.for_alli t_a ~f in - let b' = That_queue.for_alli t_b ~f in - if not ([%equal: bool] a' b') - then - Printf.failwithf - "error in for_alli: %b (for %s) <> %b (for %s)" - a' - (this_to_string t_a) - b' - (that_to_string t_b) - () - ;; - - let findi (t_a, t_b) = - let f i x = i < 7 && i % 7 = x % 7 in - let a' = This_queue.findi t_a ~f in - let b' = That_queue.findi t_b ~f in - if not ([%equal: (int * int) option] a' b') - then - Printf.failwithf - "error in findi: %s (for %s) <> %s (for %s)" - (Sexp.to_string ([%sexp_of: (int * int) option] a')) - (this_to_string t_a) - (Sexp.to_string ([%sexp_of: (int * int) option] b')) - (that_to_string t_b) - () - ;; - - let find_mapi (t_a, t_b) = - let f i x = if i < 7 && i % 7 = x % 7 then Some (i + x) else None in - let a' = This_queue.find_mapi t_a ~f in - let b' = That_queue.find_mapi t_b ~f in - if not ([%equal: int option] a' b') - then - Printf.failwithf - "error in find_mapi: %s (for %s) <> %s (for %s)" - (Sexp.to_string ([%sexp_of: int option] a')) - (this_to_string t_a) - (Sexp.to_string ([%sexp_of: int option] b')) - (that_to_string t_b) - () - ;; - - let copy (t_a, t_b) = - let copy_a = This_queue.copy t_a in - let copy_b = That_queue.copy t_b in - let start_a = This_queue.to_array t_a in - let start_b = That_queue.to_array t_b in - let end_a = This_queue.to_array copy_a in - let end_b = That_queue.to_array copy_b in - if not ([%equal: int array] end_a end_b) - then - Printf.failwithf - "error in copy: %s -> %s vs. %s -> %s" - (array_string start_a) - (array_string end_a) - (array_string start_b) - (array_string end_b) - () - ;; - - let transfer (t_a, t_b) = - let dst_a = This_queue.create () in - let dst_b = That_queue.create () in - (* sometimes puts some elements in the destination queues *) - if Random.bool () - then - List.iter [ 1; 2; 3; 4; 5 ] ~f:(fun elem -> - This_queue.enqueue dst_a elem; - That_queue.enqueue dst_b elem); - let start_a = This_queue.to_array t_a in - let start_b = That_queue.to_array t_b in - This_queue.transfer ~src:t_a ~dst:dst_a; - That_queue.transfer ~src:t_b ~dst:dst_b; - let end_a = This_queue.to_array t_a in - let end_b = That_queue.to_array t_b in - let end_a' = This_queue.to_array dst_a in - let end_b' = That_queue.to_array dst_b in - if (not ([%equal: int array] end_a' end_b')) - || not ([%equal: int array] end_a end_b) - then - Printf.failwithf - "error in transfer: %s -> (%s, %s) vs. %s -> (%s, %s)" - (array_string start_a) - (array_string end_a) - (array_string end_a') - (array_string start_b) - (array_string end_b) - (array_string end_b) - () - ;; - - let fold_check (t_a, t_b) = - let make_list fold t = fold t ~init:[] ~f:(fun acc x -> x :: acc) in - let this_l = make_list This_queue.fold t_a in - let that_l = make_list That_queue.fold t_b in - if not ([%equal: int list] this_l that_l) - then - Printf.failwithf - "error in fold: %s (from %s) <> %s (from %s)" - (Sexp.to_string (this_l |> [%sexp_of: int list])) - (this_to_string t_a) - (Sexp.to_string (that_l |> [%sexp_of: int list])) - (that_to_string t_b) - () - ;; - - let foldi_check (t_a, t_b) = - let make_list foldi t = - foldi t ~init:[] ~f:(fun i acc x -> (i, x) :: acc) - in - let this_l = make_list This_queue.foldi t_a in - let that_l = make_list That_queue.foldi t_b in - if not ([%equal: (int * int) list] this_l that_l) - then - Printf.failwithf - "error in foldi: %s (from %s) <> %s (from %s)" - (Sexp.to_string (this_l |> [%sexp_of: (int * int) list])) - (this_to_string t_a) - (Sexp.to_string (that_l |> [%sexp_of: (int * int) list])) - (that_to_string t_b) - () - ;; - - let length_check (t_a, t_b) = - let this_len = This_queue.length t_a in - let that_len = That_queue.length t_b in - if this_len <> that_len - then - Printf.failwithf - "error in length: %i (for %s) <> %i (for %s)" - this_len - (this_to_string t_a) - that_len - (that_to_string t_b) - () - ;; - - let%test_unit _ = - let t = create () in - let rec loop ~all_ops ~non_empty_ops = - if all_ops <= 0 && non_empty_ops <= 0 - then ( - let t_a, t_b = t in - let arr_a = This_queue.to_array t_a in - let arr_b = That_queue.to_array t_b in - if not ([%equal: int array] arr_a arr_b) - then - Printf.failwithf - "queue final states not equal: %s vs. %s" - (array_string arr_a) - (array_string arr_b) - ()) - else ( - let queue_was_empty = This_queue.length (fst t) = 0 in - let r = Random.int 200 in - if r < 60 - then enqueue t (Random.int 10_000) - else if r < 65 - then dequeue t - else if r < 70 - then clear t - else if r < 80 - then iter t - else if r < 85 - then iteri t - else if r < 90 - then fold_check t - else if r < 95 - then foldi_check t - else if r < 100 - then filter t - else if r < 105 - then filteri t - else if r < 110 - then concat_map t - else if r < 115 - then concat_mapi t - else if r < 120 - then transfer t - else if r < 130 - then filter_map t - else if r < 135 - then filter_mapi t - else if r < 140 - then copy t - else if r < 150 - then filter_inplace t - else if r < 155 - then for_alli t - else if r < 160 - then existsi t - else if r < 165 - then counti t - else if r < 170 - then findi t - else if r < 175 - then find_mapi t - else if r < 180 - then map t - else if r < 185 - then mapi t - else if r < 190 - then filteri_inplace t - else if r < 195 - then length_check t - else if r < 200 - then drain t - else failwith "Impossible: We did [Random.int 200] above"; - loop - ~all_ops:(all_ops - 1) - ~non_empty_ops: - (if queue_was_empty then non_empty_ops else non_empty_ops - 1)) - in - loop ~all_ops:30_000 ~non_empty_ops:20_000 - ;; - end) - ;; - - let%test_unit "modification-during-iteration" = - let x = `A 0 in - let t = of_list [ x; x ] in - let f (`A n) = - ignore n; - clear t - in - assert (does_raise (fun () -> iter t ~f)) - ;; - - let%test_unit "more-modification-during-iteration" = - let nested_iter_okay = ref false in - let t = of_list [ `iter; `clear ] in - assert ( - does_raise (fun () -> - iter t ~f:(function - | `iter -> - iter t ~f:ignore; - nested_iter_okay := true - | `clear -> clear t))); - assert !nested_iter_okay - ;; - - let%test_unit "modification-during-filter" = - let reached_unreachable = ref false in - let t = of_list [ `clear; `unreachable ] in - let f x = - match x with - | `clear -> - clear t; - false - | `unreachable -> - reached_unreachable := true; - false - in - assert (does_raise (fun () -> filter t ~f)); - assert (not !reached_unreachable) - ;; - - let%test_unit "modification-during-filter-inplace" = - let reached_unreachable = ref false in - let t = of_list [ `drop_this; `enqueue_new_element; `unreachable ] in - let f x = - (match x with - | `drop_this | `new_element -> () - | `enqueue_new_element -> enqueue t `new_element - | `unreachable -> reached_unreachable := true); - false - in - assert (does_raise (fun () -> filter_inplace t ~f)); - (* even though we said to drop the first element, the aborted call to [filter_inplace] + struct + open Queue + + module type S = S + + let does_raise = Exn.does_raise + + type nonrec 'a t = 'a t [@@deriving sexp, sexp_grammar] + + let globalize = globalize + + let%expect_test _ = + let open Expect_test_helpers_base in + let check t = + require_does_not_raise [%here] (fun () -> + invariant ignore t; + print_s [%sexp (t : int t)]) + in + let a = of_list [ 1; 2; 3 ] in + check a; + [%expect {| (1 2 3) |}]; + let b = globalize globalize_int a in + check b; + [%expect {| (1 2 3) |}]; + enqueue b 4; + print_s [%sexp (dequeue a : int option)]; + [%expect {| (1) |}]; + check a; + [%expect {| (2 3) |}]; + check b; + [%expect {| (1 2 3 4) |}] + ;; + + let capacity = capacity + let set_capacity = set_capacity + + let%test_unit _ = + let t = create () in + [%test_result: int] (capacity t) ~expect:2; + enqueue t 1; + [%test_result: int] (capacity t) ~expect:2; + enqueue t 2; + [%test_result: int] (capacity t) ~expect:2; + enqueue t 3; + [%test_result: int] (capacity t) ~expect:4; + set_capacity t 0; + [%test_result: int] (capacity t) ~expect:4; + set_capacity t 3; + [%test_result: int] (capacity t) ~expect:4; + set_capacity t 100; + [%test_result: int] (capacity t) ~expect:128; + enqueue t 4; + enqueue t 5; + set_capacity t 0; + [%test_result: int] (capacity t) ~expect:8; + set_capacity t (-1); + [%test_result: int] (capacity t) ~expect:8 + ;; + + let round_trip_sexp t = + let sexp = sexp_of_t Int.sexp_of_t t in + let t' = t_of_sexp Int.t_of_sexp sexp in + [%test_result: int list] ~expect:(to_list t) (to_list t') + ;; + + let%test_unit _ = round_trip_sexp (of_list [ 1; 2; 3; 4 ]) + let%test_unit _ = round_trip_sexp (create ()) + let%test_unit _ = round_trip_sexp (of_list []) + let invariant = invariant + let create = create + + let%test_unit _ = + let t = create () in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:2 + ;; + + let%test_unit _ = + let t = create ~capacity:0 () in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:1 + ;; + + let%test_unit _ = + let t = create ~capacity:6 () in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:8 + ;; + + let%test_unit _ = + assert (does_raise (fun () : _ Queue.t -> create ~capacity:(-1) ())) + ;; + + let singleton = singleton + + let%test_unit _ = + let t = singleton 7 in + [%test_result: int] (length t) ~expect:1; + [%test_result: int] (capacity t) ~expect:1; + [%test_result: int option] (dequeue t) ~expect:(Some 7); + [%test_result: int option] (dequeue t) ~expect:None + ;; + + let init = init + + let%test_unit _ = + let t = init 0 ~f:(fun _ -> assert false) in + [%test_result: int] (length t) ~expect:0; + [%test_result: int] (capacity t) ~expect:1; + [%test_result: int option] (dequeue t) ~expect:None + ;; + + let%test_unit _ = + let t = init 3 ~f:(fun i -> i * 2) in + [%test_result: int] (length t) ~expect:3; + [%test_result: int] (capacity t) ~expect:4; + [%test_result: int option] (dequeue t) ~expect:(Some 0); + [%test_result: int option] (dequeue t) ~expect:(Some 2); + [%test_result: int option] (dequeue t) ~expect:(Some 4); + [%test_result: int option] (dequeue t) ~expect:None + ;; + + let%test_unit _ = + assert (does_raise (fun () : unit Queue.t -> init (-1) ~f:(fun _ -> ()))) + ;; + + let get = get + let set = set + + let%test_unit _ = + let t = create () in + let get_opt t i = Option.try_with (fun () -> get t i) in + [%test_result: int option] (get_opt t 0) ~expect:None; + [%test_result: int option] (get_opt t (-1)) ~expect:None; + [%test_result: int option] (get_opt t 10) ~expect:None; + List.iter [ -1; 0; 1 ] ~f:(fun i -> + assert (does_raise (fun () -> set t i 0))); + enqueue t 0; + enqueue t 1; + enqueue t 2; + [%test_result: int option] (get_opt t 0) ~expect:(Some 0); + [%test_result: int option] (get_opt t 1) ~expect:(Some 1); + [%test_result: int option] (get_opt t 2) ~expect:(Some 2); + [%test_result: int option] (get_opt t 3) ~expect:None; + ignore (dequeue_exn t : int); + [%test_result: int option] (get_opt t 0) ~expect:(Some 1); + [%test_result: int option] (get_opt t 1) ~expect:(Some 2); + [%test_result: int option] (get_opt t 2) ~expect:None; + set t 0 3; + [%test_result: int option] (get_opt t 0) ~expect:(Some 3); + [%test_result: int option] (get_opt t 1) ~expect:(Some 2); + List.iter [ -1; 2 ] ~f:(fun i -> + assert (does_raise (fun () -> set t i 0))) + ;; + + let map = map + + let%test_unit _ = + for i = 0 to 5 do + let l = List.init i ~f:Fn.id in + let t = of_list l in + let f x = x * 2 in + let t' = map t ~f in + [%test_result: int list] (to_list t') ~expect:(List.map l ~f) + done + ;; + + let%test_unit _ = + let t = create () in + let t' = map t ~f:(fun x -> x * 2) in + [%test_result: int] (length t') ~expect:(length t); + [%test_result: int] (length t') ~expect:0; + [%test_result: int list] (to_list t') ~expect:[] + ;; + + let mapi = mapi + + let%test_unit _ = + for i = 0 to 5 do + let l = List.init i ~f:Fn.id in + let t = of_list l in + let f i x = i, x * 2 in + let t' = mapi t ~f in + [%test_result: (int * int) list] (to_list t') ~expect:(List.mapi l ~f) + done + ;; + + let%test_unit _ = + let t = create () in + let t' = mapi t ~f:(fun i x -> i, x * 2) in + [%test_result: int] (length t') ~expect:(length t); + [%test_result: int] (length t') ~expect:0; + [%test_result: (int * int) list] (to_list t') ~expect:[] + ;; + + include Test_container.Test_S1 (Queue) + + let dequeue_exn = dequeue_exn + let enqueue = enqueue + let enqueue_front = enqueue_front + let dequeue_back = dequeue_back + let dequeue_back_exn = dequeue_back_exn + let peek = peek + let peek_exn = peek_exn + let peek_back = peek_back + let peek_back_exn = peek_back_exn + let last = last + let last_exn = last_exn + + let%test_unit _ = + let t = create () in + [%test_result: int option] (peek t) ~expect:None; + [%test_result: int option] (last t) ~expect:None; + enqueue t 1; + enqueue t 2; + [%test_result: int option] (peek t) ~expect:(Some 1); + [%test_result: int] (peek_exn t) ~expect:1; + [%test_result: int option] (last t) ~expect:(Some 2); + [%test_result: int] (last_exn t) ~expect:2; + [%test_result: int] (dequeue_exn t) ~expect:1; + [%test_result: int] (dequeue_exn t) ~expect:2; + assert (does_raise (fun () -> dequeue_exn t)); + assert (does_raise (fun () -> peek_exn t)); + assert (does_raise (fun () -> peek_back_exn t)); + assert (does_raise (fun () -> last_exn t)); + enqueue_front t 1; + enqueue t 2; + enqueue_front t 0; + enqueue t 3; + enqueue t 4; + enqueue t 5; + [%test_result: int option] (peek_back t) ~expect:(Some 5); + [%test_result: int] (peek_back_exn t) ~expect:5; + [%test_result: int] (dequeue_exn t) ~expect:0; + [%test_result: int] (dequeue_exn t) ~expect:1; + [%test_result: int] (dequeue_exn t) ~expect:2; + [%test_result: int] (dequeue_back_exn t) ~expect:5; + [%test_result: int] (dequeue_back_exn t) ~expect:4; + [%test_result: int] (dequeue_back_exn t) ~expect:3 + ;; + + let dequeue_and_ignore_exn = dequeue_and_ignore_exn + + let%test_unit _ = + let t = create () in + enqueue t 1; + enqueue t 2; + enqueue t 3; + [%test_result: int] (peek_exn t) ~expect:1; + dequeue_and_ignore_exn t; + [%test_result: int] (peek_exn t) ~expect:2; + dequeue_and_ignore_exn t; + [%test_result: int] (peek_exn t) ~expect:3; + dequeue_and_ignore_exn t; + [%test_result: int option] (peek t) ~expect:None; + assert (does_raise (fun () -> dequeue_and_ignore_exn t)); + assert (does_raise (fun () -> dequeue_and_ignore_exn t)); + [%test_result: int option] (peek t) ~expect:None + ;; + + let drain = drain + + let%test_unit _ = + let t = create () in + for i = 0 to 10 do + enqueue t i + done; + [%test_result: int] (peek_exn t) ~expect:0; + [%test_result: int] (length t) ~expect:11; + let r = ref 0 in + let add i = r := !r + i in + drain t ~f:add ~while_:(fun i -> i < 7); + [%test_result: int] (peek_exn t) ~expect:7; + [%test_result: int] (length t) ~expect:4; + [%test_result: int] !r ~expect:21; + drain t ~f:add ~while_:(fun i -> i > 7); + [%test_result: int] (peek_exn t) ~expect:7; + [%test_result: int] (length t) ~expect:4; + [%test_result: int] !r ~expect:21; + drain t ~f:add ~while_:(fun i -> i > 0); + [%test_result: int option] (peek t) ~expect:None; + [%test_result: int] (length t) ~expect:0; + [%test_result: int] !r ~expect:55 + ;; + + let enqueue_all = enqueue_all + + let%test_unit _ = + let t = create () in + enqueue_all t [ 1; 2; 3 ]; + [%test_result: int] (dequeue_exn t) ~expect:1; + [%test_result: int] (dequeue_exn t) ~expect:2; + [%test_result: int option] (last t) ~expect:(Some 3); + enqueue_all t [ 4; 5 ]; + [%test_result: int option] (last t) ~expect:(Some 5); + [%test_result: int] (dequeue_exn t) ~expect:3; + [%test_result: int] (dequeue_exn t) ~expect:4; + [%test_result: int] (dequeue_exn t) ~expect:5; + assert (does_raise (fun () -> dequeue_exn t)); + enqueue_all t []; + assert (does_raise (fun () -> dequeue_exn t)) + ;; + + let of_list = of_list + let to_list = to_list + + let%test_unit _ = + for i = 0 to 4 do + let list = List.init i ~f:Fn.id in + [%test_result: int list] (to_list (of_list list)) ~expect:list + done + ;; + + let%test _ = + let t = create () in + for i = 1 to 5 do + enqueue t i + done; + [%equal: int list] (to_list t) [ 1; 2; 3; 4; 5 ] + ;; + + let of_array = of_array + let to_array = to_array + + let%test_unit _ = + for len = 0 to 4 do + let array = Array.init len ~f:Fn.id in + [%test_result: int array] (to_array (of_array array)) ~expect:array + done + ;; + + let compare = compare + let compare__local = compare__local + let equal = equal + let equal__local = equal__local + + let%test_module "comparisons" = + (module struct + let sign x = if x < 0 then ~-1 else if x > 0 then 1 else 0 + + let test t1 t2 = + [%test_result: bool] + (equal Int.equal t1 t2) + ~expect:(List.equal Int.equal (to_list t1) (to_list t2)); + [%test_result: int] + (sign (compare Int.compare t1 t2)) + ~expect:(sign (List.compare Int.compare (to_list t1) (to_list t2))); + [%test_result: bool] + (equal__local Int.equal__local t1 t2) + ~expect: + (List.equal__local Int.equal__local (to_list t1) (to_list t2)); + [%test_result: int] + (sign (compare__local Int.compare__local t1 t2)) + ~expect: + (sign + (List.compare__local + Int.compare__local + (to_list t1) + (to_list t2))) + ;; + + let lists = + [ [] + ; [ 1 ] + ; [ 2 ] + ; [ 1; 1 ] + ; [ 1; 2 ] + ; [ 2; 1 ] + ; [ 1; 1; 1 ] + ; [ 1; 2; 3 ] + ; [ 1; 2; 4 ] + ; [ 1; 2; 4; 8 ] + ; [ 1; 2; 3; 4; 5 ] + ] + ;; + + let%test_unit _ = + (* [phys_equal] inputs *) + List.iter lists ~f:(fun list -> + let t = of_list list in + test t t) + ;; + + let%test_unit _ = + List.iter lists ~f:(fun list1 -> + List.iter lists ~f:(fun list2 -> + test (of_list list1) (of_list list2))) + ;; + end) + ;; + + let clear = clear + + let%test_unit "clear" = + let q = of_list [ 1; 2; 3; 4 ] in + [%test_result: int] (length q) ~expect:4; + clear q; + [%test_result: int] (length q) ~expect:0 + ;; + + let blit_transfer = blit_transfer + + let%test_unit _ = + let q_list = [ 1; 2; 3; 4 ] in + let q = of_list q_list in + let q' = create () in + blit_transfer ~src:q ~dst:q' (); + [%test_result: int list] (to_list q') ~expect:q_list; + [%test_result: int list] (to_list q) ~expect:[] + ;; + + let%test_unit _ = + let q = of_list [ 1; 2; 3; 4 ] in + let q' = create () in + blit_transfer ~src:q ~dst:q' ~len:2 (); + [%test_result: int list] (to_list q') ~expect:[ 1; 2 ]; + [%test_result: int list] (to_list q) ~expect:[ 3; 4 ] + ;; + + let%test_unit "blit_transfer on wrapped queues" = + let list = [ 1; 2; 3; 4 ] in + let q = of_list list in + let q' = copy q in + ignore (dequeue_exn q : int); + ignore (dequeue_exn q : int); + ignore (dequeue_exn q' : int); + ignore (dequeue_exn q' : int); + ignore (dequeue_exn q' : int); + enqueue q 5; + enqueue q 6; + blit_transfer ~src:q ~dst:q' ~len:3 (); + [%test_result: int list] (to_list q') ~expect:[ 4; 3; 4; 5 ]; + [%test_result: int list] (to_list q) ~expect:[ 6 ] + ;; + + let copy = copy + + let%test_unit "copies behave independently" = + let q = of_list [ 1; 2; 3; 4 ] in + let q' = copy q in + enqueue q 5; + ignore (dequeue_exn q' : int); + [%test_result: int list] (to_list q) ~expect:[ 1; 2; 3; 4; 5 ]; + [%test_result: int list] (to_list q') ~expect:[ 2; 3; 4 ] + ;; + + let dequeue = dequeue + let filter = filter + let filteri = filteri + let filter_inplace = filter_inplace + let filteri_inplace = filteri_inplace + let concat_map = concat_map + let concat_mapi = concat_mapi + let filter_map = filter_map + let filter_mapi = filter_mapi + let counti = counti + let existsi = existsi + let for_alli = for_alli + let iter = iter + let iteri = iteri + let foldi = foldi + let findi = findi + let find_mapi = find_mapi + + let%test_module "Linked_queue bisimulation" = + (module struct + module type Queue_intf = sig + type 'a t [@@deriving sexp_of] + + val create : unit -> 'a t + val enqueue : 'a t -> 'a -> unit + val dequeue : 'a t -> 'a option + + val drain + : 'a t + -> f:(('a -> unit)[@local]) + -> while_:(('a -> bool)[@local]) + -> unit + + val to_array : 'a t -> 'a array + val fold : 'a t -> init:'b -> f:('b -> 'a -> 'b) -> 'b + val foldi : 'a t -> init:'b -> f:(int -> 'b -> 'a -> 'b) -> 'b + val iter : 'a t -> f:('a -> unit) -> unit + val iteri : 'a t -> f:(int -> 'a -> unit) -> unit + val length : 'a t -> int + val clear : 'a t -> unit + val concat_map : 'a t -> f:('a -> 'b list) -> 'b t + val concat_mapi : 'a t -> f:(int -> 'a -> 'b list) -> 'b t + val filter_map : 'a t -> f:('a -> 'b option) -> 'b t + val filter_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b t + val filter : 'a t -> f:('a -> bool) -> 'a t + val filteri : 'a t -> f:(int -> 'a -> bool) -> 'a t + val filter_inplace : 'a t -> f:('a -> bool) -> unit + val filteri_inplace : 'a t -> f:(int -> 'a -> bool) -> unit + val map : 'a t -> f:('a -> 'b) -> 'b t + val mapi : 'a t -> f:(int -> 'a -> 'b) -> 'b t + val counti : 'a t -> f:(int -> 'a -> bool) -> int + val existsi : 'a t -> f:(int -> 'a -> bool) -> bool + val for_alli : 'a t -> f:(int -> 'a -> bool) -> bool + val findi : 'a t -> f:(int -> 'a -> bool) -> (int * 'a) option + val find_mapi : 'a t -> f:(int -> 'a -> 'b option) -> 'b option + val transfer : src:'a t -> dst:'a t -> unit + val copy : 'a t -> 'a t + end + + module That_queue : Queue_intf = Linked_queue + + module This_queue : Queue_intf = struct + include Queue + + let create () = create () + let transfer ~src ~dst = blit_transfer ~src ~dst () + end + + let this_to_string this_t = + Sexp.to_string (this_t |> [%sexp_of: int This_queue.t]) + ;; + + let that_to_string that_t = + Sexp.to_string (that_t |> [%sexp_of: int That_queue.t]) + ;; + + let array_string arr = Sexp.to_string (arr |> [%sexp_of: int array]) + let create () = This_queue.create (), That_queue.create () + + let enqueue (t_a, t_b) v = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + This_queue.enqueue t_a v; + That_queue.enqueue t_b v; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "enqueue transition failure of: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let iter (t_a, t_b) = + let r_a, r_b = ref 0, ref 0 in + This_queue.iter t_a ~f:(fun x -> r_a := !r_a + x); + That_queue.iter t_b ~f:(fun x -> r_b := !r_b + x); + if !r_a <> !r_b + then + Printf.failwithf + "error in iter: %s (from %s) <> %s (from %s)" + (Int.to_string !r_a) + (this_to_string t_a) + (Int.to_string !r_b) + (that_to_string t_b) + () + ;; + + let iteri (t_a, t_b) = + let r_a, r_b = ref 0, ref 0 in + This_queue.iteri t_a ~f:(fun i x -> r_a := !r_a + (x lxor i)); + That_queue.iteri t_b ~f:(fun i x -> r_b := !r_b + (x lxor i)); + if !r_a <> !r_b + then + Printf.failwithf + "error in iteri: %s (from %s) <> %s (from %s)" + (Int.to_string !r_a) + (this_to_string t_a) + (Int.to_string !r_b) + (that_to_string t_b) + () + ;; + + let dequeue (t_a, t_b) = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + let a, b = This_queue.dequeue t_a, That_queue.dequeue t_b in + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if (not ([%equal: int option] a b)) + || not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in dequeue: %s (%s -> %s) <> %s (%s -> %s)" + (Option.value ~default:"None" (Option.map a ~f:Int.to_string)) + (array_string start_a) + (array_string end_a) + (Option.value ~default:"None" (Option.map b ~f:Int.to_string)) + (array_string start_b) + (array_string end_b) + () + ;; + + let is_even x = x land 1 = 0 + + let drain (t_a, t_b) = + let orig_a = This_queue.to_array t_a in + let orig_b = That_queue.to_array t_b in + let r_a = ref 0 in + let r_b = ref 0 in + let add r i = r := !r + i in + This_queue.drain t_a ~f:(fun i -> add r_a i) ~while_:is_even; + That_queue.drain t_b ~f:(fun i -> add r_b i) ~while_:is_even; + if not + ([%equal: int array] + (This_queue.to_array t_a) + (That_queue.to_array t_b) + && !r_a = !r_b) + then + Printf.failwithf + "error in drain: %s -> %s, %d vs. %s -> %s, %d" + (array_string orig_a) + (this_to_string t_a) + !r_a + (array_string orig_b) + (that_to_string t_b) + !r_b + () + ;; + + let clear (t_a, t_b) = + This_queue.clear t_a; + That_queue.clear t_b + ;; + + let filter (t_a, t_b) = + let t_a' = This_queue.filter t_a ~f:is_even in + let t_b' = That_queue.filter t_b ~f:is_even in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filter: %s -> %s vs. %s -> %s" + (this_to_string t_a) + (this_to_string t_a') + (that_to_string t_b) + (that_to_string t_b') + () + ;; + + let filteri (t_a, t_b) = + let t_a' = + This_queue.filteri t_a ~f:(fun i j -> + [%equal: bool] (is_even i) (is_even j)) + in + let t_b' = + That_queue.filteri t_b ~f:(fun i j -> + [%equal: bool] (is_even i) (is_even j)) + in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filteri: %s -> %s vs. %s -> %s" + (this_to_string t_a) + (this_to_string t_a') + (that_to_string t_b) + (that_to_string t_b') + () + ;; + + let filter_inplace (t_a, t_b) = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + This_queue.filter_inplace t_a ~f:is_even; + That_queue.filter_inplace t_b ~f:is_even; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in filter_inplace: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let filteri_inplace (t_a, t_b) = + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + let f i x = [%equal: bool] (is_even i) (is_even x) in + This_queue.filteri_inplace t_a ~f; + That_queue.filteri_inplace t_b ~f; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in filteri_inplace: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let concat_map (t_a, t_b) = + let f x = [ x; x + 1; x + 2 ] in + let t_a' = This_queue.concat_map t_a ~f in + let t_b' = That_queue.concat_map t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in concat_map: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let concat_mapi (t_a, t_b) = + let f i x = [ x; x + 1; x + 2; x + i ] in + let t_a' = This_queue.concat_mapi t_a ~f in + let t_b' = That_queue.concat_mapi t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in concat_mapi: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let filter_map (t_a, t_b) = + let f x = if is_even x then None else Some (x + 1) in + let t_a' = This_queue.filter_map t_a ~f in + let t_b' = That_queue.filter_map t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filter_map: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let filter_mapi (t_a, t_b) = + let f i x = + if [%equal: bool] (is_even i) (is_even x) + then None + else Some (x + 1 + i) + in + let t_a' = This_queue.filter_mapi t_a ~f in + let t_b' = That_queue.filter_mapi t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in filter_mapi: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let map (t_a, t_b) = + let f x = x * 7 in + let t_a' = This_queue.map t_a ~f in + let t_b' = That_queue.map t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in map: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let mapi (t_a, t_b) = + let f i x = (x + 3) lxor i in + let t_a' = This_queue.mapi t_a ~f in + let t_b' = That_queue.mapi t_b ~f in + if not + ([%equal: int array] + (This_queue.to_array t_a') + (That_queue.to_array t_b')) + then + Printf.failwithf + "error in mapi: %s (for %s) <> %s (for %s)" + (this_to_string t_a') + (this_to_string t_a) + (that_to_string t_b') + (that_to_string t_b) + () + ;; + + let counti (t_a, t_b) = + let f i x = i < 7 && i % 7 = x % 7 in + let a' = This_queue.counti t_a ~f in + let b' = That_queue.counti t_b ~f in + if a' <> b' + then + Printf.failwithf + "error in counti: %d (for %s) <> %d (for %s)" + a' + (this_to_string t_a) + b' + (that_to_string t_b) + () + ;; + + let existsi (t_a, t_b) = + let f i x = i < 7 && i % 7 = x % 7 in + let a' = This_queue.existsi t_a ~f in + let b' = That_queue.existsi t_b ~f in + if not ([%equal: bool] a' b') + then + Printf.failwithf + "error in existsi: %b (for %s) <> %b (for %s)" + a' + (this_to_string t_a) + b' + (that_to_string t_b) + () + ;; + + let for_alli (t_a, t_b) = + let f i x = i >= 7 || i % 7 <> x % 7 in + let a' = This_queue.for_alli t_a ~f in + let b' = That_queue.for_alli t_b ~f in + if not ([%equal: bool] a' b') + then + Printf.failwithf + "error in for_alli: %b (for %s) <> %b (for %s)" + a' + (this_to_string t_a) + b' + (that_to_string t_b) + () + ;; + + let findi (t_a, t_b) = + let f i x = i < 7 && i % 7 = x % 7 in + let a' = This_queue.findi t_a ~f in + let b' = That_queue.findi t_b ~f in + if not ([%equal: (int * int) option] a' b') + then + Printf.failwithf + "error in findi: %s (for %s) <> %s (for %s)" + (Sexp.to_string ([%sexp_of: (int * int) option] a')) + (this_to_string t_a) + (Sexp.to_string ([%sexp_of: (int * int) option] b')) + (that_to_string t_b) + () + ;; + + let find_mapi (t_a, t_b) = + let f i x = if i < 7 && i % 7 = x % 7 then Some (i + x) else None in + let a' = This_queue.find_mapi t_a ~f in + let b' = That_queue.find_mapi t_b ~f in + if not ([%equal: int option] a' b') + then + Printf.failwithf + "error in find_mapi: %s (for %s) <> %s (for %s)" + (Sexp.to_string ([%sexp_of: int option] a')) + (this_to_string t_a) + (Sexp.to_string ([%sexp_of: int option] b')) + (that_to_string t_b) + () + ;; + + let copy (t_a, t_b) = + let copy_a = This_queue.copy t_a in + let copy_b = That_queue.copy t_b in + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + let end_a = This_queue.to_array copy_a in + let end_b = That_queue.to_array copy_b in + if not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in copy: %s -> %s vs. %s -> %s" + (array_string start_a) + (array_string end_a) + (array_string start_b) + (array_string end_b) + () + ;; + + let transfer (t_a, t_b) = + let dst_a = This_queue.create () in + let dst_b = That_queue.create () in + (* sometimes puts some elements in the destination queues *) + if Random.bool () + then + List.iter [ 1; 2; 3; 4; 5 ] ~f:(fun elem -> + This_queue.enqueue dst_a elem; + That_queue.enqueue dst_b elem); + let start_a = This_queue.to_array t_a in + let start_b = That_queue.to_array t_b in + This_queue.transfer ~src:t_a ~dst:dst_a; + That_queue.transfer ~src:t_b ~dst:dst_b; + let end_a = This_queue.to_array t_a in + let end_b = That_queue.to_array t_b in + let end_a' = This_queue.to_array dst_a in + let end_b' = That_queue.to_array dst_b in + if (not ([%equal: int array] end_a' end_b')) + || not ([%equal: int array] end_a end_b) + then + Printf.failwithf + "error in transfer: %s -> (%s, %s) vs. %s -> (%s, %s)" + (array_string start_a) + (array_string end_a) + (array_string end_a') + (array_string start_b) + (array_string end_b) + (array_string end_b) + () + ;; + + let fold_check (t_a, t_b) = + let make_list fold t = fold t ~init:[] ~f:(fun acc x -> x :: acc) in + let this_l = make_list This_queue.fold t_a in + let that_l = make_list That_queue.fold t_b in + if not ([%equal: int list] this_l that_l) + then + Printf.failwithf + "error in fold: %s (from %s) <> %s (from %s)" + (Sexp.to_string (this_l |> [%sexp_of: int list])) + (this_to_string t_a) + (Sexp.to_string (that_l |> [%sexp_of: int list])) + (that_to_string t_b) + () + ;; + + let foldi_check (t_a, t_b) = + let make_list foldi t = + foldi t ~init:[] ~f:(fun i acc x -> (i, x) :: acc) + in + let this_l = make_list This_queue.foldi t_a in + let that_l = make_list That_queue.foldi t_b in + if not ([%equal: (int * int) list] this_l that_l) + then + Printf.failwithf + "error in foldi: %s (from %s) <> %s (from %s)" + (Sexp.to_string (this_l |> [%sexp_of: (int * int) list])) + (this_to_string t_a) + (Sexp.to_string (that_l |> [%sexp_of: (int * int) list])) + (that_to_string t_b) + () + ;; + + let length_check (t_a, t_b) = + let this_len = This_queue.length t_a in + let that_len = That_queue.length t_b in + if this_len <> that_len + then + Printf.failwithf + "error in length: %i (for %s) <> %i (for %s)" + this_len + (this_to_string t_a) + that_len + (that_to_string t_b) + () + ;; + + let%test_unit _ = + let t = create () in + let rec loop ~all_ops ~non_empty_ops = + if all_ops <= 0 && non_empty_ops <= 0 + then ( + let t_a, t_b = t in + let arr_a = This_queue.to_array t_a in + let arr_b = That_queue.to_array t_b in + if not ([%equal: int array] arr_a arr_b) + then + Printf.failwithf + "queue final states not equal: %s vs. %s" + (array_string arr_a) + (array_string arr_b) + ()) + else ( + let queue_was_empty = This_queue.length (fst t) = 0 in + let r = Random.int 200 in + if r < 60 + then enqueue t (Random.int 10_000) + else if r < 65 + then dequeue t + else if r < 70 + then clear t + else if r < 80 + then iter t + else if r < 85 + then iteri t + else if r < 90 + then fold_check t + else if r < 95 + then foldi_check t + else if r < 100 + then filter t + else if r < 105 + then filteri t + else if r < 110 + then concat_map t + else if r < 115 + then concat_mapi t + else if r < 120 + then transfer t + else if r < 130 + then filter_map t + else if r < 135 + then filter_mapi t + else if r < 140 + then copy t + else if r < 150 + then filter_inplace t + else if r < 155 + then for_alli t + else if r < 160 + then existsi t + else if r < 165 + then counti t + else if r < 170 + then findi t + else if r < 175 + then find_mapi t + else if r < 180 + then map t + else if r < 185 + then mapi t + else if r < 190 + then filteri_inplace t + else if r < 195 + then length_check t + else if r < 200 + then drain t + else failwith "Impossible: We did [Random.int 200] above"; + loop + ~all_ops:(all_ops - 1) + ~non_empty_ops: + (if queue_was_empty then non_empty_ops else non_empty_ops - 1)) + in + loop ~all_ops:30_000 ~non_empty_ops:20_000 + ;; + end) + ;; + + let%test_unit "modification-during-iteration" = + let x = `A 0 in + let t = of_list [ x; x ] in + let f (`A n) = + ignore n; + clear t + in + assert (does_raise (fun () -> iter t ~f)) + ;; + + let%test_unit "more-modification-during-iteration" = + let nested_iter_okay = ref false in + let t = of_list [ `iter; `clear ] in + assert ( + does_raise (fun () -> + iter t ~f:(function + | `iter -> + iter t ~f:ignore; + nested_iter_okay := true + | `clear -> clear t))); + assert !nested_iter_okay + ;; + + let%test_unit "modification-during-filter" = + let reached_unreachable = ref false in + let t = of_list [ `clear; `unreachable ] in + let f x = + match x with + | `clear -> + clear t; + false + | `unreachable -> + reached_unreachable := true; + false + in + assert (does_raise (fun () -> filter t ~f)); + assert (not !reached_unreachable) + ;; + + let%test_unit "modification-during-filter-inplace" = + let reached_unreachable = ref false in + let t = of_list [ `drop_this; `enqueue_new_element; `unreachable ] in + let f x = + (match x with + | `drop_this | `new_element -> () + | `enqueue_new_element -> enqueue t `new_element + | `unreachable -> reached_unreachable := true); + false + in + assert (does_raise (fun () -> filter_inplace t ~f)); + (* even though we said to drop the first element, the aborted call to [filter_inplace] shouldn't have made that change *) - (match peek_exn t with - | `drop_this -> () - | `new_element | `enqueue_new_element | `unreachable -> - failwith "Expected the first element to be `drop_this"); - assert (not !reached_unreachable) - ;; - - let%test_unit "filter-inplace-during-iteration" = - let reached_unreachable = ref false in - let t = of_list [ `filter_inplace; `unreachable ] in - let f x = - match x with - | `filter_inplace -> filter_inplace t ~f:(fun _ -> false) - | `unreachable -> reached_unreachable := true - in - assert (does_raise (fun () -> iter t ~f)); - assert (not !reached_unreachable) - ;; - end - (* This signature is here to remind us to update the unit tests whenever we + (match peek_exn t with + | `drop_this -> () + | `new_element | `enqueue_new_element | `unreachable -> + failwith "Expected the first element to be `drop_this"); + assert (not !reached_unreachable) + ;; + + let%test_unit "filter-inplace-during-iteration" = + let reached_unreachable = ref false in + let t = of_list [ `filter_inplace; `unreachable ] in + let f x = + match x with + | `filter_inplace -> filter_inplace t ~f:(fun _ -> false) + | `unreachable -> reached_unreachable := true + in + assert (does_raise (fun () -> iter t ~f)); + assert (not !reached_unreachable) + ;; + end + (* This signature is here to remind us to update the unit tests whenever we change [Queue]. *) : - module type of Queue)) + module type of Queue)) ;; diff --git a/test/test_sequence.ml b/test/test_sequence.ml index 56767364..33ef647b 100644 --- a/test/test_sequence.ml +++ b/test/test_sequence.ml @@ -59,8 +59,8 @@ let%test_module "Sequence.merge*" = ;; let test_merge_semantics - ~merge - ~(normalize_list : _ -> compare:((_ -> _ -> _)[@local]) -> _) + ~merge + ~(normalize_list : _ -> compare:((_ -> _ -> _)[@local]) -> _) = Base_quickcheck.Test.run_exn (module struct @@ -496,7 +496,7 @@ let%expect_test "fold_m" = s12345 ~init:[] ~f:(fun acc n -> - Simple_monad.bind Simple_monad.step ~f:(fun () -> Simple_monad.return (n :: acc))) + Simple_monad.bind Simple_monad.step ~f:(fun () -> Simple_monad.return (n :: acc))) |> printf !"%{sexp: int list Simple_monad.t}\n"; [%expect {| (Step (Step (Step (Step (Step (Return (5 4 3 2 1))))))) |}] ;; diff --git a/test/test_set_interface.ml b/test/test_set_interface.ml index cc03b20f..81d7d059 100644 --- a/test/test_set_interface.ml +++ b/test/test_set_interface.ml @@ -10,12 +10,12 @@ module _ : sig include Creators_and_accessors_generic - with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t - with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_first_class_module.t - with type ('a, 'b) set := ('a, 'b) t - with type ('a, 'b) t := ('a, 'b) t - with type ('a, 'b) tree := ('a, 'b) Set.Using_comparator.Tree.t - with type 'a elt := 'a - with type 'c cmp := 'c + with type ('a, 'b, 'c) access_options := ('a, 'b, 'c) Without_comparator.t + with type ('a, 'b, 'c) create_options := ('a, 'b, 'c) With_first_class_module.t + with type ('a, 'b) set := ('a, 'b) t + with type ('a, 'b) t := ('a, 'b) t + with type ('a, 'b) tree := ('a, 'b) Set.Using_comparator.Tree.t + with type 'a elt := 'a + with type 'c cmp := 'c end = Set diff --git a/test/test_sexpable.ml b/test/test_sexpable.ml index 31b3cbe0..c3a80ab7 100644 --- a/test/test_sexpable.ml +++ b/test/test_sexpable.ml @@ -9,19 +9,19 @@ let%test_module "Of_stringable" = type t = Double of string [@@deriving quickcheck] include Of_stringable (struct - type nonrec t = t + type nonrec t = t - let to_string (Double x) = x ^ x + let to_string (Double x) = x ^ x - let of_string x = - let length = String.length x in - let first_half = String.drop_suffix x (length / 2) in - let second_half = String.drop_suffix x (length / 2) in - if length % 2 = 0 && String.(first_half = second_half) - then Double first_half - else failwith [%string "Invalid doubled string %{x}"] - ;; - end) + let of_string x = + let length = String.length x in + let first_half = String.drop_suffix x (length / 2) in + let second_half = String.drop_suffix x (length / 2) in + if length % 2 = 0 && String.(first_half = second_half) + then Double first_half + else failwith [%string "Invalid doubled string %{x}"] + ;; + end) end let%expect_test "validate sexp grammar" = diff --git a/test/test_sign.ml b/test/test_sign.ml index 07864844..d00bd2dc 100644 --- a/test/test_sign.ml +++ b/test/test_sign.ml @@ -6,7 +6,7 @@ let%test "of_int" = of_int 37 = Pos && of_int (-22) = Neg && of_int 0 = Zero let%test_unit "( * )" = List.cartesian_product all all |> List.iter ~f:(fun (s1, s2) -> - [%test_result: int] (to_int (s1 * s2)) ~expect:(Int.( * ) (to_int s1) (to_int s2))) + [%test_result: int] (to_int (s1 * s2)) ~expect:(Int.( * ) (to_int s1) (to_int s2))) ;; let%expect_test ("hash coherence" [@tags "64-bits-only"]) = diff --git a/test/test_string.ml b/test/test_string.ml index 55172348..fa3763d2 100644 --- a/test/test_string.ml +++ b/test/test_string.ml @@ -592,7 +592,7 @@ let%test_module "tr_multi" = ; "ab", "dcba", "abcdefg", "dccdefg" ] |> List.map ~f:(fun (target, replacement, string, expected) -> - { Test.target; replacement; string; expected = Some expected }) + { Test.target; replacement; string; expected = Some expected }) ;; let%test_unit _ = @@ -757,9 +757,9 @@ let%test_module "map" = [%here] (module String) (map s ~f:(function - | 'a' -> 'b' - | 'b' -> 'a' - | x -> x)) + | 'a' -> 'b' + | 'b' -> 'a' + | x -> x)) "fbaoo" ;; end) @@ -814,9 +814,9 @@ let%test_unit _ = [%test_result: bool] ~expect:true (exists "abc" ~f:(function - | 'a' -> false - | 'b' -> true - | _ -> assert false)) + | 'a' -> false + | 'b' -> true + | _ -> assert false)) ;; let%test_unit _ = @@ -830,9 +830,9 @@ let%test_unit _ = [%test_result: bool] ~expect:false (for_all "abc" ~f:(function - | 'a' -> true - | 'b' -> false - | _ -> assert false)) + | 'a' -> true + | 'b' -> false + | _ -> assert false)) ;; let%test_unit _ = diff --git a/test/test_type_equal.ml b/test/test_type_equal.ml index 5dc30441..bfcf30fc 100644 --- a/test/test_type_equal.ml +++ b/test/test_type_equal.ml @@ -59,7 +59,7 @@ let%test_module "Type_equal" = (* let _a_to_b (a : A.t) = * let T = Id.same_witness_exn A.id B.id in * (a : B.t) - *) + *) module C = struct type 'a t diff --git a/test/test_uniform_array.ml b/test/test_uniform_array.ml index 80c02340..45115974 100644 --- a/test/test_uniform_array.ml +++ b/test/test_uniform_array.ml @@ -173,7 +173,7 @@ let%expect_test "concat_map" = print_s [%sexp (concat_map t ~f:(fun i -> of_list [ i * 10; (i * 10) + 1; (i * 10) + 2 ]) - : int t)] + : int t)] in test empty; [%expect {| () |}]; @@ -187,7 +187,7 @@ let%expect_test "concat_mapi" = [%sexp (concat_mapi t ~f:(fun idx i -> if idx = 1 then empty else of_list [ i * 10; (i * 10) + 1; (i * 10) + 2 ]) - : int t)] + : int t)] in test empty; [%expect {| () |}]; @@ -219,7 +219,7 @@ let%expect_test "filter_map" = [%sexp (filter_map t ~f:(fun i -> if i % 2 = 0 then None else Some (Char.of_int_exn (Char.to_int 'a' + i))) - : char t)] + : char t)] in test empty; [%expect {| () |}]; @@ -239,7 +239,7 @@ let%expect_test "filter_mapi" = (Int.to_string idx ^ ": " ^ Char.to_string (Char.of_int_exn (Char.to_int 'a' + i)))) - : string t)] + : string t)] in test empty; [%expect {| () |}]; @@ -278,7 +278,7 @@ let%expect_test "find_mapi" = print_s [%sexp (find_mapi t ~f:(fun idx i -> if idx % 2 = 1 then None else Char.of_int i) - : char option)] + : char option)] in test empty; [%expect {| () |}];