diff --git a/src/main/compile/dune b/src/main/compile/dune index 705ed50b9..865a8ec1a 100644 --- a/src/main/compile/dune +++ b/src/main/compile/dune @@ -12,6 +12,7 @@ ast_typed transpiler mini_c + self_mini_c compiler self_michelson ) diff --git a/src/main/compile/of_mini_c.ml b/src/main/compile/of_mini_c.ml index bc1a2f260..9851d2d36 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -25,7 +25,7 @@ let compile_expression_as_function : expression -> _ result = fun e -> let compile_function = fun e -> let%bind (input , output) = get_t_function e.type_value in let%bind body = get_function e in - let%bind body = compile_value body (t_function input output) in + let%bind body = Compiler.Program.translate_function_body body [] input in let body = Self_michelson.optimize body in let%bind (input , output) = bind_map_pair Compiler.Type.Ty.type_ (input , output) in let open! Compiler.Program in @@ -33,14 +33,17 @@ let compile_function = fun e -> let compile_expression_as_function_entry = fun program name -> let%bind aggregated = aggregate_entry program name true in + let%bind aggregated = Self_mini_c.all_expression aggregated in compile_function aggregated let compile_function_entry = fun program name -> let%bind aggregated = aggregate_entry program name false in + let%bind aggregated = Self_mini_c.all_expression aggregated in compile_function aggregated let compile_contract_entry = fun program name -> let%bind aggregated = aggregate_entry program name false in + let%bind aggregated = Self_mini_c.all_expression aggregated in let%bind compiled = compile_function aggregated in let%bind (param_ty , storage_ty) = let%bind fun_ty = get_t_function aggregated.type_value in diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index 1beb15ef2..434f03352 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -228,36 +228,7 @@ let rec transpile_literal : AST.literal -> value = fun l -> match l with | Literal_unit -> D_unit and transpile_environment_element_type : AST.environment_element -> type_value result = fun ele -> - match (AST.get_type' ele.type_value , ele.definition) with - | (AST.T_function (arg , ret) , ED_declaration (ae , ((_ :: _) as captured_variables)) ) -> - begin - match ae.expression with - | E_lambda _ -> - let%bind ret' = transpile_type ret in - let%bind arg' = transpile_type arg in - let%bind env' = transpile_environment ae.environment in - let sub_env = Mini_c.Environment.select captured_variables env' in - if sub_env = [] then - transpile_type ele.type_value - else - ok @@ Combinators.t_deep_closure sub_env arg' ret' - | _ -> transpile_type ele.type_value - end - | _ -> transpile_type ele.type_value - -and transpile_small_environment : AST.small_environment -> Environment.t result = fun x -> - let x' = AST.Environment.Small.get_environment x in - let aux prec (name , (ele : AST.environment_element)) = - let%bind tv' = transpile_environment_element_type ele in - ok @@ Environment.add (name , tv') prec - in - let%bind result = - bind_fold_right_list aux Environment.empty x' in - ok result - -and transpile_environment : AST.full_environment -> Environment.t result = fun x -> - let%bind nlst = bind_map_ne_list transpile_small_environment x in - ok @@ Environment.concat @@ List.Ne.to_list nlst + transpile_type ele.type_value and tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t result = fun t -> let%bind map_tv = get_t_sum t in @@ -435,11 +406,8 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re ) ) | E_lambda l -> - let%bind env = - trace_strong (corner_case ~loc:__LOC__ "environment") @@ - transpile_environment ae.environment in let%bind io = AST.get_t_function ae.type_annotation in - transpile_lambda env l io + transpile_lambda l io | E_list lst -> ( let%bind t = trace_strong (corner_case ~loc:__LOC__ "not a list") @@ @@ -610,40 +578,14 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re | AST.Match_tuple _ -> fail @@ unsupported_pattern_matching "tuple" ae.location ) -and transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> _ -> Mini_c.expression result = - fun env l (input_type , output_type)-> +and transpile_lambda l (input_type , output_type) = let { binder ; body } : AST.lambda = l in - (* Deep capture. Capture the relevant part of the environment. *) - let%bind c_env = - let free_variables = Ast_typed.Free_variables.lambda [] l in - let sub_env = Mini_c.Environment.select free_variables env in - ok sub_env in - let%bind (f_expr' , input_tv , output_tv) = - let%bind raw_input = transpile_type input_type in - let%bind output = transpile_type output_type in - let%bind body = transpile_annotated_expression body in - let expr' = E_closure { binder ; body } in - ok (expr' , raw_input , output) in - let tv = Mini_c.t_deep_closure c_env input_tv output_tv in - ok @@ Expression.make_tpl (f_expr' , tv) - -and transpile_lambda env l (input_type , output_type) = - let { binder ; body } : AST.lambda = l in - let fvs = AST.Free_variables.(annotated_expression (singleton binder) body) in - let%bind result = - match fvs with - | [] -> ( - let%bind result' = transpile_annotated_expression body in - let%bind input = transpile_type input_type in - let%bind output = transpile_type output_type in - let tv = Combinators.t_function input output in - let content = D_function { binder ; body = result'} in - ok @@ Combinators.Expression.make_tpl (E_literal content , tv) - ) - | _ -> ( - transpile_lambda_deep env l (input_type , output_type) - ) in - ok result + let%bind result' = transpile_annotated_expression body in + let%bind input = transpile_type input_type in + let%bind output = transpile_type output_type in + let tv = Combinators.t_function input output in + let closure = E_closure { binder ; body = result'} in + ok @@ Combinators.Expression.make_tpl (closure , tv) let transpile_declaration env (d:AST.declaration) : toplevel_statement result = match d with @@ -671,7 +613,6 @@ let check_storage f ty loc : (anon_function * _) result = | T_pair (a , b) -> (aux (snd a) true) && (aux (snd b) false) | T_or (a,b) -> (aux (snd a) false) && (aux (snd b) false) | T_function (a,b) -> (aux a false) && (aux b false) - | T_deep_closure (_,a,b) -> (aux a false) && (aux b false) | T_map (a,b) -> (aux a false) && (aux b false) | T_list a -> (aux a false) | T_set a -> (aux a false) diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/6-transpiler/transpiler.mli index 60600ea53..c03fdcb28 100644 --- a/src/passes/6-transpiler/transpiler.mli +++ b/src/passes/6-transpiler/transpiler.mli @@ -33,14 +33,11 @@ val tuple_access_to_lr : type_value -> type_value list -> int -> (type_value * [ val record_access_to_lr : type_value -> type_value AST.type_name_map -> string -> (type_value * [`Left | `Right]) list result val translate_literal : AST.literal -> value val transpile_environment_element_type : AST.environment_element -> type_value result -val transpile_small_environment : AST.small_environment -> Environment.t result -val transpile_environment : AST.full_environment -> Environment.t result val tree_of_sum : AST.type_value -> (type_name * AST.type_value) Append_tree.t result *) val transpile_annotated_expression : AST.annotated_expression -> expression result (* -val transpile_lambda_deep : Mini_c.Environment.t -> AST.lambda -> Mini_c.expression result -val transpile_lambda : Environment.t -> AST.lambda -> expression result +val transpile_lambda : AST.lambda -> expression result val transpile_declaration : environment -> AST.declaration -> toplevel_statement result *) diff --git a/src/passes/7-self_mini_c/helpers.ml b/src/passes/7-self_mini_c/helpers.ml index 9904a8083..f3931e6ce 100644 --- a/src/passes/7-self_mini_c/helpers.ml +++ b/src/passes/7-self_mini_c/helpers.ml @@ -11,8 +11,6 @@ let rec fold_type_value : ('a -> type_value -> 'a result) -> 'a -> type_value -> | T_map (a, b) | T_big_map (a, b) -> bind_fold_pair self init' (a, b) - | T_deep_closure (env, a, b) -> - bind_fold_list self init' (List.map snd env @ [a; b]) | T_list a | T_set a | T_contract a @@ -31,11 +29,7 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini | E_make_empty_set _ -> ( ok init' ) - | E_literal v -> ( - match v with - | D_function an -> self init' an.body - | _ -> ok init' - ) + | E_literal _ -> ok init' | E_constant (_, lst) -> ( let%bind res = bind_fold_list self init' lst in ok res @@ -96,16 +90,8 @@ let rec map_expression : mapper -> expression -> expression result = fun f e -> let%bind e' = f e in let return content = ok { e' with content } in match e'.content with - | E_variable _ | E_skip | E_make_none _ + | E_variable _ | E_literal _ | E_skip | E_make_none _ | E_make_empty_map (_,_) | E_make_empty_list _ | E_make_empty_set _ as em -> return em - | E_literal v -> ( - let%bind v' = match v with - | D_function an -> - let%bind body = self an.body in - ok @@ D_function { an with body } - | _ -> ok v in - return @@ E_literal v' - ) | E_constant (name, lst) -> ( let%bind lst' = bind_map_list self lst in return @@ E_constant (name,lst') diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml new file mode 100644 index 000000000..96f134c91 --- /dev/null +++ b/src/passes/7-self_mini_c/self_mini_c.ml @@ -0,0 +1,29 @@ +open Mini_c +open Trace + +(* Overly conservative for now: ok to treat pure things as impure, + must not treat impure things as pure. *) +let is_pure : expression -> bool = fun e -> + match e.content with + | E_closure _ -> true + | _ -> false + +let rec elim_dead_lambdas : expression -> expression result = fun e -> + let changed = ref false in (* ugh *) + let mapper : Helpers.mapper = fun e -> + match e.content with + | E_let_in ((x, _), e1, e2) when is_pure e1 -> + let fvs = Free_variables.expression [] e2 in + if Free_variables.mem x fvs + then ok e + else + (* pure e1 is not used, eliminate! *) + (changed := true ; ok e2) + | _ -> ok e in + let%bind e = Helpers.map_expression mapper e in + if !changed + then elim_dead_lambdas e + else ok e + +let all_expression : expression -> expression result = + elim_dead_lambdas diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 6f033acc6..4916dab73 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -86,11 +86,6 @@ let rec translate_value (v:value) ty : michelson result = match v with let%bind b' = translate_value b b_ty in ok @@ prim ~children:[b'] D_Right ) - | D_function func -> ( - match ty with - | T_function (in_ty , _) -> translate_function_body func [] in_ty - | _ -> simple_fail "expected function type" - ) | D_none -> ok @@ prim D_None | D_some s -> let%bind s' = translate_value s ty in @@ -143,19 +138,9 @@ and translate_expression (expr:expression) (env:environment) : michelson result return @@ i_push t v | E_closure anon -> ( match ty with - | T_deep_closure (small_env , input_ty , output_ty) -> ( - let selector = List.map fst small_env in - let%bind closure_pack_code = Compiler_environment.pack_closure env selector in - let%bind lambda_ty = Compiler_type.lambda_closure (small_env , input_ty , output_ty) in - let%bind lambda_body_code = translate_function_body anon small_env input_ty in - return @@ seq [ - closure_pack_code ; - i_push lambda_ty lambda_body_code ; - i_swap ; - i_apply ; - ] - ) - | _ -> simple_fail "expected closure type" + | T_function (input_ty , output_ty) -> + translate_function anon env input_ty output_ty + | _ -> simple_fail "expected function type" ) | E_application (f , arg) -> ( trace (simple_error "Compiling quote application") @@ @@ -407,6 +392,24 @@ and translate_function_body ({body ; binder} : anon_function) lst input : michel ok code +and translate_function anon env input_ty output_ty : michelson result = + let fvs = Mini_c.Free_variables.lambda [] anon in + let small_env = Mini_c.Environment.select fvs env in + let%bind lambda_ty = Compiler_type.lambda_closure (small_env , input_ty , output_ty) in + let%bind lambda_body_code = translate_function_body anon small_env input_ty in + match fvs with + | [] -> ok @@ seq [ i_push lambda_ty lambda_body_code ] + | _ :: _ -> + let selector = List.map fst small_env in + let%bind closure_pack_code = Compiler_environment.pack_closure env selector in + ok @@ seq [ + closure_pack_code ; + i_push lambda_ty lambda_body_code ; + i_swap ; + i_apply ; + ] + + type compiled_program = { input : ex_ty ; output : ex_ty ; @@ -416,7 +419,7 @@ type compiled_program = { let get_main : program -> string -> (anon_function * _) result = fun p entry -> let is_main (((name , expr), _):toplevel_statement) = match Combinators.Expression.(get_content expr , get_type expr)with - | (E_literal (D_function content) , T_function ty) + | (E_closure content , T_function ty) when name = entry -> Some (content , ty) | _ -> None diff --git a/src/passes/8-compiler/compiler_type.ml b/src/passes/8-compiler/compiler_type.ml index df0ff7bc6..d87132b08 100644 --- a/src/passes/8-compiler/compiler_type.ml +++ b/src/passes/8-compiler/compiler_type.ml @@ -73,7 +73,6 @@ module Ty = struct let comparable_type : type_value -> ex_comparable_ty result = fun tv -> match tv with | T_base b -> comparable_type_base b - | T_deep_closure _ -> fail (not_comparable "deep closure") | T_function _ -> fail (not_comparable "function") | T_or _ -> fail (not_comparable "or") | T_pair _ -> fail (not_comparable "pair") @@ -117,10 +116,6 @@ module Ty = struct let%bind (Ex_ty arg) = type_ arg in let%bind (Ex_ty ret) = type_ ret in ok @@ Ex_ty (lambda arg ret) - | T_deep_closure (_, arg, ret) -> - let%bind (Ex_ty arg) = type_ arg in - let%bind (Ex_ty ret) = type_ ret in - ok @@ Ex_ty (lambda arg ret) | T_map (k, v) -> let%bind (Ex_comparable_ty k') = comparable_type k in let%bind (Ex_ty v') = type_ v in @@ -221,10 +216,6 @@ let rec type_ : type_value -> O.michelson result = let%bind arg = type_ arg in let%bind ret = type_ ret in ok @@ O.prim ~children:[arg;ret] T_lambda - | T_deep_closure (_ , arg , ret) -> - let%bind arg = type_ arg in - let%bind ret = type_ ret in - ok @@ O.prim ~children:[arg;ret] T_lambda and annotated : type_value annotated -> O.michelson result = function @@ -242,10 +233,13 @@ and environment = fun env -> @@ List.map snd env and lambda_closure = fun (c , arg , ret) -> - let%bind capture = environment_closure c in let%bind arg = type_ arg in let%bind ret = type_ ret in - ok @@ O.t_lambda (O.t_pair capture arg) ret + match c with + | [] -> ok @@ O.t_lambda arg ret + | _ :: _ -> + let%bind capture = environment_closure c in + ok @@ O.t_lambda (O.t_pair capture arg) ret and environment_closure = function diff --git a/src/stages/mini_c/PP.ml b/src/stages/mini_c/PP.ml index e904ad01f..b36ae77a0 100644 --- a/src/stages/mini_c/PP.ml +++ b/src/stages/mini_c/PP.ml @@ -33,10 +33,6 @@ let rec type_ ppf : type_value -> _ = function | T_set(t) -> fprintf ppf "set(%a)" type_ t | T_option(o) -> fprintf ppf "option(%a)" type_ o | T_contract(t) -> fprintf ppf "contract(%a)" type_ t - | T_deep_closure(c, arg, ret) -> - fprintf ppf "[%a](%a)->(%a)" - environment c - type_ arg type_ ret and annotated ppf : type_value annotated -> _ = function | (Some ann, a) -> fprintf ppf "(%a %%%s)" type_ a ann @@ -63,7 +59,6 @@ let rec value ppf : value -> unit = function | D_pair (a, b) -> fprintf ppf "(%a), (%a)" value a value b | D_left a -> fprintf ppf "L(%a)" value a | D_right b -> fprintf ppf "R(%a)" value b - | D_function x -> function_ ppf x | D_none -> fprintf ppf "None" | D_some s -> fprintf ppf "Some (%a)" value s | D_map m -> fprintf ppf "Map[%a]" (list_sep_d value_assoc) m diff --git a/src/stages/mini_c/combinators.ml b/src/stages/mini_c/combinators.ml index c716ee367..556682907 100644 --- a/src/stages/mini_c/combinators.ml +++ b/src/stages/mini_c/combinators.ml @@ -77,22 +77,18 @@ let get_set (v:value) = match v with let get_function_with_ty (e : expression) = match (e.content , e.type_value) with - | E_literal (D_function f) , T_function ty -> ok (f , ty) + | E_closure f , T_function ty -> ok (f , ty) | _ -> simple_fail "not a function with functional type" let get_function (e : expression) = match (e.content) with - | E_literal (D_function f) -> ok (D_function f) + | E_closure f -> ok f | _ -> simple_fail "not a function" let get_t_function tv = match tv with | T_function ty -> ok ty | _ -> simple_fail "not a function" -let get_t_closure tv = match tv with - | T_deep_closure ty -> ok ty - | _ -> simple_fail "not a function" - let get_t_option (v:type_value) = match v with | T_option t -> ok t | _ -> simple_fail "not an option" @@ -169,7 +165,6 @@ let t_unit : type_value = T_base Base_unit let t_nat : type_value = T_base Base_nat let t_function x y : type_value = T_function ( x , y ) -let t_deep_closure x y z : type_value = T_deep_closure ( x , y , z ) let t_pair x y : type_value = T_pair ( x , y ) let t_union x y : type_value = T_or ( x , y ) @@ -194,7 +189,7 @@ let ez_e_sequence a b : expression = Expression.(make_tpl (E_sequence (make_tpl let d_unit : value = D_unit let basic_quote expr in_ty out_ty : expression result = - let expr' = E_literal (D_function (quote "input" expr)) in + let expr' = E_closure (quote "input" expr) in ok @@ Expression.make_tpl (expr' , t_function in_ty out_ty) let basic_int_quote expr : expression result = diff --git a/src/stages/mini_c/combinators.mli b/src/stages/mini_c/combinators.mli index 7005b2c7e..f686bd522 100644 --- a/src/stages/mini_c/combinators.mli +++ b/src/stages/mini_c/combinators.mli @@ -30,9 +30,8 @@ val get_big_map : value -> ( value * value ) list result val get_list : value -> value list result val get_set : value -> value list result val get_function_with_ty : expression -> ( anon_function * ( type_value * type_value) ) result -val get_function : expression -> value result +val get_function : expression -> anon_function result val get_t_function : type_value -> ( type_value * type_value ) result -val get_t_closure : type_value -> ( environment * type_value * type_value ) result val get_t_option : type_value -> type_value result val get_pair : value -> ( value * value ) result val get_t_pair : type_value -> ( type_value * type_value ) result @@ -57,7 +56,6 @@ val t_int : type_value val t_unit : type_value val t_nat : type_value val t_function : type_value -> type_value -> type_value -val t_deep_closure : environment -> type_value -> type_value -> type_value val t_pair : type_value annotated -> type_value annotated -> type_value val t_union : type_value annotated -> type_value annotated -> type_value (* diff --git a/src/stages/mini_c/misc.ml b/src/stages/mini_c/misc.ml index 60810643c..fb6d86449 100644 --- a/src/stages/mini_c/misc.ml +++ b/src/stages/mini_c/misc.ml @@ -22,11 +22,106 @@ module Errors = struct end +module Free_variables = struct + + type bindings = string list + let mem : string -> bindings -> bool = List.mem + let singleton : string -> bindings = fun s -> [ s ] + let union : bindings -> bindings -> bindings = (@) + let unions : bindings list -> bindings = List.concat + let empty : bindings = [] + let of_list : string list -> bindings = fun x -> x + + let rec expression : bindings -> expression -> bindings = fun b e -> + let self = expression b in + match e.content with + | E_literal v -> value b v + | E_closure f -> lambda b f + | E_skip -> empty + | E_constant (_, xs) -> unions @@ List.map self xs + | E_application (f, x) -> unions @@ [ self f ; self x ] + | E_variable n -> var_name b n + | E_make_empty_map _ -> empty + | E_make_empty_list _ -> empty + | E_make_empty_set _ -> empty + | E_make_none _ -> empty + | E_iterator (_, ((v, _), body), expr) -> + unions [ expression (union (singleton v) b) body ; + self expr ; + ] + | E_fold (((v, _), body), collection, initial) -> + unions [ expression (union (singleton v) b) body ; + self collection ; + self initial ; + ] + | E_if_bool (x, bt, bf) -> unions [ self x ; self bt ; self bf ] + | E_if_none (x, bn, ((s, _), bs)) -> + unions [ self x ; + self bn ; + expression (union (singleton s) b) bs ; + ] + | E_if_cons (x, bnil , (((h, _) , (t, _)) , bcons)) -> + unions [ self x ; + self bnil ; + expression (unions [ singleton h ; singleton t ; b ]) bcons ; + ] + | E_if_left (x, ((l, _), bl), ((r, _), br)) -> + unions [ self x ; + expression (union (singleton l) b) bl ; + expression (union (singleton r) b) br ; + ] + | E_let_in ((v , _) , expr , body) -> + unions [ self expr ; + expression (union (singleton v) b) body ; + ] + | E_sequence (x, y) -> union (self x) (self y) + (* we do not consider the assigned variable free... seems strange, + but, matches ast_typed, and does not cause any troubles? *) + | E_assignment (_, _, e) -> self e + | E_while (cond , body) -> union (self cond) (self body) + + and var_name : bindings -> var_name -> bindings = fun b n -> + if mem n b + then empty + else singleton n + + and value : bindings -> value -> bindings = fun b v -> + let self = value b in + match v with + | D_unit + | D_bool _ + | D_nat _ + | D_timestamp _ + | D_mutez _ + | D_int _ + | D_string _ + | D_bytes _ + | D_none + | D_operation _ + -> empty + | D_pair (x, y) -> unions [ self x ; self y ] + | D_left x + | D_right x + | D_some x + -> self x + | D_map kvs + | D_big_map kvs + -> unions @@ List.map (fun (k, v) -> unions [ self k ; self v ]) kvs + | D_list xs + | D_set xs + -> unions @@ List.map self xs + + and lambda : bindings -> anon_function -> bindings = fun b l -> + let b = union (singleton l.binder) b in + expression b l.body + +end + (* Converts `expr` in `fun () -> expr`. *) let functionalize (body : expression) : expression = - let content = E_literal (D_function { binder = "_" ; body }) in + let content = E_closure { binder = "_" ; body } in let type_value = t_function t_unit body.type_value in { content ; type_value } @@ -82,19 +177,14 @@ let aggregate_entry (lst : program) (name : string) (to_functionalize : bool) : fun expr -> List.fold_right' aux expr pre_declarations in match (entry_expression.content , to_functionalize) with - | (E_literal (D_function l) , false) -> ( - let l' = { l with body = wrapper l.body } in - let e' = { entry_expression with content = E_literal (D_function l') } in - ok e' - ) | (E_closure l , false) -> ( let l' = { l with body = wrapper l.body } in let%bind t' = - let%bind (_ , input_ty , output_ty) = get_t_closure entry_expression.type_value in + let%bind (input_ty , output_ty) = get_t_function entry_expression.type_value in ok (t_function input_ty output_ty) in let e' = { - content = E_literal (D_function l') ; + content = E_closure l' ; type_value = t' ; } in ok e' diff --git a/src/stages/mini_c/types.ml b/src/stages/mini_c/types.ml index 2646d3dc9..dd9a40d5b 100644 --- a/src/stages/mini_c/types.ml +++ b/src/stages/mini_c/types.ml @@ -14,7 +14,6 @@ type type_value = | T_pair of (type_value annotated * type_value annotated) | T_or of (type_value annotated * type_value annotated) | T_function of (type_value * type_value) - | T_deep_closure of (environment * type_value * type_value) | T_base of type_base | T_map of (type_value * type_value) | T_big_map of (type_value * type_value) @@ -54,7 +53,6 @@ type value = | D_list of value list | D_set of value list (* | `Macro of anon_macro ... The future. *) - | D_function of anon_function | D_operation of Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation and selector = var_name list