mbarbin / super-master-mind / 236

Committed 15 Mar 2026 05:30PM UTC coverage: 89.377% (+1.1%) from 88.313%

Build # 236

Build Type

push

github

Committed by

web-flow

Commit Message

Merge pull request #52 from mbarbin/improve-stdlib

Improve local stdlib

Coverage Stats

176 of 188 new or added lines in 15 files covered. (93.62%)

1220 of 1365 relevant lines covered (89.38%)

2333623.83 hits per line

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

92.11

/src/stdlib/nonempty_list0.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                                                 *)
(*********************************************************************************)

(* Note: Defining [(::)] as a constructor shadows [Stdlib.(::)] within this
   module. In patterns, the compiler resolves [(::)] based on the expected
   type. In expressions, we use [List.cons] when building regular lists. *)

module List = List0

type 'a t = ( :: ) of 'a * 'a list

let singleton x = x :: []
let hd (hd :: _) = hd
let tl (_ :: tl) = tl
let cons x (hd :: tl) = x :: List.cons hd tl
let to_list (hd :: tl) = List.cons hd tl

let of_list_exn (type a) : a list -> a t = function
  | [] -> invalid_arg "Nonempty_list.of_list_exn"
  | x :: xs -> x :: xs
;;

let to_array t = Stdlib.Array.of_list (to_list t)
let length ((_ : _) :: tl) = 1 + List.length tl

let init n ~f =
  if n <= 0 then invalid_arg "Nonempty_list.init";
  match List.init ~len:n ~f with
  | [] -> assert false
  | x :: xs -> x :: xs
;;

let append (hd :: tl) rest = hd :: (tl @ rest)

let map (x :: xs) ~f =
  let y = f x in
  y :: List.map xs ~f
;;

let mapi t ~f =
  match List.mapi (to_list t) ~f with
  | [] -> assert false
  | x :: xs -> x :: xs
;;

let iter t ~f = List.iter (to_list t) ~f
let fold (hd :: tl) ~init ~f = List.fold tl ~init:(f init hd) ~f
let find (hd :: tl) ~f = if f hd then Some hd else List.find_opt tl ~f
let filter t ~f = List.filter (to_list t) ~f
let filter_map t ~f = List.filter_map (to_list t) ~f

let concat_map t ~f =
  match List.concat_map (to_list t) ~f:(fun x -> to_list (f x)) with
  | [] -> assert false
  | x :: xs -> x :: xs
;;

let max_elt (hd :: tl) ~compare =
  List.fold tl ~init:hd ~f:(fun acc x ->
    match compare x acc with
    | Ordering.Gt -> x
    | Lt | Eq -> acc)
;;

module type Summable = sig
  type t

  val zero : t
  val ( + ) : t -> t -> t
end

let sum (type a) (module M : Summable with type t = a) t ~f =
  fold t ~init:M.zero ~f:(fun acc x -> M.( + ) acc (f x))
;;

let compare compare_a (hd1 :: tl1) (hd2 :: tl2) =
  match compare_a hd1 hd2 with
  | Ordering.Eq ->
    List.compare tl1 tl2 ~cmp:(fun a b -> compare_a a b |> Ordering.to_int)
    |> Ordering.of_int
  | ord -> ord
;;

let equal equal_a (hd1 :: tl1) (hd2 :: tl2) =
  equal_a hd1 hd2 && List.equal equal_a tl1 tl2
;;

module Or_unequal_lengths = struct
  type 'a t =
    | Ok of 'a
    | Unequal_lengths
end

let zip (hd1 :: tl1) (hd2 :: tl2) =
  if List.length tl1 <> List.length tl2
  then Or_unequal_lengths.Unequal_lengths
  else Or_unequal_lengths.Ok ((hd1, hd2) :: List.combine tl1 tl2)
