Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
refactor: Rename and generalise
recorder
to ppx_autoregister
Functorising to add parameters so that it can be used to inject printer registerers as well, for example.
- Loading branch information
Showing
6 changed files
with
92 additions
and
68 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,60 @@ | ||
open Ppxlib | ||
|
||
module type ARG = sig | ||
val val_prefix: string | ||
val inject_def: string -> string loc -> expression | ||
end | ||
|
||
module Make (Arg: ARG) = struct | ||
|
||
let pattern_defs = | ||
object | ||
inherit [(string * string loc) list] Ast_traverse.fold as super | ||
|
||
method! pattern p acc = | ||
let acc = super#pattern p acc in | ||
match p.ppat_desc with | ||
| Ppat_var var | Ppat_alias (_, var) -> ( | ||
match String.index_opt var.txt '_' with | ||
| Some i when String.sub var.txt 0 i = Arg.val_prefix -> | ||
let suffix = | ||
String.sub var.txt (i + 1) (String.length var.txt - i - 1) | ||
in | ||
(suffix, var) :: acc | ||
| _ -> acc) | ||
| _ -> acc | ||
end | ||
|
||
let rec get_defs bindings acc = | ||
match bindings with | ||
| [] -> List.rev @@ List.flatten acc | ||
| binding :: rest -> | ||
get_defs rest @@ (pattern_defs#pattern binding.pvb_pat [] :: acc) | ||
|
||
module Ast_builder = Ast_builder.Make (struct | ||
let loc = Location.none | ||
end) | ||
|
||
let val_recorder s = | ||
let open Ast_builder in | ||
let create_val_registration defs = | ||
let gen_expr (name, e) = Arg.inject_def name e in | ||
let val_registration = List.map gen_expr defs |> esequence in | ||
let register_toplevel = | ||
[ value_binding ~pat:punit ~expr:val_registration ] | ||
in | ||
pstr_value Nonrecursive register_toplevel | ||
in | ||
List.fold_right | ||
(fun si acc -> | ||
match si.pstr_desc with | ||
| Pstr_value (_, bindings) -> ( | ||
match get_defs bindings [] with | ||
| [] -> si :: acc | ||
| defs -> si :: create_val_registration defs :: acc) | ||
| _ -> si :: acc) | ||
s [] | ||
|
||
let expand = val_recorder | ||
|
||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,8 @@ | ||
module type ARG = sig | ||
val val_prefix: string | ||
val inject_def: string -> string Ppxlib.loc -> Ppxlib.expression | ||
end | ||
|
||
module Make (_: ARG): sig | ||
val expand: Ppxlib.structure -> Ppxlib.structure | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,16 @@ | ||
module Sampler_recorder = Ppx_autoregister.Make(struct | ||
let val_prefix = "sample" | ||
let inject_def name var = | ||
let open Ppxlib in | ||
let open Ast_builder.Default in | ||
let loc = var.Location.loc in | ||
pexp_apply ~loc | ||
(evar ~loc "Introspection.register_sampler") | ||
[ Nolabel, estring ~loc name | ||
; Nolabel, evar ~loc var.txt] | ||
end) | ||
|
||
let () = | ||
Migrate_parsetree.Driver.register ~name:"ppx_metaquot" (module Migrate_parsetree.OCaml_412) | ||
(fun _config _cookies -> Ppx_metaquot.Main.expander []); | ||
Ppxlib.Driver.register_transformation "sample_recorder" ~impl:Sampler_recorder.expand |
This file was deleted.
Oops, something went wrong.
This file was deleted.
Oops, something went wrong.