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 ced31d622..9851d2d36 100644 --- a/src/main/compile/of_mini_c.ml +++ b/src/main/compile/of_mini_c.ml @@ -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/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