mbarbin / super-master-mind / 183

Committed 16 Dec 2025 07:51PM UTC coverage: 89.487% (+0.02%) from 89.469%

Build # 183

Build Type

Pull #36

github

Committed by

web-flow

Commit Message

Merge ee06b04ce into 2659a0ccd

Pull Request Pull Request #36: Import dune 12982

Run Details

13 of 13 new or added lines in 1 file covered. (100.0%)

17 existing lines in 1 file now uncovered.

1064 of 1189 relevant lines covered (89.49%)

3125380.0 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

57.95

/src/stdlib/dyn0.ml

(*********************************************************************************)
(*  super-master-mind: A solver for the super master mind game                   *)
(*  SPDX-FileCopyrightText: 2021-2025 Mathieu Barbin <mathieu.barbin@gmail.com>  *)
(*  SPDX-License-Identifier: MIT                                                 *)
(*********************************************************************************)

(*_ Notice: This file was vendored from [Core], which we documented in the NOTICE
  at the root of the repo.

  The original license header was kept with the file, see below.

  List of changes:
*)

(* The MIT License

   Copyright (c) 2016 Jane Street Group, LLC <opensource@janestreet.com>

   Permission is hereby granted, free of charge, to any person obtaining a copy
   of this software and associated documentation files (the "Software"), to deal
   in the Software without restriction, including without limitation the rights
   to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
   copies of the Software, and to permit persons to whom the Software is
   furnished to do so, subject to the following conditions:

   The above copyright notice and this permission notice shall be included in all
   copies or substantial portions of the Software.

   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
   IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
   FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
   AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
   LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
   OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
   SOFTWARE. *)

module Array = Stdlib.ArrayLabels
module List = Stdlib.ListLabels
module String = Stdlib.StringLabels
module Bytes = Stdlib.Bytes

type t =
  | Opaque
  | Unit
  | Int of int
  | Int32 of int32
  | Int64 of int64
  | Nativeint of nativeint
  | Bool of bool
  | String of string
  | Bytes of bytes
  | Char of char
  | Float of float
  | Option of t option
  | List of t list
  | Array of t array
  | Tuple of t list
  | Record of (string * t) list
  | Variant of string * t list
  | Map of (t * t) list
  | Set of t list

let unsnoc l =
  match List.rev l with
  | last :: before_last -> Some (List.rev before_last, last)
  | [] -> None
;;

