mbarbin / super-master-mind / 181

Committed 16 Dec 2025 07:32PM UTC coverage: 89.469% (-2.5%) from 92.007%

Build # 181

Build Type

Pull #35

github

Committed by

web-flow

Commit Message

Merge 9bffa3d3e into e92bc19b9

Pull Request Pull Request #35: Vendor dyn

Run Details

49 of 86 new or added lines in 1 file covered. (56.98%)

1062 of 1187 relevant lines covered (89.47%)

3135193.93 hits per line

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

56.98

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

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 (string_of_float 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✔
NEW 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✔
NEW 71	\| ' ' ->	×
72	(* don't need to handle tabs because those are already escaped *)
73	true
NEW 74	\| _ -> false	×
75	in
76	let escape_protect_first_space s =
NEW 77	let first_char = if String.length s > 0 && is_space s.[0] then "\\" else " " in	×
NEW 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✔
NEW 88	\| Some (middle, last) ->	×
89	Pp.vbox
NEW 90	(Pp.concat	×
91	~sep:Pp.cut
NEW 92	(List.map	×
93	~f:Pp.verbatim
NEW 94	((("\"" ^ String.escaped first ^ "\\n\\")	×
NEW 95	:: List.map middle ~f:(fun s -> escape_protect_first_space s ^ "\\n\\"))	×
NEW 96	@ [ escape_protect_first_space last ^ "\"" ]))))	×
97	;;
98
99	let pp_sequence start stop x ~f =
100	let open Pp.O in	536✔
101	match x with
102	\| [] -> Pp.verbatim start ++ Pp.verbatim stop	5✔
103	\| _ ->	531✔
104	let sep = ";" ^ String.make (String.length start) ' ' in	531✔
105	Pp.hvbox
106	(Pp.concat_mapi ~sep:Pp.cut x ~f:(fun i x ->	531✔
107	Pp.box	2,132✔
108	~indent:2
109	((if i = 0 then Pp.verbatim (start ^ " ") else Pp.verbatim sep) ++ f x))	531✔
110	++ Pp.space	531✔
111	++ Pp.verbatim stop)	531✔
112	;;
113
114	let rec pp ?(in_arg = false) =	2,424✔
115	let open Pp.O in	2,437✔
116	function
NEW 117	\| Opaque -> Pp.verbatim "<opaque>"	×
118	\| Unit -> Pp.verbatim "()"	1✔
119	\| Int i -> Pp.verbatim (string_of_int i)	691✔
NEW 120	\| Int32 i -> Pp.verbatim (Int32.to_string i)	×
NEW 121	\| Int64 i -> Pp.verbatim (Int64.to_string i)	×
NEW 122	\| Nativeint i -> Pp.verbatim (Nativeint.to_string i)	×
123	\| Bool b -> Pp.verbatim (string_of_bool b)	6✔
124	\| String s -> string_in_ocaml_syntax s	18✔
NEW 125	\| Bytes b -> string_in_ocaml_syntax (Bytes.to_string b)	×
NEW 126	\| Char c -> Pp.char c	×
127	\| Float f -> Pp.verbatim (string_of_float f)	583✔
128	\| Option None -> pp ~in_arg (Variant ("None", []))	3✔
129	\| Option (Some x) -> pp ~in_arg (Variant ("Some", [ x ]))	4✔
130	\| List xs -> pp_sequence "[" "]" xs ~f:pp	38✔
131	\| Array xs -> pp_sequence "[\|" "\|]" (Array.to_list xs) ~f:pp	69✔
NEW 132	\| Set xs ->	×
NEW 133	Pp.box ~indent:2 (Pp.verbatim "set" ++ Pp.space ++ pp_sequence "{" "}" xs ~f:pp)	×
NEW 134	\| Map xs ->	×
135	Pp.box
136	~indent:2
NEW 137	(Pp.verbatim "map"	×
NEW 138	++ Pp.space	×
NEW 139	++ pp_sequence "{" "}" xs ~f:(fun (k, v) ->	×
NEW 140	Pp.box ~indent:2 (pp k ++ Pp.space ++ Pp.char ':' ++ Pp.space ++ pp v)))	×
141	\| Tuple xs ->	59✔
142	Pp.char '('	59✔
143	++ Pp.hvbox (Pp.concat_map ~sep:(Pp.seq (Pp.char ',') Pp.space) xs ~f:pp)	59✔
144	++ Pp.char ')'	59✔
145	\| Record fields ->	429✔
146	pp_sequence "{" "}" fields ~f:(fun (f, v) ->
147	Pp.box ~indent:2 (Pp.verbatim f ++ Pp.space ++ Pp.char '=' ++ Pp.space ++ pp v))	1,587✔
148	\| Variant (v, []) -> Pp.verbatim v	530✔
149	\| Variant (v, (_ :: _ as xs)) ->	6✔
150	let arg =
151	match xs with
152	\| [ x ] -> x	6✔
NEW 153	\| _ -> Tuple xs	×
154	in
155	let app = Pp.hvbox ~indent:2 (Pp.verbatim v ++ Pp.space ++ pp ~in_arg:true arg) in	6✔
NEW 156	if in_arg then Pp.char '(' ++ app ++ Pp.char ')' else app	×
157	;;
158
159	let pp t = pp t	174✔
160	let to_string t = Format.asprintf "%a" Pp.to_fmt (pp t)	20✔
161
162	type 'a builder = 'a -> t
163
164	let unit () = Unit	1✔
NEW 165	let char x = Char x	×
166	let string x = String x	4✔
167	let int x = Int x	691✔
NEW 168	let int32 x = Int32 x	×
NEW 169	let int64 x = Int64 x	×
NEW 170	let nativeint x = Nativeint x	×
171	let float x = Float x	583✔
172	let bool x = Bool x	6✔
NEW 173	let pair f g (x, y) = Tuple [ f x; g y ]	×
NEW 174	let triple f g h (x, y, z) = Tuple [ f x; g y; h z ]	×
175	let list f l = List (List.map ~f l)	38✔
176	let array f a = Array (Array.map ~f a)	69✔
177
178	let option f x =
179	Option	7✔
180	(match x with
181	\| None -> None	3✔
182	\| Some x -> Some (f x))	4✔
183	;;
184
185	let record r = Record r	415✔
NEW 186	let opaque _ = Opaque	×
187	let variant s args = Variant (s, args)	529✔
188	let hash = Stdlib.Hashtbl.hash
NEW 189	let compare x y = Ordering.of_int (compare x y)	×
NEW 190	let equal x y = x = y	×
191
192	let result ok err = function
NEW 193	\| Ok e -> variant "Ok" [ ok e ]	×
NEW 194	\| Error e -> variant "Error" [ err e ]	×
195	;;

mbarbin / super-master-mind / 181

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