objective categorical abstract machine language personal data server
at main 42 lines 1.5 kB view raw
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