Lambda
type primitive =
| Pidentity | ||
| Pbytes_to_string | ||
| Pbytes_of_string | ||
| Pignore | ||
| Prevapply | ||
| Pdirapply | ||
| Pgetglobal of Ident.t | ||
| Psetglobal of Ident.t | ||
| Pmakeblock of int * Asttypes.mutable_flag * block_shape | ||
| Pfield of int | ||
| Pfield_computed | ||
| Psetfield of int * immediate_or_pointer * initialization_or_assignment | ||
| Psetfield_computed of immediate_or_pointer * initialization_or_assignment | ||
| Pfloatfield of int | ||
| Psetfloatfield of int * initialization_or_assignment | ||
| Pduprecord of Types.record_representation * int | ||
| Pccall of Primitive.description | ||
| Praise of raise_kind | ||
| Psequand | ||
| Psequor | ||
| Pnot | ||
| Pnegint | ||
| Paddint | ||
| Psubint | ||
| Pmulint | ||
| Pdivint of is_safe | ||
| Pmodint of is_safe | ||
| Pandint | ||
| Porint | ||
| Pxorint | ||
| Plslint | ||
| Plsrint | ||
| Pasrint | ||
| Pintcomp of integer_comparison | ||
| Pcompare_ints | ||
| Pcompare_floats | ||
| Pcompare_bints of boxed_integer | ||
| Poffsetint of int | ||
| Poffsetref of int | ||
| Pintoffloat | ||
| Pfloatofint | ||
| Pnegfloat | ||
| Pabsfloat | ||
| Paddfloat | ||
| Psubfloat | ||
| Pmulfloat | ||
| Pdivfloat | ||
| Pfloatcomp of float_comparison | ||
| Pstringlength | ||
| Pstringrefu | ||
| Pstringrefs | ||
| Pbyteslength | ||
| Pbytesrefu | ||
| Pbytessetu | ||
| Pbytesrefs | ||
| Pbytessets | ||
| Pmakearray of array_kind * Asttypes.mutable_flag | ||
| Pduparray of array_kind * Asttypes.mutable_flag | (* For | |
| Parraylength of array_kind | ||
| Parrayrefu of array_kind | ||
| Parraysetu of array_kind | ||
| Parrayrefs of array_kind | ||
| Parraysets of array_kind | ||
| Pisint | ||
| Pisout | ||
| Pbintofint of boxed_integer | ||
| Pintofbint of boxed_integer | ||
| Pcvtbint of boxed_integer * boxed_integer | ||
| Pnegbint of boxed_integer | ||
| Paddbint of boxed_integer | ||
| Psubbint of boxed_integer | ||
| Pmulbint of boxed_integer | ||
| Pdivbint of {
} | ||
| Pmodbint of {
} | ||
| Pandbint of boxed_integer | ||
| Porbint of boxed_integer | ||
| Pxorbint of boxed_integer | ||
| Plslbint of boxed_integer | ||
| Plsrbint of boxed_integer | ||
| Pasrbint of boxed_integer | ||
| Pbintcomp of boxed_integer * integer_comparison | ||
| Pbigarrayref of bool * int * bigarray_kind * bigarray_layout | ||
| Pbigarrayset of bool * int * bigarray_kind * bigarray_layout | ||
| Pbigarraydim of int | ||
| Pstring_load_16 of bool | ||
| Pstring_load_32 of bool | ||
| Pstring_load_64 of bool | ||
| Pbytes_load_16 of bool | ||
| Pbytes_load_32 of bool | ||
| Pbytes_load_64 of bool | ||
| Pbytes_set_16 of bool | ||
| Pbytes_set_32 of bool | ||
| Pbytes_set_64 of bool | ||
| Pbigstring_load_16 of bool | ||
| Pbigstring_load_32 of bool | ||
| Pbigstring_load_64 of bool | ||
| Pbigstring_set_16 of bool | ||
| Pbigstring_set_32 of bool | ||
| Pbigstring_set_64 of bool | ||
| Pctconst of compile_time_constant | ||
| Pbswap16 | ||
| Pbbswap of boxed_integer | ||
| Pint_as_pointer | ||
| Popaque |
and block_shape = value_kind list option
val equal_value_kind : value_kind -> value_kind -> bool
val equal_boxed_integer : boxed_integer -> boxed_integer -> bool
type structured_constant =
| Const_base of Asttypes.constant |
| Const_block of int * structured_constant list |
| Const_float_array of string list |
| Const_immstring of string |
val equal_inline_attribute : inline_attribute -> inline_attribute -> bool
val equal_specialise_attribute : specialise_attribute -> specialise_attribute -> bool
type function_attribute = {
inline : inline_attribute; |
specialise : specialise_attribute; |
local : local_attribute; |
is_a_functor : bool; |
stub : bool; |
}
type scoped_location = Debuginfo.Scoped_location.t
type lambda =
| Lvar of Ident.t |
| Lconst of structured_constant |
| Lapply of lambda_apply |
| Lfunction of lfunction |
| Llet of let_kind * value_kind * Ident.t * lambda * lambda |
| Lletrec of (Ident.t * lambda) list * lambda |
| Lprim of primitive * lambda list * scoped_location |
| Lswitch of lambda * lambda_switch * scoped_location |
| Lstringswitch of lambda * (string * lambda) list * lambda option * scoped_location |
| Lstaticraise of int * lambda list |
| Lstaticcatch of lambda * int * (Ident.t * value_kind) list * lambda |
| Ltrywith of lambda * Ident.t * lambda |
| Lifthenelse of lambda * lambda * lambda |
| Lsequence of lambda * lambda |
| Lwhile of lambda * lambda |
| Lfor of Ident.t * lambda * lambda * Asttypes.direction_flag * lambda |
| Lassign of Ident.t * lambda |
| Lsend of meth_kind * lambda * lambda * lambda list * scoped_location |
| Levent of lambda * lambda_event |
| Lifused of Ident.t * lambda |
and lfunction = {
kind : function_kind; |
params : (Ident.t * value_kind) list; |
return : value_kind; |
body : lambda; |
attr : function_attribute; |
loc : scoped_location; |
}
and lambda_apply = {
ap_func : lambda; |
ap_args : lambda list; |
ap_loc : scoped_location; |
ap_tailcall : tailcall_attribute; |
ap_inlined : inline_attribute; |
ap_specialised : specialise_attribute; |
}
and lambda_event = {
lev_loc : scoped_location; |
lev_kind : lambda_event_kind; |
lev_repr : int ref option; |
lev_env : Env.t; |
}
and lambda_event_kind =
| Lev_before |
| Lev_after of Types.type_expr |
| Lev_function |
| Lev_pseudo |
| Lev_module_definition of Ident.t |
type program = {
module_ident : Ident.t; |
main_module_block_size : int; |
required_globals : Ident.Set.t; |
code : lambda; |
}
val const_unit : structured_constant
val const_int : int -> structured_constant
val lambda_unit : lambda
iter_head_constructor f lam
apply f
to only the first level of sub expressions of lam
. It does not recursively traverse the expression.
Same as iter_head_constructor
, but use a different callback for sub-terms which are in tail position or not.
val transl_prim : string -> string -> lambda
Translate a value from a persistent module. For instance:
transl_internal_value "CamlinternalLazy" "force"
val free_variables : lambda -> Ident.Set.t
val transl_module_path : scoped_location -> Env.t -> Path.t -> lambda
val transl_value_path : scoped_location -> Env.t -> Path.t -> lambda
val transl_extension_path : scoped_location -> Env.t -> Path.t -> lambda
val transl_class_path : scoped_location -> Env.t -> Path.t -> lambda
val subst : (Ident.t -> Types.value_description -> Env.t -> Env.t) -> ?freshen_bound_variables:bool -> lambda Ident.Map.t -> lambda -> lambda
subst update_env ?freshen_bound_variables s lt
applies a substitution s
to the lambda-term lt
.
Assumes that the image of the substitution is out of reach of the bound variables of the lambda-term (no capture).
update_env
is used to refresh the environment contained in debug events.
freshen_bound_variables
, which defaults to false
, freshens the bound variables within lt
.
val rename : Ident.t Ident.Map.t -> lambda -> lambda
A version of subst
specialized for the case where we're just renaming idents.
Bottom-up rewriting, applying the function on each node from the leaves to the root.
Rewrite each immediate sub-term with the function.
val negate_integer_comparison : integer_comparison -> integer_comparison
val swap_integer_comparison : integer_comparison -> integer_comparison
val negate_float_comparison : float_comparison -> float_comparison
val swap_float_comparison : float_comparison -> float_comparison
val default_function_attribute : function_attribute
val default_stub_attribute : function_attribute
val function_is_curried : lfunction -> bool
Maximal number of parameters for a function, or in other words, maximal length of the params
list of a lfunction
record. This is unlimited (max_int
) for bytecode, but limited (currently to 126) for native code.
val staticfail : lambda
val is_guarded : lambda -> bool
val raise_kind : raise_kind -> string
val merge_inline_attributes : inline_attribute -> inline_attribute -> inline_attribute option