add doc
This commit is contained in:
parent
e16eac77a6
commit
2ced2e784e
@ -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 ->
|
||||
|
Loading…
Reference in New Issue
Block a user