diff --git a/src/bin/expect_tests/lexer_tests.ml b/src/bin/expect_tests/lexer_tests.ml index 1e016fe78..99c75f077 100644 --- a/src/bin/expect_tests/lexer_tests.ml +++ b/src/bin/expect_tests/lexer_tests.ml @@ -99,9 +99,9 @@ ligo: lexer error: Negative byte sequence. run_ligo_bad [ "compile-contract" ; "../../test/lexer/reserved_name.ligo" ; "main" ] ; [%expect {| -ligo: lexer error: Reserved name: args. +ligo: lexer error: Reserved name: arguments. Hint: Change the name. - {"parser_loc":"in file \"reserved_name.ligo\", line 1, characters 4-8"} + {"parser_loc":"in file \"reserved_name.ligo\", line 1, characters 4-13"} If you're not sure how to fix this error, you can diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 317b92736..b7daab8fe 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -134,27 +134,27 @@ let parsify_string = fun (syntax : v_syntax) source_filename -> let%bind applied = Self_ast_simplified.all_program parsified in ok applied -let pretty_print_pascaligo = fun source -> +let pretty_print_pascaligo = fun source -> let%bind ast = Parser.Pascaligo.parse_file source in let buffer = Buffer.create 59 in - let state = Parser.Pascaligo.ParserLog.mk_state + let state = Parser_pascaligo.ParserLog.mk_state ~offsets:true ~mode:`Byte ~buffer in - Parser.Pascaligo.ParserLog.pp_ast state ast; + Parser_pascaligo.ParserLog.pp_ast state ast; ok buffer -let pretty_print_cameligo = fun source -> +let pretty_print_cameligo = fun source -> let%bind ast = Parser.Cameligo.parse_file source in let buffer = Buffer.create 59 in - let state = Parser.Cameligo.ParserLog.mk_state + let state = Parser_cameligo.ParserLog.mk_state ~offsets:true ~mode:`Byte ~buffer in Parser.Cameligo.ParserLog.pp_ast state ast; ok buffer -let pretty_print_reasonligo = fun source -> +let pretty_print_reasonligo = fun source -> let%bind ast = Parser.Reasonligo.parse_file source in let buffer = Buffer.create 59 in let state = Parser.Reasonligo.ParserLog.mk_state @@ -170,4 +170,4 @@ let pretty_print = fun syntax source_filename -> | Pascaligo -> pretty_print_pascaligo | Cameligo -> pretty_print_cameligo | ReasonLIGO -> pretty_print_reasonligo) - source_filename \ No newline at end of file + source_filename diff --git a/src/passes/1-parser/cameligo.ml b/src/passes/1-parser/cameligo.ml index 53ecdc29e..d69da91b4 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_) + ~start:(Pos.min ~file:source) + ~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/.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 0f36deb0d..d00cf9cd7 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 @@ -140,7 +131,7 @@ type t = { and ast = t -and attributes = attribute list +and attributes = attribute list and declaration = Let of (kwd_let * let_binding * attributes) reg @@ -321,6 +312,7 @@ and comp_expr = | Neq of neq bin_op reg and record = field_assign reg ne_injection + and projection = { struct_name : variable; selector : dot; @@ -344,6 +336,7 @@ and update = { updates : record reg; rbrace : rbrace; } + and path = Name of variable | Path of projection reg @@ -387,7 +380,16 @@ and cond_expr = { 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/LexToken.mli b/src/passes/1-parser/cameligo/LexToken.mli index b71398b62..3e3460bc2 100644 --- a/src/passes/1-parser/cameligo/LexToken.mli +++ b/src/passes/1-parser/cameligo/LexToken.mli @@ -85,7 +85,7 @@ type t = | Mutez of (string * Z.t) Region.reg | String of string Region.reg | Bytes of (string * Hex.t) Region.reg -| Attr2 of string Region.reg +| Attr of string Region.reg (* Keywords *) @@ -150,8 +150,7 @@ val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/1-parser/cameligo/LexToken.mll b/src/passes/1-parser/cameligo/LexToken.mll index f0bd0d319..d16388591 100644 --- a/src/passes/1-parser/cameligo/LexToken.mll +++ b/src/passes/1-parser/cameligo/LexToken.mll @@ -69,7 +69,7 @@ type t = | Mutez of (string * Z.t) Region.reg | String of string Region.reg | Bytes of (string * Hex.t) Region.reg -| Attr2 of string Region.reg +| Attr of string Region.reg (* Keywords *) @@ -147,6 +147,8 @@ let proj_token = function region, sprintf "Bytes (\"%s\", \"0x%s\")" s (Hex.show b) +| Attr Region.{region; value} -> + region, sprintf "Attr \"%s\"" value | Begin region -> region, "Begin" | Else region -> region, "Else" | End region -> region, "End" @@ -166,7 +168,6 @@ let proj_token = function | With region -> region, "With" | C_None region -> region, "C_None" | C_Some region -> region, "C_Some" -| Attr2 Region.{region; value} -> region, sprintf "Attr2 %s" value | EOF region -> region, "EOF" let to_lexeme = function @@ -205,6 +206,7 @@ let to_lexeme = function | Mutez i -> fst i.Region.value | String s -> String.escaped s.Region.value | Bytes b -> fst b.Region.value +| Attr a -> a.Region.value | Begin _ -> "begin" | Else _ -> "else" @@ -226,7 +228,7 @@ let to_lexeme = function | C_None _ -> "None" | C_Some _ -> "Some" -| Attr2 a -> a.Region.value + | EOF _ -> "" let to_string token ?(offsets=true) mode = @@ -469,11 +471,10 @@ let mk_constr lexeme region = (* Attributes *) -let mk_attr _lexeme _region = - Error Invalid_attribute - -let mk_attr2 lexeme region = - Ok (Attr2 { value = lexeme; region }) +let mk_attr header lexeme region = + if header = "[@" then + Error Invalid_attribute + else Ok (Attr Region.{value=lexeme; region}) (* Predicates *) 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/ParErr.ml b/src/passes/1-parser/cameligo/ParErr.ml index 7debe48ef..f1be602f1 100644 --- a/src/passes/1-parser/cameligo/ParErr.ml +++ b/src/passes/1-parser/cameligo/ParErr.ml @@ -46,7 +46,7 @@ let message = "\n" | 33 -> "\n" - | 460 -> + | 478 -> "\n" | 27 -> "\n" @@ -68,9 +68,13 @@ let message = "\n" | 133 -> "\n" - | 373 -> + | 379 -> "\n" - | 375 -> + | 381 -> + "\n" + | 472 -> + "\n" + | 169 -> "\n" | 134 -> "\n" @@ -80,7 +84,7 @@ let message = "\n" | 153 -> "\n" - | 374 -> + | 380 -> "\n" | 63 -> "\n" @@ -144,137 +148,141 @@ let message = "\n" | 156 -> "\n" - | 463 -> + | 481 -> "\n" - | 465 -> - "\n" - | 217 -> - "\n" - | 242 -> - "\n" - | 219 -> + | 483 -> "\n" | 221 -> "\n" - | 215 -> + | 246 -> "\n" - | 226 -> + | 223 -> "\n" - | 255 -> + | 225 -> "\n" - | 256 -> + | 219 -> "\n" - | 243 -> + | 230 -> "\n" - | 264 -> + | 259 -> "\n" - | 228 -> + | 260 -> "\n" - | 257 -> - "\n" - | 258 -> - "\n" - | 266 -> + | 247 -> "\n" | 268 -> "\n" + | 232 -> + "\n" + | 261 -> + "\n" + | 262 -> + "\n" | 270 -> "\n" | 272 -> "\n" | 274 -> "\n" - | 192 -> + | 276 -> "\n" - | 259 -> + | 278 -> "\n" - | 285 -> + | 195 -> "\n" - | 288 -> + | 263 -> "\n" - | 245 -> + | 289 -> "\n" - | 293 -> + | 292 -> "\n" - | 262 -> + | 249 -> + "\n" + | 297 -> + "\n" + | 266 -> "\n" | 160 -> "\n" | 164 -> "\n" - | 429 -> + | 445 -> "\n" - | 332 -> - "\n" - | 313 -> - "\n" - | 431 -> - "\n" - | 315 -> - "\n" - | 316 -> + | 337 -> "\n" | 317 -> "\n" - | 432 -> + | 447 -> "\n" - | 445 -> + | 319 -> "\n" - | 446 -> + | 320 -> "\n" - | 433 -> + | 321 -> "\n" - | 434 -> + | 448 -> "\n" - | 435 -> + | 462 -> "\n" - | 436 -> + | 463 -> "\n" - | 437 -> + | 449 -> "\n" - | 438 -> + | 450 -> "\n" - | 440 -> + | 452 -> "\n" - | 328 -> + | 451 -> "\n" - | 330 -> + | 453 -> + "\n" + | 454 -> + "\n" + | 455 -> + "\n" + | 457 -> + "\n" + | 333 -> + "\n" + | 335 -> + "\n" + | 339 -> + "\n" + | 336 -> "\n" | 334 -> "\n" - | 331 -> - "\n" - | 329 -> - "\n" - | 340 -> - "\n" - | 341 -> - "\n" - | 342 -> - "\n" - | 343 -> - "\n" - | 344 -> - "\n" | 345 -> "\n" - | 367 -> - "\n" | 346 -> "\n" | 348 -> "\n" - | 441 -> + | 347 -> "\n" - | 443 -> + | 349 -> "\n" - | 447 -> + | 350 -> "\n" - | 430 -> + | 351 -> "\n" - | 312 -> + | 373 -> "\n" - | 428 -> + | 352 -> + "\n" + | 354 -> + "\n" + | 458 -> + "\n" + | 460 -> + "\n" + | 464 -> + "\n" + | 446 -> + "\n" + | 316 -> + "\n" + | 444 -> "\n" | 165 -> "\n" @@ -282,65 +290,71 @@ let message = "\n" | 168 -> "\n" - | 169 -> + | 172 -> + "\n" + | 171 -> "\n" | 163 -> "\n" - | 448 -> + | 465 -> "\n" - | 450 -> + | 467 -> "\n" - | 451 -> + | 468 -> "\n" | 166 -> "\n" - | 235 -> - "\n" - | 236 -> - "\n" | 239 -> "\n" | 240 -> "\n" - | 425 -> + | 243 -> "\n" - | 170 -> + | 244 -> "\n" - | 171 -> + | 441 -> "\n" - | 172 -> + | 173 -> "\n" - | 418 -> + | 428 -> "\n" - | 419 -> + | 429 -> + "\n" + | 174 -> + "\n" + | 175 -> + "\n" + | 434 -> + "\n" + | 435 -> + "\n" + | 438 -> + "\n" + | 439 -> + "\n" + | 427 -> + "\n" + | 421 -> "\n" | 422 -> "\n" | 423 -> "\n" - | 174 -> - "\n" - | 304 -> - "\n" - | 305 -> - "\n" - | 405 -> - "\n" - | 412 -> - "\n" - | 404 -> - "\n" - | 306 -> + | 177 -> "\n" | 308 -> "\n" - | 320 -> + | 309 -> "\n" - | 321 -> + | 412 -> "\n" - | 322 -> + | 419 -> "\n" - | 323 -> + | 411 -> + "\n" + | 310 -> + "\n" + | 312 -> "\n" | 324 -> "\n" @@ -350,67 +364,79 @@ let message = "\n" | 327 -> "\n" - | 378 -> + | 329 -> "\n" - | 379 -> + | 328 -> "\n" - | 381 -> + | 330 -> "\n" - | 335 -> + | 331 -> "\n" - | 310 -> + | 332 -> "\n" - | 307 -> + | 384 -> "\n" - | 395 -> + | 385 -> "\n" - | 396 -> + | 387 -> "\n" - | 397 -> + | 340 -> "\n" - | 398 -> + | 314 -> "\n" - | 399 -> - "\n" - | 400 -> - "\n" - | 408 -> + | 311 -> "\n" | 401 -> "\n" + | 402 -> + "\n" + | 404 -> + "\n" | 403 -> "\n" - | 175 -> + | 405 -> "\n" - | 176 -> + | 406 -> + "\n" + | 407 -> + "\n" + | 415 -> + "\n" + | 408 -> + "\n" + | 410 -> + "\n" + | 178 -> "\n" | 179 -> "\n" - | 180 -> + | 182 -> "\n" | 183 -> "\n" - | 302 -> + | 186 -> "\n" - | 300 -> + | 306 -> "\n" - | 185 -> - "\n" - | 187 -> + | 304 -> "\n" | 188 -> "\n" - | 189 -> - "\n" | 190 -> "\n" - | 195 -> + | 191 -> + "\n" + | 192 -> + "\n" + | 193 -> + "\n" + | 198 -> + "\n" + | 218 -> + "\n" + | 197 -> "\n" | 214 -> "\n" - | 194 -> - "\n" - | 210 -> - "\n" | _ -> raise Not_found diff --git a/src/passes/1-parser/cameligo/ParToken.mly b/src/passes/1-parser/cameligo/ParToken.mly index 0368fad57..8319d166e 100644 --- a/src/passes/1-parser/cameligo/ParToken.mly +++ b/src/passes/1-parser/cameligo/ParToken.mly @@ -12,7 +12,7 @@ %token <(string * Z.t) Region.reg> Mutez "" %token Ident "" %token Constr "" -%token Attr2 "" +%token Attr "" (* Symbols *) diff --git a/src/passes/1-parser/cameligo/Parser.mly b/src/passes/1-parser/cameligo/Parser.mly index 107acb8e0..e6cc6f903 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; @@ -128,23 +129,23 @@ type_decl: in {region; value} } type_expr: - cartesian | sum_type | record_type { $1 } - -cartesian: - fun_type { $1 } -| fun_type "*" nsepseq(fun_type,"*") { - let value = Utils.nsepseq_cons $1 $2 $3 in - let region = nsepseq_to_region type_expr_to_region value - in TProd {region; value} } + fun_type | sum_type | record_type { $1 } fun_type: - core_type { $1 } -| core_type "->" fun_type { + cartesian { $1 } +| cartesian "->" fun_type { let start = type_expr_to_region $1 and stop = type_expr_to_region $3 in let region = cover start stop in TFun {region; value=$1,$2,$3} } +cartesian: + core_type { $1 } +| core_type "*" nsepseq(core_type,"*") { + let value = Utils.nsepseq_cons $1 $2 $3 in + let region = nsepseq_to_region type_expr_to_region value + in TProd {region; value} } + core_type: type_name { TVar $1 } | par(type_expr) { TPar $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} } @@ -202,10 +206,10 @@ field_decl: (* Top-level non-recursive definitions *) let_declaration: - "let" let_binding seq(Attr2) { + "let" let_binding seq(Attr) { let kwd_let = $1 in let attributes = $3 in - let binding = $2 in + let binding = $2 in let value = kwd_let, binding, attributes in let stop = expr_to_region binding.let_rhs in let region = cover $1 stop @@ -214,9 +218,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: @@ -441,13 +447,15 @@ 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 seq(Attr2) "in" right_expr { - let kwd_let = $1 + "let" let_binding seq(Attr) "in" right_expr { + let kwd_let = $1 and binding = $2 - and attributes = $3 + and attributes = $3 and kwd_in = $4 and body = $5 in let stop = expr_to_region body in @@ -626,9 +634,9 @@ update_record: lbrace = $1; record = $2; kwd_with = $3; - updates = { value = {compound = Braces($1,$5); - ne_elements; - terminator}; + updates = {value = {compound = Braces($1,$5); + ne_elements; + terminator}; region = cover $3 $5}; rbrace = $5} in {region; value} } @@ -656,5 +664,5 @@ sequence: in {region; value} } path : - "" {Name $1} -| projection { Path $1} + "" { Name $1 } +| projection { Path $1 } diff --git a/src/passes/1-parser/cameligo/ParserLog.ml b/src/passes/1-parser/cameligo/ParserLog.ml index 0ee1bd3e6..e0b7fd09b 100644 --- a/src/passes/1-parser/cameligo/ParserLog.ml +++ b/src/passes/1-parser/cameligo/ParserLog.ml @@ -128,15 +128,15 @@ let rec print_tokens state {decl;eof} = Utils.nseq_iter (print_statement state) decl; print_token state eof "EOF" -and print_attributes state attributes = +and print_attributes state attributes = List.iter ( - fun ({value = attribute; region}) -> - let attribute_formatted = sprintf "[@%s]" attribute in + fun ({value = attribute; region}) -> + let attribute_formatted = sprintf "[@@%s]" attribute in print_token state region attribute_formatted ) attributes and print_statement state = function - Let {value=kwd_let, let_binding, attributes; _} -> + Let {value=kwd_let, let_binding, attributes; _} -> print_token state kwd_let "let"; print_let_binding state let_binding; print_attributes state attributes @@ -538,7 +538,7 @@ and print_case_clause state {value; _} = print_expr state rhs and print_let_in state {value; _} = - let {kwd_let; binding; kwd_in; body; attributes} = value in + let {kwd_let; binding; kwd_in; body; attributes} = value in print_token state kwd_let "let"; print_let_binding state binding; print_attributes state attributes; @@ -610,31 +610,41 @@ let rec pp_ast state {decl; _} = List.iteri (List.length decls |> apply) decls and pp_declaration state = function - Let {value = (_, let_binding, _); region} -> + Let {value = (_, let_binding, attr); region} -> pp_loc_node state "Let" region; - pp_let_binding state let_binding + pp_let_binding state let_binding attr; | TypeDecl {value; region} -> pp_loc_node state "TypeDecl" region; pp_type_decl state value -and pp_let_binding state node = +and pp_let_binding state node attr = let {binders; lhs_type; let_rhs; _} = node in let fields = if lhs_type = None then 2 else 3 in - let () = + let fields = if attr = [] then fields else fields+1 in + let arity = let state = state#pad fields 0 in pp_node state ""; - pp_binders state binders in - let () = + pp_binders state binders; 0 in + let arity = match lhs_type with - None -> () + None -> arity | Some (_, type_expr) -> - let state = state#pad fields 1 in + let state = state#pad fields (arity+1) in pp_node state ""; - pp_type_expr (state#pad 1 0) type_expr in - let () = - let state = state#pad fields (fields - 1) in + pp_type_expr (state#pad 1 0) type_expr; + arity+1 in + let arity = + let state = state#pad fields (arity+1) in pp_node state ""; - pp_expr (state#pad 1 0) let_rhs + pp_expr (state#pad 1 0) let_rhs; + arity+1 in + let () = + if attr <> [] then + let state = state#pad fields (arity+1) in + pp_node state ""; + let length = List.length attr in + let apply len rank = pp_ident (state#pad len rank) + in List.iteri (apply length) attr in () and pp_type_decl state decl = @@ -838,28 +848,39 @@ and pp_fun_expr state node = in () and pp_let_in state node = - let {binding; body; _} = node in + let {binding; body; attributes; _} = node in let {binders; lhs_type; let_rhs; _} = binding in let fields = if lhs_type = None then 3 else 4 in - let () = + let fields = if attributes = [] then fields else fields+1 in + let arity = let state = state#pad fields 0 in pp_node state ""; - pp_binders state binders in - let () = + pp_binders state binders; 0 in + let arity = match lhs_type with - None -> () + None -> arity | Some (_, type_expr) -> - let state = state#pad fields 1 in + let state = state#pad fields (arity+1) in pp_node state ""; - pp_type_expr (state#pad 1 0) type_expr in - let () = - let state = state#pad fields (fields - 2) in + pp_type_expr (state#pad 1 0) type_expr; + arity+1 in + let arity = + let state = state#pad fields (arity+1) in pp_node state ""; - pp_expr (state#pad 1 0) let_rhs in - let () = - let state = state#pad fields (fields - 1) in + pp_expr (state#pad 1 0) let_rhs; + arity+1 in + let arity = + let state = state#pad fields (arity+1) in pp_node state ""; - pp_expr (state#pad 1 0) body + pp_expr (state#pad 1 0) body; + arity+1 in + let () = + if attributes <> [] then + let state = state#pad fields (arity+1) in + pp_node state ""; + let length = List.length attributes in + let apply len rank = pp_ident (state#pad len rank) + in List.iteri (apply length) attributes in () and pp_tuple_expr state {value; _} = 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..2880157db 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 Stdlib.Error error + +let parse parser : ('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/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/check_dot_git_is_dir.sh b/src/passes/1-parser/cameligo/check_dot_git_is_dir.sh deleted file mode 100755 index 7df363999..000000000 --- a/src/passes/1-parser/cameligo/check_dot_git_is_dir.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh - -set -e - -if test -d ../../.git; then - echo true > dot_git_is_dir -else - echo false > dot_git_is_dir - cat .git >> dot_git_is_dir -fi diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune index 63f695550..57806ff56 100644 --- a/src/passes/1-parser/cameligo/dune +++ b/src/passes/1-parser/cameligo/dune @@ -1,14 +1,21 @@ +;; 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) - (modules AST cameligo Parser ParserLog LexToken) + (modules + Scoping AST cameligo Parser ParserLog LexToken) (libraries menhirLib parser_shared @@ -20,6 +27,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 +47,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 +58,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) + (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=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/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 d37600adc..59a7089d5 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -1,129 +1,103 @@ open Trace -module Parser = Parser_pascaligo.Parser module AST = Parser_pascaligo.AST -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 Parser = Parser_pascaligo.Parser -module Errors = struct +module Errors = + struct + let reserved_name Region.{value; region} = + let title () = Printf.sprintf "reserved name \"%s\"" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ 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 non_linear_pattern Region.{value; region} = + let title () = + Printf.sprintf "repeated variable \"%s\" in this pattern" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let reserved_name Region.{value; region} = - let title () = Printf.sprintf "reserved name \"%s\"" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + let duplicate_parameter Region.{value; region} = + let title () = + Printf.sprintf "duplicate parameter \"%s\"" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let non_linear_pattern Region.{value; region} = - let title () = Printf.sprintf "repeated variable \"%s\" in this pattern" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + let duplicate_variant Region.{value; region} = + let title () = + Printf.sprintf "duplicate variant \"%s\" in this\ + type declaration" value in + let message () = "" in + let data = [ + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region)] + in error ~data title message - let duplicate_parameter Region.{value; region} = - let title () = Printf.sprintf "duplicate parameter \"%s\"" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message + let unrecognized_error source (start: Lexing.position) + (stop: 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 message () = + 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) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) + file in + let loc = Region.make ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in + let data = [ + ("unrecognized_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] + in error ~data title message - let duplicate_variant Region.{value; region} = - let title () = Printf.sprintf "duplicate variant \"%s\" in this\ - type declaration" value in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ region) - ] in - error ~data title message - - let detached_attributes (attrs: AST.attributes) = - let title () = "detached attributes" in - let message () = "" in - let data = [ - ("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ attrs.region) - ] 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 = [ - ("unrecognized_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) - ] in - error ~data title message + let parser_error source (start: Lexing.position) + (stop: 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 message () = + 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) + stop.pos_lnum (stop.pos_cnum - stop.pos_bol) + file in + let loc = + if start.pos_cnum = -1 then + Region.make + ~start:(Pos.min ~file:source) ~stop:(Pos.from_byte stop) + else + Region.make ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte stop) in + let data = + [("parser_loc", + fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] 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 end open Errors @@ -131,35 +105,29 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a let parse (parser: 'a parser) source lexbuf = - let Lexer.{read ; close ; _} = Lexer.open_token_stream None in + let Lexer.{read; close; _} = Lexer.open_token_stream None in let result = - try - ok (parser read lexbuf) - with - SyntaxError.Error (Non_linear_pattern var) -> - fail @@ (non_linear_pattern var) - | SyntaxError.Error (Duplicate_parameter name) -> - fail @@ (duplicate_parameter name) - | SyntaxError.Error (Duplicate_variant name) -> - fail @@ (duplicate_variant name) - | SyntaxError.Error (Reserved_name name) -> - fail @@ (reserved_name name) - | SyntaxError.Error (Detached_attributes attrs) -> - fail @@ (detached_attributes attrs) + try ok (parser read lexbuf) with + Lexer.Error e -> + fail @@ lexer_error e | 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) - | Lexer.Error e -> - fail @@ (lexer_error e) + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ parser_error source start stop lexbuf + | Scoping.Error (Scoping.Non_linear_pattern var) -> + fail @@ non_linear_pattern var + | Scoping.Error (Duplicate_parameter name) -> + fail @@ duplicate_parameter name + | Scoping.Error (Duplicate_variant name) -> + fail @@ duplicate_variant name + | Scoping.Error (Reserved_name name) -> + fail @@ reserved_name name | _ -> - let _ = Printexc.print_backtrace Pervasives.stdout in + 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) - in - close (); - result + let stop = Lexing.lexeme_end_p lexbuf in + fail @@ unrecognized_error source start stop lexbuf + in close (); result let parse_file (source: string) : AST.t result = let pp_input = 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/.links b/src/passes/1-parser/pascaligo/.links index a29429a42..6cc2d4c32 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 @@ -19,5 +18,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/ParserAPI.mli ../shared/ParserAPI.ml ../shared/LexerUnit.ml +../shared/ParserUnit.mli ../shared/ParserUnit.ml +../shared/Memo.mli +../shared/Memo.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index a855ea46e..5f95dc3e5 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -25,6 +25,7 @@ type 'a reg = 'a Region.reg type keyword = Region.t type kwd_and = Region.t +type kwd_attributes = Region.t type kwd_begin = Region.t type kwd_block = Region.t type kwd_case = Region.t @@ -109,7 +110,7 @@ type field_name = string reg type map_name = string reg type set_name = string reg type constr = string reg -type attribute = string reg +type attribute = string reg (* Parentheses *) @@ -144,12 +145,13 @@ type t = { and ast = t -and attributes = attribute list reg - and declaration = - TypeDecl of type_decl reg + TypeDecl of type_decl reg | ConstDecl of const_decl reg -| FunDecl of fun_decl reg +| FunDecl of fun_decl reg +| AttrDecl of attr_decl + +and attr_decl = string reg ne_injection reg and const_decl = { kwd_const : kwd_const; @@ -159,7 +161,7 @@ and const_decl = { equal : equal; init : expr; terminator : semi option; - attributes : attributes; + attributes : attr_decl option } (* Type declarations *) @@ -217,7 +219,7 @@ and fun_decl = { block_with : (block reg * kwd_with) option; return : expr; terminator : semi option; - attributes : attributes; + attributes : attr_decl option } and parameters = (param_decl, semi) nsepseq par reg @@ -260,11 +262,12 @@ and statements = (statement, semi) nsepseq and statement = Instr of instruction | Data of data_decl +| Attr of attr_decl and data_decl = LocalConst of const_decl reg -| LocalVar of var_decl reg -| LocalFun of fun_decl reg +| LocalVar of var_decl reg +| LocalFun of fun_decl reg and var_decl = { kwd_var : kwd_var; @@ -562,6 +565,7 @@ and field_assign = { equal : equal; field_expr : expr } + and record = field_assign reg ne_injection and projection = { diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index 598b6de4f..620be977c 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -28,6 +28,11 @@ type lexeme = string (* TOKENS *) +type attribute = { + header : string; + string : lexeme Region.reg +} + type t = (* Literals *) @@ -151,8 +156,7 @@ val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index 5a1e47c76..542a36c1e 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -26,6 +26,11 @@ let rollback buffer = (* TOKENS *) +type attribute = { + header : string; + string : lexeme Region.reg +} + type t = (* Literals *) @@ -33,7 +38,7 @@ type t = | Bytes of (lexeme * Hex.t) Region.reg | Int of (lexeme * Z.t) Region.reg | Nat of (lexeme * Z.t) Region.reg -| Mutez of (lexeme * Z.t) Region.reg +| Mutez of (lexeme * Z.t) Region.reg | Ident of lexeme Region.reg | Constr of lexeme Region.reg @@ -144,6 +149,11 @@ let proj_token = function | Constr Region.{region; value} -> region, sprintf "Constr \"%s\"" value +(* +| Attr {header; string={region; value}} -> + region, sprintf "Attr (\"%s\",\"%s\")" header value + *) + (* Symbols *) | SEMI region -> region, "SEMI" @@ -217,7 +227,7 @@ let proj_token = function | C_None region -> region, "C_None" | C_Some region -> region, "C_Some" - + (* Virtual tokens *) | EOF region -> region, "EOF" @@ -312,6 +322,7 @@ let to_lexeme = function | EOF _ -> "" +(* CONVERSIONS *) let to_string token ?(offsets=true) mode = let region, val_str = proj_token token in @@ -365,7 +376,7 @@ let keywords = [ let reserved = let open SSet in - empty |> add "args" + empty |> add "arguments" let constructors = [ (fun reg -> False reg); @@ -489,8 +500,6 @@ let eof region = EOF region type sym_err = Invalid_symbol -type attr_err = Invalid_attribute - let mk_sym lexeme region = match lexeme with (* Lexemes in common with all concrete syntaxes *) @@ -539,10 +548,9 @@ let mk_constr lexeme region = (* Attributes *) -let mk_attr _lexeme _region = - Error Invalid_attribute +type attr_err = Invalid_attribute -let mk_attr2 _lexeme _region = +let mk_attr _header _string _region = Error Invalid_attribute (* Predicates *) diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml index 4f1940204..042b0930a 100644 --- a/src/passes/1-parser/pascaligo/LexerMain.ml +++ b/src/passes/1-parser/pascaligo/LexerMain.ml @@ -7,3 +7,8 @@ module IO = end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) + +let () = + match M.trace () with + Stdlib.Ok _ -> () + | Error msg -> Printf.eprintf "\027[31m%s\027[0m%!" msg 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/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/Misc/pascaligo.ml b/src/passes/1-parser/pascaligo/Misc/pascaligo.ml new file mode 100644 index 000000000..c323496e5 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Misc/pascaligo.ml @@ -0,0 +1,39 @@ + +module ParserLog = Parser_pascaligo.ParserLog +module ParErr = Parser_pascaligo.ParErr +module SSet = Utils.String.Set + +(* Mock options. TODO: Plug in cmdliner. *) + +let pre_options = + EvalOpt.make + ~libs:[] + ~verbose:SSet.empty + ~offsets:true + ~mode:`Point + ~cmd:EvalOpt.Quiet + ~mono:true (* Monolithic API of Menhir for now *) +(* ~input:None *) +(* ~expr:true *) + +module Parser = + struct + type ast = AST.t + type expr = AST.expr + include Parser_pascaligo.Parser + end + +module ParserLog = + struct + type ast = AST.t + type expr = AST.expr + include Parser_pascaligo.ParserLog + end + +module PreUnit = ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog) +module Front = ParserAPI.Make (Lexer)(Parser)(ParErr) + +let issue_error point = + let error = Front.format_error ~offsets:true (* TODO: CLI *) + `Point (* TODO: CLI *) point + in Stdlib.Error error diff --git a/src/passes/1-parser/pascaligo/ParErr.ml b/src/passes/1-parser/pascaligo/ParErr.ml index 1e07f3913..a19b6aac2 100644 --- a/src/passes/1-parser/pascaligo/ParErr.ml +++ b/src/passes/1-parser/pascaligo/ParErr.ml @@ -58,13 +58,13 @@ let message = "\n" | 64 -> "\n" - | 517 -> + | 543 -> "\n" | 29 -> "\n" | 32 -> "\n" - | 515 -> + | 541 -> "\n" | 35 -> "\n" @@ -78,23 +78,9 @@ let message = "\n" | 67 -> "\n" - | 70 -> + | 68 -> "\n" - | 71 -> - "\n" - | 72 -> - "\n" - | 73 -> - "\n" - | 80 -> - "\n" - | 81 -> - "\n" - | 76 -> - "\n" - | 77 -> - "\n" - | 78 -> + | 84 -> "\n" | 85 -> "\n" @@ -102,241 +88,225 @@ let message = "\n" | 87 -> "\n" - | 88 -> - "\n" - | 512 -> - "\n" - | 358 -> - "\n" - | 359 -> - "\n" - | 499 -> - "\n" - | 362 -> - "\n" - | 360 -> - "\n" - | 361 -> - "\n" - | 363 -> - "\n" - | 364 -> - "\n" - | 365 -> - "\n" - | 366 -> - "\n" - | 367 -> - "\n" - | 475 -> - "\n" - | 476 -> - "\n" - | 477 -> - "\n" - | 478 -> - "\n" - | 496 -> - "\n" - | 503 -> - "\n" - | 502 -> - "\n" - | 371 -> - "\n" - | 372 -> + | 514 -> "\n" | 373 -> "\n" | 374 -> "\n" + | 507 -> + "\n" + | 377 -> + "\n" + | 375 -> + "\n" + | 376 -> + "\n" | 378 -> "\n" + | 379 -> + "\n" | 380 -> "\n" + | 381 -> + "\n" | 382 -> "\n" - | 383 -> + | 484 -> + "\n" + | 485 -> + "\n" + | 486 -> + "\n" + | 487 -> + "\n" + | 504 -> + "\n" + | 511 -> + "\n" + | 510 -> + "\n" + | 386 -> "\n" | 387 -> "\n" - | 384 -> - "\n" - | 385 -> + | 388 -> "\n" | 389 -> "\n" - | 390 -> - "\n" - | 391 -> - "\n" | 393 -> "\n" | 395 -> "\n" - | 399 -> - "\n" - | 396 -> - "\n" | 397 -> "\n" - | 375 -> + | 398 -> "\n" - | 381 -> + | 402 -> + "\n" + | 399 -> + "\n" + | 400 -> "\n" | 404 -> "\n" + | 408 -> + "\n" | 405 -> "\n" | 406 -> "\n" - | 492 -> + | 390 -> "\n" - | 493 -> - "\n" - | 494 -> - "\n" - | 407 -> - "\n" - | 488 -> - "\n" - | 408 -> - "\n" - | 452 -> - "\n" - | 447 -> - "\n" - | 453 -> - "\n" - | 409 -> - "\n" - | 410 -> - "\n" - | 416 -> - "\n" - | 420 -> - "\n" - | 421 -> - "\n" - | 411 -> - "\n" - | 424 -> - "\n" - | 425 -> - "\n" - | 426 -> + | 396 -> "\n" | 413 -> "\n" + | 414 -> + "\n" | 415 -> "\n" - | 435 -> + | 500 -> "\n" - | 436 -> + | 501 -> "\n" - | 437 -> + | 502 -> "\n" - | 440 -> + | 416 -> "\n" - | 441 -> + | 496 -> "\n" - | 469 -> + | 417 -> "\n" - | 470 -> + | 461 -> "\n" - | 473 -> + | 456 -> "\n" - | 472 -> + | 462 -> "\n" - | 438 -> + | 418 -> "\n" - | 467 -> + | 419 -> "\n" - | 439 -> - "\n" - | 69 -> - "\n" - | 428 -> + | 425 -> "\n" | 429 -> "\n" | 430 -> "\n" - | 431 -> + | 420 -> "\n" - | 432 -> + | 433 -> "\n" - | 508 -> + | 434 -> "\n" - | 521 -> + | 435 -> "\n" - | 159 -> + | 422 -> "\n" - | 523 -> + | 424 -> "\n" - | 137 -> + | 444 -> "\n" - | 150 -> + | 445 -> "\n" - | 166 -> + | 446 -> "\n" - | 167 -> + | 449 -> "\n" - | 158 -> + | 450 -> "\n" - | 173 -> + | 478 -> "\n" - | 152 -> + | 479 -> "\n" - | 168 -> + | 482 -> "\n" - | 169 -> + | 481 -> "\n" - | 175 -> + | 447 -> "\n" - | 177 -> + | 476 -> "\n" - | 179 -> + | 448 -> + "\n" + | 437 -> + "\n" + | 438 -> + "\n" + | 439 -> + "\n" + | 440 -> + "\n" + | 441 -> + "\n" + | 536 -> + "\n" + | 515 -> + "\n" + | 516 -> + "\n" + | 517 -> + "\n" + | 518 -> + "\n" + | 519 -> + "\n" + | 520 -> + "\n" + | 529 -> + "\n" + | 532 -> + "\n" + | 524 -> + "\n" + | 525 -> + "\n" + | 547 -> "\n" | 181 -> "\n" - | 183 -> + | 549 -> "\n" - | 160 -> + | 159 -> "\n" - | 170 -> + | 172 -> "\n" - | 157 -> + | 188 -> "\n" - | 163 -> + | 189 -> "\n" - | 187 -> + | 180 -> "\n" - | 92 -> + | 195 -> "\n" - | 318 -> + | 174 -> "\n" - | 319 -> + | 190 -> "\n" - | 322 -> + | 191 -> "\n" - | 323 -> + | 197 -> "\n" - | 356 -> + | 199 -> "\n" - | 351 -> + | 201 -> "\n" - | 353 -> + | 203 -> "\n" - | 93 -> + | 205 -> "\n" - | 94 -> + | 182 -> "\n" - | 338 -> + | 192 -> "\n" - | 95 -> + | 179 -> "\n" - | 96 -> + | 185 -> + "\n" + | 209 -> + "\n" + | 91 -> "\n" | 342 -> "\n" @@ -346,169 +316,231 @@ let message = "\n" | 347 -> "\n" - | 349 -> + | 371 -> "\n" - | 97 -> + | 366 -> "\n" - | 136 -> + | 368 -> + "\n" + | 92 -> + "\n" + | 93 -> + "\n" + | 362 -> + "\n" + | 94 -> + "\n" + | 95 -> + "\n" + | 144 -> + "\n" + | 145 -> + "\n" + | 148 -> + "\n" + | 149 -> + "\n" + | 364 -> + "\n" + | 96 -> + "\n" + | 158 -> + "\n" + | 100 -> + "\n" + | 217 -> + "\n" + | 218 -> + "\n" + | 220 -> + "\n" + | 221 -> + "\n" + | 224 -> + "\n" + | 225 -> + "\n" + | 358 -> + "\n" + | 353 -> + "\n" + | 355 -> "\n" | 101 -> "\n" - | 195 -> - "\n" - | 196 -> - "\n" - | 198 -> - "\n" - | 199 -> - "\n" - | 202 -> - "\n" - | 203 -> - "\n" - | 334 -> - "\n" - | 329 -> - "\n" - | 331 -> - "\n" | 102 -> "\n" + | 350 -> + "\n" + | 336 -> + "\n" + | 338 -> + "\n" | 103 -> "\n" - | 326 -> + | 332 -> "\n" - | 312 -> + | 330 -> "\n" - | 314 -> + | 333 -> "\n" - | 104 -> + | 334 -> "\n" - | 308 -> + | 328 -> "\n" - | 306 -> + | 156 -> + "\n" + | 105 -> + "\n" + | 320 -> + "\n" + | 321 -> + "\n" + | 322 -> + "\n" + | 323 -> + "\n" + | 324 -> + "\n" + | 137 -> + "\n" + | 138 -> + "\n" + | 139 -> + "\n" + | 140 -> + "\n" + | 151 -> + "\n" + | 106 -> + "\n" + | 107 -> "\n" | 309 -> "\n" | 310 -> "\n" - | 304 -> + | 154 -> "\n" - | 134 -> + | 177 -> "\n" - | 106 -> + | 312 -> "\n" - | 296 -> + | 315 -> "\n" - | 297 -> + | 316 -> "\n" - | 298 -> - "\n" - | 299 -> - "\n" - | 300 -> - "\n" - | 107 -> + | 133 -> "\n" | 108 -> "\n" - | 285 -> + | 69 -> "\n" - | 286 -> + | 70 -> "\n" - | 132 -> + | 71 -> "\n" - | 155 -> + | 72 -> + "\n" + | 79 -> + "\n" + | 80 -> + "\n" + | 75 -> + "\n" + | 76 -> + "\n" + | 77 -> + "\n" + | 109 -> + "\n" + | 110 -> + "\n" + | 111 -> + "\n" + | 112 -> + "\n" + | 114 -> + "\n" + | 117 -> + "\n" + | 230 -> + "\n" + | 231 -> + "\n" + | 269 -> + "\n" + | 293 -> + "\n" + | 270 -> + "\n" + | 272 -> + "\n" + | 273 -> + "\n" + | 294 -> + "\n" + | 300 -> + "\n" + | 299 -> + "\n" + | 303 -> + "\n" + | 302 -> + "\n" + | 240 -> + "\n" + | 283 -> + "\n" + | 284 -> + "\n" + | 287 -> "\n" | 288 -> "\n" | 291 -> "\n" - | 292 -> - "\n" - | 128 -> - "\n" - | 110 -> - "\n" - | 113 -> - "\n" - | 208 -> - "\n" - | 209 -> - "\n" - | 247 -> - "\n" - | 271 -> - "\n" - | 248 -> - "\n" - | 250 -> - "\n" - | 251 -> - "\n" - | 272 -> - "\n" - | 278 -> - "\n" | 277 -> "\n" - | 281 -> - "\n" - | 280 -> - "\n" - | 218 -> - "\n" - | 261 -> - "\n" - | 262 -> - "\n" - | 265 -> - "\n" - | 266 -> - "\n" - | 269 -> - "\n" - | 255 -> - "\n" - | 257 -> - "\n" - | 219 -> - "\n" - | 244 -> - "\n" - | 245 -> - "\n" - | 253 -> + | 279 -> "\n" | 241 -> "\n" - | 210 -> + | 266 -> + "\n" + | 267 -> "\n" | 275 -> "\n" - | 211 -> + | 263 -> "\n" - | 223 -> + | 232 -> "\n" - | 224 -> + | 297 -> "\n" - | 240 -> + | 233 -> "\n" - | 225 -> + | 245 -> "\n" - | 226 -> + | 246 -> "\n" - | 234 -> + | 262 -> "\n" - | 114 -> + | 247 -> + "\n" + | 248 -> + "\n" + | 256 -> "\n" | 118 -> "\n" - | 206 -> + | 122 -> "\n" - | 119 -> + | 228 -> "\n" - | 125 -> + | 123 -> + "\n" + | 130 -> "\n" | _ -> raise Not_found diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 905e25e17..9b41ba242 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -6,39 +6,6 @@ open Region open AST -type statement_attributes_mixed = - PInstr of instruction -| PData of data_decl -| PAttributes of attributes - -let attributes_to_statement (statement, statements) = - if (List.length statements = 0) then - match statement with - | PInstr i -> Instr i, [] - | PData d -> Data d, [] - | PAttributes a -> - let open! SyntaxError in - raise (Error (Detached_attributes a)) - else ( - let statements = (Region.ghost, statement) :: statements in - let rec inner result = function - | (t, PData (LocalConst const)) :: (_, PAttributes a) :: rest -> - inner (result @ [(t, Data (LocalConst {const with value = {const.value with attributes = a}}))]) rest - | (t, PData (LocalFun func)) :: (_, PAttributes a) :: rest -> - inner (result @ [(t, Data (LocalFun {func with value = {func.value with attributes = a}}))]) rest - | (t, PData d) :: rest -> - inner (result @ [(t, Data d)]) rest - | (t, PInstr i) :: rest -> - inner (result @ [(t, Instr i)]) rest - | (_, PAttributes _) :: rest -> - inner result rest - | [] -> - result - in - let result = inner [] statements in - (snd (List.hd result), List.tl result) - ) - (* END HEADER *) %} @@ -143,15 +110,24 @@ contract: nseq(declaration) EOF { {decl=$1; eof=$2} } declaration: - type_decl { TypeDecl $1 } -| const_decl { ConstDecl $1 } -| fun_decl { FunDecl $1 } + type_decl { TypeDecl $1 } +| const_decl { ConstDecl $1 } +| fun_decl { FunDecl $1 } +| attr_decl { AttrDecl $1 } + +(* Attribute declarations *) + +attr_decl: + open_attr_decl ";"? { $1 } + +open_attr_decl: + ne_injection("attributes","") { $1 } (* Type declarations *) 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 @@ -219,7 +195,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} } @@ -234,7 +210,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; @@ -258,7 +234,7 @@ field_decl: and value = {field_name=$1; colon=$2; field_type=$3} in {region; value} } - + fun_expr: "function" parameters ":" type_expr "is" expr { let stop = expr_to_region $6 in @@ -268,76 +244,72 @@ fun_expr: colon = $3; ret_type = $4; kwd_is = $5; - return = $6 - } + return = $6} in {region; value} } (* Function declarations *) open_fun_decl: "function" fun_name parameters ":" type_expr "is" - block - "with" expr { - let fun_name = SyntaxError.check_reserved_name $2 in - let stop = expr_to_region $9 in - let region = cover $1 stop - and value = {kwd_function = $1; - fun_name; - param = $3; - colon = $4; - ret_type = $5; - kwd_is = $6; - block_with = Some ($7, $8); - return = $9; - terminator = None; - attributes = {value = []; region = Region.ghost}} - in {region; value} } + block "with" expr { + Scoping.check_reserved_name $2; + let stop = expr_to_region $9 in + let region = cover $1 stop + and value = {kwd_function = $1; + fun_name = $2; + param = $3; + colon = $4; + ret_type = $5; + kwd_is = $6; + block_with = Some ($7, $8); + return = $9; + terminator = None; + attributes = None} + in {region; value} + } | "function" fun_name parameters ":" type_expr "is" expr { - let fun_name = SyntaxError.check_reserved_name $2 in - let stop = expr_to_region $7 in - let region = cover $1 stop - and value = {kwd_function = $1; - fun_name; - param = $3; - colon = $4; - ret_type = $5; - kwd_is = $6; - block_with = None; - return = $7; - terminator = None; - attributes = {value = []; region = Region.ghost}} + Scoping.check_reserved_name $2; + let stop = expr_to_region $7 in + let region = cover $1 stop + and value = {kwd_function = $1; + fun_name = $2; + param = $3; + colon = $4; + ret_type = $5; + kwd_is = $6; + block_with = None; + return = $7; + terminator = None; + attributes = None} in {region; value} } fun_decl: - open_fun_decl semi_attributes { - let attributes, terminator = $2 in - {$1 with value = {$1.value with terminator = terminator; attributes = attributes}} - } + open_fun_decl ";"? { + {$1 with value = {$1.value with terminator=$2}} } parameters: par(nsepseq(param_decl,";")) { let params = Utils.nsepseq_to_list ($1.value: _ par).inside - in SyntaxError.check_parameters params; - $1 } + 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} } @@ -349,25 +321,25 @@ block: "begin" sep_or_term_list(statement,";") "end" { let statements, terminator = $2 in let region = cover $1 $3 - and value = {opening = Begin $1; - statements = attributes_to_statement statements; + and value = {opening = Begin $1; + statements; terminator; - closing = End $3} + closing = End $3} in {region; value} } | "block" "{" sep_or_term_list(statement,";") "}" { let statements, terminator = $3 in let region = cover $1 $4 - and value = {opening = Block ($1,$2); - statements = attributes_to_statement statements; + and value = {opening = Block ($1,$2); + statements; terminator; - closing = Block $4} + closing = Block $4} in {region; value} } statement: - instruction { PInstr $1 } -| open_data_decl { PData $1 } -| attributes { PAttributes $1 } + instruction { Instr $1 } +| open_data_decl { Data $1 } +| open_attr_decl { Attr $1 } open_data_decl: open_const_decl { LocalConst $1 } @@ -385,10 +357,9 @@ open_const_decl: equal; init; terminator = None; - attributes = {value = []; region = Region.ghost}} + attributes = None} in {region; value} } - open_var_decl: "var" unqualified_decl(":=") { let name, colon, var_type, assign, init, stop = $2 in @@ -399,33 +370,18 @@ open_var_decl: var_type; assign; init; - terminator = None; - } + terminator=None} in {region; value} } 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 } - -attributes: - "attributes" "[" nsepseq(String,";") "]" { - let region = cover $1 $4 in - let value = (Utils.nsepseq_to_list $3) in - {region; value} - } - -semi_attributes: - /* empty */ { {value = []; region = Region.ghost}, None } - | ";" { {value = []; region = Region.ghost}, Some $1 } - | ";" attributes ";" { $2, Some $1 } + in $1, $2, $3, $4, $5, region } const_decl: - open_const_decl semi_attributes { - let attributes, terminator = $2 in - {$1 with value = {$1.value with terminator = terminator; attributes = attributes }} - } + open_const_decl ";"? { + {$1 with value = {$1.value with terminator=$2}} } instruction: conditional { Cond $1 } @@ -589,7 +545,7 @@ clause_block: let statements, terminator = $2 in let region = cover $1 $3 in let value = {lbrace = $1; - inside = attributes_to_statement statements, terminator; + inside = statements, terminator; rbrace = $3} in ShortBlock {value; region} } @@ -629,7 +585,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) @@ -671,10 +627,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; @@ -689,13 +645,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.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 4a186980e..06c42718a 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -114,29 +114,25 @@ let rec print_tokens state ast = Utils.nseq_iter (print_decl state) decl; print_token state eof "EOF" -and print_attributes state attributes = - let attributes = List.fold_left (fun all a -> all ^ a.value ^ ";") "" attributes.value in - let line = - sprintf "attributes[%s]" - attributes - in Buffer.add_string state#buffer line +and print_attr_decl state = + print_ne_injection state "attributes" print_string and print_decl state = function TypeDecl decl -> print_type_decl state decl | ConstDecl decl -> print_const_decl state decl | FunDecl decl -> print_fun_decl state decl +| AttrDecl decl -> print_attr_decl state decl and print_const_decl state {value; _} = let {kwd_const; name; colon; const_type; - equal; init; terminator; attributes} = value in + equal; init; terminator; _} = value in print_token state kwd_const "const"; print_var state name; print_token state colon ":"; print_type_expr state const_type; print_token state equal "="; print_expr state init; - print_terminator state terminator; - print_attributes state attributes + print_terminator state terminator and print_type_decl state {value; _} = let {kwd_type; name; kwd_is; @@ -206,7 +202,7 @@ and print_type_tuple state {value; _} = and print_fun_decl state {value; _} = let {kwd_function; fun_name; param; colon; ret_type; kwd_is; block_with; - return; terminator; attributes } = value in + return; terminator; _} = value in print_token state kwd_function "function"; print_var state fun_name; print_parameters state param; @@ -220,7 +216,6 @@ and print_fun_decl state {value; _} = print_token state kwd_with "with"); print_expr state return; print_terminator state terminator; - print_attributes state attributes and print_fun_expr state {value; _} = let {kwd_function; param; colon; @@ -296,6 +291,7 @@ and print_statements state sequence = and print_statement state = function Instr instr -> print_instruction state instr | Data data -> print_data_decl state data +| Attr attr -> print_attr_decl state attr and print_instruction state = function Cond {value; _} -> print_conditional state value @@ -607,7 +603,7 @@ and print_field_assign state {value; _} = print_token state equal "="; print_expr state field_expr -and print_update_expr state {value; _} = +and print_update_expr state {value; _} = let {record; kwd_with; updates} = value in print_path state record; print_token state kwd_with "with"; @@ -688,10 +684,10 @@ and print_opening state lexeme = function print_token state kwd lexeme | KwdBracket (kwd, lbracket) -> print_token state kwd lexeme; - print_token state lbracket "{" + print_token state lbracket "[" and print_closing state = function - RBracket rbracket -> print_token state rbracket "}" + RBracket rbracket -> print_token state rbracket "]" | End kwd_end -> print_token state kwd_end "end" and print_binding state {value; _} = @@ -848,21 +844,27 @@ and pp_declaration state = function | FunDecl {value; region} -> pp_loc_node state "FunDecl" region; pp_fun_decl state value +| AttrDecl {value; region} -> + pp_loc_node state "AttrDecl" region; + pp_attr_decl state value + +and pp_attr_decl state = pp_ne_injection pp_string state and pp_fun_decl state decl = + let arity = 5 in let () = - let state = state#pad 5 0 in + let state = state#pad arity 0 in pp_ident state decl.fun_name in let () = - let state = state#pad 5 1 in + let state = state#pad arity 1 in pp_node state ""; pp_parameters state decl.param in let () = - let state = state#pad 5 2 in + let state = state#pad arity 2 in pp_node state ""; pp_type_expr (state#pad 1 0) decl.ret_type in let () = - let state = state#pad 5 3 in + let state = state#pad arity 3 in pp_node state ""; let statements = match decl.block_with with @@ -870,15 +872,16 @@ and pp_fun_decl state decl = | None -> Instr (Skip Region.ghost), [] in pp_statements state statements in let () = - let state = state#pad 5 4 in + let state = state#pad arity 4 in pp_node state ""; pp_expr (state#pad 1 0) decl.return in () and pp_const_decl state decl = - pp_ident (state#pad 3 0) decl.name; - pp_type_expr (state#pad 3 1) decl.const_type; - pp_expr (state#pad 3 2) decl.init + let arity = 3 in + pp_ident (state#pad arity 0) decl.name; + pp_type_expr (state#pad arity 1) decl.const_type; + pp_expr (state#pad arity 2) decl.init and pp_type_expr state = function TProd cartesian -> @@ -979,6 +982,9 @@ and pp_statement state = function | Data data_decl -> pp_node state "Data"; pp_data_decl (state#pad 1 0) data_decl +| Attr attr_decl -> + pp_node state "Attr"; + pp_attr_decl state attr_decl.value and pp_instruction state = function Cond {value; region} -> @@ -1161,18 +1167,18 @@ and pp_bin_cons state (head, _, tail) = and pp_injection : 'a.(state -> 'a -> unit) -> state -> 'a injection -> unit = fun printer state inj -> - let elements = Utils.sepseq_to_list inj.elements in - let length = List.length elements in - let apply len rank = printer (state#pad len rank) - in List.iteri (apply length) elements + let elements = Utils.sepseq_to_list inj.elements in + let length = List.length elements in + let apply len rank = printer (state#pad len rank) + in List.iteri (apply length) elements and pp_ne_injection : 'a.(state -> 'a -> unit) -> state -> 'a ne_injection -> unit = fun printer state inj -> - let ne_elements = Utils.nsepseq_to_list inj.ne_elements in - let length = List.length ne_elements in - let apply len rank = printer (state#pad len rank) - in List.iteri (apply length) ne_elements + let ne_elements = Utils.nsepseq_to_list inj.ne_elements in + let length = List.length ne_elements in + let apply len rank = printer (state#pad len rank) + in List.iteri (apply length) ne_elements and pp_tuple_pattern state tuple = let patterns = Utils.nsepseq_to_list tuple.inside in 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..9b2cc2f28 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 Stdlib.Error error - Error (Reserved_name name) -> - let () = Unit.close_all () in +let parse parser : ('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 96% rename from src/passes/1-parser/pascaligo/SyntaxError.ml rename to src/passes/1-parser/pascaligo/Scoping.ml index a2a7296e5..73a7012ac 100644 --- a/src/passes/1-parser/pascaligo/SyntaxError.ml +++ b/src/passes/1-parser/pascaligo/Scoping.ml @@ -1,12 +1,12 @@ [@@@warning "-42"] + 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 -| Detached_attributes of AST.attributes type error = t @@ -95,11 +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 - -let check_reserved_name_opt = function - Some var -> ignore (check_reserved_name var) -| None -> () (* 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 2ae8e0f60..000000000 --- a/src/passes/1-parser/pascaligo/SyntaxError.mli +++ /dev/null @@ -1,27 +0,0 @@ -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 -| Detached_attributes of AST.attributes - -type error = t - -exception Error of t - -module Ord : - sig - type t = AST.variable - val compare : t -> t -> int - end - -module VarSet : Set.S with type elt = Ord.t - -val check_reserved_name : AST.variable -> AST.variable -val check_reserved_name_opt : AST.variable option -> unit -val check_reserved_names : VarSet.t -> VarSet.t -val check_pattern : AST.pattern -> unit -val check_variants : AST.variant Region.reg list -> unit -val check_parameters : AST.param_decl list -> unit -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 a2e873338..2cd411592 100644 --- a/src/passes/1-parser/pascaligo/Tests/pp.ligo +++ b/src/passes/1-parser/pascaligo/Tests/pp.ligo @@ -63,12 +63,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/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/check_dot_git_is_dir.sh b/src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh deleted file mode 100755 index 7df363999..000000000 --- a/src/passes/1-parser/pascaligo/check_dot_git_is_dir.sh +++ /dev/null @@ -1,10 +0,0 @@ -#!/bin/sh - -set -e - -if test -d ../../.git; then - echo true > dot_git_is_dir -else - echo false > dot_git_is_dir - cat .git >> dot_git_is_dir -fi diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index 4e365191b..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,32 +53,21 @@ (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))) -;; 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/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..c60a3367c 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 ~file:source) + ~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 e972ad9c6..543bf9ea3 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,8 @@ $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 +../cameligo/Scoping.mli +../cameligo/Scoping.ml \ No newline at end of file diff --git a/src/passes/1-parser/reasonligo/LexToken.mli b/src/passes/1-parser/reasonligo/LexToken.mli index 3c8aadb96..09142e23d 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mli +++ b/src/passes/1-parser/reasonligo/LexToken.mli @@ -143,8 +143,7 @@ val mk_int : lexeme -> Region.t -> (token, int_err) result val mk_nat : lexeme -> Region.t -> (token, nat_err) result val mk_mutez : lexeme -> Region.t -> (token, int_err) result val mk_ident : lexeme -> Region.t -> (token, ident_err) result -val mk_attr : lexeme -> Region.t -> (token, attr_err) result -val mk_attr2 : lexeme -> Region.t -> (token, attr_err) result +val mk_attr : string -> lexeme -> Region.t -> (token, attr_err) result val mk_sym : lexeme -> Region.t -> (token, sym_err) result val mk_kwd : lexeme -> Region.t -> (token, kwd_err) result val mk_string : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/reasonligo/LexToken.mll b/src/passes/1-parser/reasonligo/LexToken.mll index 8949dc64f..e4689082a 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mll +++ b/src/passes/1-parser/reasonligo/LexToken.mll @@ -453,11 +453,10 @@ let mk_constr lexeme region = mk_constr' lexeme region lexicon (* Attributes *) -let mk_attr lexeme region = - Ok (Attr { value = lexeme; region }) - -let mk_attr2 _lexeme _region = - Error Invalid_attribute +let mk_attr header lexeme region = + if header = "[@" then + Ok (Attr Region.{value=lexeme; region}) + else Error Invalid_attribute (* Predicates *) 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/Misc/Misc.ml b/src/passes/1-parser/reasonligo/Misc/Misc.ml new file mode 100644 index 000000000..9e0ac54bf --- /dev/null +++ b/src/passes/1-parser/reasonligo/Misc/Misc.ml @@ -0,0 +1,65 @@ +type error = + IntErr of LexToken.int_err +| IdentErr of LexToken.ident_err +| NatErr of LexToken.nat_err +| SymErr of LexToken.sym_err +| KwdErr of LexToken.kwd_err + +let rec first_of_expr = function + ECase {value; _} -> + (match LexToken.mk_kwd "switch" value.kwd_match with + Error e -> Error (KwdErr e) + | Ok token -> Ok token) +| ECond {value; _} -> + (match LexToken.mk_kwd "if" value.kwd_if with + Error e -> Error (KwdErr e) + | Ok token -> Ok token) +| EPar {value; _} -> + (match LexToken.mk_sym "(" value.lpar with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EAnnot {value; _} -> + (match LexToken.mk_sym "(" value.lpar with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EUnit {value=opening, _; _} -> + (match LexToken.mk_sym "(" opening with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EBytes b -> + Ok (LexToken.mk_bytes (fst b.value) b.region) +| EVar v -> + (match LexToken.mk_ident v.value v.region with + Error e -> Error (IdentErr e) + | Ok token -> Ok token) +| ESeq {value; _} -> + let opening = + match value.compound with + BeginEnd (opening, _) + | Braces (opening, _) + | Brackets (opening, _) -> opening + in (match LexToken.mk_sym "{" opening with + Error e -> Error (SymErr e) + | Ok token -> Ok token) +| EProj {value; _} -> + let structure = value.struct_name in + (match LexToken.mk_ident structure.value structure.region with + Error e -> Error (IdentErr e) + | Ok token -> Ok token) +| EFun {value; _} -> + (match LexToken.mk_kwd "fun" value.kwd_fun with + Error e -> Error (KwdErr e) + | Ok token -> Ok token) +| _ -> failwith "TODO" +(* + +| ELogic expr -> first_of_logic_expr expr +| EArith expr -> first_of_arith_expr expr +| EString expr -> first_of_string_expr expr +| EList expr -> first_of_list_expr expr +| EConstr expr -> first_of_constr_expr expr +| ECall {value=expr,_; _} -> first_of_expr expr +| ERecord {value; _} -> (*field_assign reg ne_injection *) +| ETuple {value; _} -> (* (expr, comma) nsepseq *) +| ELetIn {value; _} -> first_of_let_in value + *) diff --git a/src/passes/1-parser/reasonligo/ParErr.ml b/src/passes/1-parser/reasonligo/ParErr.ml index 594f9ecd4..18b32b373 100644 --- a/src/passes/1-parser/reasonligo/ParErr.ml +++ b/src/passes/1-parser/reasonligo/ParErr.ml @@ -46,9 +46,9 @@ let message = "\n" | 11 -> "\n" - | 509 -> + | 528 -> "\n" - | 503 -> + | 61 -> "\n" | 48 -> "\n" @@ -68,335 +68,387 @@ let message = "\n" | 14 -> "\n" - | 60 -> - "\n" | 65 -> "\n" - | 505 -> + | 70 -> "\n" - | 145 -> + | 524 -> "\n" - | 146 -> + | 185 -> "\n" - | 144 -> + | 186 -> "\n" - | 329 -> + | 184 -> "\n" - | 331 -> + | 302 -> "\n" - | 330 -> + | 304 -> "\n" - | 61 -> + | 303 -> + "\n" + | 66 -> + "\n" + | 69 -> "\n" | 64 -> "\n" - | 59 -> + | 183 -> "\n" - | 143 -> + | 311 -> "\n" - | 338 -> + | 313 -> "\n" - | 340 -> + | 312 -> "\n" - | 339 -> + | 191 -> "\n" - | 151 -> - "\n" - | 152 -> - "\n" - | 78 -> - "\n" - | 325 -> - "\n" - | 327 -> - "\n" - | 326 -> - "\n" - | 92 -> - "\n" - | 155 -> + | 192 -> "\n" | 118 -> "\n" - | 125 -> + | 298 -> "\n" - | 87 -> + | 300 -> "\n" - | 105 -> - "\n" - | 107 -> - "\n" - | 108 -> - "\n" - | 106 -> - "\n" - | 88 -> - "\n" - | 93 -> - "\n" - | 80 -> - "\n" - | 81 -> - "\n" - | 82 -> + | 299 -> "\n" | 132 -> "\n" - | 334 -> - "\n" - | 336 -> - "\n" - | 335 -> - "\n" - | 133 -> - "\n" - | 136 -> - "\n" - | 137 -> - "\n" - | 157 -> - "\n" - | 159 -> + | 195 -> "\n" | 158 -> "\n" - | 512 -> + | 165 -> "\n" - | 218 -> + | 127 -> "\n" - | 514 -> + | 145 -> "\n" - | 216 -> + | 147 -> "\n" - | 250 -> + | 148 -> "\n" - | 248 -> + | 146 -> "\n" - | 249 -> + | 128 -> "\n" - | 230 -> + | 133 -> "\n" - | 235 -> - "\n" - | 252 -> - "\n" - | 254 -> - "\n" - | 255 -> - "\n" - | 258 -> - "\n" - | 219 -> - "\n" - | 226 -> - "\n" - | 227 -> - "\n" - | 260 -> - "\n" - | 262 -> - "\n" - | 264 -> - "\n" - | 266 -> - "\n" - | 194 -> - "\n" - | 195 -> - "\n" - | 206 -> - "\n" - | 215 -> - "\n" - | 199 -> - "\n" - | 207 -> - "\n" - | 208 -> - "\n" - | 196 -> - "\n" - | 197 -> - "\n" - | 198 -> - "\n" - | 256 -> - "\n" - | 257 -> - "\n" - | 277 -> - "\n" - | 233 -> - "\n" - | 279 -> - "\n" - | 67 -> - "\n" - | 463 -> - "\n" - | 464 -> - "\n" - | 387 -> + | 120 -> "\n" | 121 -> "\n" | 122 -> "\n" - | 120 -> + | 172 -> "\n" - | 466 -> + | 307 -> "\n" - | 467 -> + | 309 -> + "\n" + | 308 -> + "\n" + | 173 -> + "\n" + | 176 -> + "\n" + | 177 -> + "\n" + | 197 -> + "\n" + | 199 -> + "\n" + | 198 -> + "\n" + | 59 -> + "\n" + | 531 -> + "\n" + | 225 -> + "\n" + | 533 -> + "\n" + | 223 -> + "\n" + | 257 -> + "\n" + | 255 -> + "\n" + | 256 -> + "\n" + | 237 -> + "\n" + | 242 -> + "\n" + | 259 -> + "\n" + | 261 -> + "\n" + | 262 -> + "\n" + | 265 -> + "\n" + | 226 -> + "\n" + | 233 -> + "\n" + | 234 -> + "\n" + | 267 -> + "\n" + | 269 -> + "\n" + | 271 -> + "\n" + | 273 -> + "\n" + | 201 -> + "\n" + | 202 -> + "\n" + | 213 -> + "\n" + | 222 -> + "\n" + | 206 -> + "\n" + | 214 -> + "\n" + | 215 -> + "\n" + | 203 -> + "\n" + | 204 -> + "\n" + | 205 -> + "\n" + | 263 -> + "\n" + | 284 -> + "\n" + | 240 -> + "\n" + | 286 -> + "\n" + | 72 -> "\n" | 483 -> "\n" - | 492 -> + | 484 -> "\n" - | 469 -> + | 423 -> "\n" - | 470 -> + | 161 -> "\n" - | 468 -> + | 162 -> "\n" - | 471 -> + | 160 -> "\n" - | 472 -> - "\n" - | 473 -> - "\n" - | 475 -> - "\n" - | 476 -> - "\n" - | 477 -> - "\n" - | 478 -> + | 486 -> "\n" | 487 -> "\n" - | 488 -> + | 504 -> "\n" - | 474 -> + | 513 -> + "\n" + | 498 -> "\n" | 499 -> "\n" | 497 -> "\n" - | 465 -> + | 488 -> "\n" - | 321 -> + | 489 -> + "\n" + | 490 -> + "\n" + | 492 -> + "\n" + | 493 -> + "\n" + | 494 -> + "\n" + | 495 -> + "\n" + | 509 -> + "\n" + | 510 -> + "\n" + | 491 -> + "\n" + | 520 -> + "\n" + | 518 -> + "\n" + | 485 -> + "\n" + | 372 -> + "\n" + | 366 -> + "\n" + | 367 -> + "\n" + | 369 -> + "\n" + | 368 -> + "\n" + | 365 -> + "\n" + | 76 -> + "\n" + | 446 -> + "\n" + | 326 -> + "\n" + | 332 -> + "\n" + | 333 -> + "\n" + | 336 -> + "\n" + | 337 -> + "\n" + | 328 -> + "\n" + | 339 -> + "\n" + | 100 -> + "\n" + | 78 -> + "\n" + | 80 -> "\n" | 315 -> "\n" | 316 -> "\n" - | 318 -> + | 117 -> "\n" - | 317 -> - "\n" - | 314 -> - "\n" - | 71 -> - "\n" - | 410 -> - "\n" - | 298 -> - "\n" - | 304 -> - "\n" - | 305 -> - "\n" - | 308 -> - "\n" - | 309 -> - "\n" - | 300 -> - "\n" - | 178 -> - "\n" - | 73 -> - "\n" - | 75 -> - "\n" - | 419 -> - "\n" - | 420 -> - "\n" - | 77 -> - "\n" - | 160 -> - "\n" - | 412 -> - "\n" - | 413 -> - "\n" - | 415 -> - "\n" - | 416 -> - "\n" - | 193 -> - "\n" - | 229 -> - "\n" - | 74 -> - "\n" - | 447 -> + | 82 -> "\n" | 448 -> "\n" - | 456 -> + | 449 -> "\n" - | 457 -> + | 451 -> "\n" - | 459 -> + | 452 -> + "\n" + | 200 -> + "\n" + | 236 -> + "\n" + | 79 -> + "\n" + | 467 -> + "\n" + | 468 -> + "\n" + | 476 -> + "\n" + | 477 -> + "\n" + | 479 -> + "\n" + | 480 -> + "\n" + | 469 -> + "\n" + | 470 -> + "\n" + | 81 -> "\n" | 460 -> "\n" - | 449 -> + | 461 -> "\n" - | 450 -> + | 455 -> "\n" - | 76 -> + | 454 -> + "\n" + | 458 -> + "\n" + | 348 -> + "\n" + | 356 -> + "\n" + | 360 -> + "\n" + | 359 -> + "\n" + | 355 -> + "\n" + | 349 -> + "\n" + | 457 -> + "\n" + | 340 -> + "\n" + | 341 -> + "\n" + | 346 -> + "\n" + | 347 -> + "\n" + | 342 -> + "\n" + | 343 -> + "\n" + | 344 -> + "\n" + | 84 -> + "\n" + | 85 -> + "\n" + | 318 -> + "\n" + | 323 -> + "\n" + | 324 -> + "\n" + | 389 -> + "\n" + | 436 -> + "\n" + | 437 -> + "\n" + | 438 -> + "\n" + | 439 -> "\n" | 440 -> "\n" | 441 -> "\n" - | 425 -> + | 435 -> "\n" - | 422 -> + | 325 -> "\n" - | 428 -> + | 362 -> "\n" - | 429 -> + | 363 -> "\n" - | 434 -> + | 373 -> "\n" - | 438 -> + | 374 -> "\n" - | 437 -> + | 413 -> "\n" - | 433 -> + | 420 -> "\n" - | 423 -> + | 408 -> "\n" - | 427 -> + | 409 -> "\n" - | 162 -> + | 407 -> "\n" - | 163 -> + | 375 -> "\n" - | 290 -> + | 376 -> "\n" - | 295 -> - "\n" - | 296 -> - "\n" - | 357 -> - "\n" - | 400 -> - "\n" - | 401 -> + | 377 -> "\n" | 402 -> "\n" @@ -406,105 +458,69 @@ let message = "\n" | 405 -> "\n" - | 399 -> + | 417 -> "\n" - | 297 -> + | 418 -> "\n" - | 311 -> + | 401 -> "\n" - | 312 -> + | 429 -> "\n" - | 322 -> + | 427 -> "\n" - | 323 -> - "\n" - | 377 -> + | 364 -> "\n" | 384 -> "\n" - | 342 -> + | 385 -> "\n" - | 343 -> + | 383 -> "\n" - | 324 -> - "\n" - | 344 -> - "\n" - | 345 -> - "\n" - | 346 -> - "\n" - | 370 -> - "\n" - | 371 -> - "\n" - | 372 -> - "\n" - | 373 -> + | 378 -> "\n" | 379 -> "\n" | 380 -> "\n" - | 369 -> + | 394 -> + "\n" + | 395 -> + "\n" + | 396 -> + "\n" + | 397 -> + "\n" + | 399 -> + "\n" + | 398 -> "\n" | 393 -> "\n" - | 391 -> + | 320 -> "\n" - | 313 -> + | 321 -> "\n" - | 348 -> + | 86 -> "\n" - | 349 -> + | 87 -> "\n" - | 347 -> + | 88 -> "\n" - | 350 -> + | 89 -> "\n" - | 351 -> + | 90 -> "\n" - | 352 -> + | 91 -> "\n" - | 359 -> + | 96 -> "\n" - | 360 -> + | 97 -> "\n" - | 361 -> + | 98 -> "\n" - | 362 -> + | 111 -> "\n" - | 364 -> - "\n" - | 363 -> - "\n" - | 358 -> - "\n" - | 292 -> - "\n" - | 293 -> - "\n" - | 164 -> - "\n" - | 165 -> - "\n" - | 166 -> - "\n" - | 167 -> - "\n" - | 168 -> - "\n" - | 169 -> - "\n" - | 174 -> - "\n" - | 175 -> - "\n" - | 176 -> - "\n" - | 188 -> - "\n" - | 237 -> + | 244 -> "\n" | _ -> raise Not_found diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index a6eea7961..12f2e7f42 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} } @@ -240,21 +244,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 @@ -419,8 +427,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 -> @@ -468,8 +479,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 @@ -535,7 +547,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; @@ -555,6 +567,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..c2df027e2 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -6,39 +6,101 @@ 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 Stdlib.Error error + +let parse parser : ('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" - 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 + 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 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/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..5f6970ee0 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) + (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=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 ))) diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 7889c9c18..30277f72f 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,17 +44,18 @@ let abort msg = let help language extension () = let file = Filename.basename Sys.argv.(0) in printf "Usage: %s [