Skip to content

Commit

Permalink
fix: generate shims for "stdlib", using dune configurator; fix warnings
Browse files Browse the repository at this point in the history
warn-error was a mistake
  • Loading branch information
c-cube committed May 12, 2020
1 parent 187d8d6 commit 9929be3
Show file tree
Hide file tree
Showing 5 changed files with 54 additions and 30 deletions.
2 changes: 1 addition & 1 deletion gen.opam
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ build: [
["dune" "build" "@doc" "-p" name] {with-doc}
]
depends: [
"dune" {build}
"dune" {>= "1.1"}
"base-bytes"
"odoc" {with-doc}
"qcheck" {with-test}
Expand Down
21 changes: 14 additions & 7 deletions src/dune
Original file line number Diff line number Diff line change
@@ -1,19 +1,26 @@
(executable
(name mkshims)
(modules mkshims)
(libraries dune.configurator))

(rule
(targets GenShims_.ml)
(deps ./mkshims.exe)
(action (run ./mkshims.exe)))

(rule
(targets flambda.flags)
(deps (file mkflags.ml))
(mode fallback)
(action
(run ocaml ./mkflags.ml))
)
(action (run ocaml ./mkflags.ml)))

(library
(name gen)
(public_name gen)
(wrapped false)
(modules Gen GenLabels GenM GenClone GenMList GenM_intf Gen_intf GenLabels_intf)
(flags :standard -w +a-4-42-44-48-50-58-32-60@8 -safe-string -nolabels)
(modules Gen GenLabels GenM GenClone GenMList GenM_intf Gen_intf GenLabels_intf GenShims_)
(flags :standard -warn-error -a+8 -safe-string -nolabels)
(ocamlopt_flags :standard (:include flambda.flags))
(libraries bytes)
(inline_tests (backend qtest.lib))
)
(inline_tests (backend qtest.lib)))

44 changes: 22 additions & 22 deletions src/gen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -376,7 +376,7 @@ let take n gen =

(*$Q
(Q.pair Q.small_int (Q.list Q.small_int)) (fun (n,l) -> \
of_list l |> take n |> length = Pervasives.min n (List.length l))
of_list l |> take n |> length = GenShims_.Stdlib.min n (List.length l))
*)

(* call [gen] at most [n] times, and stop *)
Expand Down Expand Up @@ -668,7 +668,7 @@ let eq ?(eq=(=)) gen1 gen2 =
eq (of_list l1)(of_list l2) = (l1 = l2))
*)

let lexico ?(cmp=Pervasives.compare) gen1 gen2 =
let lexico ?(cmp=GenShims_.Stdlib.compare) gen1 gen2 =
let rec lexico () =
match gen1(), gen2() with
| None, None -> 0
Expand All @@ -684,7 +684,7 @@ let compare ?cmp gen1 gen2 = lexico ?cmp gen1 gen2
(*$Q
(Q.pair (Q.list Q.small_int)(Q.list Q.small_int)) (fun (l1,l2) -> \
let sign x = if x < 0 then -1 else if x=0 then 0 else 1 in \
sign (compare (of_list l1)(of_list l2)) = sign (Pervasives.compare l1 l2))
sign (compare (of_list l1)(of_list l2)) = sign (GenShims_.Stdlib.compare l1 l2))
*)

let rec find p e = match e () with
Expand Down Expand Up @@ -838,17 +838,17 @@ let merge next_gen =

(*$T
merge (of_list [of_list [1;3;5]; of_list [2;4;6]; of_list [7;8;9]]) \
|> to_list |> List.sort Pervasives.compare = [1;2;3;4;5;6;7;8;9]
|> to_list |> List.sort GenShims_.Stdlib.compare = [1;2;3;4;5;6;7;8;9]
*)

(*$R
let e = of_list [1--3; 4--6; 7--9] in
let e' = merge e in
OUnit.assert_equal [1;2;3;4;5;6;7;8;9]
(to_list e' |> List.sort Pervasives.compare);
(to_list e' |> List.sort GenShims_.Stdlib.compare);
*)

let intersection ?(cmp=Pervasives.compare) gen1 gen2 =
let intersection ?(cmp=GenShims_.Stdlib.compare) gen1 gen2 =
let x1 = ref (gen1 ()) in
let x2 = ref (gen2 ()) in
let rec next () =
Expand All @@ -869,7 +869,7 @@ let intersection ?(cmp=Pervasives.compare) gen1 gen2 =
|> to_list = [1;2;4;8]
*)

let sorted_merge ?(cmp=Pervasives.compare) gen1 gen2 =
let sorted_merge ?(cmp=GenShims_.Stdlib.compare) gen1 gen2 =
let x1 = ref (gen1 ()) in
let x2 = ref (gen2 ()) in
fun () ->
Expand Down Expand Up @@ -937,7 +937,7 @@ module Heap = struct
x
end

let sorted_merge_n ?(cmp=Pervasives.compare) l =
let sorted_merge_n ?(cmp=GenShims_.Stdlib.compare) l =
(* make a heap of (value, generator) *)
let cmp (v1,_) (v2,_) = cmp v1 v2 in
let heap = Heap.empty ~cmp in
Expand Down Expand Up @@ -1169,15 +1169,15 @@ let product gena genb =

(*$T
product (1--3) (of_list ["a"; "b"]) |> to_list \
|> List.sort Pervasives.compare = \
|> List.sort GenShims_.Stdlib.compare = \
[1, "a"; 1, "b"; 2, "a"; 2, "b"; 3, "a"; 3, "b"]
*)

(*$R
let printer = pi2list in
let e = Gen.product (1--3) (4--5) in
OUnit.assert_equal ~printer [1,4; 1,5; 2,4; 2,5; 3,4; 3,5]
(List.sort Pervasives.compare (Gen.to_list e));
(List.sort GenShims_.Stdlib.compare (Gen.to_list e));
*)

(* Group equal consecutive elements together. *)
Expand Down Expand Up @@ -1232,7 +1232,7 @@ let uniq ?(eq=(=)) gen =
[0;1;0;2;3;4;5;10]
*)

