From 9570caac53859a1aa11cb94713a0a82cc36e68df Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Tue, 14 Jan 2020 01:27:35 +0100 Subject: [PATCH] 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 [