Merge branch 'optim/nested_record_update' into 'dev'

Optimize transpilation of nested record update

See merge request ligolang/ligo!510

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 } ;
+                         DIP { DUP ; CDR ; SWAP ; CAR ; CDR } ;
-                         DIG 3 ;
-                         CDR ;
-                         SWAP ;
-                         CAR ;
                          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 } ;
+                                 CDR ;
-                                 DIG 4 ;
+                                 DIP { DUP } ;
-                                 CAR ;
+                                 SWAP ;
-                                 DIP 2 { DUP } ;
-                                 DIG 2 ;
-                                 DIP { DROP ; CDR } ;
                                  PAIR ;
                                  CAR ;
                                  DIP { DROP 4 } } ;

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 rec aux res (r,p,up) =
-      let%bind ty_lmap =
+        let ty = get_type_expression r in
-        trace_strong (corner_case ~loc:__LOC__ "not a record") @@
+        let%bind ty_lmap =
-        get_t_record (get_type_expression record) in
+          trace_strong (corner_case ~loc:__LOC__ "not a record") @@
-      let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in
+          get_t_record (ty) in
-      let%bind path = 
+        let%bind ty' = transpile_type (ty) in 
-        trace_strong (corner_case ~loc:__LOC__ "record access") @@
+        let%bind ty'_lmap = Ast_typed.Helpers.bind_map_lmap_t transpile_type ty_lmap in
-        record_access_to_lr ty' ty'_lmap path 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

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

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