diff --git a/src/bin/expect_tests/contract_tests.ml b/src/bin/expect_tests/contract_tests.ml index e49fd5ed5..af6a644d7 100644 --- a/src/bin/expect_tests/contract_tests.ml +++ b/src/bin/expect_tests/contract_tests.ml @@ -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 } } ; diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml index 6bb73efc0..37c005ef6 100644 --- a/src/passes/10-transpiler/transpiler.ml +++ b/src/passes/10-transpiler/transpiler.ml @@ -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 diff --git a/src/stages/4-ast_typed/misc.ml b/src/stages/4-ast_typed/misc.ml index 8612f2ece..95c1b9289 100644 --- a/src/stages/4-ast_typed/misc.ml +++ b/src/stages/4-ast_typed/misc.ml @@ -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 diff --git a/src/stages/4-ast_typed/misc.mli b/src/stages/4-ast_typed/misc.mli index 2a0a443fa..924702ce8 100644 --- a/src/stages/4-ast_typed/misc.mli +++ b/src/stages/4-ast_typed/misc.mli @@ -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