diff --git a/src/passes/2-simplify/dune b/src/passes/2-simplify/dune index 9649d13dc..e27b5139d 100644 --- a/src/passes/2-simplify/dune +++ b/src/passes/2-simplify/dune @@ -6,6 +6,7 @@ tezos-utils parser ast_simplified + self_ast_simplified operators) (modules ligodity pascaligo simplify) (preprocess diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index d7443741a..321c87cf5 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1002,16 +1002,60 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun assign_instrs in let aux prev ass_exp = match ass_exp.expression with - | E_variable name -> SMap.add name ass_exp prev + | E_assign ( name , _ , _ ) -> + let expr' = e_variable name in + SMap.add name expr' prev | _ -> prev in + let captured_list = List.filter_map + (fun ass_exp -> match ass_exp.expression with + | E_assign ( name, _ , _ ) -> Some name + | _ -> None ) + assign_instrs' in let init_record = e_record (List.fold_left aux SMap.empty assign_instrs') in - (*later , init_record will be placed in a let_in *) - (* replace assignments to variable to assignments to record *) + (* replace assignments to X assignments to record *) + let%bind block' = simpl_block fc.block.value in + let%bind block' = block' None in + let replace_with_record exp = + match exp.expression with + | E_assign ( name , path , expr ) -> + let path' = ( match path with + | [] -> [Access_record name] + (* This will fail for deep tuple access, see LIGO-131 *) + | _ -> ((Access_record name)::path) ) in + ok @@ e_assign "_COMPILER_fold_record" path' expr + | E_variable name -> + if (List.mem name captured_list) then + ok @@ e_accessor (e_variable "_COMPILER_fold_record") [Access_record name] + else ok @@ exp + | _ -> ok @@ exp in + let%bind block'' = Self_ast_simplified.map_expression replace_with_record block' in + (* build the lambda*) + (* let%bind (elt_type' : type_expression) = simpl_type_expression fc.elt_type in *) + (* let%bind (record_type : type_expression) = ... in *) + (* Here it's not possible to know the type of the variable captures in the record ..*) + let lambda = e_lambda "_COMPILER_for_collect_lambda" None None block'' in + let%bind collect = simpl_expression fc.expr in + let fold = e_constant "LIST_FOLD" [collect ; init_record ; lambda] in + let final = e_let_in ("_COMPILER_init_record", None) init_record + @@ (e_let_in ("_COMPILER_folded_record", None) fold (e_skip ())) in - return_statement @@ init_record + (* build the sequence of assigments back to the original variables *) + let aux (prev : expression) (captured_varname : string) = + let access = e_accessor (e_variable "_COMPILER_folded_record") + [Access_record captured_varname] in + let assign = e_assign captured_varname [] access in + e_sequence prev assign in + + let ( final_sequence : expression ) = List.fold_left aux final captured_list in + + return_statement @@ final_sequence + +(** NODE TO AVOID THE DIRT: + have a E_unsimplified 'a which is then transformed in a self pass ?? +**) let simpl_program : Raw.ast -> program result = fun t -> bind_list @@ List.map simpl_declaration @@ nseq_to_list t.decl \ No newline at end of file diff --git a/src/passes/3-self_ast_simplified/self_ast_simplified.ml b/src/passes/3-self_ast_simplified/self_ast_simplified.ml index aa18b4a8c..b73113cdb 100644 --- a/src/passes/3-self_ast_simplified/self_ast_simplified.ml +++ b/src/passes/3-self_ast_simplified/self_ast_simplified.ml @@ -21,3 +21,5 @@ let all_program = let all_expression = let all_p = List.map Helpers.map_expression all in bind_chain all_p + +let map_expression = Helpers.map_expression diff --git a/src/test/contracts/loop.ligo b/src/test/contracts/loop.ligo index 2b7447942..6e5e709a8 100644 --- a/src/test/contracts/loop.ligo +++ b/src/test/contracts/loop.ligo @@ -40,20 +40,27 @@ function for_collection (var nee : unit; var nuu : unit) : (int * string) is blo record st = st; acc = acc; end; var folded_record : (record st : string; acc : int end ) := list_fold(mylist , init_record , lamby) ; + skip ; + st := folded_record.st ; + acc := folded_record.acc ; + } with (folded_record.acc , folded_record.st) -// function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { -// var acc : int := 0 ; -// var st : string := "to" ; -// var mylist : list(int) := list 1 ; 1 ; 1 end ; +function for_collection_ (var nee : unit; var nuu : unit) : (int * string) is block { + var acc : int := 0 ; + var st : string := "to" ; + var toto : (string * string) := ("foo","bar") ; -// for x : int in list mylist -// begin -// acc := acc + x ; -// st := st^"to" ; -// end + var mylist : list(int) := list 1 ; 1 ; 1 end ; -// } with acc + for x : int in list mylist + begin + toto.1 := "r"; + acc := acc + x ; + st := st^"to" ; + end + +} with acc function dummy (const n : nat) : nat is block { while (False) block { skip }