let string_in_ocaml_syntax str =
  let is_space = function
    | ' ' ->
      (* don't need to handle tabs because those are already escaped *)
      true
    | _ -> false
  in
  let escape_protect_first_space s =
    let first_char = if String.length s > 0 && is_space s.[0] then "\\" else " " in
    first_char ^ String.escaped s
  in
  (* CR-someday aalekseyev: should use the method from
     [Dune_lang.prepare_formatter] so that the formatter can fit multiple lines
     on one line. *)
  match String.split_on_char ~sep:'\n' str with
  | [] -> assert false
  | first :: rest ->
    (match unsnoc rest with
     | None -> Pp.verbatim (Printf.sprintf "%S" first)
     | Some (middle, last) ->
       Pp.vbox
         (Pp.concat
            ~sep:Pp.cut
            (List.map
               ~f:Pp.verbatim
               ((("\"" ^ String.escaped first ^ "\\n\\")
                 :: List.map middle ~f:(fun s -> escape_protect_first_space s ^ "\\n\\"))
                @ [ escape_protect_first_space last ^ "\"" ]))))
;;

(* Float-to-string conversion that preserves round-trip accuracy.
   Algorithm from sexplib0 (https://github.com/janestreet/sexplib0):
   - %.17G is guaranteed to round-trip
   - %.15G avoids ugly trailing digits (e.g. "3.1400000000000001") for floats
     converted from decimals with <= 15 significant digits
   - Try %.15G first; if it doesn't round-trip, use %.17G *)
let float_to_string x =
  let s = Printf.sprintf "%.15G" x in
  if float_of_string s = x then s else Printf.sprintf "%.17G" x
;;

let pp_sequence start stop x ~f =
  let open Pp.O in
  match x with
  | [] -> Pp.verbatim start ++ Pp.verbatim stop
  | _ ->
    let sep = ";" ^ String.make (String.length start) ' ' in
    Pp.hvbox
      (Pp.concat_mapi ~sep:Pp.cut x ~f:(fun i x ->
         Pp.box
           ~indent:2
           ((if i = 0 then Pp.verbatim (start ^ " ") else Pp.verbatim sep) ++ f x))
       ++ Pp.space
       ++ Pp.verbatim stop)
;;

let rec pp ?(in_arg = false) =
  let open Pp.O in
  function
  | Opaque -> Pp.verbatim "<opaque>"
  | Unit -> Pp.verbatim "()"
  | Int i -> Pp.verbatim (string_of_int i)
  | Int32 i -> Pp.verbatim (Int32.to_string i)
  | Int64 i -> Pp.verbatim (Int64.to_string i)
  | Nativeint i -> Pp.verbatim (Nativeint.to_string i)
  | Bool b -> Pp.verbatim (string_of_bool b)
  | String s -> string_in_ocaml_syntax s
  | Bytes b -> string_in_ocaml_syntax (Bytes.to_string b)
  | Char c -> Pp.char c
  | Float f -> Pp.verbatim (float_to_string f)
  | Option None -> pp ~in_arg (Variant ("None", []))
  | Option (Some x) -> pp ~in_arg (Variant ("Some", [ x ]))
  | List xs -> pp_sequence "[" "]" xs ~f:pp
  | Array xs -> pp_sequence "[|" "|]" (Array.to_list xs) ~f:pp
  | Set xs ->
    Pp.box ~indent:2 (Pp.verbatim "set" ++ Pp.space ++ pp_sequence "{" "}" xs ~f:pp)
  | Map xs ->
    Pp.box
      ~indent:2
      (Pp.verbatim "map"
       ++ Pp.space
       ++ pp_sequence "{" "}" xs ~f:(fun (k, v) ->
         Pp.box ~indent:2 (pp k ++ Pp.space ++ Pp.char ':' ++ Pp.space ++ pp v)))
  | Tuple xs ->
    Pp.char '('
    ++ Pp.hvbox (Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp)
    ++ Pp.char ')'
  | Record fields ->
    pp_sequence "{" "}" fields ~f:(fun (f, v) ->
      Pp.box ~indent:2 (Pp.verbatim f ++ Pp.space ++ Pp.char '=' ++ Pp.space ++ pp v))
  | Variant (v, []) -> Pp.verbatim v
  | Variant (v, (_ :: _ as xs)) ->
    let arg =
      match xs with
      | [ x ] -> x
      | _ -> Tuple xs
    in
    let app = Pp.hvbox ~indent:2 (Pp.verbatim v ++ Pp.space ++ pp ~in_arg:true arg) in
    if in_arg then Pp.char '(' ++ app ++ Pp.char ')' else app
;;

let pp t = pp t
let to_string t = Format.asprintf "%a" Pp.to_fmt (pp t)

type 'a builder = 'a -> t

let unit () = Unit
let char x = Char x
let string x = String x
let int x = Int x
let int32 x = Int32 x
let int64 x = Int64 x
let nativeint x = Nativeint x
let float x = Float x
let bool x = Bool x
let pair f g (x, y) = Tuple [ f x; g y ]
let triple f g h (x, y, z) = Tuple [ f x; g y; h z ]
let list f l = List (List.map ~f l)
let array f a = Array (Array.map ~f a)

let option f x =
  Option
    (match x with
     | None -> None
     | Some x -> Some (f x))
;;

let record r = Record r
let opaque _ = Opaque
let variant s args = Variant (s, args)
let hash = Stdlib.Hashtbl.hash
let compare x y = Ordering.of_int (compare x y)
let equal x y = x = y

let result ok err = function
  | Ok e -> variant "Ok" [ ok e ]
  | Error e -> variant "Error" [ err e ]
;;

1	(*********************************************************************************)
2	(* super-master-mind: A solver for the super master mind game *)
3	(* SPDX-FileCopyrightText: 2021-2025 Mathieu Barbin <mathieu.barbin@gmail.com> *)
4	(* SPDX-License-Identifier: MIT *)
5	(*********************************************************************************)
6
7	(*_ Notice: This file was vendored from [Core], which we documented in the NOTICE
8	at the root of the repo.
9
10	The original license header was kept with the file, see below.
11
12	List of changes:
13	*)
14
15	(* The MIT License
16
17	Copyright (c) 2016 Jane Street Group, LLC <opensource@janestreet.com>
18
19	Permission is hereby granted, free of charge, to any person obtaining a copy
20	of this software and associated documentation files (the "Software"), to deal
21	in the Software without restriction, including without limitation the rights
22	to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
23	copies of the Software, and to permit persons to whom the Software is
24	furnished to do so, subject to the following conditions:
25
26	The above copyright notice and this permission notice shall be included in all
27	copies or substantial portions of the Software.
28
29	THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
30	IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
31	FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
32	AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
33	LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
34	OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
35	SOFTWARE. *)
36
37	module Array = Stdlib.ArrayLabels
38	module List = Stdlib.ListLabels
39	module String = Stdlib.StringLabels
40	module Bytes = Stdlib.Bytes
41
42	type t =
43	\| Opaque
44	\| Unit
45	\| Int of int
46	\| Int32 of int32
47	\| Int64 of int64
48	\| Nativeint of nativeint
49	\| Bool of bool
50	\| String of string
51	\| Bytes of bytes
52	\| Char of char
53	\| Float of float
54	\| Option of t option
55	\| List of t list
56	\| Array of t array
57	\| Tuple of t list
58	\| Record of (string * t) list
59	\| Variant of string * t list
60	\| Map of (t * t) list
61	\| Set of t list
62
63	let unsnoc l =
64	match List.rev l with	18✔
65	\| last :: before_last -> Some (List.rev before_last, last)	×
66	\| [] -> None	18✔
67	;;
68
69	let string_in_ocaml_syntax str =
70	let is_space = function	18✔
71	\| ' ' ->	×
72	(* don't need to handle tabs because those are already escaped *)
73	true
74	\| _ -> false	×
75	in
76	let escape_protect_first_space s =
77	let first_char = if String.length s > 0 && is_space s.[0] then "\\" else " " in	×
78	first_char ^ String.escaped s	×
79	in
80	(* CR-someday aalekseyev: should use the method from
81	[Dune_lang.prepare_formatter] so that the formatter can fit multiple lines
82	on one line. *)
83	match String.split_on_char ~sep:'\n' str with
84	\| [] -> assert false
85	\| first :: rest ->	18✔
86	(match unsnoc rest with
87	\| None -> Pp.verbatim (Printf.sprintf "%S" first)	18✔
88	\| Some (middle, last) ->	×
89	Pp.vbox
90	(Pp.concat	×
91	~sep:Pp.cut
92	(List.map	×
93	~f:Pp.verbatim
94	((("\"" ^ String.escaped first ^ "\\n\\")	×
95	:: List.map middle ~f:(fun s -> escape_protect_first_space s ^ "\\n\\"))	×
96	@ [ escape_protect_first_space last ^ "\"" ]))))	×
97	;;
98
99	(* Float-to-string conversion that preserves round-trip accuracy.
100	Algorithm from sexplib0 (https://github.com/janestreet/sexplib0):
101	- %.17G is guaranteed to round-trip
102	- %.15G avoids ugly trailing digits (e.g. "3.1400000000000001") for floats
103	converted from decimals with <= 15 significant digits
104	- Try %.15G first; if it doesn't round-trip, use %.17G *)
105	let float_to_string x =
106	let s = Printf.sprintf "%.15G" x in	583✔
107	if float_of_string s = x then s else Printf.sprintf "%.17G" x	223✔
108	;;
109
110	let pp_sequence start stop x ~f =
111	let open Pp.O in	536✔
112	match x with
113	\| [] -> Pp.verbatim start ++ Pp.verbatim stop	5✔
114	\| _ ->	531✔
115	let sep = ";" ^ String.make (String.length start) ' ' in	531✔
116	Pp.hvbox
117	(Pp.concat_mapi ~sep:Pp.cut x ~f:(fun i x ->	531✔
118	Pp.box	2,132✔
119	~indent:2
120	((if i = 0 then Pp.verbatim (start ^ " ") else Pp.verbatim sep) ++ f x))	531✔
121	++ Pp.space	531✔
122	++ Pp.verbatim stop)	531✔
123	;;
124
125	let rec pp ?(in_arg = false) =	2,424✔
126	let open Pp.O in	2,437✔
127	function
UNCOV 128	\| Opaque -> Pp.verbatim "<opaque>"	×
129	\| Unit -> Pp.verbatim "()"	1✔
130	\| Int i -> Pp.verbatim (string_of_int i)	691✔
UNCOV 131	\| Int32 i -> Pp.verbatim (Int32.to_string i)	×
UNCOV 132	\| Int64 i -> Pp.verbatim (Int64.to_string i)	×
UNCOV 133	\| Nativeint i -> Pp.verbatim (Nativeint.to_string i)	×
134	\| Bool b -> Pp.verbatim (string_of_bool b)	6✔
135	\| String s -> string_in_ocaml_syntax s	18✔
UNCOV 136	\| Bytes b -> string_in_ocaml_syntax (Bytes.to_string b)	×
UNCOV 137	\| Char c -> Pp.char c	×
138	\| Float f -> Pp.verbatim (float_to_string f)	583✔
139	\| Option None -> pp ~in_arg (Variant ("None", []))	3✔
140	\| Option (Some x) -> pp ~in_arg (Variant ("Some", [ x ]))	4✔
141	\| List xs -> pp_sequence "[" "]" xs ~f:pp	38✔
142	\| Array xs -> pp_sequence "[\|" "\|]" (Array.to_list xs) ~f:pp	69✔
UNCOV 143	\| Set xs ->	×
144	Pp.box ~indent:2 (Pp.verbatim "set" ++ Pp.space ++ pp_sequence "{" "}" xs ~f:pp)	×
UNCOV 145	\| Map xs ->	×
146	Pp.box
147	~indent:2
148	(Pp.verbatim "map"	×
149	++ Pp.space	×
UNCOV 150	++ pp_sequence "{" "}" xs ~f:(fun (k, v) ->	×
UNCOV 151	Pp.box ~indent:2 (pp k ++ Pp.space ++ Pp.char ':' ++ Pp.space ++ pp v)))	×
152	\| Tuple xs ->	59✔
153	Pp.char '('	59✔
154	++ Pp.hvbox (Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp)	59✔
155	++ Pp.char ')'	59✔
156	\| Record fields ->	429✔
157	pp_sequence "{" "}" fields ~f:(fun (f, v) ->
158	Pp.box ~indent:2 (Pp.verbatim f ++ Pp.space ++ Pp.char '=' ++ Pp.space ++ pp v))	1,587✔
159	\| Variant (v, []) -> Pp.verbatim v	530✔
160	\| Variant (v, (_ :: _ as xs)) ->	6✔
161	let arg =
162	match xs with
163	\| [ x ] -> x	6✔
164	\| _ -> Tuple xs	×
165	in
166	let app = Pp.hvbox ~indent:2 (Pp.verbatim v ++ Pp.space ++ pp ~in_arg:true arg) in	6✔
167	if in_arg then Pp.char '(' ++ app ++ Pp.char ')' else app	×
168	;;
169
170	let pp t = pp t	174✔
171	let to_string t = Format.asprintf "%a" Pp.to_fmt (pp t)	20✔
172
173	type 'a builder = 'a -> t
174
175	let unit () = Unit	1✔
UNCOV 176	let char x = Char x	×
177	let string x = String x	4✔
178	let int x = Int x	691✔
UNCOV 179	let int32 x = Int32 x	×
180	let int64 x = Int64 x	×
UNCOV 181	let nativeint x = Nativeint x	×
182	let float x = Float x	583✔
183	let bool x = Bool x	6✔
UNCOV 184	let pair f g (x, y) = Tuple [ f x; g y ]	×
UNCOV 185	let triple f g h (x, y, z) = Tuple [ f x; g y; h z ]	×
186	let list f l = List (List.map ~f l)	38✔
187	let array f a = Array (Array.map ~f a)	69✔
188
189	let option f x =
190	Option	7✔
191	(match x with
192	\| None -> None	3✔
193	\| Some x -> Some (f x))	4✔
194	;;
195
196	let record r = Record r	415✔
197	let opaque _ = Opaque	×
198	let variant s args = Variant (s, args)	529✔
199	let hash = Stdlib.Hashtbl.hash
200	let compare x y = Ordering.of_int (compare x y)	×
201	let equal x y = x = y	×
202
203	let result ok err = function
UNCOV 204	\| Ok e -> variant "Ok" [ ok e ]	×
UNCOV 205	\| Error e -> variant "Error" [ err e ]	×
206	;;

mbarbin / super-master-mind / 183

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous