diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index c785ee780..4b5a1b874 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -576,6 +576,7 @@ and simpl_fun_declaration : bind_fold_right_list aux result body in let expression : expression = e_lambda ~loc binder (Some input_type) (Some output_type) result in + (* let _toto = Format.printf "TAMERE %a \n" Ast_simplified.PP.expression expression in *) let type_annotation = Some (T_function (input_type, output_type)) in ok ((name , type_annotation) , expression) ) @@ -1017,30 +1018,45 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun block which will become the body of the lambda *) let%bind block' = simpl_block fc.block.value in let%bind block' = block' None in + let replace_with_record exp = match exp.expression with + (* replace asignement *) | E_assign ( name , path , expr ) -> let path' = ( match path with - | [] -> [Access_tuple 0 ; Access_record name ] @ path + | [] -> [Access_record name] (* This will fail for deep tuple access, see LIGO-131 *) - | _ -> [Access_tuple 0 ; Access_record name ] @ path ) in - ok @@ e_assign "arguments" path' expr + | _ -> ( (Access_record name) :: path ) + ) in + ok @@ e_assign "_COMPILER_acc" path' expr | E_variable name -> if (name = fc.var.value ) then - ok @@ e_accessor (e_variable "arguments") [Access_tuple 1] + (* replace reference to the collection element *) + ok @@ (e_variable "_COMPILER_collec_elt") else if (List.mem name captured_list) then - let acc_arg = e_accessor (e_variable "arguments") [Access_tuple 0] in - ok @@ e_accessor (acc_arg) [Access_record name] + (* replace reference fold accumulator *) + ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] else ok @@ exp | _ -> ok @@ exp in - let%bind block'' = Self_ast_simplified.map_expression replace_with_record block' in + let%bind block' = Self_ast_simplified.map_expression replace_with_record block' in + + (* append the return value *) let rec add_return expr = match expr.expression with | E_sequence (a,b) -> e_sequence a (add_return b) - | _ -> e_sequence expr (e_accessor (e_variable "arguments") [Access_tuple 0]) in - let block_with_return = add_return block'' in + | _ -> e_sequence expr (e_variable "_COMPILER_acc") in + let block' = add_return block' in + + (* prepend the body with let accumulator = argument.0 in let collec_elt = argument.1 in*) + let%bind elt_type = simpl_type_expression fc.elt_type in + let acc = e_accessor (e_variable "arguments") [Access_tuple 0] in + let collec_elt = e_accessor (e_variable "arguments") [Access_tuple 1] in + let args_let_in = e_let_in ("_COMPILER_acc", None) acc @@ + e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (e_skip ()) in + let block' = e_sequence args_let_in block' in + (* build the lambda*) - let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block_with_return in + let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block' in let%bind collect = simpl_expression fc.expr in let op_name = match fc.collection with | Map _ -> "MAP_FOLD" @@ -1049,7 +1065,7 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let fold = e_constant op_name [collect ; init_record ; lambda] in let folded_record = e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) in - (* build the sequence of assigments back to the original variables *) + (* append assigments of fold result to the original captured variables *) let aux (prev : expression) (captured_varname : string) = let access = e_accessor (e_variable "_COMPILER_folded_record") [Access_record captured_varname] in @@ -1057,7 +1073,6 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun e_sequence prev assign in let ( final_sequence : expression ) = List.fold_left aux folded_record captured_list in - let _ = Format.printf "___ GEN ____\n %a \n" Ast_simplified.PP.expression final_sequence in return_statement @@ final_sequence