after review 1

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

@@ -335,9 +335,11 @@ and field_assign = {
 }
 
 and update = {
+  lbrace : lbrace;
   record : path;
   kwd_with : kwd_with;
   updates : record reg;
+  rbrace : rbrace;
 }
 and path =
   Name of variable

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

@@ -616,12 +616,18 @@ record_expr:
     in {region; value} }
 
 update_record:
-  "{" path "with" record_expr "}" {
+  "{" path "with" sep_or_term_list(field_assignment,";") "}" {
     let region = cover $1 $5 in
+    let ne_elements, terminator = $4 in
     let value = {
+      lbrace   = $1;
       record   = $2;
       kwd_with = $3;
-      updates = $4}
+      updates  = { value = {compound = Braces($1,$5);
+                  ne_elements;
+                  terminator};
+                  region = cover $3 $5};
+      rbrace   = $5}
     in {region; value} }
 
 field_assignment:

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

@@ -176,10 +176,12 @@ and print_projection state {value; _} =
   print_nsepseq state "." print_selection field_path
 
 and print_update state {value; _} =
- let {record; kwd_with; updates} = value in
+ let {lbrace; record; kwd_with; updates; rbrace} = value in
+ print_token state lbrace "{";
  print_path   state record;
  print_token state kwd_with "with";
- print_record_expr state updates
+ print_record_expr state updates;
+ print_token state rbrace "}"
 
 and print_path state = function
   Name var  -> print_var        state var

src/passes/1-parser/cameligo/Tests/pp.mligo

@@ -24,3 +24,6 @@ let e = Some (a, B b)
 let z = z.1.2
 let v = "hello" ^ "world" ^ "!"
 let w = Map.literal [(1,"1"); (2,"2")]
+
+let r = { field = 0}
+let r = { r with field = 42}

src/passes/1-parser/pascaligo/Tests/pp.ligo

@@ -24,6 +24,8 @@ function back (var store : store) : list (operation) * store is
     x := map [1 -> "1"; 2 -> "2"];
     y := a.b.c[3];
     a := "hello " ^ "world" ^ "!";
+    r := record a = 0 end;
+    r := r with record a = 42 end;
     patch store.backers with set [(1); f(2*3)];
     remove (1,2,3) from set foo.bar;
     remove 3 from map foo.bar;

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

