This commit is contained in:
Lesenechal Remi 2019-10-28 18:40:53 +01:00
parent e16eac77a6
commit 2ced2e784e

View File

@ -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 ->