;;

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	(* Note: Defining [(::)] as a constructor shadows [Stdlib.(::)] within this
8	module. In patterns, the compiler resolves [(::)] based on the expected
9	type. In expressions, we use [List.cons] when building regular lists. *)
10
11	module List = List0
12
13	type 'a t = ( :: ) of 'a * 'a list
14
15	let singleton x = x :: []	27✔
16	let hd (hd :: _) = hd	19✔
17	let tl (_ :: tl) = tl	3✔
18	let cons x (hd :: tl) = x :: List.cons hd tl	2✔
19	let to_list (hd :: tl) = List.cons hd tl	1,889✔
20
21	let of_list_exn (type a) : a list -> a t = function
22	\| [] -> invalid_arg "Nonempty_list.of_list_exn"	1✔
23	\| x :: xs -> x :: xs	300,870✔
24	;;
25
26	let to_array t = Stdlib.Array.of_list (to_list t)	1✔
27	let length ((_ : _) :: tl) = 1 + List.length tl	12✔
28
29	let init n ~f =
NEW 30	if n <= 0 then invalid_arg "Nonempty_list.init";	×
31	match List.init ~len:n ~f with	1✔
32	\| [] -> assert false
33	\| x :: xs -> x :: xs	1✔
34	;;
35
36	let append (hd :: tl) rest = hd :: (tl @ rest)	1✔
37
38	let map (x :: xs) ~f =
39	let y = f x in	2,858✔
40	y :: List.map xs ~f	2,858✔
41	;;
42
43	let mapi t ~f =
44	match List.mapi (to_list t) ~f with	1✔
45	\| [] -> assert false
46	\| x :: xs -> x :: xs	1✔
47	;;
48
49	let iter t ~f = List.iter (to_list t) ~f	1✔
50	let fold (hd :: tl) ~init ~f = List.fold tl ~init:(f init hd) ~f	895,494✔
51	let find (hd :: tl) ~f = if f hd then Some hd else List.find_opt tl ~f	3✔
52	let filter t ~f = List.filter (to_list t) ~f	1✔
53	let filter_map t ~f = List.filter_map (to_list t) ~f	1✔
54
55	let concat_map t ~f =
56	match List.concat_map (to_list t) ~f:(fun x -> to_list (f x)) with	1✔
57	\| [] -> assert false
58	\| x :: xs -> x :: xs	1✔
59	;;
60
61	let max_elt (hd :: tl) ~compare =
62	List.fold tl ~init:hd ~f:(fun acc x ->	1✔
63	match compare x acc with	4✔
64	\| Ordering.Gt -> x	2✔
NEW 65	\| Lt \| Eq -> acc)	×
66	;;
67
68	module type Summable = sig
69	type t
70
71	val zero : t
72	val ( + ) : t -> t -> t
73	end
74
75	let sum (type a) (module M : Summable with type t = a) t ~f =
76	fold t ~init:M.zero ~f:(fun acc x -> M.( + ) acc (f x))	1✔
77	;;
78
79	let compare compare_a (hd1 :: tl1) (hd2 :: tl2) =
80	match compare_a hd1 hd2 with	2✔
81	\| Ordering.Eq ->	2✔
82	List.compare tl1 tl2 ~cmp:(fun a b -> compare_a a b \|> Ordering.to_int)	2✔
83	\|> Ordering.of_int	2✔
NEW 84	\| ord -> ord	×
85	;;
86
87	let equal equal_a (hd1 :: tl1) (hd2 :: tl2) =
88	equal_a hd1 hd2 && List.equal equal_a tl1 tl2	1,563✔
89	;;
90
91	module Or_unequal_lengths = struct
92	type 'a t =
93	\| Ok of 'a
94	\| Unequal_lengths
95	end
96
97	let zip (hd1 :: tl1) (hd2 :: tl2) =
98	if List.length tl1 <> List.length tl2	1,560✔
99	then Or_unequal_lengths.Unequal_lengths	2✔
100	else Or_unequal_lengths.Ok ((hd1, hd2) :: List.combine tl1 tl2)	1,558✔
101	;;

mbarbin / super-master-mind / 236

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