objective categorical abstract machine language personal data server
1type t =
2 { mutable imports: string list
3 ; mutable generated_unions: string list
4 ; mutable union_names: (string list * string) list (* refs -> context name *)
5 ; buf: Buffer.t }
6
7let make () =
8 {imports= []; generated_unions= []; union_names= []; buf= Buffer.create 4096}
9
10(** add an import if not already present *)
11let add_import t module_name =
12 if not (List.mem module_name t.imports) then
13 t.imports <- module_name :: t.imports
14
15let get_imports t = t.imports
16
17(** mark a union type as generated to avoid duplicates *)
18let mark_union_generated t union_name =
19 if not (List.mem union_name t.generated_unions) then
20 t.generated_unions <- union_name :: t.generated_unions
21
22let is_union_generated t union_name = List.mem union_name t.generated_unions
23
24(** register a context-based name for a union based on its refs,
25 allowing inline unions to be reused when the same refs appear elsewhere *)
26let register_union_name t refs context_name =
27 let sorted_refs = List.sort String.compare refs in
28 if not (List.exists (fun (r, _) -> r = sorted_refs) t.union_names) then
29 t.union_names <- (sorted_refs, context_name) :: t.union_names
30
31(** look up a union's registered context-based name *)
32let lookup_union_name t refs =
33 let sorted_refs = List.sort String.compare refs in
34 List.assoc_opt sorted_refs t.union_names
35
36let emit t s = Buffer.add_string t.buf s
37
38let emitln t s = Buffer.add_string t.buf s ; Buffer.add_char t.buf '\n'
39
40let emit_newline t = Buffer.add_char t.buf '\n'
41
42let contents t = Buffer.contents t.buf