From 79f2df2314f8fd89adfd8e924b1ca4e1fc8a4779 Mon Sep 17 00:00:00 2001
From: Pierre-Emmanuel Wulfman <pierre.emmanuel.wulfman@gmail.com>
Date: Fri, 20 Mar 2020 11:54:31 +0100
Subject: [PATCH] optim for record

---
 src/passes/10-transpiler/transpiler.ml | 29 +++++++++++++++++++-------
 1 file changed, 21 insertions(+), 8 deletions(-)

diff --git a/src/passes/10-transpiler/transpiler.ml b/src/passes/10-transpiler/transpiler.ml
index 6bb73efc0..2e167fdd9 100644
--- a/src/passes/10-transpiler/transpiler.ml
+++ b/src/passes/10-transpiler/transpiler.ml
@@ -474,14 +474,27 @@ 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} when record = r && path = p -> 
+              aux res' (record',path',update')
+            | _ -> 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