let sort ?(cmp=Pervasives.compare) gen =
let sort ?(cmp=GenShims_.Stdlib.compare) gen =
(* build heap *)
let h = Heap.empty ~cmp in
iter (Heap.insert h) gen;
Expand All @@ -1248,7 +1248,7 @@ let sort ?(cmp=Pervasives.compare) gen =

(* NOTE: using a set is not really possible, because once we have built the
set there is no simple way to iterate on it *)
let sort_uniq ?(cmp=Pervasives.compare) gen =
let sort_uniq ?(cmp=GenShims_.Stdlib.compare) gen =
uniq ~eq:(fun x y -> cmp x y = 0) (sort ~cmp gen)

(*$T
Expand Down Expand Up @@ -1350,7 +1350,7 @@ let permutations g =
next (make_machine (List.length l) l)

(*$T permutations
permutations (1--3) |> to_list |> List.sort Pervasives.compare = \
permutations (1--3) |> to_list |> List.sort GenShims_.Stdlib.compare = \
[[1;2;3]; [1;3;2]; [2;1;3]; [2;3;1]; [3;1;2]; [3;2;1]]
permutations empty |> to_list = [[]]
permutations (singleton 1) |> to_list = [[1]]
Expand Down Expand Up @@ -1434,7 +1434,7 @@ let permutations_heap g =
else next {elts = a; n=n; is=[0]}

(*$T permutations_heap
permutations_heap (1--3) |> to_list |> List.sort Pervasives.compare = \
permutations_heap (1--3) |> to_list |> List.sort GenShims_.Stdlib.compare = \
[[|1;2;3|]; [|1;3;2|]; [|2;1;3|]; [|2;3;1|]; [|3;1;2|]; [|3;2;1|]]
permutations_heap empty |> to_list = []
permutations_heap (singleton 1) |> to_list = [[|1|]]
Expand Down Expand Up @@ -1480,8 +1480,8 @@ let combinations n g =
next (make_state n l)

(*$T
combinations 2 (1--4) |> map (List.sort Pervasives.compare) \
|> to_list |> List.sort Pervasives.compare = \
combinations 2 (1--4) |> map (List.sort GenShims_.Stdlib.compare) \
|> to_list |> List.sort GenShims_.Stdlib.compare = \
[[1;2]; [1;3]; [1;4]; [2;3]; [2;4]; [3;4]]
combinations 0 (1--4) |> to_list = [[]]
combinations 1 (singleton 1) |> to_list = [[1]]
Expand Down Expand Up @@ -1521,12 +1521,12 @@ let power_set g =
next (make_state l)

(*$T
power_set (1--3) |> map (List.sort Pervasives.compare) \
|> to_list |> List.sort Pervasives.compare = \
power_set (1--3) |> map (List.sort GenShims_.Stdlib.compare) \
|> to_list |> List.sort GenShims_.Stdlib.compare = \
[[]; [1]; [1;2]; [1;2;3]; [1;3]; [2]; [2;3]; [3]]
power_set empty |> to_list = [[]]
power_set (singleton 1) |> map (List.sort Pervasives.compare) \
|> to_list |> List.sort Pervasives.compare = [[]; [1]]
power_set (singleton 1) |> map (List.sort GenShims_.Stdlib.compare) \
|> to_list |> List.sort GenShims_.Stdlib.compare = [[]; [1]]
*)

(** {3 Conversion} *)
Expand Down Expand Up @@ -1843,10 +1843,10 @@ module Restart = struct

let uniq ?eq e () = uniq ?eq (e ())

let sort ?(cmp=Pervasives.compare) enum =
let sort ?(cmp=GenShims_.Stdlib.compare) enum =
fun () -> sort ~cmp (enum ())

let sort_uniq ?(cmp=Pervasives.compare) e =
let sort_uniq ?(cmp=GenShims_.Stdlib.compare) e =
let e' = sort ~cmp e in
uniq ~eq:(fun x y -> cmp x y = 0) e'

Expand Down
1 change: 1 addition & 0 deletions src/genClone.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ type 'a gen = unit -> 'a option

class virtual ['a] t = object
method virtual gen : 'a gen (** Generator of values tied to this copy *)

method virtual clone : 'a t (** Clone the internal state *)
end
(** A generator that can be cloned as many times as required. *)
Expand Down
16 changes: 16 additions & 0 deletions src/mkshims.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
module C = Configurator.V1

let write_file f s =
let out = open_out f in
output_string out s; flush out; close_out out

let shims_pre_407 = "module Stdlib = Pervasives"

let shims_post_407 = "module Stdlib = Stdlib"

let () =
C.main ~name:"mkshims" (fun c ->
let version = C.ocaml_config_var_exn c "version" in
let major, minor = Scanf.sscanf version "%u.%u" (fun maj min -> maj, min) in
write_file "GenShims_.ml" (if (major, minor) >= (4,7) then shims_post_407 else shims_pre_407);
)

0 comments on commit 9929be3

Please sign in to comment.