prepend the body of the lambda with let_in's
This commit is contained in:
parent
7f7f19854a
commit
0cf7471441
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user