Module Flambda

type call_kind =
  1. | Indirect
  2. | Direct of Closure_id.t
type const =
  1. | Int of int
  2. | Char of char
type apply = {
  1. func : Variable.t;
  2. args : Variable.t list;
  3. kind : call_kind;
  4. dbg : Debuginfo.t;
  5. inline : Lambda.inline_attribute;
  6. specialise : Lambda.specialise_attribute;
}
type assign = {
  1. being_assigned : Mutable_variable.t;
  2. new_value : Variable.t;
}
type send = {
  1. kind : Lambda.meth_kind;
  2. meth : Variable.t;
  3. obj : Variable.t;
  4. args : Variable.t list;
  5. dbg : Debuginfo.t;
}
type project_closure = Projection.project_closure
type move_within_set_of_closures = Projection.move_within_set_of_closures
type project_var = Projection.project_var
type specialised_to = {
  1. var : Variable.t;
  2. projection : Projection.t option;
}
type t =
  1. | Var of Variable.t
  2. | Let of let_expr
  3. | Let_mutable of let_mutable
  4. | Let_rec of (Variable.t * named) list * t
  5. | Apply of apply
  6. | Send of send
  7. | Assign of assign
  8. | If_then_else of Variable.t * t * t
  9. | Switch of Variable.t * switch
  10. | String_switch of Variable.t * (string * t) list * t option
  11. | Static_raise of Static_exception.t * Variable.t list
  12. | Static_catch of Static_exception.t * Variable.t list * t * t
  13. | Try_with of t * Variable.t * t
  14. | While of t * t
  15. | For of for_loop
  16. | Proved_unreachable
and named =
  1. | Symbol of Symbol.t
  2. | Const of const
  3. | Allocated_const of Allocated_const.t
  4. | Read_mutable of Mutable_variable.t
  5. | Read_symbol_field of Symbol.t * int
  6. | Set_of_closures of set_of_closures
  7. | Project_closure of project_closure
  8. | Move_within_set_of_closures of move_within_set_of_closures
  9. | Project_var of project_var
  10. | Prim of Clambda_primitives.primitive * Variable.t list * Debuginfo.t
  11. | Expr of t
and let_expr = private {
  1. var : Variable.t;
  2. defining_expr : named;
  3. body : t;
  4. free_vars_of_defining_expr : Variable.Set.t;
  5. free_vars_of_body : Variable.Set.t;
}
and let_mutable = {
  1. var : Mutable_variable.t;
  2. initial_value : Variable.t;
  3. contents_kind : Lambda.value_kind;
  4. body : t;
}
and set_of_closures = private {
  1. function_decls : function_declarations;
  2. free_vars : specialised_to Variable.Map.t;
  3. specialised_args : specialised_to Variable.Map.t;
  4. direct_call_surrogates : Variable.t Variable.Map.t;
}
and function_declarations = private {
  1. is_classic_mode : bool;
  2. set_of_closures_id : Set_of_closures_id.t;
  3. set_of_closures_origin : Set_of_closures_origin.t;
  4. funs : function_declaration Variable.Map.t;
}
and function_declaration = private {
  1. closure_origin : Closure_origin.t;
  2. params : Parameter.t list;
  3. body : t;
  4. free_variables : Variable.Set.t;
  5. free_symbols : Symbol.Set.t;
  6. stub : bool;
  7. dbg : Debuginfo.t;
  8. inline : Lambda.inline_attribute;
  9. specialise : Lambda.specialise_attribute;
  10. is_a_functor : bool;
  11. poll : Lambda.poll_attribute;
}
and switch = {
  1. numconsts : Numbers.Int.Set.t;
  2. consts : (int * t) list;
  3. numblocks : Numbers.Int.Set.t;
  4. blocks : (int * t) list;
  5. failaction : t option;
}
and for_loop = {
  1. bound_var : Variable.t;
  2. from_value : Variable.t;
  3. to_value : Variable.t;
  4. direction : Asttypes.direction_flag;
  5. body : t;
}
and constant_defining_value =
  1. | Allocated_const of Allocated_const.t
  2. | Block of Tag.t * constant_defining_value_block_field list
  3. | Set_of_closures of set_of_closures
  4. | Project_closure of Symbol.t * Closure_id.t
and constant_defining_value_block_field =
  1. | Symbol of Symbol.t
  2. | Const of const
