lib/kernel/names.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

(* Celebration names by language. An open assoc list rather than a fixed record,
   so an overlay can add a language purely as data (spec §2.1). Kept sorted by
   language code so sexp output is byte-stable. *)
type t = (Lang.t * string) list

let empty = []
let canonical t = List.sort (fun (a, _) (b, _) -> Lang.compare a b) t
let remove t lang = List.filter (fun (l, _) -> not (Lang.equal l lang)) t
let set t lang name = canonical ((lang, name) :: remove t lang)
let of_list l = List.fold_left (fun acc (lang, name) -> set acc lang name) empty l
let find t lang = List.find_map (fun (l, n) -> if Lang.equal l lang then Some n else None) t
let rec find_first t = function
  | [] -> None
  | lang :: rest -> ( match find t lang with Some n -> Some n | None -> find_first t rest)
let to_list t = t

let sexp_of_t t =
  Sexplib0.Sexp_conv.sexp_of_list (fun (lang, name) ->
    Sexplib0.Sexp.List [ Lang.sexp_of_t lang; Sexplib0.Sexp_conv.sexp_of_string name ])
    t

let t_of_sexp sexp =
  let list = Sexplib0.Sexp_conv.list_of_sexp (fun sexp ->
    match sexp with
    | Sexplib0.Sexp.List [ lang_sexp; name_sexp ] ->
        let lang = Lang.t_of_sexp lang_sexp in
        let name = Sexplib0.Sexp_conv.string_of_sexp name_sexp in
        (lang, name)
    | _ -> Sexplib0.Sexp_conv.of_sexp_error "Names.t_of_sexp: expected [lang_sexp name_sexp]" sexp)
    sexp in
  canonical list