From 2ced2e784e3088b3983bdc7fa0516c3faedf744e Mon Sep 17 00:00:00 2001 From: Lesenechal Remi Date: Mon, 28 Oct 2019 18:40:53 +0100 Subject: [PATCH] add doc --- src/passes/2-simplify/pascaligo.ml | 143 ++++++++++++++++++++++------- 1 file changed, 112 insertions(+), 31 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 66fe46481..ec38004b3 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -998,13 +998,88 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi -> let loop = e_loop comp body' in return_statement @@ e_let_in (fi.assign.value.name.value, Some t_int) value loop +(** simpl_for_collect + For loops over collections, like + + ``` concrete syntax : + for x : int in set myset + begin + myint := myint + x ; + myst := myst ^ "to" ; + end + ``` + + are implemented using a MAP_FOLD, LIST_FOLD or SET_FOLD: + + ``` pseudo Ast_simplified + let #COMPILER#folded_record = list_fold( mylist , + record st = st; acc = acc; end; + lamby = fun arguments -> ( + let #COMPILER#acc = arguments.0 in + let #COMPILER#elt = arguments.1 in + #COMPILER#acc.myint := #COMPILER#acc.myint + #COMPILER#elt ; + #COMPILER#acc.myst := #COMPILER#acc.myst ^ "to" ; + #COMPILER#acc + ) + ) in + { + myst := #COMPILER#folded_record.myst ; + myint := #COMPILER#folded_record.myint ; + } + ``` + + We are performing the following steps: + 1) Filtering out of the body all the constructions that can't + alter the environment (assignements and map/set patches) + and simplifying only those. + + 2) Detect the free variables and build a list of their names + (myint and myst in the previous example) + + 3) Build the initial record (later passed as 2nd argument of + `MAP/SET/LIST_FOLD`) capturing the environment using the + free variables list of (2) + + 4) In the filtered body of (1), replace occurences: + - free variable of name X as rhs ==> accessor `#COMPILER#acc.X` + - free variable of name X as lhs ==> accessor `#COMPILER#acc.X` + And, in the case of a map: + - references to the iterated key ==> variable `#COMPILER#elt_key` + - references to the iterated value ==> variable `#COMPILER#elt_value` + in the case of a set/list: + - references to the iterated value ==> variable `#COMPILER#elt` + + 5) Append the return value to the body + + 6) Prepend the declaration of the lambda arguments to the body which + is a serie of `let .. in`'s + Note that the parameter of the lambda ̀arguments` is a tree of + tuple holding: + * In the case of `list` or ̀set`: + ( folding record , current list/set element ) as + ( #COMPILER#acc , #COMPILER#elt ) + * In the case of `map`: + ( folding record , current map key , current map value ) as + ( #COMPILER#acc , #COMPILER#elt_key , #COMPILER#elt_value ) + + 7) Build the lambda using the final body of (6) + + 8) Build a sequence of assignments for all the captured variables + to their new value, namely an access to the folded record + (#COMPILER#folded_record) + + 9) Attach the sequence of 8 to the ̀let .. in` declaration + of #COMPILER#folded_record + +**) and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ -> let statements = npseq_to_list fc.block.value.statements in - (* build initial record *) - let filter_assignments (el : Raw.statement) : Raw.instruction option = match el with - | Raw.Instr (Assign _ as i) -> Some i - | _ -> None in + (* STEP 1 *) + let filter_assignments (el : Raw.statement) : Raw.instruction option = + match el with + | Raw.Instr (Assign _ as i) -> Some i + | _ -> None in let assign_instrs = List.filter_map filter_assignments statements in let%bind assign_instrs' = bind_map_list (fun el -> @@ -1012,31 +1087,37 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let%bind assign' = assign' None in ok @@ assign') assign_instrs in + (* STEP 2 *) let captured_name_list = List.filter_map - (fun ass_exp -> match ass_exp.expression with - | E_assign ( name, _ , _ ) -> Some name | _ -> None ) + (fun ass_exp -> + match ass_exp.expression with + | E_assign ( name, _ , _ ) -> Some name + | _ -> None ) assign_instrs' in + (* STEP 3 *) let add_to_record (prev: expression type_name_map) (captured_name: string) = SMap.add captured_name (e_variable captured_name) prev in let init_record = e_record (List.fold_left add_to_record SMap.empty captured_name_list) in - (* replace references to the future lambda arguments in the for body *) + (* STEP 4 *) let%bind for_body = simpl_block fc.block.value in let%bind for_body = for_body None in let replace exp = (* TODO: map and set updated/remove must also be captured *) match exp.expression with (* replace references to fold accumulator as rhs *) - | E_assign ( name , path , expr ) -> ( match path with - | [] -> ok @@ e_assign "_COMPILER_acc" [Access_record name] expr + | E_assign ( name , path , expr ) -> ( + match path with + | [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr (* This fails for deep accesses, see LIGO-131 LIGO-134 *) | _ -> - (* ok @@ e_assign "_COMPILER_acc" ((Access_record name)::path) expr) *) + (* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *) fail @@ unsupported_deep_access_for_collection fc.block ) - | E_variable name -> ( match fc.collection with + | E_variable name -> ( + match fc.collection with (* loop on map *) | Map _ -> - let k' = e_variable "_COMPILER_collec_elt_k" in - let v' = e_variable "_COMPILER_collec_elt_v" in + let k' = e_variable "#COMPILER#collec_elt_k" in + let v' = e_variable "#COMPILER#collec_elt_v" in ( match fc.bind_to with | Some (_,v) -> if ( name = fc.var.value ) then @@ -1045,34 +1126,34 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun ok @@ v' (* replace references to the the value *) else if (List.mem name captured_name_list) then (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp | None -> if ( name = fc.var.value ) then ok @@ k' (* replace references to the key *) else if (List.mem name captured_name_list) then (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp ) (* loop on set or list *) | (Set _ | List _) -> if (name = fc.var.value ) then (* replace references to the collection element *) - ok @@ (e_variable "_COMPILER_collec_elt") + ok @@ (e_variable "#COMPILER#collec_elt") else if (List.mem name captured_name_list) then (* replace references to fold accumulator as lhs *) - ok @@ e_accessor (e_variable "_COMPILER_acc") [Access_record name] + ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] else ok @@ exp ) | _ -> ok @@ exp in let%bind for_body = Self_ast_simplified.map_expression replace for_body in - (* append the return value (the accumulator) to the for body *) + (* STEP 5 *) let rec add_return (expr : expression) = match expr.expression with | E_sequence (a,b) -> e_sequence a (add_return b) - | _ -> e_sequence expr (e_variable "_COMPILER_acc") in + | _ -> e_sequence expr (e_variable "#COMPILER#acc") in let for_body = add_return for_body in - (* prepend for body with args declaration (accumulator and collection elements *) + (* STEP 6 *) let%bind elt_type = simpl_type_expression fc.elt_type in let for_body = let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in @@ -1081,35 +1162,35 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in - e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt_k", None) collec_elt_v @@ - e_let_in ("_COMPILER_collec_elt_v", None) collec_elt_k (for_body) + e_let_in ("#COMPILER#acc", None) acc @@ + e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@ + e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body) | _ -> let acc = arg_access [Access_tuple 0] in let collec_elt = arg_access [Access_tuple 1] in - e_let_in ("_COMPILER_acc", None) acc @@ - e_let_in ("_COMPILER_collec_elt", Some elt_type) collec_elt (for_body) + e_let_in ("#COMPILER#acc", None) acc @@ + e_let_in ("#COMPILER#collec_elt", Some elt_type) collec_elt (for_body) ) in - (* build the X_FOLD constant *) + (* STEP 7 *) let%bind collect = simpl_expression fc.expr in let lambda = e_lambda "arguments" None None for_body in let op_name = match fc.collection with | Map _ -> "MAP_FOLD" | Set _ -> "SET_FOLD" | List _ -> "LIST_FOLD" in let fold = e_constant op_name [collect ; init_record ; lambda] in - (* build sequence to re-assign fold result to the original captured variables *) + (* STEP 8 *) let assign_back (prev : expression option) (captured_varname : string) : expression option = - let access = e_accessor (e_variable "_COMPILER_folded_record") + let access = e_accessor (e_variable "#COMPILER#folded_record") [Access_record captured_varname] in let assign = e_assign captured_varname [] access in match prev with | None -> Some assign | Some p -> Some (e_sequence p assign) in let reassign_sequence = List.fold_left assign_back None captured_name_list in - (* attach the folded record to the re-assign sequence *) + (* STEP 9 *) let final_sequence = match reassign_sequence with (* None case means that no variables were captured *) - | None -> e_let_in ("_COMPILER_folded_record", None) fold (e_skip ()) - | Some seq -> e_let_in ("_COMPILER_folded_record", None) fold seq in + | None -> e_let_in ("#COMPILER#folded_record", None) fold (e_skip ()) + | Some seq -> e_let_in ("#COMPILER#folded_record", None) fold seq in return_statement @@ final_sequence let simpl_program : Raw.ast -> program result = fun t ->