module Constant_defining_value : sig ... end
type expr = t
type program_body =
  1. | Let_symbol of Symbol.t * constant_defining_value * program_body
  2. | Let_rec_symbol of (Symbol.t * constant_defining_value) list * program_body
  3. | Initialize_symbol of Symbol.t * Tag.t * t list * program_body
  4. | Effect of t * program_body
  5. | End of Symbol.t
type program = {
  1. imported_symbols : Symbol.Set.t;
  2. program_body : program_body;
}
val free_variables : ?ignore_uses_as_callee:unit -> ?ignore_uses_as_argument:unit -> ?ignore_uses_in_project_var:unit -> t -> Variable.Set.t
val free_variables_named : ?ignore_uses_in_project_var:unit -> named -> Variable.Set.t
val used_variables : ?ignore_uses_as_callee:unit -> ?ignore_uses_as_argument:unit -> ?ignore_uses_in_project_var:unit -> t -> Variable.Set.t
val used_variables_named : ?ignore_uses_in_project_var:unit -> named -> Variable.Set.t
val free_symbols : expr -> Symbol.Set.t
val free_symbols_named : named -> Symbol.Set.t
val free_symbols_program : program -> Symbol.Set.t
val fold_lets_option : t -> init:'a -> for_defining_expr:('a -> Variable.t -> named -> 'a * Variable.t * named) -> for_last_body:('a -> t -> t * 'b) -> filter_defining_expr: ('b -> Variable.t -> named -> Variable.Set.t -> 'b * Variable.t * named option) -> t * 'b
val map_lets : t -> for_defining_expr:(Variable.t -> named -> named) -> for_last_body:(t -> t) -> after_rebuild:(t -> t) -> t
val iter_lets : t -> for_defining_expr:(Variable.t -> named -> unit) -> for_last_body:(t -> unit) -> for_each_let:(t -> unit) -> unit
val create_let : Variable.t -> named -> t -> t
val map_defining_expr_of_let : let_expr -> f:(named -> named) -> t
module With_free_variables : sig ... end
val create_function_declaration : params:Parameter.t list -> body:t -> stub:bool -> dbg:Debuginfo.t -> inline:Lambda.inline_attribute -> specialise:Lambda.specialise_attribute -> is_a_functor:bool -> closure_origin:Closure_origin.t -> poll:Lambda.poll_attribute -> function_declaration
val update_function_declaration : function_declaration -> params:Parameter.t list -> body:t -> function_declaration
val create_function_declarations : is_classic_mode:bool -> funs:function_declaration Variable.Map.t -> function_declarations
val create_function_declarations_with_origin : is_classic_mode:bool -> funs:function_declaration Variable.Map.t -> set_of_closures_origin:Set_of_closures_origin.t -> function_declarations
val update_body_of_function_declaration : function_declaration -> body:expr -> function_declaration
val update_function_decl's_params_and_body : function_declaration -> params:Parameter.t list -> body:expr -> function_declaration
val create_function_declarations_with_closures_origin : is_classic_mode:bool -> funs:function_declaration Variable.Map.t -> set_of_closures_origin:Set_of_closures_origin.t -> function_declarations
val create_set_of_closures : function_decls:function_declarations -> free_vars:specialised_to Variable.Map.t -> specialised_args:specialised_to Variable.Map.t -> direct_call_surrogates:Variable.t Variable.Map.t -> set_of_closures
type maybe_named =
  1. | Is_expr of t
  2. | Is_named of named
val iter_general : toplevel:bool -> (t -> unit) -> (named -> unit) -> maybe_named -> unit
val print : Format.formatter -> t -> unit
val print_named : Format.formatter -> named -> unit
val print_program : Format.formatter -> program -> unit
val print_const : Format.formatter -> const -> unit
val print_constant_defining_value : Format.formatter -> constant_defining_value -> unit
val print_function_declaration : Format.formatter -> (Variable.t * function_declaration) -> unit
val print_function_declarations : Format.formatter -> function_declarations -> unit
val print_project_closure : Format.formatter -> project_closure -> unit
val print_move_within_set_of_closures : Format.formatter -> move_within_set_of_closures -> unit
val print_project_var : Format.formatter -> project_var -> unit
val print_set_of_closures : Format.formatter -> set_of_closures -> unit
val print_specialised_to : Format.formatter -> specialised_to -> unit
val equal_call_kind : call_kind -> call_kind -> bool
val equal_specialised_to : specialised_to -> specialised_to -> bool
val compare_const : const -> const -> int
val compare_project_var : project_var -> project_var -> int
val compare_move_within_set_of_closures : move_within_set_of_closures -> move_within_set_of_closures -> int
val compare_project_closure : project_closure -> project_closure -> int