Source file `month.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
open! Import
module String = Base.String

module Stable = struct
  module V1 = struct
    type t =
      | Jan
      | Feb
      | Mar
      | Apr
      | May
      | Jun
      | Jul
      | Aug
      | Sep
      | Oct
      | Nov
      | Dec
    [@@deriving
      compare ~localize
      , equal ~localize
      , globalize
      , hash
      , quickcheck ~portable
      , sexp ~stackify
      , sexp_grammar
      , typerep
      , variants]

    let failwithf = Printf.failwithf

    let of_int_exn i : t =
      match i with
      | 1 -> Jan
      | 2 -> Feb
      | 3 -> Mar
      | 4 -> Apr
      | 5 -> May
      | 6 -> Jun
      | 7 -> Jul
      | 8 -> Aug
      | 9 -> Sep
      | 10 -> Oct
      | 11 -> Nov
      | 12 -> Dec
      | _ -> failwithf "Month.of_int_exn %d" i ()
    ;;

    let of_int i =
      try Some (of_int_exn i) with
      | _ -> None
    ;;

    let to_int (t : t) =
      match t with
      | Jan -> 1
      | Feb -> 2
      | Mar -> 3
      | Apr -> 4
      | May -> 5
      | Jun -> 6
      | Jul -> 7
      | Aug -> 8
      | Sep -> 9
      | Oct -> 10
      | Nov -> 11
      | Dec -> 12
    ;;

    let to_binable t = to_int t - 1
    let of_binable i = of_int_exn (i + 1)

    include%template
      Binable.Stable.Of_binable.V1 [@mode local] [@modality portable] [@alert "-legacy"]
        (Int.Stable.V1)
        (struct
          type nonrec t = t

          let[@mode m = (global, local)] to_binable = to_binable
          let of_binable = of_binable
        end)

    include%template
      (val (Comparator.Stable.V1.make [@modality portable]) ~compare ~sexp_of_t)

    let stable_witness : t Stable_witness.t =
      Stable_witness.of_serializable Int.Stable.V1.stable_witness of_binable to_binable
    ;;
  end
end

let num_months = 12

module T = struct
  include Stable.V1

  let all = [ Jan; Feb; Mar; Apr; May; Jun; Jul; Aug; Sep; Oct; Nov; Dec ]
  let hash = to_int
end

include T

include%template (
  Hashable.Make_binable [@modality portable] (struct
    include T
  end) :
  sig
  @@ portable
    include Hashable.S_binable with type t := t
  end)

include%template
  Comparable.Make_binable_using_comparator [@mode local] [@modality portable] (struct
    include T

    (* In 108.06a and earlier, months in sexps of Maps and Sets were raw ints. From 108.07
       through 109.13, the output format remained raw as before, but both the raw and
       pretty format were accepted as input. From 109.14 on, the output format was changed
       from raw to pretty, while continuing to accept both formats. Once we believe most
       programs are beyond 109.14, we will switch the input format to no longer accept
       raw. *)
    let t_of_sexp sexp =
      match Option.try_with (fun () -> Int.t_of_sexp sexp) with
      | Some i -> of_int_exn (i + 1)
      | None -> T.t_of_sexp sexp
    ;;
  end)

(* Replace the overriden sexp converters from [Comparable.Make_binable] with the ordinary
   symbolic converters. *)
let sexp_of_t = T.sexp_of_t
let t_of_sexp = T.t_of_sexp
let shift t i = of_int_exn (1 + Int.( % ) (to_int t - 1 + i) num_months)

let all_strings =
  Portable_lazy.from_fun (fun () ->
    Iarray.of_list (List.map all ~f:(fun variant -> Sexp.to_string (sexp_of_t variant))))
;;

let to_string (t : t) =
  let all_strings = Portable_lazy.force all_strings in
  all_strings.:(to_int t - 1)
;;

let of_string =
  let table =
    Portable_lazy.from_fun (fun () ->
      Portable_lazy.force all_strings
      |> Iarray.to_list
      |> List.concat_mapi ~f:(fun i s ->
        let t = of_int_exn (i + 1) in
        [ s, t; String.lowercase s, t; String.uppercase s, t ])
      |> String_dict.of_alist_exn)
  in
  fun str ->
    match String_dict.find (Portable_lazy.force table) str with
    | Some x -> x
    | None -> failwithf "Invalid month: %s" str ()
;;

module Export = struct
  type month = t =
    | Jan
    | Feb
    | Mar
    | Apr
    | May
    | Jun
    | Jul
    | Aug
    | Sep
    | Oct
    | Nov
    | Dec
end
Source file month.ml

Source file `month.ml`
