balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improving simplifier

Browse Source
This commit is contained in:
Lesenechal Remi 2019-10-29 11:41:59 +01:00
parent ba00db2b4c
commit e86c92bc3b
1 changed files with 29 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
src/passes/2-simplify/pascaligo.ml
View File

@ -1029,9 +1029,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
``` ```
We are performing the following steps: We are performing the following steps:
1) Filtering out of the body all the constructions that can't 1) Simplifying the for body using ̀simpl_block`
alter the environment (assignements and map/set patches)
and simplifying only those.
2) Detect the free variables and build a list of their names 2) Detect the free variables and build a list of their names
(myint and myst in the previous example) (myint and myst in the previous example)
@ -1074,76 +1072,56 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
**) **)
and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc -> and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun fc ->
match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ -> match fc.collection with | Map _ -> fail @@ unsupported_for_collect_map fc.block | _ ->
let statements = npseq_to_list fc.block.value.statements in
(* STEP 1 *) (* STEP 1 *)
let filter_assignments (el : Raw.statement) : Raw.instruction option = let%bind for_body = simpl_block fc.block.value in
match el with let%bind for_body = for_body None in
| 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 ->
let%bind assign' = simpl_instruction el in
let%bind assign' = assign' None in
ok @@ assign')
assign_instrs in
(* STEP 2 *) (* STEP 2 *)
let captured_name_list = List.filter_map let%bind captured_name_list = Self_ast_simplified.fold_expression
(fun ass_exp -> (fun (prev : type_name list) (ass_exp : expression) ->
match ass_exp.expression with match ass_exp.expression with
| E_assign ( name, _ , _ ) -> Some name | E_assign ( name , _ , _ ) -> ok (name::prev)
| _ -> None ) | _ -> ok prev )
assign_instrs' in []
for_body in
(* STEP 3 *) (* STEP 3 *)
let add_to_record (prev: expression type_name_map) (captured_name: string) = let add_to_record (prev: expression type_name_map) (captured_name: string) =
SMap.add captured_name (e_variable captured_name) prev in 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 let init_record = e_record (List.fold_left add_to_record SMap.empty captured_name_list) in
(* STEP 4 *) (* STEP 4 *)
let%bind for_body = simpl_block fc.block.value in
let%bind for_body = for_body None in
let replace exp = let replace exp =
(* TODO: map and set updated/remove must also be captured *)
match exp.expression with match exp.expression with
(* replace references to fold accumulator as rhs *) (* replace references to fold accumulator as rhs *)
| E_assign ( name , path , expr ) -> ( | E_assign ( name , path , expr ) -> (
match path with match path with
| [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr | [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr
(* This fails for deep accesses, see LIGO-131 LIGO-134 *) (* 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 ) fail @@ unsupported_deep_access_for_collection fc.block )
| E_variable name -> ( | E_variable name -> (
match fc.collection with 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]
else match fc.collection with
(* loop on map *) (* loop on map *)
| Map _ -> | Map _ ->
let k' = e_variable "#COMPILER#collec_elt_k" in let k' = e_variable "#COMPILER#collec_elt_k" in
let v' = e_variable "#COMPILER#collec_elt_v" in if ( name = fc.var.value ) then
( match fc.bind_to with ok @@ k' (* replace references to the the key *)
| Some (_,v) -> else (
if ( name = fc.var.value ) then match fc.bind_to with
ok @@ k' (* replace references to the the key *) | Some (_,v) ->
else if ( name = v.value ) then let v' = e_variable "#COMPILER#collec_elt_v" in
ok @@ v' (* replace references to the the value *) if ( name = v.value ) then
else if (List.mem name captured_name_list) then ok @@ v' (* replace references to the the value *)
(* replace references to fold accumulator as lhs *) else ok @@ exp
ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name] | None -> ok @@ exp
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]
else ok @@ exp
) )
(* loop on set or list *) (* loop on set or list *)
| (Set _ | List _) -> | (Set _ | List _) ->
if (name = fc.var.value ) then if (name = fc.var.value ) then
(* replace references to the collection element *) (* 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]
else ok @@ exp else ok @@ exp
) )
| _ -> ok @@ exp in | _ -> ok @@ exp in