balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

Browse Source 
Added support for the rejection of non-linear patterns in PascaLIGO.
This commit is contained in:
Christian Rinderknecht 2020-01-08 23:35:09 +01:00
parent 9bdb0a63cd
commit b8017ca8ac
6 changed files with 220 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
src/passes/1-parser/pascaligo/AST.ml
View File

@ -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

6
src/passes/1-parser/pascaligo/AST.mli
View File

@ -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

157
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -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 *)

16
src/passes/1-parser/pascaligo/ParserMain.ml
View File

@ -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)

167
src/passes/1-parser/pascaligo/SyntaxError.ml
View File

@ -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

22
src/passes/1-parser/pascaligo/SyntaxError.mli
View File

@ -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