This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions

View file

@ -0,0 +1,4 @@
(alias
(name runtest)
(deps
(alias_rec all)))

View file

@ -0,0 +1,28 @@
# ppx_deriving_accessors
This folder contains an example of a very simple ppx deriver that will generate
accessors for record fields from the record type definition.
E.g. the following:
```ocaml
type t =
{ a : string
; b : int
}
[@@deriving accessors]
```
will generate the following:
```ocaml
let a x = x.a
let b x = x.b
```
It can also be used in `.mli` files to generate the corresponding signatures:
```ocaml
val a : t -> string
val b : t -> int
```

View file

@ -0,0 +1,4 @@
(library
(name ppx_deriving_accessors)
(kind ppx_deriver)
(libraries ppxlib))

View file

@ -0,0 +1,78 @@
open Ppxlib
module List = ListLabels
open Ast_builder.Default
let accessor_impl (ld : label_declaration) =
let loc = ld.pld_loc in
pstr_value ~loc Nonrecursive
[
{
pvb_pat = ppat_var ~loc ld.pld_name;
pvb_expr =
pexp_fun ~loc Nolabel None
(ppat_var ~loc { loc; txt = "x" })
(pexp_field ~loc
(pexp_ident ~loc { loc; txt = lident "x" })
{ loc; txt = lident ld.pld_name.txt });
pvb_attributes = [];
pvb_loc = loc;
pvb_constraint = None;
};
]
let accessor_intf ~ptype_name (ld : label_declaration) =
let loc = ld.pld_loc in
psig_value ~loc
{
pval_name = ld.pld_name;
pval_type =
ptyp_arrow ~loc Nolabel
(ptyp_constr ~loc { loc; txt = lident ptype_name.txt } [])
ld.pld_type;
pval_attributes = [];
pval_loc = loc;
pval_prim = [];
}
let generate_impl ~ctxt (_rec_flag, type_declarations) =
let loc = Expansion_context.Deriver.derived_item_loc ctxt in
List.map type_declarations ~f:(fun (td : type_declaration) ->
match td with
| {
ptype_kind = Ptype_abstract | Ptype_variant _ | Ptype_open;
ptype_loc;
_;
} ->
let ext =
Location.error_extensionf ~loc:ptype_loc
"Cannot derive accessors for non record types"
in
[ Ast_builder.Default.pstr_extension ~loc ext [] ]
| { ptype_kind = Ptype_record fields; _ } ->
List.map fields ~f:accessor_impl)
|> List.concat
let generate_intf ~ctxt (_rec_flag, type_declarations) =
let loc = Expansion_context.Deriver.derived_item_loc ctxt in
List.map type_declarations ~f:(fun (td : type_declaration) ->
match td with
| {
ptype_kind = Ptype_abstract | Ptype_variant _ | Ptype_open;
ptype_loc;
_;
} ->
let ext =
Location.error_extensionf ~loc:ptype_loc
"Cannot derive accessors for non record types"
in
[ Ast_builder.Default.psig_extension ~loc ext [] ]
| { ptype_kind = Ptype_record fields; ptype_name; _ } ->
List.map fields ~f:(accessor_intf ~ptype_name))
|> List.concat
let impl_generator = Deriving.Generator.V2.make_noarg generate_impl
let intf_generator = Deriving.Generator.V2.make_noarg generate_intf
let my_deriver =
Deriving.add "accessors" ~str_type_decl:impl_generator
~sig_type_decl:intf_generator

View file

@ -0,0 +1,24 @@
# ppx_get_env
This folder contains an example of a very simple ppx rewriter that will expand
`[%get_env "SOME_ENV_VAR"]` into the value of the env variable `SOME_ENV_VAR` at compile time,
as a string.
E.g., assuming we set `MY_VAR="foo"`, it will turn:
```ocaml
let () = print_string [%get_env "MY_VAR"]
```
into:
```ocaml
let () = print_string "foo"
```
Note that this is just a toy example and we'd actually advise you against this type of ppx
that have side effects or rely heavily on the file system or env variables unless you absolutely know
what you are doing.
In particular in this case it won't work well with dune since dune won't know about the dependency
on the env variables specified in the extension's payload.

View file

@ -0,0 +1,4 @@
(library
(name ppx_get_env)
(kind ppx_rewriter)
(libraries ppxlib))

View file

@ -0,0 +1,20 @@
open Ppxlib
let expand ~ctxt env_var =
let loc = Expansion_context.Extension.extension_point_loc ctxt in
match Sys.getenv env_var with
| value -> Ast_builder.Default.estring ~loc value
| exception Not_found ->
let ext =
Location.error_extensionf ~loc "The environement variable %s is unbound"
env_var
in
Ast_builder.Default.pexp_extension ~loc ext
let my_extension =
Extension.V3.declare "get_env" Extension.Context.expression
Ast_pattern.(single_expr_payload (estring __))
expand
let rule = Ppxlib.Context_free.Rule.extension my_extension
let () = Driver.register_transformation ~rules:[ rule ] "get_env"