35 lines
1,007 B
OCaml
35 lines
1,007 B
OCaml
|
|
open Ppxlib
|
||
|
|
|
||
|
|
let existential ~loc =
|
||
|
|
let lident = { loc; txt = Longident.parse "Constructor" } in
|
||
|
|
let pattern =
|
||
|
|
{
|
||
|
|
ppat_loc = loc;
|
||
|
|
ppat_loc_stack = [];
|
||
|
|
ppat_attributes = [];
|
||
|
|
ppat_desc =
|
||
|
|
Ppat_construct (lident, Some ([ { loc; txt = "a" } ], [%pat? _]));
|
||
|
|
}
|
||
|
|
in
|
||
|
|
[%stri let f x = match x with [%p pattern] -> ()]
|
||
|
|
|
||
|
|
let named_existential =
|
||
|
|
Context_free.Rule.extension
|
||
|
|
(Extension.V3.declare "named_existentials" Extension.Context.structure_item
|
||
|
|
Ast_pattern.(pstr nil)
|
||
|
|
(fun ~ctxt ->
|
||
|
|
let loc = Expansion_context.Extension.extension_point_loc ctxt in
|
||
|
|
existential ~loc))
|
||
|
|
|
||
|
|
let () =
|
||
|
|
Driver.V2.register_transformation ~rules:[ named_existential ]
|
||
|
|
"named_existentials"
|
||
|
|
|
||
|
|
let str_type_decl =
|
||
|
|
Deriving.Generator.V2.make_noarg (fun ~ctxt _type_decl ->
|
||
|
|
let loc = Expansion_context.Deriver.derived_item_loc ctxt in
|
||
|
|
[ existential ~loc ])
|
||
|
|
|
||
|
|
let _ = Deriving.add ~str_type_decl "named_existentials"
|
||
|
|
let () = Driver.standalone ()
|