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

Merge branch 'optim/nested_record_update' into 'dev'

Browse Source 
Optimize transpilation of nested record update

See merge request ligolang/ligo!510
This commit is contained in:
Pierre-Emmanuel Wulfman 2020-04-23 10:01:47 +00:00
commit ca3549bdee
4 changed files with 41 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
src/bin/expect_tests/contract_tests.ml
View File

@ -10,10 +10,10 @@ let%expect_test _ =
[%expect {| 1874 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "multisig.ligo" ; "main" ] ;
[%expect {| 1189 bytes |}] ;
[%expect {| 1163 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "multisig-v2.ligo" ; "main" ] ;
[%expect {| 2897 bytes |}] ;
[%expect {| 2867 bytes |}] ;
run_ligo_good [ "measure-contract" ; contract "vote.mligo" ; "main" ] ;
[%expect {| 617 bytes |}] ;
@ -388,36 +388,21 @@ let%expect_test _ =
{ DUP } ;
DIP 5 { DUP } ;
DIG 5 ;
DIP 6 { DUP } ;
DIG 6 ;
CAR ;
DIP 2 { DUP } ;
DIG 2 ;
CAR ;
SWAP ;
CDR ;
SWAP ;
PAIR ;
SWAP ;
CDR ;
SWAP ;
PAIR ;
DUP ;
DIP { DUP } ;
SWAP ;
CAR ;
DIP 3 { DUP } ;
DIG 3 ;
CDR ;
SWAP ;
CAR ;
DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ;
PAIR ;
PAIR ;
DIP { DUP } ;
SWAP ;
CDR ;
DIP { DUP ; CDR ; SWAP ; CAR ; CAR } ;
SWAP ;
PAIR ;
PAIR ;
CAR ;
DIP { DROP 7 } } ;
DIP { DROP 6 } } ;
DUP ;
CDR ;
DIP { DIP 3 { DUP } ; DIG 3 ; CDR ; CDR } ;
@ -698,12 +683,9 @@ let%expect_test _ =
{ DIP { DUP } ; SWAP } ;
DIP 3 { DUP } ;
DIG 3 ;
DIP 4 { DUP } ;
DIG 4 ;
CAR ;
DIP 2 { DUP } ;
DIG 2 ;
DIP { DROP ; CDR } ;
CDR ;
DIP { DUP } ;
SWAP ;
PAIR ;
CAR ;
DIP { DROP 4 } } ;

23
src/passes/10-transpiler/transpiler.ml
View File

@ -474,14 +474,29 @@ and transpile_annotated_expression (ae:AST.expression) : expression result =
let expr = List.fold_left aux record' path in
ok expr
| E_record_update {record; path; update} ->
let%bind ty' = transpile_type (get_type_expression record) in
let rec aux res (r,p,up) =
let ty = get_type_expression r in
let%bind ty_lmap =
trace_strong (corner_case ~loc:__LOC__ "not a record") @@
get_t_record (get_type_expression record) in
get_t_record (ty) in
let%bind ty' = transpile_type (ty) in
let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in
let%bind path =
let%bind p' =
trace_strong (corner_case ~loc:__LOC__ "record access") @@
record_access_to_lr ty' ty'_lmap path in
record_access_to_lr ty' ty'_lmap p in
let res' = res @ p' in
match (up:AST.expression).expression_content with
| AST.E_record_update {record=record'; path=path'; update=update'} -> (
match record'.expression_content with
| AST.E_record_accessor {record;path} ->
if (AST.Misc.equal_variables record r && path = p) then
aux res' (record',path',update')
else ok @@ (up,res')
| _ -> ok @@ (up,res')
)
| _ -> ok @@ (up,res')
in
let%bind (update, path) = aux [] (record, path, update) in
let path = List.map snd path in
let%bind update = transpile_annotated_expression update in
let%bind record = transpile_annotated_expression record in

5
src/stages/4-ast_typed/misc.ml
View File

@ -527,3 +527,8 @@ let program_environment (program : program) : full_environment =
let last_declaration = Location.unwrap List.(hd @@ rev program) in
match last_declaration with
| Declaration_constant { binder=_ ; expr=_ ; inline=_ ; post_env } -> post_env
let equal_variables a b : bool =
match a.expression_content, b.expression_content with
| E_variable a, E_variable b -> Var.equal a b
| _, _ -> false

2
src/stages/4-ast_typed/misc.mli
View File

@ -10,6 +10,8 @@ val merge_annotation : type_expression option -> type_expression option -> error
(* No information about what made it fail *)
val type_expression_eq : ( type_expression * type_expression ) -> bool
val equal_variables : expression -> expression -> bool
module Free_variables : sig
type bindings = expression_variable list