Merge branch 'optim/nested_record_update' into 'dev'
Optimize transpilation of nested record update See merge request ligolang/ligo!510
This commit is contained in:
commit
ca3549bdee
@ -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 } } ;
|
||||
|
@ -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%bind ty_lmap =
|
||||
trace_strong (corner_case ~loc:__LOC__ "not a record") @@
|
||||
get_t_record (get_type_expression record) in
|
||||
let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in
|
||||
let%bind path =
|
||||
trace_strong (corner_case ~loc:__LOC__ "record access") @@
|
||||
record_access_to_lr ty' ty'_lmap path 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 (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 p' =
|
||||
trace_strong (corner_case ~loc:__LOC__ "record access") @@
|
||||
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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user