Merge branch 'ast/update_with_path' into 'dev'

Modify record update, using path for update

See merge request ligolang/ligo!338

src/passes/1-parser/cameligo/AST.ml

@@ -333,10 +333,15 @@ and update = {
   lbrace : lbrace;
   record : path;
   kwd_with : kwd_with;
-  updates : record reg;
+  updates : field_path_assign reg ne_injection reg;
   rbrace : rbrace;
 }
 
+and field_path_assign = {
+  field_path  : (field_name, dot) nsepseq;
+  assignment : equal;
+  field_expr : expr
+}
 and path =
   Name of variable
 | Path of projection reg

src/passes/1-parser/cameligo/Parser.mly

@@ -627,7 +627,7 @@ record_expr:
     in {region; value} }
 
 update_record:
-  "{" path "with" sep_or_term_list(field_assignment,";") "}" {
+  "{" path "with" sep_or_term_list(field_path_assignment,";") "}" {
     let region = cover $1 $5 in
     let ne_elements, terminator = $4 in
     let value = {
@@ -641,6 +641,14 @@ update_record:
       rbrace   = $5}
     in {region; value} }
 
+field_path_assignment :
+  nsepseq(field_name,".") "=" expr {
+    let region = cover (nsepseq_to_region (fun x -> x.region) $1) (expr_to_region $3) in
+    let value  = {field_path = $1;
+                  assignment = $2;
+                  field_expr = $3}
+    in {region; value}}
+
 field_assignment:
   field_name "=" expr {
     let start  = $1.region in

src/passes/1-parser/cameligo/ParserLog.ml

@@ -188,7 +188,7 @@ and print_update state {value; _} =
  print_token state lbrace "{";
  print_path   state record;
  print_token state kwd_with "with";
- print_record_expr state updates;
+ print_ne_injection state print_field_path_assign updates;
  print_token state rbrace "}"
 
 and print_path state = function
@@ -513,6 +513,12 @@ and print_field_assign state {value; _} =
   print_token state assignment "=";
   print_expr  state field_expr
 
+and print_field_path_assign state {value; _} =
+  let {field_path; assignment; field_expr} = value in
+  print_nsepseq state "." print_var field_path;
+  print_token state assignment "=";
+  print_expr  state field_expr
+
 and print_sequence state seq =
   print_injection state print_expr seq
 
@@ -905,7 +911,7 @@ and pp_projection state proj =
 
 and pp_update state update =
   pp_path state update.record;
-  pp_ne_injection pp_field_assign state update.updates.value
+  pp_ne_injection pp_field_path_assign state update.updates.value
 
 and pp_path state = function
   Name name ->
@@ -928,6 +934,12 @@ and pp_field_assign state {value; _} =
   pp_ident (state#pad 2 0) value.field_name;
   pp_expr  (state#pad 2 1) value.field_expr
 
+and pp_field_path_assign state {value; _} =
+  pp_node  state "<field path for update>";
+  let path = Utils.nsepseq_to_list value.field_path in
+  List.iter (pp_ident (state#pad 2 0)) path;
+  pp_expr  (state#pad 2 1) value.field_expr
+
 and pp_constr_expr state = function
   ENone region ->
     pp_loc_node state "ENone" region

src/passes/1-parser/pascaligo/AST.ml

@@ -577,7 +577,13 @@ and projection = {
 and update = {
   record : path;
   kwd_with : kwd_with;
-  updates : record reg;
+  updates : field_path_assign reg ne_injection reg
+}
+
+and field_path_assign = {
+  field_path  : (field_name, dot) nsepseq;
+  equal : equal;
+  field_expr : expr
 }
 
 and selection =

src/passes/1-parser/pascaligo/Parser.mly

@@ -937,7 +937,7 @@ record_expr:
    in {region; value} }
 
 update_record:
-  path "with" ne_injection("record",field_assignment){
+  path "with" ne_injection("record",field_path_assignment){
     let region = cover (path_to_region $1) $3.region in
     let value = {
       record = $1;
@@ -954,6 +954,14 @@ field_assignment:
                   field_expr = $3}
     in {region; value} }
 
+field_path_assignment:
+  nsepseq(field_name,".") "=" expr {
+    let region = cover (nsepseq_to_region (fun x -> x.region) $1) (expr_to_region $3)
+    and value  = {field_path = $1;
+                  equal      = $2;
+                  field_expr = $3}
+    in {region; value} }
+
 fun_call:
   fun_name arguments {
     let region = cover $1.region $2.region

src/passes/1-parser/pascaligo/ParserLog.ml

@@ -603,11 +603,18 @@ and print_field_assign state {value; _} =
   print_token state equal "=";
   print_expr  state field_expr
 
-and print_update_expr state {value; _} =
+and print_field_path_assign state {value; _} =
+  let {field_path; equal; field_expr} = value in
+  print_nsepseq state "field_path" print_var field_path;
+  print_token state equal "=";
+  print_expr  state field_expr
+  
+and print_update_expr state {value; _} = 
   let {record; kwd_with; updates} = value in
   print_path state record;
   print_token state kwd_with "with";
-  print_record_expr state updates
+  print_ne_injection state "updates field" print_field_path_assign updates
+
 
 and print_projection state {value; _} =
   let {struct_name; selector; field_path} = value in
@@ -1215,7 +1222,7 @@ and pp_projection state proj =
 
 and pp_update state update =
   pp_path state update.record;
-  pp_ne_injection pp_field_assign state update.updates.value
+  pp_ne_injection pp_field_path_assign state update.updates.value
 
 and pp_selection state = function
   FieldName name ->
@@ -1320,6 +1327,12 @@ and pp_field_assign state {value; _} =
   pp_ident (state#pad 2 0) value.field_name;
   pp_expr  (state#pad 2 1) value.field_expr
 
+and pp_field_path_assign state {value; _} =
+  pp_node  state "<field path for update>";
+  let path = Utils.nsepseq_to_list value.field_path in
+  List.iter (pp_ident (state#pad 2 0)) path;
+  pp_expr  (state#pad 2 1) value.field_expr
+
 and pp_map_patch state patch =
   pp_path (state#pad 2 0) patch.path;
   pp_ne_injection pp_binding state patch.map_inj.value

src/passes/1-parser/reasonligo/Parser.mly

@@ -812,7 +812,7 @@ path :
 | projection { Path $1}
 
 update_record : 
-  "{""..."path "," sep_or_term_list(field_assignment,",") "}" {
+  "{""..."path "," sep_or_term_list(field_path_assignment,",") "}" {
     let region = cover $1 $6 in
     let ne_elements, terminator = $5 in
     let value = {
@@ -873,3 +873,21 @@ field_assignment:
       assignment = $2;
       field_expr = $3}
     in {region; value} }
+
+field_path_assignment:
+  field_name {
+    let value = {
+      field_path = ($1,[]);
+      assignment = ghost;
+      field_expr = EVar $1 }
+    in {$1 with value}
+  }
+| nsepseq(field_name,".") ":" expr {
+    let start  = nsepseq_to_region (fun x -> x.region) $1 in
+    let stop   = expr_to_region $3 in
+    let region = cover start stop in
+    let value  = {
+      field_path = $1;
+      assignment = $2;
+      field_expr = $3}
+    in {region; value} }

src/passes/2-simplify/cameligo.ml

@@ -291,14 +291,23 @@ let rec simpl_expression :
     | _ -> e_accessor (e_variable (Var.of_name name)) path in 
     let updates = u.updates.value.ne_elements in
     let%bind updates' =
-      let aux (f:Raw.field_assign Raw.reg) =
+      let aux (f:Raw.field_path_assign Raw.reg) =
         let (f,_) = r_split f in
         let%bind expr = simpl_expression f.field_expr in
-        ok (f.field_name.value, expr)
+        ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr)
       in
       bind_map_list aux @@ npseq_to_list updates 
     in
-    return @@ e_update ~loc record updates'
+    let aux ur (path, expr) = 
+      let rec aux record = function
+        | [] -> failwith "error in parsing"
+        | hd :: [] -> ok @@ e_update ~loc record hd expr
+        | hd :: tl -> 
+          let%bind expr = (aux (e_accessor ~loc record [Access_record hd]) tl) in
+          ok @@ e_update ~loc record hd expr 
+      in
+      aux ur path in
+    bind_fold_list aux record updates'
   in
 
   trace (simplifying_expr t) @@

src/passes/2-simplify/pascaligo.ml

@@ -473,14 +473,23 @@ and simpl_update = fun (u:Raw.update Region.reg) ->
   | _ -> e_accessor (e_variable (Var.of_name name)) path in
   let updates = u.updates.value.ne_elements in
   let%bind updates' =
-    let aux (f:Raw.field_assign Raw.reg) =
+    let aux (f:Raw.field_path_assign Raw.reg) =
       let (f,_) = r_split f in
       let%bind expr = simpl_expression f.field_expr in
-      ok (f.field_name.value, expr)
+        ok ( List.map (fun (x: _ Raw.reg) -> x.value) (npseq_to_list f.field_path), expr)
     in
     bind_map_list aux @@ npseq_to_list updates
   in
-  ok @@ e_update ~loc record updates'
+  let aux ur (path, expr) = 
+    let rec aux record = function
+      | [] -> failwith "error in parsing"
+      | hd :: [] -> ok @@ e_update ~loc record hd expr
+      | hd :: tl -> 
+        let%bind expr = (aux (e_accessor ~loc record [Access_record hd]) tl) in
+        ok @@ e_update ~loc record hd expr 
+    in
+    aux ur path in
+  bind_fold_list aux record updates'
 
 and simpl_logic_expression (t:Raw.logic_expr) : expression result =
   let return x = ok x in

src/passes/3-self_ast_simplified/helpers.ml

@@ -41,13 +41,9 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     let%bind res = bind_fold_lmap aux (ok init') m in
     ok res
   )
-  | E_update {record;updates} -> (
+  | E_update {record;update=(_,expr)} -> (
     let%bind res = self init' record in
-    let aux res (_, expr) =
+    let%bind res = fold_expression self res expr in
-      let%bind res = fold_expression self res expr in
-      ok res
-    in
-    let%bind res = bind_fold_list aux res updates in
     ok res 
   )
   | E_let_in { binder = _ ; rhs ; result } -> (
@@ -140,10 +136,10 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
     let%bind m' = bind_map_lmap self m in
     return @@ E_record m'
   )
-  | E_update {record; updates} -> (
+  | E_update {record; update=(l,expr)} -> (
     let%bind record = self record in
-    let%bind updates = bind_map_list (fun(l,e) -> let%bind e = self e in ok (l,e)) updates in
+    let%bind expr = self expr in
-    return @@ E_update {record;updates}
+    return @@ E_update {record;update=(l,expr)}
   )
   | E_constructor (name , e) -> (
       let%bind e' = self e in

src/passes/4-typer-new/typer.ml

@@ -529,27 +529,22 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
     let%bind (m' , state') = I.bind_fold_lmap aux (ok (I.LMap.empty , state)) m in
     let wrapped = Wrap.record (I.LMap.map get_type_annotation m') in
     return_wrapped (E_record m') state' wrapped
-  | E_update {record; updates} ->
+  | E_update {record; update=(k,expr)} ->
     let%bind (record, state) = type_expression e state record in
-    let aux (lst,state) (k, expr) =
+    let%bind (expr,state) = type_expression e state expr in
-      let%bind (expr', state) = type_expression e state expr in
-      ok ((k,expr')::lst, state)
-    in 
-    let%bind (updates, state) = bind_fold_list aux ([], state) updates in
     let wrapped = get_type_annotation record in
-    let%bind wrapped = match wrapped.type_value' with 
+    let%bind (wrapped,tv) = 
-    | T_record record ->
+      match wrapped.type_value' with 
-        let aux (k, e) =
+      | T_record record -> (
           let field_op = I.LMap.find_opt k record in
           match field_op with
+          | Some tv -> ok (record,tv)
           | None -> failwith @@ Format.asprintf "field %a is not part of record" Stage_common.PP.label k
-          | Some tv -> O.assert_type_value_eq (tv, get_type_annotation e)
+      )
-        in
+      | _ -> failwith "Update an expression which is not a record"
-        let%bind () = bind_iter_list aux updates in
-        ok (record)
-    | _ -> failwith "Update an expression which is not a record"
     in
-    return_wrapped (E_record_update (record, updates)) state (Wrap.record wrapped)
+    let%bind () = O.assert_type_value_eq (tv, get_type_annotation expr) in
+    return_wrapped (E_record_update (record, (k,expr))) state (Wrap.record wrapped)
   (* Data-structure *)
 
 (*
@@ -1139,14 +1134,11 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
   | E_record_accessor (r, Label s) ->
     let%bind r' = untype_expression r in
     return (e_accessor r' [Access_record s])
-  | E_record_update (r, updates) ->
+  | E_record_update (r, (l,e)) ->
     let%bind r' = untype_expression r in
-    let aux (Label l,e) =
+    let%bind e = untype_expression e in 
-      let%bind e = untype_expression e in 
+    let Label l = l in
-      ok (l, e)
+    return (e_update r' l e)
-    in
-    let%bind updates = bind_map_list aux updates in
-    return (e_update r' updates)
   | E_map m ->
     let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
     return (e_map m')

src/passes/4-typer-old/typer.ml

@@ -496,26 +496,22 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
       in
       let%bind m' = I.bind_fold_lmap aux (ok I.LMap.empty) m in
       return (E_record m') (t_record (I.LMap.map get_type_annotation m') ())
-  | E_update {record; updates} ->
+  | E_update {record; update =(l,expr)} ->
     let%bind record = type_expression' e record in
-    let aux acc (k, expr) =
+    let%bind expr' = type_expression' e expr in
-      let%bind expr' = type_expression' e expr in
-      ok ((k,expr')::acc)
-    in 
-    let%bind updates = bind_fold_list aux ([]) updates in
     let wrapped = get_type_annotation record in
-    let%bind () = match wrapped.type_value' with 
+    let%bind tv = 
-    | T_record record ->
+      match wrapped.type_value' with 
-        let aux (k, e) =
+      | T_record record -> (
-          let field_op = I.LMap.find_opt k record in
+          let field_op = I.LMap.find_opt l record in
           match field_op with
-          | None -> failwith @@ Format.asprintf "field %a is not part of record" Stage_common.PP.label k
+          | Some tv -> ok (tv)
-          | Some tv -> O.assert_type_value_eq (tv, get_type_annotation e)
+          | None -> failwith @@ Format.asprintf "field %a is not part of record %a" Stage_common.PP.label l O.PP.type_value wrapped
-        in
+      )
-        bind_iter_list aux updates
+      | _ -> failwith "Update an expression which is not a record"
-    | _ -> failwith "Update an expression which is not a record"
     in
-    return (E_record_update (record, updates)) wrapped
+    let%bind () = O.assert_type_value_eq (tv, get_type_annotation expr') in
+    return (E_record_update (record, (l,expr'))) wrapped
   (* Data-structure *)
   | E_list lst ->
       let%bind lst' = bind_map_list (type_expression' e) lst in
@@ -896,14 +892,11 @@ let rec untype_expression (e:O.annotated_expression) : (I.expression) result =
   | E_record_accessor (r, Label s) ->
       let%bind r' = untype_expression r in
       return (e_accessor r' [Access_record s])
-  | E_record_update (r, updates) ->
+  | E_record_update (r, (l,e)) ->
     let%bind r' = untype_expression r in
-    let aux (Label l,e) =
+    let%bind e = untype_expression e in 
-      let%bind e = untype_expression e in 
+    let Label l = l in
-      ok (l, e)
+    return (e_update r' l e)
-    in
-    let%bind updates = bind_map_list aux updates in
-    return (e_update r' updates)
   | E_map m ->
       let%bind m' = bind_map_list (bind_map_pair untype_expression) m in
       return (e_map m')

src/passes/6-transpiler/transpiler.ml

@@ -206,11 +206,11 @@ let tuple_access_to_lr : type_value -> type_value list -> int -> (type_value * [
     bind_fold_list aux (ty , []) lr_path in
   ok lst
 
-let record_access_to_lr : type_value -> type_value AST.label_map -> string -> (type_value * [`Left | `Right]) list result = fun ty tym ind ->
+let record_access_to_lr : type_value -> type_value AST.label_map -> label -> (type_value * [`Left | `Right]) list result = fun ty tym ind ->
   let tys = kv_list_of_lmap tym in
   let node_tv = Append_tree.of_list tys in
   let%bind path =
-    let aux (Label i , _) = i = ind in
+    let aux (Label i , _) = let Label ind = ind in i = ind in
     trace_option (corner_case ~loc:__LOC__ "record access leaf") @@
     Append_tree.exists_path aux node_tv in
   let lr_path = List.map (fun b -> if b then `Right else `Left) path in
@@ -348,7 +348,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
       trace_strong (corner_case ~loc:__LOC__ "record build") @@
       Append_tree.fold_ne (transpile_annotated_expression) aux node
     )
-  | E_record_accessor (record, Label property) ->
+  | E_record_accessor (record, property) ->
       let%bind ty' = transpile_type (get_type_annotation record) in
       let%bind ty_lmap =
         trace_strong (corner_case ~loc:__LOC__ "not a record") @@
@@ -365,23 +365,19 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
       let%bind record' = transpile_annotated_expression record in
       let expr = List.fold_left aux record' path in
       ok expr
-  | E_record_update (record, updates) -> 
+  | E_record_update (record, (l,expr)) -> 
       let%bind ty' = transpile_type (get_type_annotation record) in 
       let%bind ty_lmap =
         trace_strong (corner_case ~loc:__LOC__ "not a record") @@
         get_t_record (get_type_annotation record) in
       let%bind ty'_lmap = AST.bind_map_lmap transpile_type ty_lmap in
-      let aux (Label l, expr) =
+      let%bind path = 
-        let%bind path = 
+        trace_strong (corner_case ~loc:__LOC__ "record access") @@
-          trace_strong (corner_case ~loc:__LOC__ "record access") @@
+        record_access_to_lr ty' ty'_lmap l in
-          record_access_to_lr ty' ty'_lmap l in
+      let path' = List.map snd path in
-        let path' = List.map snd path in
+      let%bind expr' = transpile_annotated_expression expr in
-        let%bind expr' = transpile_annotated_expression expr in
-        ok (path',expr') 
-      in
-      let%bind updates = bind_map_list aux updates in
       let%bind record = transpile_annotated_expression record in
-      return @@ E_update (record, updates) 
+      return @@ E_update (record, (path',expr')) 
   | E_constant (name , lst) -> (
       let iterator_generator iterator_name =
         let lambda_to_iterator_body (f : AST.annotated_expression) (l : AST.lambda) =
@@ -521,7 +517,7 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
                 trace_strong (corner_case ~loc:__LOC__ "not a record") @@
                 AST.Combinators.get_t_record prev in
               let%bind ty'_map = bind_map_lmap transpile_type ty_map in
-              let%bind path = record_access_to_lr ty' ty'_map prop in
+              let%bind path = record_access_to_lr ty' ty'_map (Label prop) in
               let path' = List.map snd path in
             let%bind prop_in_ty_map = trace_option
                 (Errors.not_found "acessing prop in ty_map [TODO: better error message]")

src/passes/7-self_mini_c/helpers.ml

@@ -84,13 +84,9 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
       let%bind res = self init' exp in
       ok res
   )
-  | E_update (r, updates) -> (
+  | E_update (r, (_,e)) -> (
       let%bind res = self init' r in
-      let aux prev (_,e) =
+      let%bind res = self res e in
-          let%bind res = self prev e in
-          ok res
-      in
-      let%bind res = bind_fold_list aux res updates in
       ok res
   )
 
@@ -158,10 +154,10 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
       let%bind exp' = self exp in
       return @@ E_assignment (s, lrl, exp')
   )
-  | E_update (r, updates) -> (
+  | E_update (r, (l,e)) -> (
       let%bind r = self r in
-      let%bind updates = bind_map_list (fun (p,e) -> let%bind e = self e in ok(p,e)) updates in
+      let%bind e = self e in
-      return @@ E_update(r,updates)
+      return @@ E_update(r,(l,e))
   )
 
 let map_sub_level_expression : mapper -> expression -> expression result = fun f e ->

src/passes/7-self_mini_c/self_mini_c.ml

@@ -66,8 +66,8 @@ let rec is_pure : expression -> bool = fun e ->
 
   | E_constant (c, args)
     -> is_pure_constant c && List.for_all is_pure args
-  | E_update (e, updates)
+  | E_update (r, (_,e))
-    -> is_pure e && List.for_all (fun (_,e) -> is_pure e) updates
+    -> is_pure r && is_pure e
 
   (* I'm not sure about these. Maybe can be tested better? *)
   | E_application _
@@ -111,8 +111,8 @@ let rec is_assigned : ignore_lambdas:bool -> expression_variable -> expression -
   match e.content with
   | E_assignment (x, _, e) ->
     it x || self e
-  | E_update (r, updates) ->
+  | E_update (r, (_,e)) ->
-    List.fold_left (fun prev (_,e) -> prev || self e) (self r) updates
+    self r || self e
   | E_closure { binder; body } ->
     if ignore_lambdas
     then false

src/passes/7-self_mini_c/subst.ml

@@ -94,10 +94,10 @@ let rec replace : expression -> var_name -> var_name -> expression =
     let v = replace_var v in
     let e = replace e in
     return @@ E_assignment (v, path, e)
-  | E_update (r, updates) ->
+  | E_update (r, (p,e)) ->
     let r = replace r in
-    let updates = List.map (fun (p,e)-> (p, replace e)) updates in
+    let e = replace e in
-    return @@ E_update (r,updates)
+    return @@ E_update (r, (p,e))
   | E_while (cond, body) ->
     let cond = replace cond in
     let body = replace body in
@@ -209,10 +209,10 @@ let rec subst_expression : body:expression -> x:var_name -> expr:expression -> e
       if Var.equal s x then raise Bad_argument ;
       return @@ E_assignment (s, lrl, exp')
   )
-  | E_update (r, updates) -> (
+  | E_update (r, (p,e)) -> (
     let r' = self r in
-    let updates' = List.map (fun (p,e) -> (p, self e)) updates in
+    let e' = self e in
-    return @@ E_update(r',updates')
+    return @@ E_update(r', (p,e'))
   )
 
 let%expect_test _ =

src/passes/8-compiler/compiler_program.ml

@@ -402,32 +402,29 @@ and translate_expression (expr:expression) (env:environment) : michelson result
         i_push_unit ;
       ]
     )
-  | E_update (record, updates) -> (
+  | E_update (record, (path, expr)) -> (
     let%bind record' = translate_expression record env in
-    let insts = [
+
-      i_comment "r_update: start, move the record on top # env";
+    let record_var = Var.fresh () in
-      record';] in 
+    let env' = Environment.add (record_var, record.type_value) env in
-    let aux (init :t list) (update,expr) = 
+    let%bind expr' = translate_expression expr env' in
-      let record_var = Var.fresh () in
+    let modify_code =
-      let env' = Environment.add (record_var, record.type_value) env in
+      let aux acc step = match step with
-      let%bind expr' = translate_expression expr env' in
+        | `Left -> seq [dip i_unpair ; acc ; i_pair]
-      let modify_code =
+        | `Right -> seq [dip i_unpiar ; acc ; i_piar]
-        let aux acc step = match step with
-          | `Left -> seq [dip i_unpair ; acc ; i_pair]
-          | `Right -> seq [dip i_unpiar ; acc ; i_piar]
-        in
-        let init = dip i_drop in
-        List.fold_right' aux init update
       in
-      ok @@ init @ [
+      let init = dip i_drop in
-        expr';
+      List.fold_right' aux init path
-        i_comment "r_updates : compute rhs # rhs:env";
-        modify_code;
-        i_comment "r_update: modify code # record+rhs : env";
-        ]
     in
-    let%bind insts = bind_fold_list aux insts updates in
+    return @@ seq [
-    return @@ seq insts
+      i_comment "r_update: start # env";
+      record';
+      i_comment "r_update: move the record on top # env";
+      expr';
+      i_comment "r_updates : compute rhs # rhs:env";
+      modify_code;
+      i_comment "r_update: modify code # record+rhs : env";
+      ]
 
   )
   | E_while (expr , block) -> (

src/stages/ast_simplified/PP.ml

@@ -26,11 +26,11 @@ let rec expression ppf (e:expression) = match e.expression with
   | E_tuple lst -> fprintf ppf "(%a)" (tuple_sep_d expression) lst
   | E_accessor (ae, p) -> fprintf ppf "%a.%a" expression ae access_path p
   | E_record m -> fprintf ppf "{%a}" (lrecord_sep expression (const " , ")) m
-  | E_update {record; updates} -> fprintf ppf "%a with {%a}" expression record (tuple_sep_d (fun ppf (a,b) -> fprintf ppf "%a = %a" label a expression b)) updates
+  | E_update {record; update=(path,expr)} -> fprintf ppf "%a with { %a = %a }" expression record Stage_common.PP.label path expression expr
   | E_map m -> fprintf ppf "[%a]" (list_sep_d assoc_expression) m
   | E_big_map m -> fprintf ppf "big_map[%a]" (list_sep_d assoc_expression) m
   | E_list lst -> fprintf ppf "[%a]" (list_sep_d expression) lst
-  | E_set lst -> fprintf ppf "{%a}" (list_sep_d expression) lst
+  | E_set lst  -> fprintf ppf "{%a}" (list_sep_d expression) lst
   | E_look_up (ds, ind) -> fprintf ppf "(%a)[%a]" expression ds expression ind
   | E_lambda {binder;input_type;output_type;result} ->
       fprintf ppf "lambda (%a:%a) : %a return %a"

src/stages/ast_simplified/combinators.ml

@@ -174,9 +174,10 @@ let e_ez_record ?loc (lst : (string * expr) list) : expression =
 let e_record ?loc map =
   let lst = Map.String.to_kv_list map in
   e_ez_record ?loc lst 
-let e_update ?loc record updates = 
+
-  let updates = List.map (fun (x,y) -> (Label x, y)) updates in
+let e_update ?loc record path expr = 
-  location_wrap ?loc @@ E_update {record; updates}
+  let update = (Label path, expr) in
+  location_wrap ?loc @@ E_update {record; update}
 
 let get_e_accessor = fun t ->
   match t with

src/stages/ast_simplified/combinators.mli

@@ -109,7 +109,7 @@ val e_typed_set : ?loc:Location.t -> expression list -> type_expression -> expre
 
 val e_lambda : ?loc:Location.t -> expression_variable -> type_expression option -> type_expression option -> expression -> expression
 val e_record : ?loc:Location.t -> expr Map.String.t -> expression
-val e_update : ?loc:Location.t -> expression -> (string * expression) list -> expression
+val e_update : ?loc:Location.t -> expression -> string -> expression -> expression
 
 val e_ez_record : ?loc:Location.t -> ( string * expr ) list -> expression
 (*

src/stages/ast_simplified/misc.ml

@@ -133,14 +133,14 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
       simple_fail "comparing record with other expression"
   
   | E_update ura, E_update urb ->
-    let%bind lst =
+    let _ = 
-      generic_try (simple_error "updates with different number of fields")
+      generic_try (simple_error "Updating different record") @@ 
-      (fun () -> List.combine ura.updates urb.updates) in
+      fun () -> assert_value_eq (ura.record, urb.record) in
     let aux ((Label a,expra),(Label b, exprb))=
-      assert (String.equal a b); 
+      assert (String.equal a b);
       assert_value_eq (expra,exprb)
     in
-    let%bind _all = bind_list @@ List.map aux lst in
+    let%bind _all = aux (ura.update, urb.update) in
     ok ()
   | E_update _, _ ->
      simple_fail "comparing record update with other expression"

src/stages/ast_simplified/types.ml

@@ -67,6 +67,6 @@ and expression = {
   expression : expression' ;
   location : Location.t ;
 }
-and update = {record: expr; updates: (label*expr)list}
+and update = { record: expr; update: (label *expr) }
 
 and matching_expr = (expr,unit) matching

src/stages/ast_typed/PP.ml

@@ -40,7 +40,7 @@ and expression ppf (e:expression) : unit =
   | E_lambda l -> fprintf ppf "%a" lambda l
   | E_tuple_accessor (ae, i) -> fprintf ppf "%a.%d" annotated_expression ae i
   | E_record_accessor (ae, l) -> fprintf ppf "%a.%a" annotated_expression ae label l
-  | E_record_update (ae, ups) -> fprintf ppf "%a with record[%a]" annotated_expression ae (lmap_sep annotated_expression (const " , ")) (LMap.of_list ups)
+  | E_record_update (ae, (path,expr)) -> fprintf ppf "%a with record[%a=%a]" annotated_expression ae Stage_common.PP.label path annotated_expression expr
   | E_tuple lst -> fprintf ppf "tuple[@;  @[<v>%a@]@;]" (list_sep annotated_expression (tag ",@;")) lst
   | E_record m -> fprintf ppf "record[%a]" (lmap_sep annotated_expression (const " , ")) m
   | E_map m -> fprintf ppf "map[@;  @[<v>%a@]@;]" (list_sep assoc_annotated_expression (tag ",@;")) m

src/stages/ast_typed/misc.ml

@@ -179,7 +179,7 @@ module Free_variables = struct
     | E_constructor (_ , a) -> self a
     | E_record m -> unions @@ List.map self @@ LMap.to_list m
     | E_record_accessor (a, _) -> self a
-    | E_record_update (r,ups) -> union (self r) @@ unions @@ List.map (fun (_,e) -> self e) ups
+    | E_record_update (r,(_,e)) -> union (self r) @@ self e
     | E_tuple_accessor (a, _) -> self a
     | E_list lst -> unions @@ List.map self lst
     | E_set lst -> unions @@ List.map self lst

src/stages/ast_typed/misc_smart.ml

@@ -72,14 +72,10 @@ module Captured_variables = struct
       let%bind lst' = bind_map_list self @@ LMap.to_list m in
       ok @@ unions lst'
     | E_record_accessor (a, _) -> self a
-    | E_record_update (r,ups) -> 
+    | E_record_update (r,(_,e)) -> 
       let%bind r = self r in
-      let aux (_, e) =
+      let%bind e = self e in
-        let%bind e = self e in
+      ok @@ union r e
-        ok e
-      in
-      let%bind lst = bind_map_list aux ups in
-      ok @@ union r @@ unions lst
     | E_tuple_accessor (a, _) -> self a
     | E_list lst ->
       let%bind lst' = bind_map_list self lst in

src/stages/ast_typed/types.ml

@@ -85,7 +85,7 @@ and 'a expression' =
   (* Record *)
   | E_record of ('a) label_map
   | E_record_accessor of (('a) * label)
-  | E_record_update of ('a * (label* 'a) list)
+  | E_record_update of ('a * (label * 'a))
   (* Data Structures *)
   | E_map of (('a) * ('a)) list
   | E_big_map of (('a) * ('a)) list

src/stages/common/PP.mli

@@ -13,3 +13,4 @@ val type_expression' : (formatter -> 'a -> unit) -> formatter -> 'a type_express
 val type_operator    : (formatter -> 'a -> unit) -> formatter -> 'a type_operator -> unit
 val type_constant    : formatter -> type_constant -> unit
 val literal          : formatter -> literal -> unit
+val list_sep_d       : (formatter -> 'a -> unit) -> formatter -> 'a list -> unit

src/stages/mini_c/PP.ml

@@ -99,8 +99,8 @@ and expression' ppf (e:expression') = match e with
       fprintf ppf "fold %a on %a with %a do ( %a )" expression collection expression initial Stage_common.PP.name name expression body
   | E_assignment (r , path , e) ->
       fprintf ppf "%a.%a := %a" Stage_common.PP.name r (list_sep lr (const ".")) path expression e
-  | E_update (r, updates) ->
+  | E_update (r, (path,e)) ->
-      fprintf ppf "%a with {%a}" expression r (list_sep_d (fun ppf (path, e) -> fprintf ppf "%a = %a" (list_sep lr (const ".")) path expression e)) updates
+      fprintf ppf "%a with {%a=%a}" expression r (list_sep lr (const ".")) path expression e
   | E_while (e , b) ->
       fprintf ppf "while (%a) %a" expression e expression b
 

src/stages/mini_c/misc.ml

@@ -81,7 +81,7 @@ module Free_variables = struct
     | E_sequence (x, y) -> union (self x) (self y)
     (* NB different from ast_typed... *)
     | E_assignment (v, _, e) -> unions [ var_name b v ; self e ]
-    | E_update (e, updates) -> union (self e) (unions @@ List.map (fun (_,e) -> self e) updates)
+    | E_update (r, (_,e)) -> union (self r) (self e)
     | E_while (cond , body) -> union (self cond) (self body)
 
   and var_name : bindings -> var_name -> bindings = fun b n ->

src/stages/mini_c/types.ml

@@ -73,7 +73,7 @@ and expression' =
   | E_let_in of ((var_name * type_value) * inline * expression * expression)
   | E_sequence of (expression * expression)
   | E_assignment of (expression_variable * [`Left | `Right] list * expression)
-  | E_update of (expression * ([`Left | `Right] list * expression) list)
+  | E_update of (expression * ([`Left | `Right] list * expression))
   | E_while of (expression * expression)
 
 and expression = {

src/stages/typesystem/misc.ml

@@ -189,10 +189,10 @@ module Substitution = struct
         let%bind val_ = s_annotated_expression ~v ~expr val_ in
         let%bind l = s_label ~v ~expr l in
         ok @@ T.E_record_accessor (val_, l)
-      | T.E_record_update (r, ups) ->
+      | T.E_record_update (r, (l,e)) ->
         let%bind r = s_annotated_expression ~v ~expr r in
-        let%bind ups = bind_map_list (fun (l,e) -> let%bind e = s_annotated_expression ~v ~expr e in ok (l,e)) ups in
+        let%bind e = s_annotated_expression ~v ~expr e in
-        ok @@ T.E_record_update (r,ups)
+        ok @@ T.E_record_update (r,(l,e))
       | T.E_map             val_val_list ->
         let%bind val_val_list = bind_map_list (fun (val1 , val2) ->
             let%bind val1 = s_annotated_expression ~v ~expr val1 in

src/test/contracts/record.ligo

@@ -64,5 +64,5 @@ end
 
 function modify_inner (const r : double_record) : double_record is
   block {
-    r := r with record inner = r.inner with record b = 2048; end; end;
+    r := r with record inner.b = 2048; end;
   } with r

src/test/contracts/record.mligo

@@ -50,4 +50,4 @@ type double_record = {
   inner : abc;
 }
 
-let modify_inner (r : double_record) : double_record = {r with inner = {r.inner with b = 2048 }}
+let modify_inner (r : double_record) : double_record = {r with inner.b = 2048 }

src/test/contracts/record.religo

@@ -50,4 +50,4 @@ type double_record = {
   inner : abc,
 };
 
-let modify_inner = (r : double_record) : double_record => {...r,inner : {...r.inner, b : 2048 } };
+let modify_inner = (r : double_record) : double_record => {...r,inner.b : 2048 };