From 6bf91538c42e801933dfd6550e991f6977d9059e Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Fri, 10 Jan 2020 15:32:54 +0100 Subject: [PATCH 1/8] Some refactoring. I removed AST.mli from CameLIGO (for maintenance's sake). I removed useless functions. I renamed unlexer.ml to Unlexer.ml I added a cleaning rule for my Makefile in Makefile.cfg --- src/passes/1-parser/cameligo/.links | 1 - src/passes/1-parser/cameligo/AST.ml | 22 +- src/passes/1-parser/cameligo/AST.mli | 367 ------------------ .../cameligo/{unlexer.ml => Unlexer.ml} | 0 src/passes/1-parser/cameligo/dune | 33 +- src/passes/1-parser/pascaligo/.links | 1 - src/passes/1-parser/pascaligo/Makefile.cfg | 5 + src/passes/1-parser/pascaligo/SyntaxError.ml | 5 +- src/passes/1-parser/pascaligo/SyntaxError.mli | 3 +- .../pascaligo/{unlexer.ml => Unlexer.ml} | 0 src/passes/1-parser/pascaligo/dune | 21 +- src/passes/1-parser/reasonligo/.links | 2 - src/passes/1-parser/reasonligo/Makefile.cfg | 5 + .../reasonligo/{unlexer.ml => Unlexer.ml} | 0 src/passes/1-parser/reasonligo/dune | 37 +- 15 files changed, 81 insertions(+), 421 deletions(-) delete mode 100644 src/passes/1-parser/cameligo/AST.mli rename src/passes/1-parser/cameligo/{unlexer.ml => Unlexer.ml} (100%) create mode 100644 src/passes/1-parser/pascaligo/Makefile.cfg rename src/passes/1-parser/pascaligo/{unlexer.ml => Unlexer.ml} (100%) create mode 100644 src/passes/1-parser/reasonligo/Makefile.cfg rename src/passes/1-parser/reasonligo/{unlexer.ml => Unlexer.ml} (100%) diff --git a/src/passes/1-parser/cameligo/.links b/src/passes/1-parser/cameligo/.links index a29429a42..6f2bb3b81 100644 --- a/src/passes/1-parser/cameligo/.links +++ b/src/passes/1-parser/cameligo/.links @@ -1,5 +1,4 @@ $HOME/git/OCaml-build/Makefile -$HOME/git/OCaml-build/Makefile.cfg $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli diff --git a/src/passes/1-parser/cameligo/AST.ml b/src/passes/1-parser/cameligo/AST.ml index 65c07a49d..7329b8939 100644 --- a/src/passes/1-parser/cameligo/AST.ml +++ b/src/passes/1-parser/cameligo/AST.ml @@ -21,15 +21,6 @@ open Utils type 'a reg = 'a Region.reg -let rec last to_region = function - [] -> Region.ghost -| [x] -> to_region x -| _::t -> last to_region t - -let nsepseq_to_region to_region (hd,tl) = - let reg (_, item) = to_region item in - Region.cover (to_region hd) (last reg tl) - (* Keywords of OCaml *) type keyword = Region.t @@ -368,9 +359,18 @@ and cond_expr = { ifso : expr; kwd_else : kwd_else; ifnot : expr -} + } -(* Projecting regions of the input source code *) +(* Projecting regions from some nodes of the AST *) + +let rec last to_region = function + [] -> Region.ghost +| [x] -> to_region x +| _::t -> last to_region t + +let nsepseq_to_region to_region (hd,tl) = + let reg (_, item) = to_region item in + Region.cover (to_region hd) (last reg tl) let type_expr_to_region = function TProd {region; _} diff --git a/src/passes/1-parser/cameligo/AST.mli b/src/passes/1-parser/cameligo/AST.mli deleted file mode 100644 index c00771ef8..000000000 --- a/src/passes/1-parser/cameligo/AST.mli +++ /dev/null @@ -1,367 +0,0 @@ -(* Abstract Syntax Tree (AST) for Cameligo *) - -[@@@warning "-30"] - -open Utils - -(* Regions - - The AST carries all the regions where tokens have been found by the - lexer, plus additional regions corresponding to whole subtrees - (like entire expressions, patterns etc.). These regions are needed - for error reporting and source-to-source transformations. To make - these pervasive regions more legible, we define singleton types for - the symbols, keywords etc. with suggestive names like "kwd_and" - denoting the _region_ of the occurrence of the keyword "and". -*) - -type 'a reg = 'a Region.reg - -val last : ('a -> Region.t) -> 'a list -> Region.t -val nsepseq_to_region : ('a -> Region.t) -> ('a,'sep) nsepseq -> Region.t - -(* Some keywords of OCaml *) - -type keyword = Region.t -type kwd_and = Region.t -type kwd_begin = Region.t -type kwd_else = Region.t -type kwd_end = Region.t -type kwd_false = Region.t -type kwd_fun = Region.t -type kwd_if = Region.t -type kwd_in = Region.t -type kwd_let = Region.t -type kwd_let_entry = Region.t -type kwd_match = Region.t -type kwd_mod = Region.t -type kwd_not = Region.t -type kwd_of = Region.t -type kwd_or = Region.t -type kwd_then = Region.t -type kwd_true = Region.t -type kwd_type = Region.t -type kwd_with = Region.t - -(* Data constructors *) - -type c_None = Region.t -type c_Some = Region.t - -(* Symbols *) - -type arrow = Region.t (* "->" *) -type cons = Region.t (* "::" *) -type cat = Region.t (* "^" *) -type append = Region.t (* "@" *) -type dot = Region.t (* "." *) - -(* Arithmetic operators *) - -type minus = Region.t (* "-" *) -type plus = Region.t (* "+" *) -type slash = Region.t (* "/" *) -type times = Region.t (* "*" *) - -(* Boolean operators *) - -type bool_or = Region.t (* "||" *) -type bool_and = Region.t (* "&&" *) - -(* Comparisons *) - -type equal = Region.t (* "=" *) -type neq = Region.t (* "<>" *) -type lt = Region.t (* "<" *) -type gt = Region.t (* ">" *) -type leq = Region.t (* "=<" *) -type geq = Region.t (* ">=" *) - -(* Compounds *) - -type lpar = Region.t (* "(" *) -type rpar = Region.t (* ")" *) -type lbracket = Region.t (* "[" *) -type rbracket = Region.t (* "]" *) -type lbrace = Region.t (* "{" *) -type rbrace = Region.t (* "}" *) - -(* Separators *) - -type comma = Region.t (* "," *) -type semi = Region.t (* ";" *) -type vbar = Region.t (* "|" *) -type colon = Region.t - -(* Wildcard *) - -type wild = Region.t (* "_" *) - -(* Literals *) - -type variable = string reg -type fun_name = string reg -type type_name = string reg -type field_name = string reg -type type_constr = string reg -type constr = string reg - -(* Parentheses *) - -type 'a par = { - lpar : lpar; - inside : 'a; - rpar : rpar -} - -type the_unit = lpar * rpar - -(* The Abstract Syntax Tree (finally) *) - -type t = { - decl : declaration nseq; - eof : eof -} - -and ast = t - -and eof = Region.t - -and declaration = - Let of (kwd_let * let_binding) reg (* let x = e *) -| TypeDecl of type_decl reg (* type ... *) - -(* Non-recursive values *) - -and let_binding = { (* p = e p : t = e *) - binders : pattern nseq; - lhs_type : (colon * type_expr) option; - eq : equal; - let_rhs : expr -} - -(* Recursive types *) - -and type_decl = { - kwd_type : kwd_type; - name : type_name; - eq : equal; - type_expr : type_expr -} - -and type_expr = - TProd of cartesian -| TSum of (variant reg, vbar) nsepseq reg -| TRecord of field_decl reg ne_injection reg -| TApp of (type_constr * type_tuple) reg -| TFun of (type_expr * arrow * type_expr) reg -| TPar of type_expr par reg -| TVar of variable - -and cartesian = (type_expr, times) nsepseq reg - -and variant = { - constr : constr; - arg : (kwd_of * type_expr) option -} - -and field_decl = { - field_name : field_name; - colon : colon; - field_type : type_expr -} - -and type_tuple = (type_expr, comma) nsepseq par reg - -and pattern = - PConstr of constr_pattern (* True () None A B(3,"") *) -| PUnit of the_unit reg (* () *) -| PFalse of kwd_false (* false *) -| PTrue of kwd_true (* true *) -| PVar of variable (* x *) -| PInt of (Lexer.lexeme * Z.t) reg (* 7 *) -| PNat of (Lexer.lexeme * Z.t) reg (* 7p 7n *) -| PBytes of (Lexer.lexeme * Hex.t) reg (* 0xAA0F *) -| PString of string reg (* "foo" *) -| PWild of wild (* _ *) -| PList of list_pattern -| PTuple of (pattern, comma) nsepseq reg (* p1, p2, ... *) -| PPar of pattern par reg (* (p) *) -| PRecord of field_pattern reg ne_injection reg (* {a=...; ...} *) -| PTyped of typed_pattern reg (* (x : int) *) - -and constr_pattern = -| PNone of c_None -| PSomeApp of (c_Some * pattern) reg -| PConstrApp of (constr * pattern option) reg - -and list_pattern = - PListComp of pattern injection reg (* [p1; p2; ...] *) -| PCons of (pattern * cons * pattern) reg (* p1 :: p2 *) - -and typed_pattern = { - pattern : pattern; - colon : colon; - type_expr : type_expr -} - -and field_pattern = { - field_name : field_name; - eq : equal; - pattern : pattern -} - -and expr = - ECase of expr case reg (* p1 -> e1 | p2 -> e2 | ... *) -| ECond of cond_expr reg (* if e1 then e2 else e3 *) -| EAnnot of (expr * colon * type_expr) par reg (* (e : t) *) -| ELogic of logic_expr -| EArith of arith_expr -| EString of string_expr -| EList of list_expr (* x::y::l [1;2;3] *) -| EConstr of constr_expr (* A B(1,A) (C A) *) -| ERecord of field_assign reg ne_injection reg (* {f1=e1; ... } *) -| EProj of projection reg (* x.y.z M.x.y *) -| EVar of variable (* x *) -| ECall of (expr * expr nseq) reg (* e e1 ... en *) -| EBytes of (string * Hex.t) reg (* 0xAEFF *) -| EUnit of the_unit reg (* () *) -| ETuple of (expr, comma) nsepseq reg (* e1, e2, ... *) -| EPar of expr par reg (* (e) *) -| ELetIn of let_in reg (* let p1 = e1 and p2 = e2 and ... in e *) -| EFun of fun_expr reg (* fun x -> e *) -| ESeq of expr injection reg (* begin e1; e2; ... ; en end *) - -and 'a injection = { - compound : compound; - elements : ('a, semi) sepseq; - terminator : semi option -} - -and 'a ne_injection = { - compound : compound; - ne_elements : ('a, semi) nsepseq; - terminator : semi option -} - -and compound = - BeginEnd of kwd_begin * kwd_end -| Braces of lbrace * rbrace -| Brackets of lbracket * rbracket - -and list_expr = - ECons of cat bin_op reg (* e1 :: e3 *) -| EListComp of expr injection reg (* [e1; e2; ...] *) -(*| Append of (expr * append * expr) reg *) (* e1 @ e2 *) - -and string_expr = - Cat of cat bin_op reg (* e1 ^ e2 *) -| String of string reg (* "foo" *) - -and constr_expr = - ENone of c_None -| ESomeApp of (c_Some * expr) reg -| EConstrApp of (constr * expr option) reg - -and arith_expr = - Add of plus bin_op reg (* e1 + e2 *) -| Sub of minus bin_op reg (* e1 - e2 *) -| Mult of times bin_op reg (* e1 * e2 *) -| Div of slash bin_op reg (* e1 / e2 *) -| Mod of kwd_mod bin_op reg (* e1 mod e2 *) -| Neg of minus un_op reg (* -e *) -| Int of (string * Z.t) reg (* 12345 *) -| Nat of (string * Z.t) reg (* 3n *) -| Mutez of (string * Z.t) reg (* 1.00tz 3tz 233mutez *) - -and logic_expr = - BoolExpr of bool_expr -| CompExpr of comp_expr - -and bool_expr = - Or of kwd_or bin_op reg -| And of kwd_and bin_op reg -| Not of kwd_not un_op reg -| True of kwd_true -| False of kwd_false - -and 'a bin_op = { - op : 'a; - arg1 : expr; - arg2 : expr -} - -and 'a un_op = { - op : 'a; - arg : expr -} - -and comp_expr = - Lt of lt bin_op reg -| Leq of leq bin_op reg -| Gt of gt bin_op reg -| Geq of geq bin_op reg -| Equal of equal bin_op reg -| Neq of neq bin_op reg - -and projection = { - struct_name : variable; - selector : dot; - field_path : (selection, dot) nsepseq -} - -and selection = - FieldName of variable -| Component of (string * Z.t) reg - -and field_assign = { - field_name : field_name; - assignment : equal; - field_expr : expr -} - -and 'a case = { - kwd_match : kwd_match; - expr : expr; - kwd_with : kwd_with; - lead_vbar : vbar option; - cases : ('a case_clause reg, vbar) nsepseq reg -} - -and 'a case_clause = { - pattern : pattern; - arrow : arrow; - rhs : 'a -} - -and let_in = { - kwd_let : kwd_let; - binding : let_binding; - kwd_in : kwd_in; - body : expr -} - -and fun_expr = { - kwd_fun : kwd_fun; - binders : pattern nseq; - lhs_type : (colon * type_expr) option; - arrow : arrow; - body : expr -} - -and cond_expr = { - kwd_if : kwd_if; - test : expr; - kwd_then : kwd_then; - ifso : expr; - kwd_else : kwd_else; - ifnot : expr -} - -(* Projecting regions from sundry nodes of the AST. See the first - comment at the beginning of this file. *) - -val pattern_to_region : pattern -> Region.t -val expr_to_region : expr -> Region.t -val type_expr_to_region : type_expr -> Region.t -val selection_to_region : selection -> Region.t diff --git a/src/passes/1-parser/cameligo/unlexer.ml b/src/passes/1-parser/cameligo/Unlexer.ml similarity index 100% rename from src/passes/1-parser/cameligo/unlexer.ml rename to src/passes/1-parser/cameligo/Unlexer.ml diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune index 63f695550..b47cb64f6 100644 --- a/src/passes/1-parser/cameligo/dune +++ b/src/passes/1-parser/cameligo/dune @@ -1,10 +1,16 @@ +;; Build of the lexer + (ocamllex LexToken) +;; Build of the parser + (menhir (merge_into Parser) (modules ParToken Parser) (flags -la 1 --table --strict --explain --external-tokens LexToken)) +;; Build of the parser as a library + (library (name parser_cameligo) (public_name ligo.parser.cameligo) @@ -20,6 +26,18 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared))) +;; Build of the unlexer (for covering the +;; error states of the LR automaton) + +(executable + (name Unlexer) + (libraries str) + (preprocess + (pps bisect_ppx --conditional)) + (modules Unlexer)) + +;; Local build of a standalone lexer + (executable (name LexerMain) (libraries parser_cameligo) @@ -28,6 +46,8 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Parser_shared -open Parser_cameligo))) +;; Local build of a standalone parser + (executable (name ParserMain) (libraries parser_cameligo) @@ -37,19 +57,16 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo))) -(executable - (name Unlexer) - (libraries str) - (preprocess - (pps bisect_ppx --conditional)) - (modules Unlexer)) +;; Build of the covering of error states in the LR automaton (rule (targets Parser.msg) (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly) - (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly ))) + (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly))) + +;; Build of all the LIGO source file that cover all error states (rule (targets all.ligo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) - (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) \ No newline at end of file + (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=mligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) \ No newline at end of file diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index a29429a42..6f2bb3b81 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -1,5 +1,4 @@ $HOME/git/OCaml-build/Makefile -$HOME/git/OCaml-build/Makefile.cfg $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli diff --git a/src/passes/1-parser/pascaligo/Makefile.cfg b/src/passes/1-parser/pascaligo/Makefile.cfg new file mode 100644 index 000000000..2f2a6b197 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Makefile.cfg @@ -0,0 +1,5 @@ +SHELL := dash +BFLAGS := -strict-sequence -w +A-48-4 -g + +clean:: +> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml diff --git a/src/passes/1-parser/pascaligo/SyntaxError.ml b/src/passes/1-parser/pascaligo/SyntaxError.ml index d402be17e..84e73b061 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.ml +++ b/src/passes/1-parser/pascaligo/SyntaxError.ml @@ -1,5 +1,6 @@ [@@@warning "-42"] + type t = Reserved_name of AST.variable | Duplicate_parameter of AST.variable @@ -96,10 +97,6 @@ let check_reserved_name var = 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 diff --git a/src/passes/1-parser/pascaligo/SyntaxError.mli b/src/passes/1-parser/pascaligo/SyntaxError.mli index ee3d96872..ba90b2f37 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.mli +++ b/src/passes/1-parser/pascaligo/SyntaxError.mli @@ -1,3 +1,5 @@ +(* This module exports checks on scoping, called from the parser. *) + type t = Reserved_name of AST.variable | Duplicate_parameter of AST.variable @@ -18,7 +20,6 @@ module Ord : 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 diff --git a/src/passes/1-parser/pascaligo/unlexer.ml b/src/passes/1-parser/pascaligo/Unlexer.ml similarity index 100% rename from src/passes/1-parser/pascaligo/unlexer.ml rename to src/passes/1-parser/pascaligo/Unlexer.ml diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index 4e365191b..e7a6dead2 100644 --- a/src/passes/1-parser/pascaligo/dune +++ b/src/passes/1-parser/pascaligo/dune @@ -58,27 +58,16 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo))) -;; Les deux directives (rule) qui suivent sont pour le dev local. -;; Il suffit de faire "dune build Parser.exe" pour avoir un Parser.exe dans le dossier. -;; Pour le purger, il faut faire "dune clean". -;(rule -; (targets Parser.exe) -; (deps ParserMain.exe) -; (action (copy ParserMain.exe Parser.exe)) -; (mode promote-until-clean)) - -;(rule -; (targets Lexer.exe) -; (deps LexerMain.exe) -; (action (copy LexerMain.exe Lexer.exe)) -; (mode promote-until-clean)) +;; Build of the covering of error states in the LR automaton (rule (targets Parser.msg) (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly) - (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly ))) + (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly))) + +;; Build of all the LIGO source file that cover all error states (rule (targets all.ligo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) - (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) + (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly))) diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links index e972ad9c6..a8d7e0b2b 100644 --- a/src/passes/1-parser/reasonligo/.links +++ b/src/passes/1-parser/reasonligo/.links @@ -1,5 +1,4 @@ $HOME/git/OCaml-build/Makefile -$HOME/git/OCaml-build/Makefile.cfg $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli @@ -22,7 +21,6 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/ParserUnit.ml Stubs/Simple_utils.ml Stubs/Parser_cameligo.ml -../cameligo/AST.mli ../cameligo/AST.ml ../cameligo/ParserLog.mli ../cameligo/ParserLog.ml diff --git a/src/passes/1-parser/reasonligo/Makefile.cfg b/src/passes/1-parser/reasonligo/Makefile.cfg new file mode 100644 index 000000000..2f2a6b197 --- /dev/null +++ b/src/passes/1-parser/reasonligo/Makefile.cfg @@ -0,0 +1,5 @@ +SHELL := dash +BFLAGS := -strict-sequence -w +A-48-4 -g + +clean:: +> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml diff --git a/src/passes/1-parser/reasonligo/unlexer.ml b/src/passes/1-parser/reasonligo/Unlexer.ml similarity index 100% rename from src/passes/1-parser/reasonligo/unlexer.ml rename to src/passes/1-parser/reasonligo/Unlexer.ml diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune index a38f523db..c3a81bb8d 100644 --- a/src/passes/1-parser/reasonligo/dune +++ b/src/passes/1-parser/reasonligo/dune @@ -1,9 +1,15 @@ +;; Build of the lexer + (ocamllex LexToken) +;; Build of the parser + (menhir - (merge_into Parser) - (modules ParToken Parser) - (flags -la 1 --table --explain --strict --external-tokens LexToken)) + (merge_into Parser) + (modules ParToken Parser) + (flags -la 1 --table --explain --strict --external-tokens LexToken)) + +;; Build of the parser as a library (library (name parser_reasonligo) @@ -22,6 +28,18 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo))) +;; Build of the unlexer (for covering the +;; error states of the LR automaton) + +(executable + (name Unlexer) + (libraries str) + (preprocess + (pps bisect_ppx --conditional)) + (modules Unlexer)) + +;; Local build of a standalone lexer + (executable (name LexerMain) (libraries parser_reasonligo) @@ -30,6 +48,8 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Parser_shared -open Parser_reasonligo))) +;; Local build of a standalone parser + (executable (name ParserMain) (libraries @@ -41,19 +61,16 @@ (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_cameligo -open Parser_shared -open Parser_reasonligo))) -(executable - (name Unlexer) - (libraries str) - (preprocess - (pps bisect_ppx --conditional)) - (modules Unlexer)) +;; Build of the covering of error states in the LR automaton (rule (targets Parser.msg) (deps (:script_messages ../../../../vendors/ligo-utils/simple-utils/messages.sh) Parser.mly LexToken.mli ParToken.mly) (action (run %{script_messages} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly Parser.mly ))) +;; Build of all the LIGO source file that cover all error states + (rule (targets all.ligo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) - (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=ligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) + (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=religo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) From 9570caac53859a1aa11cb94713a0a82cc36e68df Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Tue, 14 Jan 2020 01:27:35 +0100 Subject: [PATCH 2/8] Refactoring to bring local builds of the parsers closer to the global build. Added --expr to parse expressions. --- src/passes/1-parser/cameligo.ml | 60 ++++---- .../cameligo/{.unlexer.tag => .Unlexer.tag} | 0 src/passes/1-parser/cameligo/Makefile.cfg | 5 + src/passes/1-parser/cameligo/Parser.mly | 10 +- src/passes/1-parser/cameligo/ParserLog.mli | 5 +- src/passes/1-parser/cameligo/ParserMain.ml | 78 +++++++++- src/passes/1-parser/cameligo/Scoping.ml | 132 ++++++++++++++++ src/passes/1-parser/cameligo/Scoping.mli | 16 ++ src/passes/1-parser/cameligo/dune | 5 +- src/passes/1-parser/dune | 19 +-- src/passes/1-parser/pascaligo.ml | 20 +-- src/passes/1-parser/pascaligo.mli | 25 ++- .../pascaligo/{.unlexer.tag => .Unlexer.tag} | 0 .../pascaligo/{ => Misc}/SParserMain.ml | 0 src/passes/1-parser/pascaligo/Parser.mly | 42 ++--- src/passes/1-parser/pascaligo/ParserLog.mli | 6 +- src/passes/1-parser/pascaligo/ParserMain.ml | 121 ++++++++------- .../pascaligo/{SyntaxError.ml => Scoping.ml} | 1 - src/passes/1-parser/pascaligo/Scoping.mli | 18 +++ src/passes/1-parser/pascaligo/SyntaxError.mli | 27 ---- src/passes/1-parser/pascaligo/Tests/pp.ligo | 4 +- src/passes/1-parser/pascaligo/dune | 4 +- src/passes/1-parser/pascaligo/pascaligo.ml | 8 +- src/passes/1-parser/reasonligo.ml | 143 ++++++++---------- .../reasonligo/{.unlexer.tag => .Unlexer.tag} | 0 src/passes/1-parser/reasonligo/.links | 2 + src/passes/1-parser/reasonligo/Parser.mly | 27 +++- src/passes/1-parser/reasonligo/ParserMain.ml | 95 +++++++++--- src/passes/1-parser/reasonligo/dune | 2 +- src/passes/1-parser/shared/EvalOpt.ml | 26 ++-- src/passes/1-parser/shared/EvalOpt.mli | 25 +-- src/passes/1-parser/shared/ParserAPI.ml | 15 +- src/passes/1-parser/shared/ParserAPI.mli | 11 +- src/passes/1-parser/shared/ParserUnit.ml | 132 ++++++++++------ src/passes/2-simplify/dune | 7 +- src/passes/2-simplify/pascaligo.ml | 7 +- src/test/dune | 4 +- src/test/parser_negative_tests.ml | 6 +- 38 files changed, 724 insertions(+), 384 deletions(-) rename src/passes/1-parser/cameligo/{.unlexer.tag => .Unlexer.tag} (100%) create mode 100644 src/passes/1-parser/cameligo/Makefile.cfg create mode 100644 src/passes/1-parser/cameligo/Scoping.ml create mode 100644 src/passes/1-parser/cameligo/Scoping.mli rename src/passes/1-parser/pascaligo/{.unlexer.tag => .Unlexer.tag} (100%) rename src/passes/1-parser/pascaligo/{ => Misc}/SParserMain.ml (100%) rename src/passes/1-parser/pascaligo/{SyntaxError.ml => Scoping.ml} (99%) create mode 100644 src/passes/1-parser/pascaligo/Scoping.mli delete mode 100644 src/passes/1-parser/pascaligo/SyntaxError.mli rename src/passes/1-parser/reasonligo/{.unlexer.tag => .Unlexer.tag} (100%) diff --git a/src/passes/1-parser/cameligo.ml b/src/passes/1-parser/cameligo.ml index 53ecdc29e..cd8bc94f2 100644 --- a/src/passes/1-parser/cameligo.ml +++ b/src/passes/1-parser/cameligo.ml @@ -6,7 +6,7 @@ module ParserLog = Parser_cameligo.ParserLog module LexToken = Parser_cameligo.LexToken module Lexer = Lexer.Make(LexToken) -module Errors = struct +module Errors = struct let lexer_error (e: Lexer.error AST.reg) = let title () = "lexer error" in @@ -18,62 +18,62 @@ module Errors = struct ] in error ~data title message - let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = + let parser_error source (start: Lexing.position) (stop: Lexing.position) lexbuf = let title () = "parser error" in - let file = if source = "" then - "" - else + let file = if source = "" then + "" + else Format.sprintf "In file \"%s|%s\"" start.pos_fname source in let str = Format.sprintf "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" (Lexing.lexeme lexbuf) start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) file in let message () = str in let loc = if start.pos_cnum = -1 then Region.make ~start: Pos.min - ~stop:(Pos.from_byte end_) + ~stop:(Pos.from_byte stop) else Region.make ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in + ~stop:(Pos.from_byte stop) + in let data = [ ("parser_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc ) - ] + ] in error ~data title message - - let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = + + let unrecognized_error source (start: Lexing.position) (stop: Lexing.position) lexbuf = let title () = "unrecognized error" in - let file = if source = "" then - "" - else + let file = if source = "" then + "" + else Format.sprintf "In file \"%s|%s\"" start.pos_fname source in let str = Format.sprintf "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" (Lexing.lexeme lexbuf) start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) file in let message () = str in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) + let loc = Region.make + ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in let data = [ - ("unrecognized_loc", + ("unrecognized_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) + ) ] in error ~data title message @@ -83,23 +83,23 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) source lexbuf = +let parse (parser: 'a parser) source lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in - let result = + let result = try ok (parser read lexbuf) with | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error source start end_ lexbuf) + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ (parser_error source start stop lexbuf) | Lexer.Error e -> fail @@ (lexer_error e) | _ -> let _ = Printexc.print_backtrace Pervasives.stdout in let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (unrecognized_error source start end_ lexbuf) + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ (unrecognized_error source start stop lexbuf) in close (); result @@ -122,8 +122,8 @@ let parse_file (source: string) : AST.t result = let parse_string (s:string) : AST.t result = let lexbuf = Lexing.from_string s in - parse (Parser.contract) "" lexbuf + parse Parser.contract "" lexbuf let parse_expression (s:string) : AST.expr result = - let lexbuf = Lexing.from_string s in - parse (Parser.interactive_expr) "" lexbuf \ No newline at end of file + let lexbuf = Lexing.from_string s in + parse Parser.interactive_expr "" lexbuf diff --git a/src/passes/1-parser/cameligo/.unlexer.tag b/src/passes/1-parser/cameligo/.Unlexer.tag similarity index 100% rename from src/passes/1-parser/cameligo/.unlexer.tag rename to src/passes/1-parser/cameligo/.Unlexer.tag diff --git a/src/passes/1-parser/cameligo/Makefile.cfg b/src/passes/1-parser/cameligo/Makefile.cfg new file mode 100644 index 000000000..2f2a6b197 --- /dev/null +++ b/src/passes/1-parser/cameligo/Makefile.cfg @@ -0,0 +1,5 @@ +SHELL := dash +BFLAGS := -strict-sequence -w +A-48-4 -g + +clean:: +> rm -f Parser.msg Parser.msg.map Parser.msg.states Version.ml diff --git a/src/passes/1-parser/cameligo/Parser.mly b/src/passes/1-parser/cameligo/Parser.mly index 11f858752..c4c93d6a5 100644 --- a/src/passes/1-parser/cameligo/Parser.mly +++ b/src/passes/1-parser/cameligo/Parser.mly @@ -119,6 +119,7 @@ declaration: type_decl: "type" type_name "=" type_expr { + Scoping.check_reserved_name $2; let region = cover $1 (type_expr_to_region $4) in let value = { kwd_type = $1; @@ -175,6 +176,7 @@ type_tuple: sum_type: ioption("|") nsepseq(variant,"|") { + Scoping.check_variants (Utils.nsepseq_to_list $2); let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -188,6 +190,8 @@ variant: record_type: "{" sep_or_term_list(field_decl,";") "}" { let ne_elements, terminator = $2 in + let () = Utils.nsepseq_to_list ne_elements + |> Scoping.check_fields in let region = cover $1 $3 and value = {compound = Braces ($1,$3); ne_elements; terminator} in TRecord {region; value} } @@ -213,9 +217,11 @@ let_declaration: let_binding: "" nseq(sub_irrefutable) type_annotation? "=" expr { let binders = Utils.nseq_cons (PVar $1) $2 in + Utils.nseq_iter Scoping.check_pattern binders; {binders; lhs_type=$3; eq=$4; let_rhs=$5} } | irrefutable type_annotation? "=" expr { + Scoping.check_pattern $1; {binders=$1,[]; lhs_type=$2; eq=$3; let_rhs=$4} } type_annotation: @@ -440,7 +446,9 @@ cases(right_expr): in fst_case, ($2,snd_case)::others } case_clause(right_expr): - pattern "->" right_expr { {pattern=$1; arrow=$2; rhs=$3} } + pattern "->" right_expr { + Scoping.check_pattern $1; + {pattern=$1; arrow=$2; rhs=$3} } let_expr(right_expr): "let" let_binding "in" right_expr { diff --git a/src/passes/1-parser/cameligo/ParserLog.mli b/src/passes/1-parser/cameligo/ParserLog.mli index bae31ee93..d16252478 100644 --- a/src/passes/1-parser/cameligo/ParserLog.mli +++ b/src/passes/1-parser/cameligo/ParserLog.mli @@ -25,6 +25,7 @@ val pattern_to_string : val expr_to_string : offsets:bool -> mode:[`Point|`Byte] -> AST.expr -> string -(** {1 Pretty-printing of the AST} *) +(** {1 Pretty-printing of AST nodes} *) -val pp_ast : state -> AST.t -> unit +val pp_ast : state -> AST.t -> unit +val pp_expr : state -> AST.expr -> unit diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index f1b03fd25..83966754a 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -6,22 +6,86 @@ module IO = let options = EvalOpt.read "CameLIGO" ext end -module ExtParser = +module Parser = struct - type ast = AST.t + type ast = AST.t type expr = AST.expr include Parser end -module ExtParserLog = +module ParserLog = struct - type ast = AST.t + type ast = AST.t + type expr = AST.expr include ParserLog end -module MyLexer = Lexer.Make (LexToken) +module Lexer = Lexer.Make (LexToken) module Unit = - ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) -let () = Unit.run () +(* Main *) + +let issue_error point = + let error = Unit.format_error ~offsets:IO.options#offsets + IO.options#mode point + in (Unit.close_all (); Stdlib.Error error) + +let parse (parser: unit -> ('a,string) Stdlib.result) : ('a,string) Stdlib.result = + try parser () with + (* Scoping errors *) + + | Scoping.Error (Scoping.Reserved_name name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + issue_error + ("Reserved name.\nHint: Change the name.\n", None, invalid)) + + | Scoping.Error (Scoping.Duplicate_variant name) -> + let token = + Lexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate constructor in this sum type declaration.\n\ + Hint: Change the constructor.\n", + None, token + in issue_error point + + | Scoping.Error (Scoping.Non_linear_pattern var) -> + let token = + Lexer.Token.mk_ident var.Region.value var.Region.region in + (match token with + (* Cannot fail because [var] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Repeated variable in this pattern.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + + | Scoping.Error (Scoping.Duplicate_field name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Duplicate field name in this record declaration.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + +let () = + if IO.options#expr + then match parse (fun () -> Unit.parse Unit.parse_expr) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg + else match parse (fun () -> Unit.parse Unit.parse_contract) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/cameligo/Scoping.ml b/src/passes/1-parser/cameligo/Scoping.ml new file mode 100644 index 000000000..5f45c643b --- /dev/null +++ b/src/passes/1-parser/cameligo/Scoping.ml @@ -0,0 +1,132 @@ +[@@@warning "-42"] + + +type t = + Reserved_name of AST.variable +| Duplicate_variant of AST.variable +| Non_linear_pattern of AST.variable +| Duplicate_field 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 "assert" + |> add "balance" + |> add "time" + |> add "amount" + |> add "gas" + |> add "sender" + |> add "source" + |> add "failwith" + |> add "continue" + |> add "stop" + |> add "int" + |> add "abs" + |> add "unit" + +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)) + +(* Checking the linearity of patterns *) + +open! AST + +let rec vars_of_pattern env = function + PConstr p -> vars_of_pconstr env p +| PUnit _ | PFalse _ | PTrue _ +| PInt _ | PNat _ | PBytes _ +| PString _ | PWild _ -> env +| PVar var -> + if VarSet.mem var env then + raise (Error (Non_linear_pattern var)) + else VarSet.add var env +| PList l -> vars_of_plist env l +| PTuple t -> Utils.nsepseq_foldl vars_of_pattern env t.value +| PPar p -> vars_of_pattern env p.value.inside +| PRecord p -> vars_of_fields env p.value.ne_elements +| PTyped p -> vars_of_pattern env p.value.pattern + +and vars_of_fields env fields = + Utils.nsepseq_foldl vars_of_field_pattern env fields + +and vars_of_field_pattern env field = + let var = field.value.field_name in + if VarSet.mem var env then + raise (Error (Non_linear_pattern var)) + else + let p = field.value.pattern + in vars_of_pattern (VarSet.add var env) p + +and vars_of_pconstr env = function + PNone _ -> env +| PSomeApp {value=_, pattern; _} -> + vars_of_pattern env pattern +| PConstrApp {value=_, Some pattern; _} -> + vars_of_pattern env pattern +| PConstrApp {value=_,None; _} -> env + +and vars_of_plist env = function + PListComp {value; _} -> + Utils.sepseq_foldl vars_of_pattern env value.elements +| PCons {value; _} -> + let head, _, tail = value in + List.fold_left vars_of_pattern env [head; tail] + +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 record fields *) + +let check_fields fields = + let add acc {value; _} = + if VarSet.mem (value: field_decl).field_name acc then + raise (Error (Duplicate_field value.field_name)) + else VarSet.add value.field_name acc in + let fields = + List.fold_left add VarSet.empty fields + in ignore fields diff --git a/src/passes/1-parser/cameligo/Scoping.mli b/src/passes/1-parser/cameligo/Scoping.mli new file mode 100644 index 000000000..61ca10f02 --- /dev/null +++ b/src/passes/1-parser/cameligo/Scoping.mli @@ -0,0 +1,16 @@ +(* This module exports checks on scoping, called from the parser. *) + +type t = + Reserved_name of AST.variable +| Duplicate_variant of AST.variable +| Non_linear_pattern of AST.variable +| Duplicate_field of AST.variable + +type error = t + +exception Error of t + +val check_reserved_name : AST.variable -> unit +val check_pattern : AST.pattern -> unit +val check_variants : AST.variant Region.reg list -> unit +val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune index b47cb64f6..57806ff56 100644 --- a/src/passes/1-parser/cameligo/dune +++ b/src/passes/1-parser/cameligo/dune @@ -14,7 +14,8 @@ (library (name parser_cameligo) (public_name ligo.parser.cameligo) - (modules AST cameligo Parser ParserLog LexToken) + (modules + Scoping AST cameligo Parser ParserLog LexToken) (libraries menhirLib parser_shared @@ -67,6 +68,6 @@ ;; Build of all the LIGO source file that cover all error states (rule - (targets all.ligo) + (targets all.mligo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=mligo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) \ No newline at end of file diff --git a/src/passes/1-parser/dune b/src/passes/1-parser/dune index bbf559aa0..25154ae45 100644 --- a/src/passes/1-parser/dune +++ b/src/passes/1-parser/dune @@ -2,15 +2,12 @@ (name parser) (public_name ligo.parser) (libraries - simple-utils - tezos-utils - parser_shared - parser_pascaligo - parser_cameligo - parser_reasonligo - ) + simple-utils + tezos-utils + parser_shared + parser_pascaligo + parser_cameligo + parser_reasonligo) (preprocess - (pps ppx_let bisect_ppx --conditional) - ) - (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared)) -) + (pps ppx_let bisect_ppx --conditional)) + (flags (:standard -w +1..62-4-9-44-40-42-48-30@39@33 -open Simple_utils -open Parser_shared))) diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 2cf59bb3b..a86c5a5dd 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -2,10 +2,10 @@ open Trace module Parser = Parser_pascaligo.Parser module AST = Parser_pascaligo.AST -module ParserLog = Parser_pascaligo.ParserLog +(*module ParserLog = Parser_pascaligo.ParserLog*) module LexToken = Parser_pascaligo.LexToken module Lexer = Lexer.Make(LexToken) -module SyntaxError = Parser_pascaligo.SyntaxError +module Scoping = Parser_pascaligo.Scoping module Errors = struct @@ -70,22 +70,22 @@ module Errors = struct end_.pos_lnum (end_.pos_cnum - end_.pos_bol) file in - let message () = str in + let message () = str in let loc = if start.pos_cnum = -1 then Region.make ~start: Pos.min - ~stop:(Pos.from_byte end_) + ~stop:(Pos.from_byte end_) else Region.make ~start:(Pos.from_byte start) ~stop:(Pos.from_byte end_) - in + in let data = [ ("parser_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc ) - ] + ] in error ~data title message @@ -127,13 +127,13 @@ let parse (parser: 'a parser) source lexbuf = try ok (parser read lexbuf) with - SyntaxError.Error (Non_linear_pattern var) -> + Scoping.Error (Scoping.Non_linear_pattern var) -> fail @@ (non_linear_pattern var) - | SyntaxError.Error (Duplicate_parameter name) -> + | Scoping.Error (Duplicate_parameter name) -> fail @@ (duplicate_parameter name) - | SyntaxError.Error (Duplicate_variant name) -> + | Scoping.Error (Duplicate_variant name) -> fail @@ (duplicate_variant name) - | SyntaxError.Error (Reserved_name name) -> + | Scoping.Error (Reserved_name name) -> fail @@ (reserved_name name) | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in diff --git a/src/passes/1-parser/pascaligo.mli b/src/passes/1-parser/pascaligo.mli index e82d6ab35..13e75b7e9 100644 --- a/src/passes/1-parser/pascaligo.mli +++ b/src/passes/1-parser/pascaligo.mli @@ -1,21 +1,18 @@ -(* This file provides an interface to the PascaLIGO parser. *) +(** This file provides an interface to the PascaLIGO parser. *) -open Trace - -module Parser = Parser_pascaligo.Parser module AST = Parser_pascaligo.AST -module ParserLog = Parser_pascaligo.ParserLog -module LexToken = Parser_pascaligo.LexToken - -(** Open a PascaLIGO filename given by string and convert into an abstract syntax tree. *) -val parse_file : string -> (AST.t result) +(** Open a PascaLIGO filename given by string and convert into an + abstract syntax tree. *) +val parse_file : string -> AST.t Trace.result (** Convert a given string into a PascaLIGO abstract syntax tree *) -val parse_string : string -> AST.t result +val parse_string : string -> AST.t Trace.result -(** Parse a given string as a PascaLIGO expression and return an expression AST. +(** Parse a given string as a PascaLIGO expression and return an + expression AST. -This is intended to be used for interactive interpreters, or other scenarios -where you would want to parse a PascaLIGO expression outside of a contract. *) -val parse_expression : string -> AST.expr result + This is intended to be used for interactive interpreters, or other + scenarios where you would want to parse a PascaLIGO expression + outside of a contract. *) +val parse_expression : string -> AST.expr Trace.result diff --git a/src/passes/1-parser/pascaligo/.unlexer.tag b/src/passes/1-parser/pascaligo/.Unlexer.tag similarity index 100% rename from src/passes/1-parser/pascaligo/.unlexer.tag rename to src/passes/1-parser/pascaligo/.Unlexer.tag diff --git a/src/passes/1-parser/pascaligo/SParserMain.ml b/src/passes/1-parser/pascaligo/Misc/SParserMain.ml similarity index 100% rename from src/passes/1-parser/pascaligo/SParserMain.ml rename to src/passes/1-parser/pascaligo/Misc/SParserMain.ml diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 131362464..f99bbcc53 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -118,7 +118,7 @@ declaration: type_decl: "type" type_name "is" type_expr ";"? { - ignore (SyntaxError.check_reserved_name $2); + Scoping.check_reserved_name $2; let stop = match $5 with Some region -> region @@ -186,7 +186,7 @@ type_tuple: sum_type: "|"? nsepseq(variant,"|") { - SyntaxError.check_variants (Utils.nsepseq_to_list $2); + Scoping.check_variants (Utils.nsepseq_to_list $2); let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -201,7 +201,7 @@ record_type: "record" sep_or_term_list(field_decl,";") "end" { let ne_elements, terminator = $2 in let () = Utils.nsepseq_to_list ne_elements - |> SyntaxError.check_fields in + |> Scoping.check_fields in let region = cover $1 $3 and value = {opening = Kwd $1; ne_elements; @@ -243,11 +243,11 @@ open_fun_decl: "function" fun_name parameters ":" type_expr "is" block "with" expr { - let fun_name = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let stop = expr_to_region $9 in let region = cover $1 stop and value = {kwd_function = $1; - fun_name; + fun_name = $2; param = $3; colon = $4; ret_type = $5; @@ -257,11 +257,11 @@ open_fun_decl: terminator = None} in {region; value} } | "function" fun_name parameters ":" type_expr "is" expr { - let fun_name = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let stop = expr_to_region $7 in let region = cover $1 stop and value = {kwd_function = $1; - fun_name; + fun_name = $2; param = $3; colon = $4; ret_type = $5; @@ -279,26 +279,26 @@ parameters: par(nsepseq(param_decl,";")) { let params = Utils.nsepseq_to_list ($1.value: _ par).inside - in SyntaxError.check_parameters params; + in Scoping.check_parameters params; $1 } param_decl: "var" var ":" param_type { - let var = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let stop = type_expr_to_region $4 in let region = cover $1 stop and value = {kwd_var = $1; - var; + var = $2; colon = $3; param_type = $4} in ParamVar {region; value} } | "const" var ":" param_type { - let var = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let stop = type_expr_to_region $4 in let region = cover $1 stop and value = {kwd_const = $1; - var; + var = $2; colon = $3; param_type = $4} in ParamConst {region; value} } @@ -362,9 +362,9 @@ open_var_decl: unqualified_decl(OP): var ":" type_expr OP expr { - let var = SyntaxError.check_reserved_name $1 in + Scoping.check_reserved_name $1; let region = expr_to_region $5 - in var, $2, $3, $4, $5, region } + in $1, $2, $3, $4, $5, region } const_decl: open_const_decl ";"? { @@ -571,7 +571,7 @@ cases(rhs): case_clause(rhs): pattern "->" rhs { - SyntaxError.check_pattern $1; + Scoping.check_pattern $1; fun rhs_to_region -> let start = pattern_to_region $1 in let region = cover start (rhs_to_region $3) @@ -613,10 +613,10 @@ for_loop: in For (ForInt {region; value}) } | "for" var arrow_clause? "in" collection expr block { - let var = SyntaxError.check_reserved_name $2 in + Scoping.check_reserved_name $2; let region = cover $1 $7.region in let value = {kwd_for = $1; - var; + var = $2; bind_to = $3; kwd_in = $4; collection = $5; @@ -631,13 +631,13 @@ collection: var_assign: var ":=" expr { - let name = SyntaxError.check_reserved_name $1 in - let region = cover name.region (expr_to_region $3) - and value = {name; assign=$2; expr=$3} + Scoping.check_reserved_name $1; + let region = cover $1.region (expr_to_region $3) + and value = {name=$1; assign=$2; expr=$3} in {region; value} } arrow_clause: - "->" var { $1, SyntaxError.check_reserved_name $2 } + "->" var { Scoping.check_reserved_name $2; ($1,$2) } (* Expressions *) diff --git a/src/passes/1-parser/pascaligo/ParserLog.mli b/src/passes/1-parser/pascaligo/ParserLog.mli index c1c9bf521..955c1590b 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.mli +++ b/src/passes/1-parser/pascaligo/ParserLog.mli @@ -18,6 +18,7 @@ val print_tokens : state -> AST.t -> unit val print_path : state -> AST.path -> unit val print_pattern : state -> AST.pattern -> unit val print_instruction : state -> AST.instruction -> unit +val print_expr : state -> AST.expr -> unit (** {1 Printing tokens from the AST in a string} *) @@ -30,6 +31,7 @@ val pattern_to_string : val instruction_to_string : offsets:bool -> mode:[`Point|`Byte] -> AST.instruction -> string -(** {1 Pretty-printing of the AST} *) +(** {1 Pretty-printing of AST nodes} *) -val pp_ast : state -> AST.t -> unit +val pp_ast : state -> AST.t -> unit +val pp_expr : state -> AST.expr -> unit diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index b3b0936a0..852486287 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -6,100 +6,97 @@ module IO = let options = EvalOpt.read "PascaLIGO" ext end -module ExtParser = +module Parser = struct - type ast = AST.t + type ast = AST.t type expr = AST.expr include Parser end -module ExtParserLog = +module ParserLog = struct - type ast = AST.t + type ast = AST.t + type expr = AST.expr include ParserLog end -module MyLexer = Lexer.Make (LexToken) +module Lexer = Lexer.Make (LexToken) module Unit = - ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) -open! SyntaxError +(* Main *) -let () = - try Unit.run () with - (* Ad hoc errors from the parser *) +let issue_error point = + let error = Unit.format_error ~offsets:IO.options#offsets + IO.options#mode point + in (Unit.close_all (); Stdlib.Error error) - Error (Reserved_name name) -> - let () = Unit.close_all () in +let parse (parser: unit -> ('a,string) Stdlib.result) : ('a,string) Stdlib.result = + try parser () with + (* Scoping errors *) + + | Scoping.Error (Scoping.Duplicate_parameter name) -> let token = - MyLexer.Token.mk_ident name.Region.value name.Region.region in + Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> - let point = "Reserved name.\nHint: 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) + issue_error ("Duplicate parameter.\nHint: Change the name.\n", + None, invalid)) - | Error (Duplicate_parameter name) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Reserved_name name) -> let token = - MyLexer.Token.mk_ident name.Region.value name.Region.region in + Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> - let point = "Duplicate parameter.\nHint: 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) + issue_error + ("Reserved name.\nHint: Change the name.\n", None, invalid)) - | Error (Duplicate_variant name) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Duplicate_variant name) -> let token = - MyLexer.Token.mk_constr name.Region.value name.Region.region in - let point = "Duplicate variant in this sum type declaration.\n\ - Hint: Change the name.\n", - None, token in - let error = - Unit.format_error ~offsets:IO.options#offsets - IO.options#mode point - in Printf.eprintf "\027[31m%s\027[0m%!" error + Lexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate constructor in this sum type declaration.\n\ + Hint: Change the constructor.\n", + None, token + in issue_error point - | Error (Non_linear_pattern var) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Non_linear_pattern var) -> let token = - MyLexer.Token.mk_ident var.Region.value var.Region.region in + Lexer.Token.mk_ident var.Region.value var.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [var] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | 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) + None, invalid + in issue_error point) - | Error (Duplicate_field name) -> - let () = Unit.close_all () in + | Scoping.Error (Scoping.Duplicate_field name) -> let token = - MyLexer.Token.mk_ident name.Region.value name.Region.region in + Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - Stdlib.Error _ -> - assert false (* Should not fail if [name] is valid. *) + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false | Ok invalid -> let point = "Duplicate field name in this record declaration.\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) + None, invalid + in issue_error point) + +let () = + if IO.options#expr + then match parse (fun () -> Unit.parse Unit.parse_expr) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg + else match parse (fun () -> Unit.parse Unit.parse_contract) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/pascaligo/SyntaxError.ml b/src/passes/1-parser/pascaligo/Scoping.ml similarity index 99% rename from src/passes/1-parser/pascaligo/SyntaxError.ml rename to src/passes/1-parser/pascaligo/Scoping.ml index 84e73b061..73a7012ac 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.ml +++ b/src/passes/1-parser/pascaligo/Scoping.ml @@ -95,7 +95,6 @@ let check_reserved_names vars = let check_reserved_name var = if SSet.mem var.value reserved then raise (Error (Reserved_name var)) - else var (* Checking the linearity of patterns *) diff --git a/src/passes/1-parser/pascaligo/Scoping.mli b/src/passes/1-parser/pascaligo/Scoping.mli new file mode 100644 index 000000000..71f8c1244 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Scoping.mli @@ -0,0 +1,18 @@ +(* This module exports checks on scoping, called from the parser. *) + +type t = + Reserved_name of AST.variable +| Duplicate_parameter of AST.variable +| Duplicate_variant of AST.variable +| Non_linear_pattern of AST.variable +| Duplicate_field of AST.variable + +type error = t + +exception Error of t + +val check_reserved_name : AST.variable -> unit +val check_pattern : AST.pattern -> unit +val check_variants : AST.variant Region.reg list -> unit +val check_parameters : AST.param_decl list -> unit +val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/1-parser/pascaligo/SyntaxError.mli b/src/passes/1-parser/pascaligo/SyntaxError.mli deleted file mode 100644 index ba90b2f37..000000000 --- a/src/passes/1-parser/pascaligo/SyntaxError.mli +++ /dev/null @@ -1,27 +0,0 @@ -(* This module exports checks on scoping, called from the parser. *) - -type t = - Reserved_name of AST.variable -| Duplicate_parameter of AST.variable -| Duplicate_variant of AST.variable -| Non_linear_pattern of AST.variable -| Duplicate_field 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_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 -val check_fields : AST.field_decl Region.reg list -> unit diff --git a/src/passes/1-parser/pascaligo/Tests/pp.ligo b/src/passes/1-parser/pascaligo/Tests/pp.ligo index 78c06c34d..aa7a56af0 100644 --- a/src/passes/1-parser/pascaligo/Tests/pp.ligo +++ b/src/passes/1-parser/pascaligo/Tests/pp.ligo @@ -61,12 +61,12 @@ function claim (var store : store) : list (operation) * store is case store.backers[sender] of None -> failwith ("Not a backer.") - | Some (amount) -> + | Some (quantity) -> if balance >= store.goal or store.funded then failwith ("Goal reached: no refund.") else begin - operations.0.foo := list [transaction (unit, sender, amount)]; + operations.0.foo := list [transaction (unit, sender, quantity)]; remove sender from map store.backers end end diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index e7a6dead2..8ab2030cc 100644 --- a/src/passes/1-parser/pascaligo/dune +++ b/src/passes/1-parser/pascaligo/dune @@ -15,7 +15,7 @@ (name parser_pascaligo) (public_name ligo.parser.pascaligo) (modules - SyntaxError AST pascaligo Parser ParserLog LexToken) + Scoping AST pascaligo Parser ParserLog LexToken ParErr) (libraries menhirLib parser_shared @@ -53,7 +53,7 @@ (name ParserMain) (libraries parser_pascaligo) (modules - ParErr ParserMain) + ParserMain) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo))) diff --git a/src/passes/1-parser/pascaligo/pascaligo.ml b/src/passes/1-parser/pascaligo/pascaligo.ml index 8a76623e3..21b604e3e 100644 --- a/src/passes/1-parser/pascaligo/pascaligo.ml +++ b/src/passes/1-parser/pascaligo/pascaligo.ml @@ -1,5 +1,5 @@ -module Parser = Parser -module AST = AST -module Lexer = Lexer -module LexToken = LexToken +module Lexer = Lexer +module LexToken = LexToken +module AST = AST +module Parser = Parser module ParserLog = ParserLog diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index c919ef399..b3cc3cc7d 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -6,87 +6,76 @@ module ParserLog = Parser_cameligo.ParserLog module LexToken = Parser_reasonligo.LexToken module Lexer = Lexer.Make(LexToken) module SyntaxError = Parser_reasonligo.SyntaxError +module Scoping = Parser_cameligo.Scoping -module Errors = struct +module Errors = + struct + let lexer_error (e: Lexer.error AST.reg) = + let title () = "lexer error" in + let message () = Lexer.error_to_string e.value in + let data = [ + ("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region)] + in error ~data title message - let lexer_error (e: Lexer.error AST.reg) = - let title () = "lexer error" in - let message () = Lexer.error_to_string e.value in - let data = [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ e.region - ) - ] in - error ~data title message + let wrong_function_arguments expr = + let title () = "wrong function arguments" in + let message () = "" in + let expression_loc = AST.expr_to_region expr in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)] + in error ~data title message - let wrong_function_arguments expr = - let title () = "wrong function arguments" in - let message () = "" in - let expression_loc = AST.expr_to_region expr in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc) - ] in - error ~data title message + let parser_error source (start: Lexing.position) + (end_: Lexing.position) lexbuf = + let title () = "parser error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let str = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file in + let message () = str in + let loc = + if start.pos_cnum = -1 + then Region.make + ~start: Pos.min + ~stop:(Pos.from_byte end_) + else Region.make + ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte end_) in + let data = + [("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] + in error ~data title message - let parser_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "parser error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = if start.pos_cnum = -1 then - Region.make - ~start: Pos.min - ~stop:(Pos.from_byte end_) - else - Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in - let data = - [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) - ] - in - error ~data title message - - let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = - let title () = "unrecognized error" in - let file = if source = "" then - "" - else - Format.sprintf "In file \"%s|%s\"" start.pos_fname source - in - let str = Format.sprintf - "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" - (Lexing.lexeme lexbuf) - start.pos_lnum (start.pos_cnum - start.pos_bol) - end_.pos_lnum (end_.pos_cnum - end_.pos_bol) - file - in - let message () = str in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) - ] in - error ~data title message + let unrecognized_error source (start: Lexing.position) (end_: Lexing.position) lexbuf = + let title () = "unrecognized error" in + let file = + if source = "" then "" + else + Format.sprintf "In file \"%s|%s\"" start.pos_fname source in + let str = + Format.sprintf + "Parse error at \"%s\" from (%d, %d) to (%d, %d). %s\n" + (Lexing.lexeme lexbuf) + start.pos_lnum (start.pos_cnum - start.pos_bol) + end_.pos_lnum (end_.pos_cnum - end_.pos_bol) + file in + let message () = str in + let loc = Region.make + ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte end_) in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] + in error ~data title message end diff --git a/src/passes/1-parser/reasonligo/.unlexer.tag b/src/passes/1-parser/reasonligo/.Unlexer.tag similarity index 100% rename from src/passes/1-parser/reasonligo/.unlexer.tag rename to src/passes/1-parser/reasonligo/.Unlexer.tag diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links index a8d7e0b2b..543bf9ea3 100644 --- a/src/passes/1-parser/reasonligo/.links +++ b/src/passes/1-parser/reasonligo/.links @@ -24,3 +24,5 @@ Stubs/Parser_cameligo.ml ../cameligo/AST.ml ../cameligo/ParserLog.mli ../cameligo/ParserLog.ml +../cameligo/Scoping.mli +../cameligo/Scoping.ml \ No newline at end of file diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 14936a7ff..2b19bae15 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -148,6 +148,7 @@ declaration: type_decl: "type" type_name "=" type_expr { + Scoping.check_reserved_name $2; let region = cover $1 (type_expr_to_region $4) and value = {kwd_type = $1; name = $2; @@ -192,6 +193,7 @@ core_type: sum_type: "|" nsepseq(variant,"|") { + Scoping.check_variants (Utils.nsepseq_to_list $2); let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -205,6 +207,8 @@ variant: record_type: "{" sep_or_term_list(field_decl,",") "}" { let ne_elements, terminator = $2 in + let () = Utils.nsepseq_to_list ne_elements + |> Scoping.check_fields in let region = cover $1 $3 and value = {compound = Braces ($1,$3); ne_elements; terminator} in TRecord {region; value} } @@ -239,21 +243,25 @@ es6_func: let_binding: "" type_annotation? "=" expr { - {binders = PVar $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} + Scoping.check_reserved_name $1; + {binders = PVar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | "_" type_annotation? "=" expr { - {binders = PWild $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} + {binders = PWild $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | unit type_annotation? "=" expr { - {binders = PUnit $1,[]; lhs_type=$2; eq=$3; let_rhs=$4} + {binders = PUnit $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | record_pattern type_annotation? "=" expr { + Scoping.check_pattern (PRecord $1); {binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | par(closed_irrefutable) type_annotation? "=" expr { + Scoping.check_pattern $1.value.inside; {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} } | tuple(sub_irrefutable) type_annotation? "=" expr { + Utils.nsepseq_iter Scoping.check_pattern $1; let hd, tl = $1 in let start = pattern_to_region hd in let stop = last fst tl in @@ -417,8 +425,11 @@ fun_expr: let region = cover start stop in let rec arg_to_pattern = function - EVar v -> PVar v + EVar v -> + Scoping.check_reserved_name v; + PVar v | EAnnot {region; value = {inside = EVar v, colon, typ; _}} -> + Scoping.check_reserved_name v; let value = {pattern = PVar v; colon; type_expr = typ} in PTyped {region; value} | EPar p -> @@ -452,8 +463,9 @@ fun_expr: arg_to_pattern (EAnnot e), [] | ETuple {value = fun_args; _} -> let bindings = - List.map (arg_to_pattern <@ snd) (snd fun_args) - in arg_to_pattern (fst fun_args), bindings + List.map (arg_to_pattern <@ snd) (snd fun_args) in + List.iter Scoping.check_pattern bindings; + arg_to_pattern (fst fun_args), bindings | EUnit e -> arg_to_pattern (EUnit e), [] | e -> let open! SyntaxError @@ -518,7 +530,7 @@ switch_expr(right_expr): let region = cover start stop and cases = { region = nsepseq_to_region (fun x -> x.region) $4; - value = $4} in + value = $4} in let value = { kwd_match = $1; expr = $2; @@ -538,6 +550,7 @@ cases(right_expr): case_clause(right_expr): "|" pattern "=>" right_expr ";"? { + Scoping.check_pattern $2; let start = pattern_to_region $2 and stop = expr_to_region $4 in let region = cover start stop diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index 94f437f9d..7f01eb48c 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -6,39 +6,100 @@ module IO = let options = EvalOpt.read "ReasonLIGO" ext end -module ExtParser = +module Parser = struct - type ast = AST.t + type ast = AST.t type expr = AST.expr include Parser end -module ExtParserLog = +module ParserLog = struct - type ast = AST.t + type ast = AST.t + type expr = AST.expr include ParserLog end -module MyLexer = Lexer.Make (LexToken) +module Lexer = Lexer.Make (LexToken) module Unit = - ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) (* Main *) -let () = - try Unit.run () with - (* Ad hoc errors from the parsers *) +let issue_error point = + let error = Unit.format_error ~offsets:IO.options#offsets + IO.options#mode point + in (Unit.close_all (); Stdlib.Error error) + +let parse (parser: unit -> ('a,string) Stdlib.result) : ('a,string) Stdlib.result = + try parser () with + (* Ad hoc errors from the parser *) SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) -> - let () = Unit.close_all () in - let msg = "It looks like you are defining a function, \ - however we do not\n\ - understand the parameters declaration.\n\ - Examples of valid functions:\n\ - let x = (a: string, b: int) : int => 3;\n\ - let x = (a: string) : string => \"Hello, \" ++ a;\n" + let msg = "It looks like you are defining a function, \ + however we do not\n\ + understand the parameters declaration.\n\ + Examples of valid functions:\n\ + let x = (a: string, b: int) : int => 3;\n\ + let x = (a: string) : string => \"Hello, \" ++ a;\n" and reg = AST.expr_to_region expr in let error = Unit.short_error ~offsets:IO.options#offsets IO.options#mode msg reg - in Printf.eprintf "\027[31m%s\027[0m%!" error + in (Unit.close_all (); Stdlib.Error error) + + (* Scoping errors *) + + | Scoping.Error (Scoping.Reserved_name name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + issue_error + ("Reserved name.\nHint: Change the name.\n", None, invalid)) + + | Scoping.Error (Scoping.Duplicate_variant name) -> + let token = + Lexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate constructor in this sum type declaration.\n\ + Hint: Change the constructor.\n", + None, token + in issue_error point + + | Scoping.Error (Scoping.Non_linear_pattern var) -> + let token = + Lexer.Token.mk_ident var.Region.value var.Region.region in + (match token with + (* Cannot fail because [var] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Repeated variable in this pattern.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + + | Scoping.Error (Scoping.Duplicate_field name) -> + let token = + Lexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + (* Cannot fail because [name] is a not a + reserved name for the lexer. *) + Stdlib.Error _ -> assert false + | Ok invalid -> + let point = "Duplicate field name in this record declaration.\n\ + Hint: Change the name.\n", + None, invalid + in issue_error point) + +let () = + if IO.options#expr + then match parse (fun () -> Unit.parse Unit.parse_expr) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg + else match parse (fun () -> Unit.parse Unit.parse_contract) with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune index c3a81bb8d..5f6970ee0 100644 --- a/src/passes/1-parser/reasonligo/dune +++ b/src/passes/1-parser/reasonligo/dune @@ -71,6 +71,6 @@ ;; Build of all the LIGO source file that cover all error states (rule - (targets all.ligo) + (targets all.religo) (deps (:script_cover ../../../../vendors/ligo-utils/simple-utils/cover.sh) Parser.mly LexToken.mli ParToken.mly Parser.msg Unlexer.exe) (action (run %{script_cover} --lex-tokens=LexToken.mli --par-tokens=ParToken.mly --ext=religo --unlexer=./Unlexer.exe --messages=Parser.msg --dir=. --concatenate Parser.mly ))) diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 7889c9c18..924a51e08 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -14,10 +14,11 @@ type options = < offsets : bool; mode : [`Byte | `Point]; cmd : command; - mono : bool + mono : bool; + expr : bool > -let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono = +let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr = object method input = input method libs = libs @@ -26,6 +27,7 @@ let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono = method mode = mode method cmd = cmd method mono = mono + method expr = expr end (** {1 Auxiliary functions} *) @@ -42,7 +44,7 @@ let abort msg = let help language extension () = let file = Filename.basename Sys.argv.(0) in printf "Usage: %s [