Moved stuff to module [SyntaxError] from [AST] and [Parser].

Added support for the rejection of non-linear patterns in PascaLIGO.

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

@@ -761,48 +761,3 @@ let rhs_to_region = expr_to_region
 let selection_to_region = function
   FieldName {region; _}
   | Component {region; _} -> region
-
-(* Extracting variables from patterns *)
-
-module Ord =
-  struct
-    type t = string Region.reg
-    let compare v1 v2 =
-      compare v1.value v2.value
-  end
-
-module VSet = Set.Make (Ord)
-
-let rec vars_of_pattern env = function
-  PConstr p -> vars_of_pconstr env p
-| PVar v -> VSet.add v env
-| PWild _ | PInt _ | PNat _ | PBytes _ | PString _ -> env
-| PList l -> vars_of_plist env l
-| PTuple t -> vars_of_ptuple env t.value
-
-and vars_of_pconstr env = function
-  PUnit _ | PFalse _ | PTrue _ | PNone _ -> env
-| PSomeApp {value=_, {value={inside; _};_}; _} ->
-    vars_of_pattern env inside
-| PConstrApp {value=_, Some tuple; _} ->
-    vars_of_ptuple env tuple.value
-| PConstrApp {value=_,None; _} -> env
-
-and vars_of_plist env = function
-  PListComp {value; _} ->
-    vars_of_pinj env value
-| PNil _ ->
-    env
-| PParCons {value={inside; _}; _} ->
-   let head, _, tail = inside in
-   vars_of_pattern (vars_of_pattern env head) tail
-| PCons {value; _} ->
-    Utils.nsepseq_foldl vars_of_pattern env value
-
-and vars_of_pinj env inj =
-  Utils.sepseq_foldl vars_of_pattern env inj.elements
-
-and vars_of_ptuple env {inside; _} =
-    Utils.nsepseq_foldl vars_of_pattern env inside
-
-let vars_of_pattern = vars_of_pattern VSet.empty

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

@@ -615,9 +615,3 @@ val lhs_to_region        : lhs -> Region.t
 val rhs_to_region        : rhs -> Region.t
 val if_clause_to_region  : if_clause -> Region.t
 val selection_to_region  : selection -> Region.t
-
-(* Extracting variables from patterns *)
-
-module VSet : Set.S with type elt = string Region.reg
-
-val vars_of_pattern : pattern -> VSet.t

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

@@ -6,60 +6,7 @@
 open Region
 open AST
 
-module SSet = Utils.String.Set
+(* END HEADER *)
-
-let reserved =
-  let open SSet in
-  empty
-  |> add "get_force"
-  |> add "get_chain_id"
-  |> add "transaction"
-  |> add "get_contract"
-  |> add "get_entrypoint"
-  |> add "size"
-  |> add "int"
-  |> add "abs"
-  |> add "is_nat"
-  |> add "amount"
-  |> add "balance"
-  |> add "now"
-  |> add "unit"
-  |> add "source"
-  |> add "sender"
-  |> add "failwith"
-  |> add "bitwise_or"
-  |> add "bitwise_and"
-  |> add "bitwise_xor"
-  |> add "string_concat"
-  |> add "string_slice"
-  |> add "crypto_check"
-  |> add "crypto_hash_key"
-  |> add "bytes_concat"
-  |> add "bytes_slice"
-  |> add "bytes_pack"
-  |> add "bytes_unpack"
-  |> add "set_empty"
-  |> add "set_mem"
-  |> add "set_add"
-  |> add "set_remove"
-  |> add "set_iter"
-  |> add "set_fold"
-  |> add "list_iter"
-  |> add "list_fold"
-  |> add "list_map"
-  |> add "map_iter"
-  |> add "map_map"
-  |> add "map_fold"
-  |> add "map_remove"
-  |> add "map_update"
-  |> add "map_get"
-  |> add "map_mem"
-  |> add "sha_256"
-  |> add "sha_512"
-  |> add "blake2b"
-  |> add "cons"
-
- (* END HEADER *)
 %}
 
 (* See [ParToken.mly] for the definition of tokens. *)
