Module Ppx_deriving
Public API of ppx_deriving
executable.
Registration
type deriver
=
{
}
A type of deriving plugins.
A structure or signature deriving function accepts a list of
~options
, a~path
of modules for the type declaration currently being processed (with[]
for toplevel phrases), and a type declaration item (type t = .. and t' = ..
), and returns a list of items to be appended after the type declaration item in structure and signature. It is invoked by[\@\@deriving]
annotations.A type deriving function accepts a type and returns a corresponding derived expression. It is invoked by
[%derive.foo:]
and[%foo:]
annotations. If this function is missing, the corresponding[%foo:]
annotation is ignored.The structure and signature deriving functions are invoked in the order in which they appear in the source code.
val register : deriver -> unit
register deriver
registersderiver
according to itsname
field.
val add_register_hook : (deriver -> unit) -> unit
add_register_hook hook
addshook
to be executed whenever a new deriver is registered.
val derivers : unit -> deriver list
derivers ()
returns all currently registered derivers.
val create : string -> ?core_type:(Ppxlib.core_type -> Ppxlib.expression) -> ?type_ext_str:(options:(string * Ppxlib.expression) list -> path:string list -> Ppxlib.type_extension -> Ppxlib.structure) -> ?type_ext_sig:(options:(string * Ppxlib.expression) list -> path:string list -> Ppxlib.type_extension -> Ppxlib.signature) -> ?type_decl_str:(options:(string * Ppxlib.expression) list -> path:string list -> Ppxlib.type_declaration list -> Ppxlib.structure) -> ?type_decl_sig:(options:(string * Ppxlib.expression) list -> path:string list -> Ppxlib.type_declaration list -> Ppxlib.signature) -> ?module_type_decl_str:(options:(string * Ppxlib.expression) list -> path:string list -> Ppxlib.module_type_declaration -> Ppxlib.structure) -> ?module_type_decl_sig:(options:(string * Ppxlib.expression) list -> path:string list -> Ppxlib.module_type_declaration -> Ppxlib.signature) -> unit -> deriver
Creating
deriver
structure.
val lookup : string -> deriver option
lookup name
looks up a deriver calledname
.
Coercions
val string_of_core_type : Ppxlib.Parsetree.core_type -> string
string_of_core_type typ
unparsestyp
, omitting any attributes.
Option parsing
Hygiene
val create_quoter : unit -> quoter
quoter ()
creates an empty quoter.
val quote : quoter:quoter -> Ppxlib.expression -> Ppxlib.expression
quote quoter expr
records a pure expressionexpr
withinquoter
and returns an expression which has the same value asexpr
in the context thatsanitize
provides.
val sanitize : ?module_:Ppxlib.Longident.t -> ?quoter:quoter -> Ppxlib.expression -> Ppxlib.expression
sanitize module_ quoter expr
wrapsexpr
in a way that ensures that the contents ofmodule_
andPervasives
, as well as the identifiers in expressions returned byquote
are in scope, and returns the wrapped expression.module_
defaults toPpx_deriving_runtime
if it's not provided
val with_quoter : (quoter -> 'a -> Ppxlib.expression) -> 'a -> Ppxlib.expression
with_quoter fn
≡fun fn a -> let quoter = create_quoter () in sanitize ~quoter (fn quoter a)
AST manipulation
val expand_path : path:string list -> string -> string
expand_path name
returnsname
with thepath
module path prepended, e.g.expand_path ["Foo";"M"] "t"
="Foo.M.t"
andexpand_path [] "t"
="t"
val path_of_type_decl : path:string list -> Ppxlib.type_declaration -> string list
path_of_type_decl ~path type_
returnspath
iftype_
does not have a manifest or the manifest is not a constructor, and the module path of manifest otherwise.path_of_type_decl
is useful when determining the canonical path location of fields and constructors; e.g. fortype bar = M.foo = A | B
, it will return["M"]
.
val mangle_type_decl : ?fixpoint:string -> [ `Prefix of string | `Suffix of string | `PrefixSuffix of string * string ] -> Ppxlib.type_declaration -> string
mangle_type_decl ~fixpoint affix type_
derives a function name fromtype_
name by doing nothing iftype_
is namedfixpoint
("t"
by default), or appending and/or prependingaffix
via an underscore.
val mangle_lid : ?fixpoint:string -> [ `Prefix of string | `Suffix of string | `PrefixSuffix of string * string ] -> Ppxlib.Longident.t -> Ppxlib.Longident.t
mangle_lid ~fixpoint affix lid
does the same asmangle_type_decl
, but for the last component oflid
.
val attr : deriver:string -> string -> Ppxlib.attributes -> Ppxlib.attribute option
attr ~deriver name attrs
searches for an attribute[\@deriving.deriver.attr]
inattrs
if any attribute with name starting with\@deriving.deriver
exists, or[\@deriver.attr]
if any attribute with name starting with\@deriver
exists, or[\@attr]
otherwise.
val attr_warning : Ppxlib.expression -> Ppxlib.attribute
attr_warning expr
builds the attribute\@ocaml.warning expr
val free_vars_in_core_type : Ppxlib.core_type -> tyvar list
free_vars_in_core_type typ
returns unique free variables intyp
in lexical order.
val remove_pervasives : deriver:string -> Ppxlib.core_type -> Ppxlib.core_type
remove_pervasives ~deriver typ
removes the leading "Pervasives." module name in longidents. Type expressions marked with[\@nobuiltin]
are ignored.The name of the deriving plugin should be passed as
deriver
; it is used in error messages.
val fresh_var : string list -> string
fresh_var bound
returns a fresh variable name not present inbound
. The name is selected in alphabetical succession.
val fold_left_type_decl : ('a -> tyvar -> 'a) -> 'a -> Ppxlib.type_declaration -> 'a
fold_left_type_decl fn accum type_
performs a left fold over all type variable (i.e. not wildcard) parameters intype_
.
val fold_right_type_decl : (tyvar -> 'a -> 'a) -> Ppxlib.type_declaration -> 'a -> 'a
fold_right_type_decl fn accum type_
performs a right fold over all type variable (i.e. not wildcard) parameters intype_
.
val fold_left_type_ext : ('a -> tyvar -> 'a) -> 'a -> Ppxlib.type_extension -> 'a
fold_left_type_ext fn accum type_
performs a left fold over all type variable (i.e. not wildcard) parameters intype_
.
val fold_right_type_ext : (tyvar -> 'a -> 'a) -> Ppxlib.type_extension -> 'a -> 'a
fold_right_type_ext fn accum type_
performs a right fold over all type variable (i.e. not wildcard) parameters intype_
.
val poly_fun_of_type_decl : Ppxlib.type_declaration -> Ppxlib.expression -> Ppxlib.expression
poly_fun_of_type_decl type_ expr
wrapsexpr
intofun poly_N -> ...
for every type parameter'N
present intype_
. For example, iftype_
refers totype ('a, 'b) map
,expr
will be wrapped intofun poly_a poly_b -> [%e expr]
._
parameters are ignored.
val poly_fun_of_type_ext : Ppxlib.type_extension -> Ppxlib.expression -> Ppxlib.expression
Same as
poly_fun_of_type_decl
but for type extension.
val poly_apply_of_type_decl : Ppxlib.type_declaration -> Ppxlib.expression -> Ppxlib.expression
poly_apply_of_type_decl type_ expr
wrapsexpr
intoexpr poly_N
for every type parameter'N
present intype_
. For example, iftype_
refers totype ('a, 'b) map
,expr
will be wrapped into[%e expr] poly_a poly_b
._
parameters are ignored.
val poly_apply_of_type_ext : Ppxlib.type_extension -> Ppxlib.expression -> Ppxlib.expression
Same as
poly_apply_of_type_decl
but for type extension.
val poly_arrow_of_type_decl : (Ppxlib.core_type -> Ppxlib.core_type) -> Ppxlib.type_declaration -> Ppxlib.core_type -> Ppxlib.core_type
poly_arrow_of_type_decl fn type_ typ
wrapstyp
in an arrow withfn [%type: 'N]
as argument for every type parameter'N
present intype_
. For example, iftype_
refers totype ('a, 'b) map
andfn
isfun var -> [%type: [%t var] -> string]
,typ
will be wrapped into('a -> string) -> ('b -> string) -> [%t typ]
._
parameters are ignored.
val poly_arrow_of_type_ext : (Ppxlib.core_type -> Ppxlib.core_type) -> Ppxlib.type_extension -> Ppxlib.core_type -> Ppxlib.core_type
Same as
poly_arrow_of_type_decl
but for type extension.
val core_type_of_type_decl : Ppxlib.type_declaration -> Ppxlib.core_type
core_type_of_type_decl type_
constructs type('a, 'b, ...) t
for type declarationtype ('a, 'b, ...) t = ...
.
val core_type_of_type_ext : Ppxlib.type_extension -> Ppxlib.core_type
Same as
core_type_of_type_decl
but for type extension.
val instantiate : string list -> Ppxlib.type_declaration -> Ppxlib.core_type * string list * string list
instantiate bound type_
returnstyp, vars, bound'
wheretyp
is a type instantiated from type declarationtype_
,vars
≡free_vars_in_core_type typ
andbound'
≡bound @ vars
.
val fold_exprs : ?unit:Ppxlib.expression -> (Ppxlib.expression -> Ppxlib.expression -> Ppxlib.expression) -> Ppxlib.expression list -> Ppxlib.expression
fold_exprs ~unit fn exprs
foldsexprs
using head ofexprs
as initial accumulator value, orunit
ifexprs = []
.See also
seq_reduce
andbinop_reduce
.
val seq_reduce : ?sep:Ppxlib.expression -> Ppxlib.expression -> Ppxlib.expression -> Ppxlib.expression
When
sep
is present:seq_reduce
≡fun x a b -> [%expr [%e a]; [%e x]; [%e b]]
. Whensep
is missing:seq_reduce
≡fun a b -> [%expr [%e a]; [%e b]]
.
Miscellanea
module Ast_convenience : sig ... end