I forbade empty patches (parser). Fixed AST pretty-printer (PascaLIGO).

Changed accordingly the simplifier: the dead code for the error about
empty record patches is no long.

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

@@ -187,7 +187,7 @@ and type_decl = {
 and type_expr =
   TProd   of cartesian
 | TSum    of (variant reg, vbar) nsepseq reg
-| TRecord of field_decl reg injection reg
+| TRecord of field_decl reg ne_injection reg
 | TApp    of (type_name * type_tuple) reg
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
@@ -217,7 +217,7 @@ and fun_decl = {
     colon        : colon;
     ret_type     : type_expr;
     kwd_is       : kwd_is;
-    local_decls  : local_decl list option;
+    local_decls  : local_decl list;
     block        : block reg option;
     kwd_with     : kwd_with option;
     return       : expr;
@@ -315,14 +315,14 @@ and set_patch  = {
   kwd_patch : kwd_patch;
   path      : path;
   kwd_with  : kwd_with;
-  set_inj   : expr injection reg
+  set_inj   : expr ne_injection reg
 }
 
 and map_patch  = {
   kwd_patch : kwd_patch;
   path      : path;
   kwd_with  : kwd_with;
-  map_inj   : binding reg injection reg
+  map_inj   : binding reg ne_injection reg
 }
 
 and binding = {
@@ -335,7 +335,7 @@ and record_patch = {
   kwd_patch  : kwd_patch;
   path       : path;
   kwd_with   : kwd_with;
-  record_inj : record_expr
+  record_inj : field_assign reg ne_injection reg
 }
 
 and cond_expr = {
@@ -479,6 +479,13 @@ and 'a injection = {
   closing    : closing
 }
 
+and 'a ne_injection = {
+  opening     : opening;
+  ne_elements : ('a, semi) nsepseq;
+  terminator  : semi option;
+  closing     : closing
+}
+
 and opening =
   Kwd        of keyword
 | KwdBracket of keyword * lbracket

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

@@ -178,7 +178,7 @@ and type_decl = {
 and type_expr =
   TProd   of cartesian
 | TSum    of (variant reg, vbar) nsepseq reg
-| TRecord of field_decl reg injection reg
+| TRecord of field_decl reg ne_injection reg
 | TApp    of (type_name * type_tuple) reg
 | TFun    of (type_expr * arrow * type_expr) reg
 | TPar    of type_expr par reg
@@ -208,7 +208,7 @@ and fun_decl ={
     colon        : colon;
     ret_type     : type_expr;
     kwd_is       : kwd_is;
-    local_decls  : local_decl list option;
+    local_decls  : local_decl list;
     block        : block reg option;
     kwd_with     : kwd_with option;
     return       : expr;
@@ -306,14 +306,14 @@ and set_patch  = {
   kwd_patch : kwd_patch;
   path      : path;
   kwd_with  : kwd_with;
-  set_inj   : expr injection reg
+  set_inj   : expr ne_injection reg
 }
 
 and map_patch  = {
   kwd_patch : kwd_patch;
   path      : path;
   kwd_with  : kwd_with;
-  map_inj   : binding reg injection reg
+  map_inj   : binding reg ne_injection reg
 }
 
 and binding = {
@@ -326,7 +326,7 @@ and record_patch = {
   kwd_patch  : kwd_patch;
   path       : path;
   kwd_with   : kwd_with;
-  record_inj : field_assign reg injection reg
+  record_inj : field_assign reg ne_injection reg
 }
 
 and cond_expr = {
@@ -470,6 +470,13 @@ and 'a injection = {
   closing    : closing
 }
 
+and 'a ne_injection = {
+  opening     : opening;
+  ne_elements : ('a, semi) nsepseq;
+  terminator  : semi option;
+  closing     : closing
+}
+
 and opening =
   Kwd        of keyword
 | KwdBracket of keyword * lbracket

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

@@ -213,21 +213,21 @@ variant:
 
 record_type:
   Record sep_or_term_list(field_decl,SEMI) End {
-    let elements, terminator = $2 in
+    let ne_elements, terminator = $2 in
     let region = cover $1 $3
     and value = {
      opening = Kwd $1;
-     elements = Some elements;
+     ne_elements;
      terminator;
      closing = End $3}
    in {region; value}
   }
 | Record LBRACKET sep_or_term_list(field_decl,SEMI) RBRACKET {
-   let elements, terminator = $3 in
+   let ne_elements, terminator = $3 in
    let region = cover $1 $4
    and value = {
      opening = KwdBracket ($1,$2);
-     elements = Some elements;
+     ne_elements;
      terminator;
      closing = RBracket $4}
    in {region; value} }
@@ -258,7 +258,7 @@ fun_decl:
       colon        = $4;
       ret_type     = $5;
       kwd_is       = $6;
-      local_decls  = Some $7;
+      local_decls  = $7;
       block        = Some $8;
       kwd_with     = Some $9;
       return       = $10;
@@ -278,7 +278,7 @@ fun_decl:
             colon        = $4;
             ret_type     = $5;
             kwd_is       = $6;
-            local_decls  = None;
+            local_decls  = [];
             block        = None;
             kwd_with     = None;
             return       = $7;
@@ -433,7 +433,7 @@ map_remove:
     in {region; value}}
 
 set_patch:
-  Patch path With injection(Set,expr) {
+  Patch path With ne_injection(Set,expr) {
     let region = cover $1 $4.region in
     let value  = {
       kwd_patch = $1;
@@ -443,7 +443,7 @@ set_patch:
     in {region; value}}
 
 map_patch:
-  Patch path With injection(Map,binding) {
+  Patch path With ne_injection(Map,binding) {
     let region = cover $1 $4.region in
     let value  = {
       kwd_patch = $1;
@@ -491,6 +491,28 @@ injection(Kind,element):
       closing    = RBracket $3}
     in {region; value}}
 
+ne_injection(Kind,element):
+  Kind sep_or_term_list(element,SEMI) End {
+    let ne_elements, terminator = $2 in
+    let region = cover $1 $3
+    and value = {
+      opening  = Kwd $1;
+      ne_elements;
+      terminator;
+      closing = End $3}
+    in {region; value}
+  }
+| Kind LBRACKET sep_or_term_list(element,SEMI) RBRACKET {
+    let ne_elements, terminator = $3 in
+    let region = cover $1 $4
+    and value = {
+      opening  = KwdBracket ($1,$2);
+      ne_elements;
+      terminator;
+      closing = RBracket $4}
+    in {region; value}
+  }
+
 binding:
   expr ARROW expr {
     let start  = expr_to_region $1
@@ -503,7 +525,7 @@ binding:
     in {region; value}}
 
 record_patch:
-  Patch path With record_expr {
+  Patch path With ne_injection(Record,field_assignment) {
     let region = cover $1 $4.region in
     let value  = {
       kwd_patch  = $1;
@@ -906,7 +928,7 @@ record_expr:
   Record sep_or_term_list(field_assignment,SEMI) End {
     let elements, terminator = $2 in
     let region = cover $1 $3
-    and value = {
+    and value : field_assign AST.reg injection = {
       opening = Kwd $1;
       elements = Some elements;
       terminator;
@@ -916,7 +938,7 @@ record_expr:
 | Record LBRACKET sep_or_term_list(field_assignment,SEMI) RBRACKET {
    let elements, terminator = $3 in
    let region = cover $1 $4
-   and value  = {
+   and value : field_assign AST.reg injection = {
      opening = KwdBracket ($1,$2);
      elements = Some elements;
      terminator;

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

@@ -125,7 +125,7 @@ and print_sum_type buffer {value; _} =
   print_nsepseq buffer "|" print_variant value
 
 and print_record_type buffer record_type =
-  print_injection buffer "record" print_field_decl record_type
+  print_ne_injection buffer "record" print_field_decl record_type
 
 and print_type_app buffer {value; _} =
   let type_name, type_tuple = value in
@@ -222,10 +222,7 @@ and print_block_closing buffer = function
 | End kwd_end  -> print_token buffer kwd_end "end"
 
 and print_local_decls buffer sequence =
-  match sequence with
-  | Some sequence -> 
   List.iter (print_local_decl buffer) sequence
-  | None -> ()
 
 and print_local_decl buffer = function
   LocalFun  decl -> print_fun_decl  buffer decl
@@ -579,21 +576,21 @@ and print_record_patch buffer node =
   print_token        buffer kwd_patch "patch";
   print_path         buffer path;
   print_token        buffer kwd_with "with";
-  print_record_expr buffer record_inj
+  print_ne_injection buffer "record" print_field_assign record_inj
 
 and print_set_patch buffer node =
   let {kwd_patch; path; kwd_with; set_inj} = node in
   print_token        buffer kwd_patch "patch";
   print_path         buffer path;
   print_token        buffer kwd_with "with";
-  print_injection buffer "set" print_expr set_inj
+  print_ne_injection buffer "set" print_expr set_inj
 
 and print_map_patch buffer node =
   let {kwd_patch; path; kwd_with; map_inj} = node in
   print_token        buffer kwd_patch "patch";
   print_path         buffer path;
   print_token        buffer kwd_with "with";
-  print_injection  buffer "map" print_binding map_inj
+  print_ne_injection buffer "map" print_binding map_inj
 
 and print_map_remove buffer node =
   let {kwd_remove; key; kwd_from; kwd_map; map} = node in
@@ -621,6 +618,16 @@ and print_injection :
     print_terminator buffer terminator;
     print_closing    buffer closing
 
+and print_ne_injection :
+  'a.Buffer.t -> string -> (Buffer.t -> 'a -> unit) ->
+  'a ne_injection reg -> unit =
+  fun buffer kwd print {value; _} ->
+    let {opening; ne_elements; terminator; closing} = value in
+    print_opening    buffer kwd opening;
+    print_nsepseq    buffer ";" print ne_elements;
+    print_terminator buffer terminator;
+    print_closing    buffer closing
+
 and print_opening buffer lexeme = function
   Kwd kwd ->
     print_token buffer kwd lexeme
@@ -774,10 +781,10 @@ and pp_declaration buffer ~pad:(_,pc as pad) = function
     pp_type_expr buffer ~pad:(mk_pad 2 1 pc) value.type_expr
 | ConstDecl {value; _} ->
     pp_node buffer ~pad "ConstDecl";
-    pp_const_decl buffer ~pad:(mk_pad 1 0 pc) value
+    pp_const_decl buffer ~pad value
 | FunDecl {value; _} ->
     pp_node buffer ~pad "FunDecl";
-    pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
+    pp_fun_decl buffer ~pad value
 
 and pp_const_decl buffer ~pad:(_,pc) decl =
   pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value;
@@ -817,7 +824,7 @@ and pp_type_expr buffer ~pad:(_,pc as pad) = function
     let apply len rank field_decl =
       pp_field_decl buffer ~pad:(mk_pad len rank pc)
                     field_decl.value in
-    let fields = Utils.sepseq_to_list value.elements in
+    let fields = Utils.nsepseq_to_list value.ne_elements in
     List.iteri (List.length fields |> apply) fields
 
 and pp_cartesian buffer ~pad:(_,pc) {value; _} =
@@ -844,23 +851,26 @@ and pp_type_tuple buffer ~pad:(_,pc) {value; _} =
   in List.iteri (List.length components |> apply) components
 
 and pp_fun_decl buffer ~pad:(_,pc) decl =
+  let fields =
+    if decl.local_decls = [] then 5 else 6 in
   let () =
-    let pad = mk_pad 6 0 pc in
+    let pad = mk_pad fields 0 pc in
     pp_ident buffer ~pad decl.name.value in
   let () =
-    let pad = mk_pad 6 1 pc in
+    let pad = mk_pad fields 1 pc in
     pp_node buffer ~pad "<parameters>";
     pp_parameters buffer ~pad decl.param in
   let () =
-    let _, pc as pad = mk_pad 6 2 pc in
+    let _, pc as pad = mk_pad fields 2 pc in
     pp_node buffer ~pad "<return type>";
     pp_type_expr buffer ~pad:(mk_pad 1 0 pc) decl.ret_type in
   let () =
-    let pad = mk_pad 6 3 pc in
+    if fields = 6 then
+      let pad = mk_pad fields 3 pc in
       pp_node buffer ~pad "<local declarations>";
       pp_local_decls buffer ~pad decl.local_decls in
   let () =
-    let pad = mk_pad 6 4 pc in
+    let pad = mk_pad fields (fields - 2) pc in
     pp_node buffer ~pad "<block>";
     let statements =
       match decl.block with
@@ -868,7 +878,7 @@ and pp_fun_decl buffer ~pad:(_,pc) decl =
         | None ->  Instr (Skip Region.ghost), [] in
     pp_statements buffer ~pad statements in
   let () =
-    let _, pc as pad = mk_pad 6 5 pc in
+    let _, pc as pad = mk_pad fields (fields - 1) pc in
     pp_node buffer ~pad "<return>";
     pp_expr buffer ~pad:(mk_pad 1 0 pc) decl.return
   in ()
@@ -1090,6 +1100,15 @@ and pp_injection :
   let apply len rank = printer buffer ~pad:(mk_pad len rank pc)
   in List.iteri (apply length) elements
 
+and pp_ne_injection :
+  'a.(Buffer.t -> pad:(string*string) -> 'a -> unit)
+  -> Buffer.t -> pad:(string*string) -> 'a ne_injection -> unit =
+  fun printer buffer ~pad:(_,pc) inj ->
+  let ne_elements = Utils.nsepseq_to_list inj.ne_elements in
+  let length      = List.length ne_elements in
+  let apply len rank = printer buffer ~pad:(mk_pad len rank pc)
+  in List.iteri (apply length) ne_elements
+
 and pp_tuple_pattern buffer ~pad:(_,pc) tuple =
   let patterns = Utils.nsepseq_to_list tuple.inside in
   let length   = List.length patterns in
@@ -1228,7 +1247,7 @@ and pp_fun_call buffer ~pad:(_,pc) (name, args) =
 
 and pp_record_patch buffer ~pad:(_,pc as pad) patch =
   pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
-  pp_injection pp_field_assign buffer
+  pp_ne_injection pp_field_assign buffer
     ~pad patch.record_inj.value
 
 and pp_field_assign buffer ~pad:(_,pc as pad) {value; _} =
@@ -1238,7 +1257,7 @@ and pp_field_assign buffer ~pad:(_,pc as pad) {value; _} =
 
 and pp_map_patch buffer ~pad:(_,pc as pad) patch =
   pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
-  pp_injection pp_binding buffer
+  pp_ne_injection pp_binding buffer
     ~pad patch.map_inj.value
 
 and pp_binding buffer ~pad:(_,pc as pad) {value; _} =
@@ -1249,7 +1268,7 @@ and pp_binding buffer ~pad:(_,pc as pad) {value; _} =
 
 and pp_set_patch buffer ~pad:(_,pc as pad) patch =
   pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path;
-  pp_injection pp_expr buffer ~pad patch.set_inj.value
+  pp_ne_injection pp_expr buffer ~pad patch.set_inj.value
 
 and pp_map_remove buffer ~pad:(_,pc) rem =
   pp_expr buffer ~pad:(mk_pad 2 0 pc) rem.key;
@@ -1260,17 +1279,14 @@ and pp_set_remove buffer ~pad:(_,pc) rem =
   pp_path buffer ~pad:(mk_pad 2 1 pc) rem.set
 
 and pp_local_decls buffer ~pad:(_,pc) decls =
-  match decls with
-  | Some decls ->
   let apply len rank =
     pp_local_decl buffer ~pad:(mk_pad len rank pc)
   in List.iteri (List.length decls |> apply) decls
-  | None -> ()
 
 and pp_local_decl buffer ~pad:(_,pc as pad) = function
   LocalFun {value; _} ->
     pp_node buffer ~pad "LocalFun";
-    pp_fun_decl buffer ~pad:(mk_pad 1 0 pc) value
+    pp_fun_decl buffer ~pad value
 | LocalData data ->
     pp_node buffer ~pad "LocalData";
     pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data
@@ -1469,10 +1485,9 @@ and pp_annotated buffer ~pad:(_,pc) (expr, t_expr) =
   pp_expr buffer ~pad:(mk_pad 2 0 pc) expr;
   pp_type_expr buffer ~pad:(mk_pad 2 1 pc) t_expr
 
-and pp_bin_op node buffer ~pad:(_,pc) op =
+and pp_bin_op node buffer ~pad:(_,pc as pad) op =
-  pp_node buffer ~pad:(mk_pad 1 0 pc) node;
+  pp_node buffer ~pad node;
-  let _, pc = mk_pad 1 0 pc in
+  pp_expr buffer ~pad:(mk_pad 2 0 pc) op.arg1;
-  (pp_expr buffer ~pad:(mk_pad 2 0 pc) op.arg1;
+  pp_expr buffer ~pad:(mk_pad 2 1 pc) op.arg2
-   pp_expr buffer ~pad:(mk_pad 2 1 pc) op.arg2)
 
 let pp_ast buffer = pp_ast buffer ~pad:("","")

src/passes/2-simplify/pascaligo.ml

@@ -78,16 +78,6 @@ module Errors = struct
     ] in
     error ~data title message
 
-  let unsupported_empty_record_patch record_expr =
-    let title () = "empty record patch" in
-    let message () =
-      Format.asprintf "empty record patches are not supported yet" in
-    let data = [
-      ("record_loc",
-       fun () -> Format.asprintf "%a" Location.pp_lift @@ record_expr.Region.region)
-    ] in
-    error ~data title message
-
   let unsupported_non_var_pattern p =
     let title () = "pattern is not a variable" in
     let message () =
@@ -225,7 +215,7 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result =
       let%bind lst = bind_list
         @@ List.map aux
         @@ List.map apply
-        @@ pseq_to_list r.value.elements in
+        @@ npseq_to_list r.value.ne_elements in
       let m = List.fold_left (fun m (x, y) -> SMap.add x y m) SMap.empty lst in
       ok @@ T_record m
   | TSum s ->
@@ -551,11 +541,6 @@ and simpl_fun_declaration :
   fun ~loc x ->
   let open! Raw in
   let {name;param;ret_type;local_decls;block;return} : fun_decl = x in
-  let local_decls =
-    match local_decls with
-    | Some local_decls -> local_decls
-    | None -> []
-  in
   let statements =
     match block with
     | Some block -> npseq_to_list block.value.statements
@@ -736,23 +721,29 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
   | RecordPatch r -> (
       let r = r.value in
       let (name , access_path) = simpl_path r.path in
-      let%bind inj = bind_list
+
+      let head, tail = r.record_inj.value.ne_elements in
+
+      let%bind tail' = bind_list
         @@ List.map (fun (x: Raw.field_assign Region.reg) ->
             let (x , loc) = r_split x in
             let%bind e = simpl_expression x.field_expr
             in ok (x.field_name.value, e , loc)
           )
-        @@ pseq_to_list r.record_inj.value.elements in
+        @@ List.map snd tail in
+
+      let%bind head' =
+        let (x , loc) = r_split head in
+        let%bind e = simpl_expression x.field_expr
+        in ok (x.field_name.value, e , loc) in
+
       let%bind expr =
         let aux = fun (access , v , loc) ->
           e_assign ~loc name (access_path @ [Access_record access]) v in
-        let assigns = List.map aux inj in
+
-        match assigns with
+        let hd, tl = aux head', List.map aux tail' in
-        | [] -> fail @@ unsupported_empty_record_patch r.record_inj
-        | hd :: tl -> (
         let aux acc cur = e_sequence acc cur in
         ok @@ List.fold_left aux hd tl
-          )
       in
       return_statement @@ expr
   )
@@ -767,7 +758,7 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
             let%bind value' = simpl_expression value
             in ok @@ (key', value')
           )
-        @@ pseq_to_list map_p.map_inj.value.elements in
+        @@ npseq_to_list map_p.map_inj.value.ne_elements in
       let expr =
         match inj with
         | [] -> e_skip ~loc ()
@@ -785,7 +776,7 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul
       let%bind inj =
         bind_list @@
         List.map simpl_expression @@
-        pseq_to_list setp.set_inj.value.elements in
+        npseq_to_list setp.set_inj.value.ne_elements in
       let expr =
         match inj with
         | [] -> e_skip ~loc ()

src/test/contracts/map.ligo

@@ -29,10 +29,6 @@ function patch_ (var m: foobar) : foobar is block {
   patch m with map [0 -> 5; 1 -> 6; 2 -> 7]
 } with m
 
-function patch_empty (var m : foobar) : foobar is block {
-  patch m with map []
-} with m
-
 function patch_deep (var m: foobar * nat) : foobar * nat is
   begin patch m.0 with map [1 -> 9]; end with m
 

src/test/contracts/set_arithmetic.ligo

@@ -26,11 +26,5 @@ function patch_op (var s: set(string)) : set(string) is
 function patch_op_deep (var s: set(string)*nat) : set(string)*nat is
   begin patch s.0 with set ["foobar"]; end with s
 
-function patch_op_empty (var s: set(string)) : set(string) is
-  begin patch s with set []; end with s
-
 function mem_op (const s : set(string)) : bool is
   begin skip end with set_mem("foobar" , s)
-
-
-

src/test/integration_tests.ml

@@ -276,10 +276,6 @@ let set_arithmetic () : unit result =
       (e_pair
          (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
          (e_nat 42)) in
-  let%bind () =
-    expect_eq program "patch_op_empty"
-      (e_set [e_string "foo" ; e_string "bar"])
-      (e_set [e_string "foo" ; e_string "bar"]) in
   let%bind () =
     expect_eq program "mem_op"
       (e_set [e_string "foo" ; e_string "bar" ; e_string "foobar"])
@@ -451,11 +447,6 @@ let map_ type_f path : unit result =
     let expected = ez [(0, 5) ; (1, 6) ; (2, 7)] in
     expect_eq program "patch_" input expected
   in
-  let%bind () =
-    let input = ez [(0,0) ; (1,1) ; (2,2)] in
-    let expected = ez [(0,0) ; (1,1) ; (2,2)] in
-    expect_eq program "patch_empty" input expected
-  in
   let%bind () =
     let input = (e_pair
                    (ez [(0,0) ; (1,1) ; (2,2)])