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
(* Copyright 2022-2023 Kotoi-Xie Consultancy, Inc. This file is a part of the
==== Bindoj (https://kxc.dev/bindoj) ====
software project that is developed, maintained, and distributed by
Kotoi-Xie Consultancy, Inc. (https://kxc.inc) which is also known as KXC.
Licensed under the Apache License, Version 2.0 (the "License"); you may not
use this file except in compliance with the License. You may obtain a copy
of the License at http://www.apache.org/licenses/LICENSE-2.0. Unless required
by applicable law or agreed to in writing, software distributed under the
License is distributed on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS
OF ANY KIND, either express or implied. See the License for the specific
language governing permissions and limitations under the License.
*)
(* Acknowledgements --- AnchorZ Inc. --- The current/initial version or a
significant portion of this file is developed under the funding provided by
AnchorZ Inc. to satisfy its needs in its product development workflow.
*)
open Ppxlib
open Ast_helper
let locmk ?loc txt = { txt; loc = loc |? !Ast_helper.default_loc }
let strloc ?loc x : label with_loc = locmk ?loc x
let lidloc ?loc x = locmk ?loc (Longident.parse x)
let typcons ?loc ?attrs ?(args=[]) x = Typ.constr ?loc ?attrs (lidloc ?loc x) args
let pvar ?loc ?attrs s = Pat.var ?loc ?attrs (strloc s)
let evar ?open_ ?loc ?attrs s =
Exp.ident ?loc ?attrs (lidloc s)
|> match open_ with
| None -> identity
| Some opening ->
({ popen_expr = Mod.ident ?loc (lidloc ?loc opening);
popen_override = Fresh;
popen_loc = loc |? !Ast_helper.default_loc;
popen_attributes = [];
} : open_declaration
) |> Exp.open_ ?loc
let elist ?(loc=Location.none) =
let rec go acc = function
| [] -> acc
| x :: xs -> go [%expr [%e x] :: [%e acc]] xs
in
fun xs -> List.rev xs |> go [%expr []]
let plist ?(loc=Location.none) =
let rec go acc = function
| [] -> acc
| x :: xs -> go [%pat? [%p x] :: [%p acc]] xs
in
fun xs -> List.rev xs |> go [%pat? []]
let attr name value =
Attr.mk (locmk name) (PStr [Str.eval value])
let doc_attribute = function
| `docstr doc -> [attr "ocaml.doc" (Exp.constant (Const.string doc))]
| `nodoc -> []
| _ -> failwith "unknown polymorphic variant for docstr"
let show_attribute = [attr "deriving" (Exp.ident (lidloc "show"))]
let warning_attribute str = [attr "warning" (Exp.constant (Const.string str))]
let sprintf fmt = Format.asprintf fmt
let escape_as_constructor_name (s: string) =
(* TODO #128: proper escaping *)
s
open Bindoj_base.Type_desc
let to_rec_flag { td_kind; _ } =
match td_kind with
| Alias_decl _ -> Nonrecursive
| Record_decl _ | Variant_decl _ -> Recursive
let type_name_with_codec : ?codec:Coretype.codec -> string -> string =
fun ?(codec=`default) name ->
match codec with
| `default -> name
| `open_ m -> sprintf "%s.%s" m name
| `in_module m -> sprintf "%s.t" m