@@ -171,10 +118,7 @@ declaration:
 
 type_decl:
   "type" type_name "is" type_expr ";"? {
-    let () =
+    ignore (SyntaxError.check_reserved_name $2);
-      if SSet.mem $2.value reserved then
-        let open! SyntaxError in
-        raise (Error (Reserved_name $2)) in
     let stop =
       match $5 with
         Some region -> region
@@ -242,14 +186,7 @@ type_tuple:
 
 sum_type:
   "|"? nsepseq(variant,"|") {
-    let add acc {value; _} =
+    SyntaxError.check_variants (Utils.nsepseq_to_list $2);
-      if VSet.mem value.constr acc then
-        let open! SyntaxError in
-        raise (Error (Duplicate_variant value.constr))
-      else VSet.add value.constr acc in
-    let variants =
-      Utils.nsepseq_foldl add VSet.empty $2 in
-    let () = ignore variants in
     let region = nsepseq_to_region (fun x -> x.region) $2
     in TSum {region; value=$2} }
 
@@ -290,13 +227,7 @@ fun_expr:
   "function" fun_name? parameters ":" type_expr "is"
      block
   "with" expr {
-    let () =
+    let ()     = SyntaxError.check_reserved_name_opt $2 in
-      match $2 with
-        Some name ->
-          if SSet.mem name.value reserved then
-            let open! SyntaxError in
-            raise (Error (Reserved_name name))
-      | None -> () in
     let stop   = expr_to_region $9 in
     let region = cover $1 stop
     and value  = {kwd_function = $1;
@@ -309,13 +240,7 @@ fun_expr:
                   return       = $9}
     in {region; value} }
 | "function" fun_name? parameters ":" type_expr "is" expr {
-    let () =
+    let ()     = SyntaxError.check_reserved_name_opt $2 in
-      match $2 with
-        Some name ->
-          if SSet.mem name.value reserved then
-            let open! SyntaxError in
-            raise (Error (Reserved_name name))
-      | None -> () in
     let stop   = expr_to_region $7 in
     let region = cover $1 stop
     and value  = {kwd_function = $1;
@@ -346,47 +271,28 @@ open_fun_decl:
 
 parameters:
   par(nsepseq(param_decl,";")) {
-    let open! AST in
-    let contents : (param_decl, semi) Utils.nsepseq par reg = $1 in
-    let add acc = function
-      ParamConst {value; _} ->
-        if VSet.mem value.var acc then
-          let open! SyntaxError in
-          raise (Error (Duplicate_parameter value.var))
-        else VSet.add value.var acc
-    | ParamVar {value; _} ->
-        if VSet.mem value.var acc then
-          let open! SyntaxError in
-          raise (Error (Duplicate_parameter value.var))
-        else VSet.add value.var acc in
     let params =
-      Utils.nsepseq_foldl add VSet.empty contents.value.inside in
+      Utils.nsepseq_to_list ($1.value: _ par).inside
-    let () = ignore params
+    in SyntaxError.check_parameters params;
-    in $1 }
+       $1 }
 
 param_decl:
   "var" var ":" param_type {
-    let () =
+    let var    = SyntaxError.check_reserved_name $2 in
-      if SSet.mem $2.value reserved then
-        let open! SyntaxError in
-        raise (Error (Reserved_name $2)) in
     let stop   = type_expr_to_region $4 in
     let region = cover $1 stop
     and value  = {kwd_var    = $1;
-                  var        = $2;
+                  var;
                   colon      = $3;
                   param_type = $4}
     in ParamVar {region; value}
   }
 | "const" var ":" param_type {
-    let () =
+    let var    = SyntaxError.check_reserved_name $2 in
-      if SSet.mem $2.value reserved then
-        let open! SyntaxError in
-        raise (Error (Reserved_name $2)) in
     let stop   = type_expr_to_region $4 in
     let region = cover $1 stop
     and value  = {kwd_const  = $1;
-                  var        = $2;
+                  var;
                   colon      = $3;
                   param_type = $4}
     in ParamConst {region; value} }
@@ -450,12 +356,9 @@ open_var_decl:
 
 unqualified_decl(OP):
   var ":" type_expr OP expr {
-    let () =
+    let var    = SyntaxError.check_reserved_name $1 in
-      if SSet.mem $1.value reserved then
-        let open! SyntaxError in
-        raise (Error (Reserved_name $1)) in
     let region = expr_to_region $5
-    in $1, $2, $3, $4, $5, region }
+    in var, $2, $3, $4, $5, region }
 
 const_decl:
   open_const_decl ";"? {
@@ -662,14 +565,7 @@ cases(rhs):
 
 case_clause(rhs):
   pattern "->" rhs {
-    let vars = AST.vars_of_pattern $1 in
+    SyntaxError.check_pattern $1;
-    let is_reserved elt = SSet.mem elt.value reserved in
-    let inter = VSet.filter is_reserved vars in
-    let () =
-      if not (VSet.is_empty inter) then
-        let clash = VSet.choose inter in
-        let open! SyntaxError in
-        raise (Error (Reserved_name clash)) in
     fun rhs_to_region ->
       let start  = pattern_to_region $1 in
       let region = cover start (rhs_to_region $3)
@@ -711,13 +607,10 @@ for_loop:
     in For (ForInt {region; value})
   }
 | "for" var arrow_clause? "in" collection expr block {
-    let () =
+    let var    = SyntaxError.check_reserved_name $2 in
-      if SSet.mem $2.value reserved then
-        let open! SyntaxError in
-        raise (Error (Reserved_name $2)) in
     let region = cover $1 $7.region in
     let value  = {kwd_for    = $1;
-                  var        = $2;
+                  var;
                   bind_to    = $3;
                   kwd_in     = $4;
                   collection = $5;
@@ -732,21 +625,13 @@ collection:
 
 var_assign:
   var ":=" expr {
-    let () =
+    let name   = SyntaxError.check_reserved_name $1 in
-      if SSet.mem $1.value reserved then
+    let region = cover name.region (expr_to_region $3)
-        let open! SyntaxError in
+    and value  = {name; assign=$2; expr=$3}
-        raise (Error (Reserved_name $1)) in
-    let region = cover $1.region (expr_to_region $3)
-    and value  = {name=$1; assign=$2; expr=$3}
     in {region; value} }
 
 arrow_clause:
-  "->" var {
+  "->" var { $1, SyntaxError.check_reserved_name $2 }
-    let () =
-      if SSet.mem $2.value reserved then
-        let open! SyntaxError in
-        raise (Error (Reserved_name $2))
-    in $1,$2 }
 
 (* Expressions *)
 

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

@@ -71,3 +71,19 @@ let () =
         Unit.format_error ~offsets:IO.options#offsets
                           IO.options#mode point
       in Printf.eprintf "\027[31m%s\027[0m%!" error
+
+  | Error (Non_linear_pattern var) ->
+      let () = Unit.close_all () in
+      let token =
+        MyLexer.Token.mk_ident var.Region.value var.Region.region in
+      (match token with
+         Stdlib.Error _ ->
+           assert false (* Should not fail if [name] is valid. *)
+       | Ok invalid ->
+          let point = "Repeated variable in this pattern.\n\
+                       Hint: Change the name.\n",
+                      None, invalid in
+          let error =
+            Unit.format_error ~offsets:IO.options#offsets
+                              IO.options#mode point
+          in Printf.eprintf "\027[31m%s\027[0m%!" error)

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

@@ -1,8 +1,169 @@
+[@@@warning "-42"]
+
 type t =
-  Reserved_name of string Region.reg
+  Reserved_name       of AST.variable
-| Duplicate_parameter of string Region.reg
+| Duplicate_parameter of AST.variable
-| Duplicate_variant of string Region.reg
+| Duplicate_variant   of AST.variable
+| Non_linear_pattern  of AST.variable
 
 type error = t
 
 exception Error of t
+
+open Region
+
+(* Useful modules *)
+
+module SSet = Utils.String.Set
+
+module Ord =
+  struct
+    type t = AST.variable
+    let compare v1 v2 =
+      compare v1.value v2.value
+  end
+
+module VarSet = Set.Make (Ord)
+
+(* Checking the definition of reserved names (shadowing) *)
+
+let reserved =
+  let open SSet in
+  empty
+  |> add "get_force"
+  |> add "get_chain_id"
+  |> add "transaction"
+  |> add "get_contract"
+  |> add "get_entrypoint"
+  |> add "size"
+  |> add "int"
+  |> add "abs"
+  |> add "is_nat"
+  |> add "amount"
+  |> add "balance"
+  |> add "now"
+  |> add "unit"
+  |> add "source"
+  |> add "sender"
+  |> add "failwith"
+  |> add "bitwise_or"
+  |> add "bitwise_and"
+  |> add "bitwise_xor"
+  |> add "string_concat"
+  |> add "string_slice"
+  |> add "crypto_check"
+  |> add "crypto_hash_key"
+  |> add "bytes_concat"
+  |> add "bytes_slice"
+  |> add "bytes_pack"
+  |> add "bytes_unpack"
+  |> add "set_empty"
+  |> add "set_mem"
+  |> add "set_add"
+  |> add "set_remove"
+  |> add "set_iter"
+  |> add "set_fold"
+  |> add "list_iter"
+  |> add "list_fold"
+  |> add "list_map"
+  |> add "map_iter"
+  |> add "map_map"
+  |> add "map_fold"
+  |> add "map_remove"
+  |> add "map_update"
+  |> add "map_get"
+  |> add "map_mem"
+  |> add "sha_256"
+  |> add "sha_512"
+  |> add "blake2b"
+  |> add "cons"
+
+let check_reserved_names vars =
+  let is_reserved elt = SSet.mem elt.value reserved in
+  let inter = VarSet.filter is_reserved vars in
+  if not (VarSet.is_empty inter) then
+    let clash = VarSet.choose inter in
+    raise (Error (Reserved_name clash))
+  else vars
+
+let check_reserved_name var =
+  if SSet.mem var.value reserved then
+    raise (Error (Reserved_name var))
+  else var
+
+let check_reserved_name_opt = function
+  Some var -> ignore (check_reserved_name var)
+| None     -> ()
+
+(* Checking the linearity of patterns *)
+
+open! AST
+
+let rec vars_of_pattern env = function
+  PConstr p -> vars_of_pconstr env p
+| PWild _ | PInt _ | PNat _ | PBytes _ | PString _ -> env
+| PList l -> vars_of_plist env l
+| PTuple t -> vars_of_ptuple env t.value
+| PVar var ->
+    if VarSet.mem var env then
+      raise (Error (Non_linear_pattern var))
+    else VarSet.add var env
+
+and vars_of_pconstr env = function
+  PUnit _ | PFalse _ | PTrue _ | PNone _ -> env
+| PSomeApp {value=_, {value={inside; _};_}; _} ->
+    vars_of_pattern env inside
+| PConstrApp {value=_, Some tuple; _} ->
+    vars_of_ptuple env tuple.value
+| PConstrApp {value=_,None; _} -> env
+
+and vars_of_plist env = function
+  PListComp {value; _} ->
+    vars_of_pinj env value
+| PNil _ ->
+    env
+| PParCons {value={inside; _}; _} ->
+   let head, _, tail = inside in
+   vars_of_pattern (vars_of_pattern env head) tail
+| PCons {value; _} ->
+    Utils.nsepseq_foldl vars_of_pattern env value
+
+and vars_of_pinj env inj =
+  Utils.sepseq_foldl vars_of_pattern env inj.elements
+
+and vars_of_ptuple env {inside; _} =
+  Utils.nsepseq_foldl vars_of_pattern env inside
+
+let check_linearity = vars_of_pattern VarSet.empty
+
+(* Checking patterns *)
+
+let check_pattern p =
+  check_linearity p |> check_reserved_names |> ignore
+
+(* Checking variants for duplicates *)
+
+let check_variants variants =
+  let add acc {value; _} =
+    if VarSet.mem value.constr acc then
+      raise (Error (Duplicate_variant value.constr))
+    else VarSet.add value.constr acc in
+  let variants =
+    List.fold_left add VarSet.empty variants
+  in ignore variants
+
+(* Checking parameters *)
+
+let check_parameters params =
+  let add acc = function
+    ParamConst {value; _} ->
+      if VarSet.mem value.var acc then
+        raise (Error (Duplicate_parameter value.var))
+      else VarSet.add value.var acc
+  | ParamVar {value; _} ->
+      if VarSet.mem value.var acc then
+        raise (Error (Duplicate_parameter value.var))
+      else VarSet.add value.var acc in
+  let params =
+    List.fold_left add VarSet.empty params
+  in ignore params

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

@@ -1,8 +1,24 @@
 type t =
-  Reserved_name of string Region.reg
+  Reserved_name       of AST.variable
-| Duplicate_parameter of string Region.reg
+| Duplicate_parameter of AST.variable
-| Duplicate_variant of string Region.reg
+| Duplicate_variant   of AST.variable
+| Non_linear_pattern  of AST.variable
 
 type error = t
 
 exception Error of t
+
+module Ord :
+  sig
+    type t = AST.variable
+    val compare : t -> t -> int
+  end
+
+module VarSet : Set.S with type elt = Ord.t
+
+val check_reserved_name     : AST.variable -> AST.variable
+val check_reserved_name_opt : AST.variable option -> unit
+val check_reserved_names    : VarSet.t -> VarSet.t
+val check_pattern           : AST.pattern -> unit
+val check_variants          : AST.variant Region.reg list -> unit
+val check_parameters        : AST.param_decl list -> unit