mbarbin / super-master-mind / 217

Committed 31 Jan 2026 12:24PM UTC coverage: 50.206% (-38.1%) from 88.313%

Build # 217

Build Type

Pull #45

github

Committed by

web-flow

Commit Message

Merge 235b668da into 3d48eb3d9

Pull Request Pull Request #45: Dune pkg ci migration

Run Details

610 of 1215 relevant lines covered (50.21%)

597078.5 hits per line

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

45.26

/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 ^ "\"" ]))))
;;

external format_float : string -> float -> string = "caml_format_float"

(* 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
   - Adds "." if needed to make a valid float lexeme (from stdlib) *)
let float_to_string =
  let valid_float_lexeme s =
    let l = String.length s in
    let rec loop i =
      if i >= l
      then s ^ "."
      else (
        match s.[i] with
        | '0' .. '9' | '-' -> loop (i + 1)
        | _ -> s)
    in
    loop 0
  in
  fun x ->
    let s = format_float "%.15g" x in
    valid_float_lexeme @@ if float_of_string s = x then s else format_float "%.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	1✔
65	\| last :: before_last -> Some (List.rev before_last, last)	×
66	\| [] -> None	1✔
67	;;
68
69	let string_in_ocaml_syntax str =
70	let is_space = function	1✔
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 ->	1✔
86	(match unsnoc rest with
87	\| None -> Pp.verbatim (Printf.sprintf "%S" first)	1✔
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	external format_float : string -> float -> string = "caml_format_float"
100
101	(* Float-to-string conversion that preserves round-trip accuracy.
102	Algorithm from sexplib0 (https://github.com/janestreet/sexplib0):
103	- %.17g is guaranteed to round-trip
104	- %.15g avoids ugly trailing digits (e.g. "3.1400000000000001") for floats
105	converted from decimals with <= 15 significant digits
106	- Try %.15g first; if it doesn't round-trip, use %.17g
107	- Adds "." if needed to make a valid float lexeme (from stdlib) *)
108	let float_to_string =
109	let valid_float_lexeme s =
110	let l = String.length s in	40✔
111	let rec loop i =	40✔
112	if i >= l	85✔
113	then s ^ "."	10✔
114	else (	75✔
115	match s.[i] with
116	\| '0' .. '9' \| '-' -> loop (i + 1)	×
117	\| _ -> s)	30✔
118	in
119	loop 0
120	in
121	fun x ->
122	let s = format_float "%.15g" x in	40✔
123	valid_float_lexeme @@ if float_of_string s = x then s else format_float "%.17g" x	12✔
124	;;
125
126	let pp_sequence start stop x ~f =
127	let open Pp.O in	38✔
128	match x with
129	\| [] -> Pp.verbatim start ++ Pp.verbatim stop	×
130	\| _ ->	38✔
131	let sep = ";" ^ String.make (String.length start) ' ' in	38✔
132	Pp.hvbox
133	(Pp.concat_mapi ~sep:Pp.cut x ~f:(fun i x ->	38✔
134	Pp.box	174✔
135	~indent:2
136	((if i = 0 then Pp.verbatim (start ^ " ") else Pp.verbatim sep) ++ f x))	38✔
137	++ Pp.space	38✔
138	++ Pp.verbatim stop)	38✔
139	;;
140
141	let rec pp ?(in_arg = false) =	225✔
142	let open Pp.O in	225✔
143	function
144	\| Opaque -> Pp.verbatim "<opaque>"	×
145	\| Unit -> Pp.verbatim "()"	×
146	\| Int i -> Pp.verbatim (string_of_int i)	33✔
147	\| Int32 i -> Pp.verbatim (Int32.to_string i)	×
148	\| Int64 i -> Pp.verbatim (Int64.to_string i)	×
149	\| Nativeint i -> Pp.verbatim (Nativeint.to_string i)	×
150	\| Bool b -> Pp.verbatim (string_of_bool b)	×
151	\| String s -> string_in_ocaml_syntax s	1✔
152	\| Bytes b -> string_in_ocaml_syntax (Bytes.to_string b)	×
153	\| Char c -> Pp.char c	×
154	\| Float f -> Pp.verbatim (float_to_string f)	40✔
155	\| Option None -> pp ~in_arg (Variant ("None", []))	×
156	\| Option (Some x) -> pp ~in_arg (Variant ("Some", [ x ]))	×
157	\| List xs -> pp_sequence "[" "]" xs ~f:pp	5✔
158	\| Array xs -> pp_sequence "[\|" "\|]" (Array.to_list xs) ~f:pp	17✔
159	\| Set xs ->	×
160	Pp.box ~indent:2 (Pp.verbatim "set" ++ Pp.space ++ pp_sequence "{" "}" xs ~f:pp)	×
161	\| Map xs ->	×
162	Pp.box
163	~indent:2
164	(Pp.verbatim "map"	×
165	++ Pp.space	×
166	++ pp_sequence "{" "}" xs ~f:(fun (k, v) ->	×
167	Pp.box ~indent:2 (pp k ++ Pp.space ++ Pp.char ':' ++ Pp.space ++ pp v)))	×
168	\| Tuple xs ->	17✔
169	Pp.char '('	17✔
170	++ Pp.hvbox (Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp)	17✔
171	++ Pp.char ')'	17✔
172	\| Record fields ->	16✔
173	pp_sequence "{" "}" fields ~f:(fun (f, v) ->
174	Pp.box ~indent:2 (Pp.verbatim f ++ Pp.space ++ Pp.char '=' ++ Pp.space ++ pp v))	78✔
175	\| Variant (v, []) -> Pp.verbatim v	96✔
176	\| Variant (v, (_ :: _ as xs)) ->	×
177	let arg =
178	match xs with
179	\| [ x ] -> x	×
180	\| _ -> Tuple xs	×
181	in
182	let app = Pp.hvbox ~indent:2 (Pp.verbatim v ++ Pp.space ++ pp ~in_arg:true arg) in	×
183	if in_arg then Pp.char '(' ++ app ++ Pp.char ')' else app	×
184	;;
185
186	let pp t = pp t	17✔
187	let to_string t = Format.asprintf "%a" Pp.to_fmt (pp t)	1✔
188
189	type 'a builder = 'a -> t
190
191	let unit () = Unit	×
192	let char x = Char x	×
193	let string x = String x	×
194	let int x = Int x	33✔
195	let int32 x = Int32 x	×
196	let int64 x = Int64 x	×
197	let nativeint x = Nativeint x	×
198	let float x = Float x	40✔
199	let bool x = Bool x	×
200	let pair f g (x, y) = Tuple [ f x; g y ]	×
201	let triple f g h (x, y, z) = Tuple [ f x; g y; h z ]	×
202	let list f l = List (List.map ~f l)	5✔
203	let array f a = Array (Array.map ~f a)	17✔
204
205	let option f x =
206	Option	×
207	(match x with
208	\| None -> None	×
209	\| Some x -> Some (f x))	×
210	;;
211
212	let record r = Record r	15✔
213	let opaque _ = Opaque	×
214	let variant s args = Variant (s, args)	96✔
215	let hash = Stdlib.Hashtbl.hash
216	let compare x y = Ordering.of_int (compare x y)	×
217	let equal x y = x = y	×
218
219	let result ok err = function
220	\| Ok e -> variant "Ok" [ ok e ]	×
221	\| Error e -> variant "Error" [ err e ]	×
222	;;

mbarbin / super-master-mind / 217

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