From b8017ca8ac6d8af1072da553a1bdb4f4e58a23c8 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Wed, 8 Jan 2020 23:35:09 +0100 Subject: [PATCH] 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 | 45 ----- src/passes/1-parser/pascaligo/AST.mli | 6 - src/passes/1-parser/pascaligo/Parser.mly | 157 +++------------- src/passes/1-parser/pascaligo/ParserMain.ml | 16 ++ src/passes/1-parser/pascaligo/SyntaxError.ml | 167 +++++++++++++++++- src/passes/1-parser/pascaligo/SyntaxError.mli | 22 ++- 6 files changed, 220 insertions(+), 193 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 9aca3eaf3..4abaf6453 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/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 diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index 70620a880..5fddb96cb 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/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 diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index efff9226f..a072c3253 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -6,60 +6,7 @@ open Region open AST -module SSet = Utils.String.Set - -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 *) +(* END HEADER *) %} (* See [ParToken.mly] for the definition of tokens. *) @@ -171,10 +118,7 @@ declaration: type_decl: "type" type_name "is" type_expr ";"? { - let () = - if SSet.mem $2.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $2)) in + ignore (SyntaxError.check_reserved_name $2); let stop = match $5 with Some region -> region @@ -242,14 +186,7 @@ type_tuple: sum_type: "|"? nsepseq(variant,"|") { - let add acc {value; _} = - 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 + SyntaxError.check_variants (Utils.nsepseq_to_list $2); 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 () = - match $2 with - Some name -> - if SSet.mem name.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name name)) - | None -> () in + let () = SyntaxError.check_reserved_name_opt $2 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 () = - match $2 with - Some name -> - if SSet.mem name.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name name)) - | None -> () in + let () = SyntaxError.check_reserved_name_opt $2 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 - let () = ignore params - in $1 } + Utils.nsepseq_to_list ($1.value: _ par).inside + in SyntaxError.check_parameters params; + $1 } param_decl: "var" var ":" param_type { - let () = - if SSet.mem $2.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $2)) in + let var = SyntaxError.check_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 () = - if SSet.mem $2.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $2)) in + let var = SyntaxError.check_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 () = - if SSet.mem $1.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $1)) in + let var = SyntaxError.check_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 - 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 + SyntaxError.check_pattern $1; 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 () = - if SSet.mem $2.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $2)) in + let var = SyntaxError.check_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 () = - if SSet.mem $1.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $1)) in - let region = cover $1.region (expr_to_region $3) - and value = {name=$1; assign=$2; expr=$3} + let name = SyntaxError.check_reserved_name $1 in + let region = cover name.region (expr_to_region $3) + and value = {name; assign=$2; expr=$3} in {region; value} } arrow_clause: - "->" var { - let () = - if SSet.mem $2.value reserved then - let open! SyntaxError in - raise (Error (Reserved_name $2)) - in $1,$2 } + "->" var { $1, SyntaxError.check_reserved_name $2 } (* Expressions *) diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 8ed914f1b..cc0af5d37 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/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) diff --git a/src/passes/1-parser/pascaligo/SyntaxError.ml b/src/passes/1-parser/pascaligo/SyntaxError.ml index 4bdc77d88..356a9de59 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.ml +++ b/src/passes/1-parser/pascaligo/SyntaxError.ml @@ -1,8 +1,169 @@ +[@@@warning "-42"] + type t = - Reserved_name of string Region.reg -| Duplicate_parameter of string Region.reg -| Duplicate_variant of string Region.reg + Reserved_name of AST.variable +| Duplicate_parameter of AST.variable +| 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 diff --git a/src/passes/1-parser/pascaligo/SyntaxError.mli b/src/passes/1-parser/pascaligo/SyntaxError.mli index 4bdc77d88..4484144b5 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.mli +++ b/src/passes/1-parser/pascaligo/SyntaxError.mli @@ -1,8 +1,24 @@ type t = - Reserved_name of string Region.reg -| Duplicate_parameter of string Region.reg -| Duplicate_variant of string Region.reg + Reserved_name of AST.variable +| Duplicate_parameter of AST.variable +| 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