@@ -530,14 +530,26 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
     let wrapped = Wrap.record (I.LMap.map get_type_annotation m') in
     return_wrapped (E_record m') state' wrapped
   | E_update {record; updates} ->
-    let%bind (record, state') = type_expression e state record in
+    let%bind (record, state) = type_expression e state record in
-    let aux (acc, state) (k, expr) =
+    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')::acc, state')
+      ok ((k,expr')::lst, state)
     in 
-    let%bind(updates,state') = bind_fold_list aux ([], state') updates in
+    let%bind (updates, state) = bind_fold_list aux ([], state) updates in
-    let wrapped = Wrap.list (List.map (fun (_,e) -> get_type_annotation e) updates) in
+    let wrapped = get_type_annotation record in
-    return_wrapped (E_record_update (record, updates)) state' wrapped
+    let%bind wrapped = match wrapped.type_value' with 
+    | T_record record ->
+        let aux (k, e) =
+          let field_op = I.LMap.find_opt k record in
+          match field_op with
+          | 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
+        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)
   (* Data-structure *)
 
 (*

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

@@ -504,13 +504,16 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
     in 
     let%bind updates = bind_fold_list aux ([]) updates in
     let wrapped = get_type_annotation record in
-    let wrapped = match wrapped.type_value' with 
+    let%bind () = match wrapped.type_value' with 
     | T_record record ->
-        let aux acc (k, e) =
+        let aux (k, e) =
-          I.LMap.add k (get_type_annotation e) acc
+          let field_op = I.LMap.find_opt k record in
+          match field_op with
+          | 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
-        t_record (List.fold_left aux record updates) ()
+        bind_iter_list aux updates
-    | _ -> failwith "Update something which is not a record"
+    | _ -> failwith "Update an expression which is not a record"
     in
     return (E_record_update (record, updates)) wrapped
   (* Data-structure *)

src/stages/ast_simplified/misc.ml

@@ -99,7 +99,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
           PP.expression a
           PP.expression b
       in
-      fail @@ (fun () -> error (thunk "comparing constant with other stuff") error_content ())
+      fail @@ (fun () -> error (thunk "comparing constant with other expression") error_content ())
 
   | E_constructor (ca, a), E_constructor (cb, b) when ca = cb -> (
       let%bind _eq = assert_value_eq (a, b) in
@@ -108,7 +108,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
   | E_constructor _, E_constructor _ ->
       simple_fail "different constructors"
   | E_constructor _, _ ->
-      simple_fail "comparing constructor with other stuff"
+      simple_fail "comparing constructor with other expression"
 
   | E_tuple lsta, E_tuple lstb -> (
       let%bind lst =
@@ -118,7 +118,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
       ok ()
     )
   | E_tuple _, _ ->
-      simple_fail "comparing tuple with other stuff"
+      simple_fail "comparing tuple with other expression"
 
   | E_record sma, E_record smb -> (
       let aux _ a b =
@@ -130,7 +130,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
       ok ()
     )
   | E_record _, _ ->
-      simple_fail "comparing record with other stuff"
+      simple_fail "comparing record with other expression"
   
   | E_update ura, E_update urb ->
     let%bind lst =
@@ -143,7 +143,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
     let%bind _all = bind_list @@ List.map aux lst in
     ok ()
   | E_update _, _ ->
-     simple_fail "comparing record update with orther stuff"
+     simple_fail "comparing record update with other expression"
 
   | (E_map lsta, E_map lstb | E_big_map lsta, E_big_map lstb) -> (
       let%bind lst = generic_try (simple_error "maps of different lengths")
@@ -159,7 +159,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
       ok ()
     )
   | (E_map _ | E_big_map _), _ ->
-      simple_fail "comparing map with other stuff"
+      simple_fail "comparing map with other expression"
 
   | E_list lsta, E_list lstb -> (
       let%bind lst =
@@ -169,7 +169,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
       ok ()
     )
   | E_list _, _ ->
-      simple_fail "comparing list with other stuff"
+      simple_fail "comparing list with other expression"
 
   | E_set lsta, E_set lstb -> (
       let lsta' = List.sort (compare) lsta in
@@ -181,7 +181,7 @@ let rec assert_value_eq (a, b: (expression * expression )) : unit result =
       ok ()
     )
   | E_set _, _ ->
-      simple_fail "comparing set with other stuff"
+      simple_fail "comparing set with other expression"
 
   | (E_ascription (a , _) ,  _b') -> assert_value_eq (a , b)
   | (_a' , E_ascription (b , _)) -> assert_value_eq (a , b)

src/test/contracts/record.ligo

@@ -38,7 +38,7 @@ function modify (const r : foobar) : foobar is
 
 function modify_abc (const r : abc) : abc is
   block {
-    r := r with record b = 2048; end;
+    r := r with record b = 2048; c = 42; end;
   } with r
 
 type big_record is record
@@ -56,3 +56,12 @@ const br : big_record = record
   d = 23 ;
   e = 23 ;
 end
+
+type double_record is record
+  inner : abc;
+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;
+  } with r

src/test/contracts/record.mligo

@@ -28,7 +28,7 @@ let projection (r : foobar) : int = r.foo + r.bar
 
 let modify (r : foobar) : foobar = {foo = 256; bar = r.bar}
 
-let modify_abc (r : abc) : abc = {r with {b = 2048}}
+let modify_abc (r : abc) : abc = {r with b = 2048; c = 42}
 
 type big_record = {
      a : int ;
@@ -45,3 +45,9 @@ let br : big_record = {
   d = 23 ;
   e = 23 ;
 }
+
+type double_record = {
+  inner : abc;
+}
+
+let modify_inner (r : double_record) : double_record = {r with inner = {r.inner with b = 2048 }}

src/test/integration_tests.ml

@@ -682,7 +682,7 @@ let record () : unit result  =
     let make_expected = fun n -> ez_e_record [
         ("a" , e_int n) ;
         ("b" , e_int 2048) ;
-        ("c" , e_int n)
+        ("c" , e_int 42)
       ] in
     expect_eq_n program "modify_abc" make_input make_expected
   in
@@ -690,6 +690,15 @@ let record () : unit result  =
     let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
     expect_eq_evaluate program "br" expected
   in
+  let%bind () =
+    let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
+    let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
+        ("a" , e_int n) ;
+        ("b" , e_int 2048) ;
+        ("c" , e_int n)
+    ])] in
+    expect_eq_n program "modify_inner" make_input make_expected
+  in
   ok ()
 
 let record_mligo () : unit result  =
@@ -719,7 +728,7 @@ let record_mligo () : unit result  =
     let make_expected = fun n -> ez_e_record [
         ("a" , e_int n) ;
         ("b" , e_int 2048) ;
-        ("c" , e_int n)
+        ("c" , e_int 42)
       ] in
     expect_eq_n program "modify_abc" make_input make_expected
   in
@@ -727,6 +736,15 @@ let record_mligo () : unit result  =
     let expected = record_ez_int ["a";"b";"c";"d";"e"] 23 in
     expect_eq_evaluate program "br" expected
   in
+  let%bind () =
+    let make_input = fun n -> ez_e_record [("inner", record_ez_int ["a";"b";"c"] n)] in
+    let make_expected = fun n -> ez_e_record [("inner", ez_e_record[
+        ("a" , e_int n) ;
+        ("b" , e_int 2048) ;
+        ("c" , e_int n)
+    ])] in
+    expect_eq_n program "modify_inner" make_input make_expected
+  in
   ok ()
 
 let tuple () : unit result  =