From 51ccc28e3ca27b5f69d91d2239de4e4b0a3ec0ed Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Sat, 4 Jan 2020 19:49:22 +0100 Subject: [PATCH 1/4] Sharing standalone lexers and parsers, and parser error API. --- src/passes/1-parser/cameligo/.links | 4 + src/passes/1-parser/cameligo/LexerMain.ml | 61 +------ src/passes/1-parser/cameligo/ParserAPI.mli | 22 --- src/passes/1-parser/cameligo/ParserMain.ml | 162 +++-------------- src/passes/1-parser/cameligo/dune | 6 +- src/passes/1-parser/pascaligo/.links | 4 + src/passes/1-parser/pascaligo/LexerMain.ml | 61 +------ src/passes/1-parser/pascaligo/ParserAPI.ml | 82 --------- src/passes/1-parser/pascaligo/ParserAPI.mli | 22 --- src/passes/1-parser/pascaligo/ParserMain.ml | 162 +++-------------- src/passes/1-parser/pascaligo/dune | 15 +- src/passes/1-parser/reasonligo/.links | 4 + src/passes/1-parser/reasonligo/LexerMain.ml | 61 +------ src/passes/1-parser/reasonligo/ParserAPI.ml | 82 --------- src/passes/1-parser/reasonligo/ParserAPI.mli | 22 --- src/passes/1-parser/reasonligo/ParserMain.ml | 164 +++--------------- src/passes/1-parser/reasonligo/dune | 2 +- .../{cameligo => shared}/ParserAPI.ml | 62 +++++-- src/passes/1-parser/shared/ParserAPI.mli | 60 +++++++ src/passes/1-parser/shared/dune | 10 +- 20 files changed, 227 insertions(+), 841 deletions(-) delete mode 100644 src/passes/1-parser/cameligo/ParserAPI.mli delete mode 100644 src/passes/1-parser/pascaligo/ParserAPI.ml delete mode 100644 src/passes/1-parser/pascaligo/ParserAPI.mli delete mode 100644 src/passes/1-parser/reasonligo/ParserAPI.ml delete mode 100644 src/passes/1-parser/reasonligo/ParserAPI.mli rename src/passes/1-parser/{cameligo => shared}/ParserAPI.ml (59%) create mode 100644 src/passes/1-parser/shared/ParserAPI.mli diff --git a/src/passes/1-parser/cameligo/.links b/src/passes/1-parser/cameligo/.links index eca6c8680..a29429a42 100644 --- a/src/passes/1-parser/cameligo/.links +++ b/src/passes/1-parser/cameligo/.links @@ -16,4 +16,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/Markup.mli ../shared/Utils.mli ../shared/Utils.ml +../shared/ParserAPI.mli +../shared/ParserAPI.ml +../shared/LexerUnit.ml +../shared/ParserUnit.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/cameligo/LexerMain.ml b/src/passes/1-parser/cameligo/LexerMain.ml index 80ae8b00d..e9775b803 100644 --- a/src/passes/1-parser/cameligo/LexerMain.ml +++ b/src/passes/1-parser/cameligo/LexerMain.ml @@ -1,56 +1,9 @@ -(** Driver for the LIGO lexer *) +(** Driver for the CameLIGO lexer *) -let extension = ".mligo" -let options = EvalOpt.read "CameLIGO" extension +module IO = + struct + let ext = ".mligo" + let options = EvalOpt.read "CameLIGO" ext + end -(** Error printing and exception tracing -*) -let () = Printexc.record_backtrace true - -let external_ text = - Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; - -(** {1 Preprocessing the input source and opening the input channels} *) - -(** Path for CPP inclusions (#include) -*) -let lib_path = - match options#libs with - [] -> "" - | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" - -let prefix = - match options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(file |> basename |> remove_extension) - -let suffix = ".pp" ^ extension - -let pp_input = - if Utils.String.Set.mem "cpp" options#verbose - then prefix ^ suffix - else let pp_input, pp_out = Filename.open_temp_file prefix suffix - in close_out pp_out; pp_input - -let cpp_cmd = - match options#input with - None | Some "-" -> - Printf.sprintf "cpp -traditional-cpp%s - > %s" - lib_path pp_input - | Some file -> - Printf.sprintf "cpp -traditional-cpp%s %s > %s" - lib_path file pp_input - -let () = - if Utils.String.Set.mem "cpp" options#verbose - then Printf.eprintf "%s\n%!" cpp_cmd; - if Sys.command cpp_cmd <> 0 then - external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) - -(** {1 Running the lexer on the input file} *) - -module Log = LexerLog.Make (Lexer.Make (LexToken)) - -let () = Log.trace ~offsets:options#offsets - options#mode (Some pp_input) options#cmd +module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) diff --git a/src/passes/1-parser/cameligo/ParserAPI.mli b/src/passes/1-parser/cameligo/ParserAPI.mli deleted file mode 100644 index 7d969a33c..000000000 --- a/src/passes/1-parser/cameligo/ParserAPI.mli +++ /dev/null @@ -1,22 +0,0 @@ -(** Generic parser API for LIGO *) - -module Make (Lexer: Lexer.S with module Token := LexToken) - (Parser: module type of Parser) - (ParErr: sig val message: int -> string end) : - sig - (* Monolithic and incremental APIs of Menhir for parsing *) - - val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t - val incr_contract : Lexer.instance -> AST.t - - (* Error handling *) - - type message = string - type valid = Lexer.token - type invalid = Lexer.token - type error = message * valid option * invalid - - exception Point of error - - val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string - end diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index 8ed546f50..855dc639e 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -1,145 +1,27 @@ (** Driver for the CameLIGO parser *) -let extension = ".mligo" -let options = EvalOpt.read "CameLIGO" extension +module IO = + struct + let ext = ".mligo" + let options = EvalOpt.read "CameLIGO" ext + end -open Printf +module ExtParser = + struct + type ast = AST.t + type expr = AST.expr + include Parser + end -(** Error printing and exception tracing -*) -let () = Printexc.record_backtrace true +module ExtParserLog = + struct + type ast = AST.t + include ParserLog + end -(** Extracting the input file -*) -let file = - match options#input with - None | Some "-" -> false - | Some _ -> true - -(** {1 Error printing and exception tracing} *) - -let () = Printexc.record_backtrace true - -let external_ text = - Utils.highlight (sprintf "External error: %s" text); exit 1;; - -(** {1 Preprocessing the input source and opening the input channels} *) - -(** Path for CPP inclusions (#include) -*) -let lib_path = - match options#libs with - [] -> "" - | libs -> let mk_I dir path = sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" - -let prefix = - match options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(file |> basename |> remove_extension) - -let suffix = ".pp" ^ extension - -let pp_input = - if Utils.String.Set.mem "cpp" options#verbose - then prefix ^ suffix - else let pp_input, pp_out = Filename.open_temp_file prefix suffix - in close_out pp_out; pp_input - -let cpp_cmd = - match options#input with - None | Some "-" -> - sprintf "cpp -traditional-cpp%s - > %s" - lib_path pp_input - | Some file -> - sprintf "cpp -traditional-cpp%s %s > %s" - lib_path file pp_input - -let () = - if Utils.String.Set.mem "cpp" options#verbose - then eprintf "%s\n%!" cpp_cmd; - if Sys.command cpp_cmd <> 0 then - external_ (sprintf "the command \"%s\" failed." cpp_cmd) - -(** {1 Instanciating the lexer} *) - -module Lexer = Lexer.Make (LexToken) -module Log = LexerLog.Make (Lexer) -module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) - -let lexer_inst = Lexer.open_token_stream (Some pp_input) -let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst - -and cout = stdout - -let log = Log.output_token ~offsets:options#offsets - options#mode options#cmd cout - -and close_all () = close (); close_out cout - -(** {1 Tokeniser} *) - -let tokeniser = read ~log - -(** {1 Main} *) - -let () = - try - let ast = - if options#mono - then ParserFront.mono_contract tokeniser buffer - else ParserFront.incr_contract lexer_inst in - if Utils.String.Set.mem "ast" options#verbose - then let buffer = Buffer.create 131 in - let state = ParserLog.mk_state - ~offsets:options#offsets - ~mode:options#mode - ~buffer in - begin - ParserLog.pp_ast state ast; - Buffer.output_buffer stdout buffer - end - else if Utils.String.Set.mem "ast-tokens" options#verbose - then let buffer = Buffer.create 131 in - let state = ParserLog.mk_state - ~offsets:options#offsets - ~mode:options#mode - ~buffer in - begin - ParserLog.print_tokens state ast; - Buffer.output_buffer stdout buffer - end - with - (* Lexing errors *) - Lexer.Error err -> - close_all (); - let msg = - Lexer.format_error ~offsets:options#offsets - options#mode err ~file - in prerr_string msg - - (* Incremental API of Menhir *) - | ParserFront.Point point -> - let () = close_all () in - let error = - ParserFront.format_error ~offsets:options#offsets - options#mode point - in eprintf "\027[31m%s\027[0m%!" error - - (* Monolithic API of Menhir *) - | Parser.Error -> - let () = close_all () in - let invalid, valid_opt = - match get_win () with - Lexer.Nil -> - assert false (* Safe: There is always at least EOF. *) - | Lexer.One invalid -> invalid, None - | Lexer.Two (invalid, valid) -> invalid, Some valid in - let point = "", valid_opt, invalid in - let error = - ParserFront.format_error ~offsets:options#offsets - options#mode point - in eprintf "\027[31m%s\027[0m%!" error - - (* I/O errors *) - | Sys_error msg -> Utils.highlight msg +module M = ParserUnit.Make (IO) + (Lexer.Make (LexToken)) + (AST) + (ExtParser) + (ParErr) + (ExtParserLog) diff --git a/src/passes/1-parser/cameligo/dune b/src/passes/1-parser/cameligo/dune index 786b20f31..8bfac351e 100644 --- a/src/passes/1-parser/cameligo/dune +++ b/src/passes/1-parser/cameligo/dune @@ -15,9 +15,9 @@ str simple-utils tezos-utils - getopt ) + getopt) (preprocess - (pps bisect_ppx --conditional) ) + (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared))) (executable @@ -32,7 +32,7 @@ (name ParserMain) (libraries parser_cameligo) (modules - ParErr ParserAPI ParserMain) + ParErr ParserMain) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_cameligo))) diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index eca6c8680..a29429a42 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -16,4 +16,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/Markup.mli ../shared/Utils.mli ../shared/Utils.ml +../shared/ParserAPI.mli +../shared/ParserAPI.ml +../shared/LexerUnit.ml +../shared/ParserUnit.ml Stubs/Simple_utils.ml diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml index 9838fcbc4..4f1940204 100644 --- a/src/passes/1-parser/pascaligo/LexerMain.ml +++ b/src/passes/1-parser/pascaligo/LexerMain.ml @@ -1,56 +1,9 @@ -(** Driver for the LIGO lexer *) +(** Driver for the PascaLIGO lexer *) -let extension = ".ligo" -let options = EvalOpt.read "PascaLIGO" extension +module IO = + struct + let ext = ".ligo" + let options = EvalOpt.read "PascaLIGO" ext + end -(** Error printing and exception tracing -*) -let () = Printexc.record_backtrace true - -let external_ text = - Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; - -(** {1 Preprocessing the input source and opening the input channels} *) - -(** Path for CPP inclusions (#include) -*) -let lib_path = - match options#libs with - [] -> "" - | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" - -let prefix = - match options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(file |> basename |> remove_extension) - -let suffix = ".pp" ^ extension - -let pp_input = - if Utils.String.Set.mem "cpp" options#verbose - then prefix ^ suffix - else let pp_input, pp_out = Filename.open_temp_file prefix suffix - in close_out pp_out; pp_input - -let cpp_cmd = - match options#input with - None | Some "-" -> - Printf.sprintf "cpp -traditional-cpp%s - > %s" - lib_path pp_input - | Some file -> - Printf.sprintf "cpp -traditional-cpp%s %s > %s" - lib_path file pp_input - -let () = - if Utils.String.Set.mem "cpp" options#verbose - then Printf.eprintf "%s\n%!" cpp_cmd; - if Sys.command cpp_cmd <> 0 then - external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) - -(** {1 Running the lexer on the input file} *) - -module Log = LexerLog.Make (Lexer.Make (LexToken)) - -let () = Log.trace ~offsets:options#offsets - options#mode (Some pp_input) options#cmd +module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) diff --git a/src/passes/1-parser/pascaligo/ParserAPI.ml b/src/passes/1-parser/pascaligo/ParserAPI.ml deleted file mode 100644 index df82173a9..000000000 --- a/src/passes/1-parser/pascaligo/ParserAPI.ml +++ /dev/null @@ -1,82 +0,0 @@ -(* Generic parser for LIGO *) - -(* Main functor *) - -module Make (Lexer: Lexer.S with module Token := LexToken) - (Parser: module type of Parser) - (ParErr: sig val message : int -> string end) = - struct - module I = Parser.MenhirInterpreter - module S = MenhirLib.General (* Streams *) - - (* The call [stack checkpoint] extracts the parser's stack out of - a checkpoint. *) - - let stack = function - I.HandlingError env -> I.stack env - | _ -> assert false - - (* The call [state checkpoint] extracts the number of the current - state out of a parser checkpoint. *) - - let state checkpoint : int = - match Lazy.force (stack checkpoint) with - S.Nil -> 0 (* WARNING: Hack. The first state should be 0. *) - | S.Cons (I.Element (s,_,_,_),_) -> I.number s - - (* The parser has successfully produced a semantic value. *) - - let success v = v - - (* The parser has suspended itself because of a syntax error. Stop. *) - - type message = string - type valid = Lexer.token - type invalid = Lexer.token - type error = message * valid option * invalid - - exception Point of error - - let failure get_win checkpoint = - let message = ParErr.message (state checkpoint) in - match get_win () with - Lexer.Nil -> assert false - | Lexer.One invalid -> - raise (Point (message, None, invalid)) - | Lexer.Two (invalid, valid) -> - raise (Point (message, Some valid, invalid)) - - (* The two Menhir APIs are called from the following two functions. *) - - let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t = - let supplier = I.lexer_lexbuf_to_supplier read buffer - and failure = failure get_win in - let parser = Parser.Incremental.contract buffer.Lexing.lex_curr_p in - let ast = I.loop_handle success failure supplier parser - in close (); ast - - let mono_contract = Parser.contract - - (* Errors *) - - let format_error ?(offsets=true) mode (msg, valid_opt, invalid) = - let invalid_region = LexToken.to_region invalid in - let header = - "Parse error " ^ invalid_region#to_string ~offsets mode in - let trailer = - match valid_opt with - None -> - if LexToken.is_eof invalid then "" - else let invalid_lexeme = LexToken.to_lexeme invalid in - Printf.sprintf ", before \"%s\"" invalid_lexeme - | Some valid -> - let valid_lexeme = LexToken.to_lexeme valid in - let s = Printf.sprintf ", after \"%s\"" valid_lexeme in - if LexToken.is_eof invalid then s - else - let invalid_lexeme = LexToken.to_lexeme invalid in - Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in - let header = header ^ trailer in - header ^ (if msg = "" then ".\n" else ":\n" ^ msg) - - end diff --git a/src/passes/1-parser/pascaligo/ParserAPI.mli b/src/passes/1-parser/pascaligo/ParserAPI.mli deleted file mode 100644 index afc0fb8ba..000000000 --- a/src/passes/1-parser/pascaligo/ParserAPI.mli +++ /dev/null @@ -1,22 +0,0 @@ -(** Generic parser API for LIGO *) - -module Make (Lexer: Lexer.S with module Token := LexToken) - (Parser: module type of Parser) - (ParErr: module type of ParErr) : - sig - (* Monolithic and incremental APIs of Menhir for parsing *) - - val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t - val incr_contract : Lexer.instance -> AST.t - - (* Error handling *) - - type message = string - type valid = Lexer.token - type invalid = Lexer.token - type error = message * valid option * invalid - - exception Point of error - - val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string - end diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 489008453..3fcae9dec 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -1,145 +1,27 @@ (** Driver for the PascaLIGO parser *) -let extension = ".ligo" -let options = EvalOpt.read "PascaLIGO" extension +module IO = + struct + let ext = ".ligo" + let options = EvalOpt.read "PascaLIGO" ext + end -open Printf +module ExtParser = + struct + type ast = AST.t + type expr = AST.expr + include Parser + end -(** Error printing and exception tracing -*) -let () = Printexc.record_backtrace true +module ExtParserLog = + struct + type ast = AST.t + include ParserLog + end -(** Extracting the input file -*) -let file = - match options#input with - None | Some "-" -> false - | Some _ -> true - -(** {1 Error printing and exception tracing} *) - -let () = Printexc.record_backtrace true - -let external_ text = - Utils.highlight (sprintf "External error: %s" text); exit 1;; - -(** {1 Preprocessing the input source and opening the input channels} *) - -(** Path for CPP inclusions (#include) -*) -let lib_path = - match options#libs with - [] -> "" - | libs -> let mk_I dir path = sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" - -let prefix = - match options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(file |> basename |> remove_extension) - -let suffix = ".pp" ^ extension - -let pp_input = - if Utils.String.Set.mem "cpp" options#verbose - then prefix ^ suffix - else let pp_input, pp_out = Filename.open_temp_file prefix suffix - in close_out pp_out; pp_input - -let cpp_cmd = - match options#input with - None | Some "-" -> - sprintf "cpp -traditional-cpp%s - > %s" - lib_path pp_input - | Some file -> - sprintf "cpp -traditional-cpp%s %s > %s" - lib_path file pp_input - -let () = - if Utils.String.Set.mem "cpp" options#verbose - then eprintf "%s\n%!" cpp_cmd; - if Sys.command cpp_cmd <> 0 then - external_ (sprintf "the command \"%s\" failed." cpp_cmd) - -(** {1 Instanciating the lexer} *) - -module Lexer = Lexer.Make (LexToken) -module Log = LexerLog.Make (Lexer) -module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) - -let lexer_inst = Lexer.open_token_stream (Some pp_input) -let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst - -and cout = stdout - -let log = Log.output_token ~offsets:options#offsets - options#mode options#cmd cout - -and close_all () = close (); close_out cout - -(** {1 Tokeniser} *) - -let tokeniser = read ~log - -(** {1 Main} *) - -let () = - try - let ast = - if options#mono - then ParserFront.mono_contract tokeniser buffer - else ParserFront.incr_contract lexer_inst in - if Utils.String.Set.mem "ast" options#verbose - then let buffer = Buffer.create 131 in - let state = ParserLog.mk_state - ~offsets:options#offsets - ~mode:options#mode - ~buffer in - begin - ParserLog.pp_ast state ast; - Buffer.output_buffer stdout buffer - end - else if Utils.String.Set.mem "ast-tokens" options#verbose - then let buffer = Buffer.create 131 in - let state = ParserLog.mk_state - ~offsets:options#offsets - ~mode:options#mode - ~buffer in - begin - ParserLog.print_tokens state ast; - Buffer.output_buffer stdout buffer - end - with - (* Lexing errors *) - Lexer.Error err -> - close_all (); - let msg = - Lexer.format_error ~offsets:options#offsets - options#mode err ~file - in prerr_string msg - - (* Incremental API of Menhir *) - | ParserFront.Point point -> - let () = close_all () in - let error = - ParserFront.format_error ~offsets:options#offsets - options#mode point - in eprintf "\027[31m%s\027[0m%!" error - - (* Monolithic API of Menhir *) - | Parser.Error -> - let () = close_all () in - let invalid, valid_opt = - match get_win () with - Lexer.Nil -> - assert false (* Safe: There is always at least EOF. *) - | Lexer.One invalid -> invalid, None - | Lexer.Two (invalid, valid) -> invalid, Some valid in - let point = "", valid_opt, invalid in - let error = - ParserFront.format_error ~offsets:options#offsets - options#mode point - in eprintf "\027[31m%s\027[0m%!" error - - (* I/O errors *) - | Sys_error msg -> Utils.highlight msg +module M = ParserUnit.Make (IO) + (Lexer.Make (LexToken)) + (AST) + (ExtParser) + (ParErr) + (ExtParserLog) diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index 908455acb..1c12ca706 100644 --- a/src/passes/1-parser/pascaligo/dune +++ b/src/passes/1-parser/pascaligo/dune @@ -10,15 +10,14 @@ (public_name ligo.parser.pascaligo) (modules AST pascaligo Parser ParserLog LexToken) (libraries - menhirLib - parser_shared - hex - simple-utils - tezos-utils - ) + menhirLib + parser_shared + hex + simple-utils + tezos-utils) (preprocess (pps bisect_ppx --conditional)) - (flags (:standard -open Parser_shared -open Simple_utils))) + (flags (:standard -open Parser_shared -open Simple_utils))) (executable (name LexerMain) @@ -33,7 +32,7 @@ (name ParserMain) (libraries parser_pascaligo) (modules - ParErr ParserAPI ParserMain) + ParErr ParserMain) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_shared -open Parser_pascaligo))) diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links index e827ae13e..e972ad9c6 100644 --- a/src/passes/1-parser/reasonligo/.links +++ b/src/passes/1-parser/reasonligo/.links @@ -16,6 +16,10 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/Markup.mli ../shared/Utils.mli ../shared/Utils.ml +../shared/ParserAPI.mli +../shared/ParserAPI.ml +../shared/LexerUnit.ml +../shared/ParserUnit.ml Stubs/Simple_utils.ml Stubs/Parser_cameligo.ml ../cameligo/AST.mli diff --git a/src/passes/1-parser/reasonligo/LexerMain.ml b/src/passes/1-parser/reasonligo/LexerMain.ml index b49af81ff..756a2f103 100644 --- a/src/passes/1-parser/reasonligo/LexerMain.ml +++ b/src/passes/1-parser/reasonligo/LexerMain.ml @@ -1,56 +1,9 @@ -(** Driver for the LIGO lexer *) +(** Driver for the ReasonLIGO lexer *) -let extension = ".religo" -let options = EvalOpt.read "ReasonLIGO" extension +module IO = + struct + let ext = ".religo" + let options = EvalOpt.read "ReasonLIGO" ext + end -(** Error printing and exception tracing -*) -let () = Printexc.record_backtrace true - -let external_ text = - Utils.highlight (Printf.sprintf "External error: %s" text); exit 1;; - -(** {1 Preprocessing the input source and opening the input channels} *) - -(** Path for CPP inclusions (#include) -*) -let lib_path = - match options#libs with - [] -> "" - | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" - -let prefix = - match options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(file |> basename |> remove_extension) - -let suffix = ".pp" ^ extension - -let pp_input = - if Utils.String.Set.mem "cpp" options#verbose - then prefix ^ suffix - else let pp_input, pp_out = Filename.open_temp_file prefix suffix - in close_out pp_out; pp_input - -let cpp_cmd = - match options#input with - None | Some "-" -> - Printf.sprintf "cpp -traditional-cpp%s - > %s" - lib_path pp_input - | Some file -> - Printf.sprintf "cpp -traditional-cpp%s %s > %s" - lib_path file pp_input - -let () = - if Utils.String.Set.mem "cpp" options#verbose - then Printf.eprintf "%s\n%!" cpp_cmd; - if Sys.command cpp_cmd <> 0 then - external_ (Printf.sprintf "the command \"%s\" failed." cpp_cmd) - -(** {1 Running the lexer on the input file} *) - -module Log = LexerLog.Make (Lexer.Make (LexToken)) - -let () = Log.trace ~offsets:options#offsets - options#mode (Some pp_input) options#cmd +module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) diff --git a/src/passes/1-parser/reasonligo/ParserAPI.ml b/src/passes/1-parser/reasonligo/ParserAPI.ml deleted file mode 100644 index df82173a9..000000000 --- a/src/passes/1-parser/reasonligo/ParserAPI.ml +++ /dev/null @@ -1,82 +0,0 @@ -(* Generic parser for LIGO *) - -(* Main functor *) - -module Make (Lexer: Lexer.S with module Token := LexToken) - (Parser: module type of Parser) - (ParErr: sig val message : int -> string end) = - struct - module I = Parser.MenhirInterpreter - module S = MenhirLib.General (* Streams *) - - (* The call [stack checkpoint] extracts the parser's stack out of - a checkpoint. *) - - let stack = function - I.HandlingError env -> I.stack env - | _ -> assert false - - (* The call [state checkpoint] extracts the number of the current - state out of a parser checkpoint. *) - - let state checkpoint : int = - match Lazy.force (stack checkpoint) with - S.Nil -> 0 (* WARNING: Hack. The first state should be 0. *) - | S.Cons (I.Element (s,_,_,_),_) -> I.number s - - (* The parser has successfully produced a semantic value. *) - - let success v = v - - (* The parser has suspended itself because of a syntax error. Stop. *) - - type message = string - type valid = Lexer.token - type invalid = Lexer.token - type error = message * valid option * invalid - - exception Point of error - - let failure get_win checkpoint = - let message = ParErr.message (state checkpoint) in - match get_win () with - Lexer.Nil -> assert false - | Lexer.One invalid -> - raise (Point (message, None, invalid)) - | Lexer.Two (invalid, valid) -> - raise (Point (message, Some valid, invalid)) - - (* The two Menhir APIs are called from the following two functions. *) - - let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t = - let supplier = I.lexer_lexbuf_to_supplier read buffer - and failure = failure get_win in - let parser = Parser.Incremental.contract buffer.Lexing.lex_curr_p in - let ast = I.loop_handle success failure supplier parser - in close (); ast - - let mono_contract = Parser.contract - - (* Errors *) - - let format_error ?(offsets=true) mode (msg, valid_opt, invalid) = - let invalid_region = LexToken.to_region invalid in - let header = - "Parse error " ^ invalid_region#to_string ~offsets mode in - let trailer = - match valid_opt with - None -> - if LexToken.is_eof invalid then "" - else let invalid_lexeme = LexToken.to_lexeme invalid in - Printf.sprintf ", before \"%s\"" invalid_lexeme - | Some valid -> - let valid_lexeme = LexToken.to_lexeme valid in - let s = Printf.sprintf ", after \"%s\"" valid_lexeme in - if LexToken.is_eof invalid then s - else - let invalid_lexeme = LexToken.to_lexeme invalid in - Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in - let header = header ^ trailer in - header ^ (if msg = "" then ".\n" else ":\n" ^ msg) - - end diff --git a/src/passes/1-parser/reasonligo/ParserAPI.mli b/src/passes/1-parser/reasonligo/ParserAPI.mli deleted file mode 100644 index 7d969a33c..000000000 --- a/src/passes/1-parser/reasonligo/ParserAPI.mli +++ /dev/null @@ -1,22 +0,0 @@ -(** Generic parser API for LIGO *) - -module Make (Lexer: Lexer.S with module Token := LexToken) - (Parser: module type of Parser) - (ParErr: sig val message: int -> string end) : - sig - (* Monolithic and incremental APIs of Menhir for parsing *) - - val mono_contract : (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> AST.t - val incr_contract : Lexer.instance -> AST.t - - (* Error handling *) - - type message = string - type valid = Lexer.token - type invalid = Lexer.token - type error = message * valid option * invalid - - exception Point of error - - val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string - end diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index 0af4c4a76..ee7d562de 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -1,145 +1,27 @@ -(** Driver for the Reason LIGO parser *) +(** Driver for the ReasonLIGO parser *) -let extension = ".religo" -let options = EvalOpt.read "ReasonLIGO" extension +module IO = + struct + let ext = ".religo" + let options = EvalOpt.read "ReasonLIGO" ext + end -open Printf +module ExtParser = + struct + type ast = AST.t + type expr = AST.expr + include Parser + end -(** Error printing and exception tracing -*) -let () = Printexc.record_backtrace true +module ExtParserLog = + struct + type ast = AST.t + include ParserLog + end -(** Extracting the input file -*) -let file = - match options#input with - None | Some "-" -> false - | Some _ -> true - -(** {1 Error printing and exception tracing} *) - -let () = Printexc.record_backtrace true - -let external_ text = - Utils.highlight (sprintf "External error: %s" text); exit 1;; - -(** {1 Preprocessing the input source and opening the input channels} *) - -(** Path for CPP inclusions (#include) -*) -let lib_path = - match options#libs with - [] -> "" - | libs -> let mk_I dir path = sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" - -let prefix = - match options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(file |> basename |> remove_extension) - -let suffix = ".pp" ^ extension - -let pp_input = - if Utils.String.Set.mem "cpp" options#verbose - then prefix ^ suffix - else let pp_input, pp_out = Filename.open_temp_file prefix suffix - in close_out pp_out; pp_input - -let cpp_cmd = - match options#input with - None | Some "-" -> - sprintf "cpp -traditional-cpp%s - > %s" - lib_path pp_input - | Some file -> - sprintf "cpp -traditional-cpp%s %s > %s" - lib_path file pp_input - -let () = - if Utils.String.Set.mem "cpp" options#verbose - then eprintf "%s\n%!" cpp_cmd; - if Sys.command cpp_cmd <> 0 then - external_ (sprintf "the command \"%s\" failed." cpp_cmd) - -(** {1 Instanciating the lexer} *) - -module Lexer = Lexer.Make (LexToken) -module Log = LexerLog.Make (Lexer) -module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) - -let lexer_inst = Lexer.open_token_stream (Some pp_input) -let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst - -and cout = stdout - -let log = Log.output_token ~offsets:options#offsets - options#mode options#cmd cout - -and close_all () = close (); close_out cout - -(** {1 Tokeniser} *) - -let tokeniser = read ~log - -(** {1 Main} *) - -let () = - try - let ast = - if options#mono - then ParserFront.mono_contract tokeniser buffer - else ParserFront.incr_contract lexer_inst in - if Utils.String.Set.mem "ast" options#verbose - then let buffer = Buffer.create 131 in - let state = ParserLog.mk_state - ~offsets:options#offsets - ~mode:options#mode - ~buffer in - begin - ParserLog.pp_ast state ast; - Buffer.output_buffer stdout buffer - end - else if Utils.String.Set.mem "ast-tokens" options#verbose - then let buffer = Buffer.create 131 in - let state = ParserLog.mk_state - ~offsets:options#offsets - ~mode:options#mode - ~buffer in - begin - ParserLog.print_tokens state ast; - Buffer.output_buffer stdout buffer - end - with - (* Lexing errors *) - Lexer.Error err -> - close_all (); - let msg = - Lexer.format_error ~offsets:options#offsets - options#mode err ~file - in prerr_string msg - - (* Incremental API of Menhir *) - | ParserFront.Point point -> - let () = close_all () in - let error = - ParserFront.format_error ~offsets:options#offsets - options#mode point - in eprintf "\027[31m%s\027[0m%!" error - - (* Monolithic API of Menhir *) - | Parser.Error -> - let () = close_all () in - let invalid, valid_opt = - match get_win () with - Lexer.Nil -> - assert false (* Safe: There is always at least EOF. *) - | Lexer.One invalid -> invalid, None - | Lexer.Two (invalid, valid) -> invalid, Some valid in - let point = "", valid_opt, invalid in - let error = - ParserFront.format_error ~offsets:options#offsets - options#mode point - in eprintf "\027[31m%s\027[0m%!" error - - (* I/O errors *) - | Sys_error msg -> Utils.highlight msg +module M = ParserUnit.Make (IO) + (Lexer.Make (LexToken)) + (AST) + (ExtParser) + (ParErr) + (ExtParserLog) diff --git a/src/passes/1-parser/reasonligo/dune b/src/passes/1-parser/reasonligo/dune index 12b0c6d27..63faf40ba 100644 --- a/src/passes/1-parser/reasonligo/dune +++ b/src/passes/1-parser/reasonligo/dune @@ -36,7 +36,7 @@ parser_reasonligo parser_cameligo) (modules - ParErr ParserAPI ParserMain) + ParErr ParserMain) (preprocess (pps bisect_ppx --conditional)) (flags (:standard -open Simple_utils -open Parser_cameligo -open Parser_shared -open Parser_reasonligo))) diff --git a/src/passes/1-parser/cameligo/ParserAPI.ml b/src/passes/1-parser/shared/ParserAPI.ml similarity index 59% rename from src/passes/1-parser/cameligo/ParserAPI.ml rename to src/passes/1-parser/shared/ParserAPI.ml index df82173a9..e24be2b48 100644 --- a/src/passes/1-parser/cameligo/ParserAPI.ml +++ b/src/passes/1-parser/shared/ParserAPI.ml @@ -1,9 +1,47 @@ (* Generic parser for LIGO *) +module type PARSER = + sig + (* The type of tokens, abstract syntax trees and expressions *) + + type token + type ast + type expr + + (* This exception is raised by the monolithic API functions. *) + + exception Error + + (* The monolithic API. *) + + val interactive_expr : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> expr + val contract : + (Lexing.lexbuf -> token) -> Lexing.lexbuf -> ast + + module MenhirInterpreter : + sig + (* The incremental API. *) + + include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE + with type token = token + end + + (* The entry point(s) to the incremental API. *) + + module Incremental : + sig + val interactive_expr : + Lexing.position -> expr MenhirInterpreter.checkpoint + val contract : + Lexing.position -> ast MenhirInterpreter.checkpoint + end + end + (* Main functor *) -module Make (Lexer: Lexer.S with module Token := LexToken) - (Parser: module type of Parser) +module Make (Lexer: Lexer.S) + (Parser: PARSER with type token = Lexer.Token.token) (ParErr: sig val message : int -> string end) = struct module I = Parser.MenhirInterpreter @@ -31,9 +69,9 @@ module Make (Lexer: Lexer.S with module Token := LexToken) (* The parser has suspended itself because of a syntax error. Stop. *) type message = string - type valid = Lexer.token - type invalid = Lexer.token - type error = message * valid option * invalid + type valid = Parser.token + type invalid = Parser.token + type error = message * valid option * invalid exception Point of error @@ -48,7 +86,7 @@ module Make (Lexer: Lexer.S with module Token := LexToken) (* The two Menhir APIs are called from the following two functions. *) - let incr_contract Lexer.{read; buffer; get_win; close; _} : AST.t = + let incr_contract Lexer.{read; buffer; get_win; close; _} : Parser.ast = let supplier = I.lexer_lexbuf_to_supplier read buffer and failure = failure get_win in let parser = Parser.Incremental.contract buffer.Lexing.lex_curr_p in @@ -60,21 +98,21 @@ module Make (Lexer: Lexer.S with module Token := LexToken) (* Errors *) let format_error ?(offsets=true) mode (msg, valid_opt, invalid) = - let invalid_region = LexToken.to_region invalid in + let invalid_region = Lexer.Token.to_region invalid in let header = "Parse error " ^ invalid_region#to_string ~offsets mode in let trailer = match valid_opt with None -> - if LexToken.is_eof invalid then "" - else let invalid_lexeme = LexToken.to_lexeme invalid in + if Lexer.Token.is_eof invalid then "" + else let invalid_lexeme = Lexer.Token.to_lexeme invalid in Printf.sprintf ", before \"%s\"" invalid_lexeme | Some valid -> - let valid_lexeme = LexToken.to_lexeme valid in + let valid_lexeme = Lexer.Token.to_lexeme valid in let s = Printf.sprintf ", after \"%s\"" valid_lexeme in - if LexToken.is_eof invalid then s + if Lexer.Token.is_eof invalid then s else - let invalid_lexeme = LexToken.to_lexeme invalid in + let invalid_lexeme = Lexer.Token.to_lexeme invalid in Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in let header = header ^ trailer in header ^ (if msg = "" then ".\n" else ":\n" ^ msg) diff --git a/src/passes/1-parser/shared/ParserAPI.mli b/src/passes/1-parser/shared/ParserAPI.mli new file mode 100644 index 000000000..79ca137c4 --- /dev/null +++ b/src/passes/1-parser/shared/ParserAPI.mli @@ -0,0 +1,60 @@ +(* Generic parser API for LIGO *) + +module type PARSER = + sig + (* The type of tokens. *) + + type token + type ast + type expr + + (* This exception is raised by the monolithic API functions. *) + + exception Error + + (* The monolithic API. *) + + val interactive_expr : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> expr + val contract : (Lexing.lexbuf -> token) -> Lexing.lexbuf -> ast + + (* The incremental API. *) + + module MenhirInterpreter : + sig + include MenhirLib.IncrementalEngine.INCREMENTAL_ENGINE + with type token = token + end + + (* The entry point(s) to the incremental API. *) + + module Incremental : + sig + val interactive_expr : + Lexing.position -> expr MenhirInterpreter.checkpoint + val contract : + Lexing.position -> ast MenhirInterpreter.checkpoint + end + end + +module Make (Lexer: Lexer.S) + (Parser: PARSER with type token = Lexer.Token.token) + (ParErr: sig val message : int -> string end) : + sig + (* Monolithic and incremental APIs of Menhir for parsing *) + + val mono_contract : + (Lexing.lexbuf -> Lexer.token) -> Lexing.lexbuf -> Parser.ast + val incr_contract : + Lexer.instance -> Parser.ast + + (* Error handling *) + + type message = string + type valid = Parser.token + type invalid = Parser.token + type error = message * valid option * invalid + + exception Point of error + + val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string + end diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune index ca41804a8..10e377a93 100644 --- a/src/passes/1-parser/shared/dune +++ b/src/passes/1-parser/shared/dune @@ -4,15 +4,17 @@ (name parser_shared) (public_name ligo.parser.shared) (libraries + menhirLib simple-utils uutf getopt - zarith - ) + zarith) (preprocess - (pps bisect_ppx --conditional) - ) + (pps bisect_ppx --conditional)) (modules + LexerUnit + ParserUnit + ParserAPI Lexer LexerLog Utils From 12619232dfd5e1afda4db7ddafad104f6065eacf Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Sat, 4 Jan 2020 23:32:50 +0100 Subject: [PATCH 2/4] Forgot to add. --- src/passes/1-parser/shared/LexerUnit.ml | 65 +++++++++ src/passes/1-parser/shared/ParserUnit.ml | 167 +++++++++++++++++++++++ 2 files changed, 232 insertions(+) create mode 100644 src/passes/1-parser/shared/LexerUnit.ml create mode 100644 src/passes/1-parser/shared/ParserUnit.ml diff --git a/src/passes/1-parser/shared/LexerUnit.ml b/src/passes/1-parser/shared/LexerUnit.ml new file mode 100644 index 000000000..8094bdddd --- /dev/null +++ b/src/passes/1-parser/shared/LexerUnit.ml @@ -0,0 +1,65 @@ +(* Functor to build a standalone LIGO lexer *) + +module type S = + sig + val ext : string (* LIGO file extension *) + val options : EvalOpt.options (* CLI options *) + end + +module Make (IO: S) (Lexer: Lexer.S) = + struct + open Printf + (* Error printing and exception tracing *) + + let () = Printexc.record_backtrace true + + let external_ text = + Utils.highlight (sprintf "External error: %s" text); exit 1 + + (* Preprocessing the input source and opening the input channels *) + + (* Path for CPP inclusions (#include) *) + + let lib_path = + match IO.options#libs with + [] -> "" + | libs -> let mk_I dir path = sprintf " -I %s%s" dir path + in List.fold_right mk_I libs "" + + let prefix = + match IO.options#input with + None | Some "-" -> "temp" + | Some file -> Filename.(file |> basename |> remove_extension) + + let suffix = ".pp" ^ IO.ext + + let pp_input = + if Utils.String.Set.mem "cpp" IO.options#verbose + then prefix ^ suffix + else let pp_input, pp_out = Filename.open_temp_file prefix suffix + in close_out pp_out; pp_input + + let cpp_cmd = + match IO.options#input with + None | Some "-" -> + sprintf "cpp -traditional-cpp%s - > %s" + lib_path pp_input + | Some file -> + sprintf "cpp -traditional-cpp%s %s > %s" + lib_path file pp_input + + let () = + if Utils.String.Set.mem "cpp" IO.options#verbose + then eprintf "%s\n%!" cpp_cmd; + if Sys.command cpp_cmd <> 0 then + external_ (sprintf "the command \"%s\" failed." cpp_cmd) + + (* Running the lexer on the input file *) + + module Log = LexerLog.Make (Lexer) + + let () = Log.trace ~offsets:IO.options#offsets + IO.options#mode (Some pp_input) + IO.options#cmd + + end diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml new file mode 100644 index 000000000..fe1af9559 --- /dev/null +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -0,0 +1,167 @@ +(* Functor to build a standalone LIGO parser *) + +module type S = + sig + val ext : string (* LIGO file extension *) + val options : EvalOpt.options (* CLI options *) + end + +module type Pretty = + sig + type state + type ast + val pp_ast : + state -> ast -> unit + val mk_state : + offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state + val print_tokens : state -> ast -> unit + end + +module Make (IO: S) + (Lexer: Lexer.S) + (AST: sig type t type expr end) + (Parser: ParserAPI.PARSER + with type ast = AST.t + and type expr = AST.expr + and type token = Lexer.token) + (ParErr: sig val message : int -> string end) + (ParserLog: Pretty with type ast = AST.t) = + struct + open Printf + + (* Error printing and exception tracing *) + + let () = Printexc.record_backtrace true + + let external_ text = + Utils.highlight (sprintf "External error: %s" text); exit 1 + + (* Extracting the input file *) + + let file = + match IO.options#input with + None | Some "-" -> false + | Some _ -> true + + (* Preprocessing the input source and opening the input channels *) + + (* Path for CPP inclusions (#include) *) + + let lib_path = + match IO.options#libs with + [] -> "" + | libs -> let mk_I dir path = sprintf " -I %s%s" dir path + in List.fold_right mk_I libs "" + + let prefix = + match IO.options#input with + None | Some "-" -> "temp" + | Some file -> Filename.(file |> basename |> remove_extension) + + let suffix = ".pp" ^ IO.ext + + let pp_input = + if Utils.String.Set.mem "cpp" IO.options#verbose + then prefix ^ suffix + else let pp_input, pp_out = Filename.open_temp_file prefix suffix + in close_out pp_out; pp_input + + let cpp_cmd = + match IO.options#input with + None | Some "-" -> + sprintf "cpp -traditional-cpp%s - > %s" + lib_path pp_input + | Some file -> + sprintf "cpp -traditional-cpp%s %s > %s" + lib_path file pp_input + + let () = + if Utils.String.Set.mem "cpp" IO.options#verbose + then eprintf "%s\n%!" cpp_cmd; + if Sys.command cpp_cmd <> 0 then + external_ (sprintf "the command \"%s\" failed." cpp_cmd) + + (* Instanciating the lexer *) + + module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) + + let lexer_inst = Lexer.open_token_stream (Some pp_input) + let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst + + and cout = stdout + + let close_all () = close (); close_out cout + + (* Tokeniser *) + + module Log = LexerLog.Make (Lexer) + + let log = Log.output_token ~offsets:IO.options#offsets + IO.options#mode IO.options#cmd cout + + let tokeniser = read ~log + + (* Main *) + + let () = + try + let ast = + if IO.options#mono + then ParserFront.mono_contract tokeniser buffer + else ParserFront.incr_contract lexer_inst in + if Utils.String.Set.mem "ast" IO.options#verbose + then let buffer = Buffer.create 131 in + let state = ParserLog.mk_state + ~offsets:IO.options#offsets + ~mode:IO.options#mode + ~buffer in + begin + ParserLog.pp_ast state ast; + Buffer.output_buffer stdout buffer + end + else if Utils.String.Set.mem "ast-tokens" IO.options#verbose + then let buffer = Buffer.create 131 in + let state = ParserLog.mk_state + ~offsets:IO.options#offsets + ~mode:IO.options#mode + ~buffer in + begin + ParserLog.print_tokens state ast; + Buffer.output_buffer stdout buffer + end + with + (* Lexing errors *) + Lexer.Error err -> + close_all (); + let msg = + Lexer.format_error ~offsets:IO.options#offsets + IO.options#mode err ~file + in prerr_string msg + + (* Incremental API of Menhir *) + | ParserFront.Point point -> + let () = close_all () in + let error = + ParserFront.format_error ~offsets:IO.options#offsets + IO.options#mode point + in eprintf "\027[31m%s\027[0m%!" error + + (* Monolithic API of Menhir *) + | Parser.Error -> + let () = close_all () in + let invalid, valid_opt = + match get_win () with + Lexer.Nil -> + assert false (* Safe: There is always at least EOF. *) + | Lexer.One invalid -> invalid, None + | Lexer.Two (invalid, valid) -> invalid, Some valid in + let point = "", valid_opt, invalid in + let error = + ParserFront.format_error ~offsets:IO.options#offsets + IO.options#mode point + in eprintf "\027[31m%s\027[0m%!" error + + (* I/O errors *) + | Sys_error msg -> Utils.highlight msg + + end From 9e7c97637cb460d550cc2fab160ec310db07c988 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Wed, 8 Jan 2020 16:39:52 +0100 Subject: [PATCH 3/4] Added support for language-specific parse errors for PascaLIGO: * Duplicate variants in the same type declaration * Duplicate parameter in the same function declaration * Shadowing of predefined value in a declaration I fixed the architecture for that support: ParserMain.ml is now where those specific errors are handled, and they are produced by the semantic actions of the parsers. --- src/passes/1-parser/cameligo/LexToken.mli | 2 + src/passes/1-parser/cameligo/LexToken.mll | 20 +- src/passes/1-parser/cameligo/ParserMain.ml | 12 +- src/passes/1-parser/pascaligo.ml | 89 +++-- src/passes/1-parser/pascaligo/AST.ml | 47 ++- src/passes/1-parser/pascaligo/AST.mli | 6 + src/passes/1-parser/pascaligo/LexToken.mli | 2 + src/passes/1-parser/pascaligo/LexToken.mll | 9 + src/passes/1-parser/pascaligo/Parser.mly | 144 +++++++- src/passes/1-parser/pascaligo/ParserMain.ml | 58 +++- src/passes/1-parser/pascaligo/SyntaxError.ml | 8 + src/passes/1-parser/pascaligo/SyntaxError.mli | 8 + src/passes/1-parser/pascaligo/dune | 3 +- src/passes/1-parser/reasonligo.ml | 36 +- src/passes/1-parser/reasonligo/LexToken.mli | 8 +- src/passes/1-parser/reasonligo/LexToken.mll | 316 +++++++++--------- src/passes/1-parser/reasonligo/Parser.mly | 4 +- src/passes/1-parser/reasonligo/ParserMain.ml | 29 +- .../1-parser/reasonligo/SyntaxError.mli | 4 +- src/passes/1-parser/shared/ParserAPI.ml | 25 +- src/passes/1-parser/shared/ParserAPI.mli | 8 +- src/passes/1-parser/shared/ParserUnit.ml | 44 ++- src/test/contracts/chain_id.ligo | 2 +- src/test/integration_tests.ml | 58 ++-- 24 files changed, 651 insertions(+), 291 deletions(-) create mode 100644 src/passes/1-parser/pascaligo/SyntaxError.ml create mode 100644 src/passes/1-parser/pascaligo/SyntaxError.mli diff --git a/src/passes/1-parser/cameligo/LexToken.mli b/src/passes/1-parser/cameligo/LexToken.mli index 16a8ac403..79fd2519c 100644 --- a/src/passes/1-parser/cameligo/LexToken.mli +++ b/src/passes/1-parser/cameligo/LexToken.mli @@ -137,12 +137,14 @@ type ident_err = Reserved_name type nat_err = Invalid_natural | Non_canonical_zero_nat type sym_err = Invalid_symbol +type kwd_err = Invalid_keyword 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_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 val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/cameligo/LexToken.mll b/src/passes/1-parser/cameligo/LexToken.mll index 0871c0d32..5c8136624 100644 --- a/src/passes/1-parser/cameligo/LexToken.mll +++ b/src/passes/1-parser/cameligo/LexToken.mll @@ -1,4 +1,6 @@ { + (* START HEADER *) + type lexeme = string let sprintf = Printf.sprintf @@ -236,8 +238,7 @@ let to_region token = proj_token token |> fst (* Injections *) -type int_err = - Non_canonical_zero +type int_err = Non_canonical_zero (* LEXIS *) @@ -258,8 +259,7 @@ let keywords = [ (fun reg -> Then reg); (fun reg -> True reg); (fun reg -> Type reg); - (fun reg -> With reg) -] + (fun reg -> With reg)] let reserved = let open SSet in @@ -323,8 +323,20 @@ let lexicon : lexis = cstr = build constructors; res = reserved} +(* Keywords *) + +type kwd_err = Invalid_keyword + +let mk_kwd ident region = + match SMap.find_opt ident lexicon.kwd with + Some mk_kwd -> Ok (mk_kwd region) + | None -> Error Invalid_keyword + +(* Identifiers *) + type ident_err = Reserved_name +(* END OF HEADER *) } (* START LEXER DEFINITION *) diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index 855dc639e..f1b03fd25 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -19,9 +19,9 @@ module ExtParserLog = include ParserLog end -module M = ParserUnit.Make (IO) - (Lexer.Make (LexToken)) - (AST) - (ExtParser) - (ParErr) - (ExtParserLog) +module MyLexer = Lexer.Make (LexToken) + +module Unit = + ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + +let () = Unit.run () diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 05c0af4df..e14600bc7 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -5,8 +5,9 @@ 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 Errors = struct +module Errors = struct let lexer_error (e: Lexer.error AST.reg) = let title () = "lexer error" in @@ -18,31 +19,59 @@ module Errors = struct ] in error ~data title message - let parser_error start end_ = - let title () = "parser error" in - let message () = "" in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) - in + let reserved_name Region.{value; region} = + let title () = Printf.sprintf "reserved name \"%s\"" value in + let message () = "" in let data = [ - ("parser_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) + ("location", + fun () -> Format.asprintf "%a" Location.pp_lift @@ region) ] in error ~data title message - - let unrecognized_error start end_ = - let title () = "unrecognized error" in + + let duplicate_parameter Region.{value; region} = + let title () = Printf.sprintf "duplicate parameter \"%s\"" value in let message () = "" in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) + 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 parser_error start end_ = + let title () = "parser error" in + let message () = "" in + let loc = Region.make + ~start:(Pos.from_byte start) + ~stop:(Pos.from_byte end_) in let data = [ - ("unrecognized_loc", + ("parser_loc", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) + ) + ] in + error ~data title message + + let unrecognized_error start end_ = + let title () = "unrecognized error" in + let message () = "" 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 @@ -52,19 +81,25 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) lexbuf = +let parse (parser: 'a parser) lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in - let result = + let result = try ok (parser read lexbuf) with - | Parser.Error -> + 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) + | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in - let end_ = Lexing.lexeme_end_p lexbuf in - fail @@ (parser_error start end_) - | Lexer.Error e -> + let end_ = Lexing.lexeme_end_p lexbuf + in fail @@ (parser_error start end_) + | 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 @@ -94,5 +129,5 @@ let parse_string (s:string) : AST.t result = parse (Parser.contract) lexbuf let parse_expression (s:string) : AST.expr result = - let lexbuf = Lexing.from_string s in + let lexbuf = Lexing.from_string s in parse (Parser.interactive_expr) lexbuf diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 826df1c6d..9aca3eaf3 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -760,4 +760,49 @@ let rhs_to_region = expr_to_region let selection_to_region = function FieldName {region; _} -| Component {region; _} -> region + | Component {region; _} -> region + +(* Extracting variables from patterns *) + +module Ord = + struct + type t = string Region.reg + let compare v1 v2 = + compare v1.value v2.value + end + +module VSet = Set.Make (Ord) + +let rec vars_of_pattern env = function + PConstr p -> vars_of_pconstr env p +| PVar v -> VSet.add v env +| PWild _ | PInt _ | PNat _ | PBytes _ | PString _ -> env +| PList l -> vars_of_plist env l +| PTuple t -> vars_of_ptuple env t.value + +and vars_of_pconstr env = function + PUnit _ | PFalse _ | PTrue _ | PNone _ -> env +| PSomeApp {value=_, {value={inside; _};_}; _} -> + vars_of_pattern env inside +| PConstrApp {value=_, Some tuple; _} -> + vars_of_ptuple env tuple.value +| PConstrApp {value=_,None; _} -> env + +and vars_of_plist env = function + PListComp {value; _} -> + vars_of_pinj env value +| PNil _ -> + env +| PParCons {value={inside; _}; _} -> + let head, _, tail = inside in + vars_of_pattern (vars_of_pattern env head) tail +| PCons {value; _} -> + Utils.nsepseq_foldl vars_of_pattern env value + +and vars_of_pinj env inj = + Utils.sepseq_foldl vars_of_pattern env inj.elements + +and vars_of_ptuple env {inside; _} = + Utils.nsepseq_foldl vars_of_pattern env inside + +let vars_of_pattern = vars_of_pattern VSet.empty diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index 5fddb96cb..70620a880 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -615,3 +615,9 @@ val lhs_to_region : lhs -> Region.t val rhs_to_region : rhs -> Region.t val if_clause_to_region : if_clause -> Region.t val selection_to_region : selection -> Region.t + +(* Extracting variables from patterns *) + +module VSet : Set.S with type elt = string Region.reg + +val vars_of_pattern : pattern -> VSet.t diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index aa906f8d8..0908eff3f 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -138,12 +138,14 @@ type ident_err = Reserved_name type nat_err = Invalid_natural | Non_canonical_zero_nat type sym_err = Invalid_symbol +type kwd_err = Invalid_keyword 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_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 val mk_bytes : lexeme -> Region.t -> token val mk_constr : lexeme -> Region.t -> token diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index 090a25825..f1d219655 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -389,6 +389,15 @@ let lexicon : lexis = cstr = build constructors; res = reserved} +(* Keywords *) + +type kwd_err = Invalid_keyword + +let mk_kwd ident region = + match SMap.find_opt ident lexicon.kwd with + Some mk_kwd -> Ok (mk_kwd region) + | None -> Error Invalid_keyword + (* Identifiers *) type ident_err = Reserved_name diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 322198752..efff9226f 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -6,7 +6,60 @@ open Region open AST -(* END HEADER *) +module SSet = Utils.String.Set + +let reserved = + let open SSet in + empty + |> add "get_force" + |> add "get_chain_id" + |> add "transaction" + |> add "get_contract" + |> add "get_entrypoint" + |> add "size" + |> add "int" + |> add "abs" + |> add "is_nat" + |> add "amount" + |> add "balance" + |> add "now" + |> add "unit" + |> add "source" + |> add "sender" + |> add "failwith" + |> add "bitwise_or" + |> add "bitwise_and" + |> add "bitwise_xor" + |> add "string_concat" + |> add "string_slice" + |> add "crypto_check" + |> add "crypto_hash_key" + |> add "bytes_concat" + |> add "bytes_slice" + |> add "bytes_pack" + |> add "bytes_unpack" + |> add "set_empty" + |> add "set_mem" + |> add "set_add" + |> add "set_remove" + |> add "set_iter" + |> add "set_fold" + |> add "list_iter" + |> add "list_fold" + |> add "list_map" + |> add "map_iter" + |> add "map_map" + |> add "map_fold" + |> add "map_remove" + |> add "map_update" + |> add "map_get" + |> add "map_mem" + |> add "sha_256" + |> add "sha_512" + |> add "blake2b" + |> add "cons" + + (* END HEADER *) %} (* See [ParToken.mly] for the definition of tokens. *) @@ -118,6 +171,10 @@ declaration: type_decl: "type" type_name "is" type_expr ";"? { + let () = + if SSet.mem $2.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $2)) in let stop = match $5 with Some region -> region @@ -185,6 +242,14 @@ type_tuple: sum_type: "|"? nsepseq(variant,"|") { + let add acc {value; _} = + if VSet.mem value.constr acc then + let open! SyntaxError in + raise (Error (Duplicate_variant value.constr)) + else VSet.add value.constr acc in + let variants = + Utils.nsepseq_foldl add VSet.empty $2 in + let () = ignore variants in let region = nsepseq_to_region (fun x -> x.region) $2 in TSum {region; value=$2} } @@ -225,6 +290,13 @@ fun_expr: "function" fun_name? parameters ":" type_expr "is" block "with" expr { + let () = + match $2 with + Some name -> + if SSet.mem name.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name name)) + | None -> () in let stop = expr_to_region $9 in let region = cover $1 stop and value = {kwd_function = $1; @@ -237,6 +309,13 @@ fun_expr: return = $9} in {region; value} } | "function" fun_name? parameters ":" type_expr "is" expr { + let () = + match $2 with + Some name -> + if SSet.mem name.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name name)) + | None -> () in let stop = expr_to_region $7 in let region = cover $1 stop and value = {kwd_function = $1; @@ -256,7 +335,7 @@ fun_decl: open_fun_decl { $1 } | fun_expr ";" { let region = cover $1.region $2 - and value = {fun_expr=$1; terminator= Some $2} + and value = {fun_expr=$1; terminator = Some $2} in {region; value} } open_fun_decl: @@ -266,10 +345,31 @@ open_fun_decl: in {region; value} } parameters: - par(nsepseq(param_decl,";")) { $1 } + par(nsepseq(param_decl,";")) { + let open! AST in + let contents : (param_decl, semi) Utils.nsepseq par reg = $1 in + let add acc = function + ParamConst {value; _} -> + if VSet.mem value.var acc then + let open! SyntaxError in + raise (Error (Duplicate_parameter value.var)) + else VSet.add value.var acc + | ParamVar {value; _} -> + if VSet.mem value.var acc then + let open! SyntaxError in + raise (Error (Duplicate_parameter value.var)) + else VSet.add value.var acc in + let params = + Utils.nsepseq_foldl add VSet.empty contents.value.inside in + let () = ignore params + in $1 } param_decl: "var" var ":" param_type { + let () = + if SSet.mem $2.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $2)) in let stop = type_expr_to_region $4 in let region = cover $1 stop and value = {kwd_var = $1; @@ -279,6 +379,10 @@ param_decl: in ParamVar {region; value} } | "const" var ":" param_type { + let () = + if SSet.mem $2.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $2)) in let stop = type_expr_to_region $4 in let region = cover $1 stop and value = {kwd_const = $1; @@ -346,13 +450,16 @@ open_var_decl: unqualified_decl(OP): var ":" type_expr OP expr { + let () = + if SSet.mem $1.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $1)) in let region = expr_to_region $5 in $1, $2, $3, $4, $5, region } const_decl: - open_const_decl { $1 } -| open_const_decl ";" { - {$1 with value = {$1.value with terminator = Some $2}} } + open_const_decl ";"? { + {$1 with value = {$1.value with terminator=$2}} } instruction: conditional { Cond $1 } @@ -555,6 +662,14 @@ cases(rhs): case_clause(rhs): pattern "->" rhs { + let vars = AST.vars_of_pattern $1 in + let is_reserved elt = SSet.mem elt.value reserved in + let inter = VSet.filter is_reserved vars in + let () = + if not (VSet.is_empty inter) then + let clash = VSet.choose inter in + let open! SyntaxError in + raise (Error (Reserved_name clash)) in fun rhs_to_region -> let start = pattern_to_region $1 in let region = cover start (rhs_to_region $3) @@ -596,6 +711,10 @@ for_loop: in For (ForInt {region; value}) } | "for" var arrow_clause? "in" collection expr block { + let () = + if SSet.mem $2.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $2)) in let region = cover $1 $7.region in let value = {kwd_for = $1; var = $2; @@ -613,12 +732,21 @@ collection: var_assign: var ":=" expr { + let () = + if SSet.mem $1.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $1)) in let region = cover $1.region (expr_to_region $3) and value = {name=$1; assign=$2; expr=$3} in {region; value} } arrow_clause: - "->" var { $1,$2 } + "->" var { + let () = + if SSet.mem $2.value reserved then + let open! SyntaxError in + raise (Error (Reserved_name $2)) + in $1,$2 } (* Expressions *) @@ -646,7 +774,7 @@ cond_expr: disj_expr: conj_expr { $1 } -| disj_expr "or" conj_expr { +| disj_expr "or" conj_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 3fcae9dec..8ed914f1b 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -19,9 +19,55 @@ module ExtParserLog = include ParserLog end -module M = ParserUnit.Make (IO) - (Lexer.Make (LexToken)) - (AST) - (ExtParser) - (ParErr) - (ExtParserLog) +module MyLexer = Lexer.Make (LexToken) + +module Unit = + ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + +open! SyntaxError + +let () = + try Unit.run () with + (* Ad hoc errors from the parser *) + + Error (Reserved_name name) -> + let () = Unit.close_all () in + let token = + MyLexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + Stdlib.Error _ -> + assert false (* Should not fail if [name] is valid. *) + | 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) + + | Error (Duplicate_parameter name) -> + let () = Unit.close_all () in + let token = + MyLexer.Token.mk_ident name.Region.value name.Region.region in + (match token with + Stdlib.Error _ -> + assert false (* Should not fail if [name] is valid. *) + | 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) + + | Error (Duplicate_variant name) -> + let () = Unit.close_all () in + let token = + MyLexer.Token.mk_constr name.Region.value name.Region.region in + let point = "Duplicate variant in this 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 diff --git a/src/passes/1-parser/pascaligo/SyntaxError.ml b/src/passes/1-parser/pascaligo/SyntaxError.ml new file mode 100644 index 000000000..4bdc77d88 --- /dev/null +++ b/src/passes/1-parser/pascaligo/SyntaxError.ml @@ -0,0 +1,8 @@ +type t = + Reserved_name of string Region.reg +| Duplicate_parameter of string Region.reg +| Duplicate_variant of string Region.reg + +type error = t + +exception Error of t diff --git a/src/passes/1-parser/pascaligo/SyntaxError.mli b/src/passes/1-parser/pascaligo/SyntaxError.mli new file mode 100644 index 000000000..4bdc77d88 --- /dev/null +++ b/src/passes/1-parser/pascaligo/SyntaxError.mli @@ -0,0 +1,8 @@ +type t = + Reserved_name of string Region.reg +| Duplicate_parameter of string Region.reg +| Duplicate_variant of string Region.reg + +type error = t + +exception Error of t diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index 1c12ca706..a75445932 100644 --- a/src/passes/1-parser/pascaligo/dune +++ b/src/passes/1-parser/pascaligo/dune @@ -8,7 +8,8 @@ (library (name parser_pascaligo) (public_name ligo.parser.pascaligo) - (modules AST pascaligo Parser ParserLog LexToken) + (modules + SyntaxError AST pascaligo Parser ParserLog LexToken) (libraries menhirLib parser_shared diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index dbf28b756..1d8b99bc5 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -29,31 +29,31 @@ module Errors = struct ] in error ~data title message - let parser_error start end_ = + let parser_error start end_ = let title () = "parser error" in - let message () = "" in - let loc = Region.make - ~start:(Pos.from_byte start) - ~stop:(Pos.from_byte end_) + let message () = "" 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 start end_ = + + let unrecognized_error start end_ = let title () = "unrecognized error" in let message () = "" 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 end_) in let data = [ ("location", fun () -> Format.asprintf "%a" Location.pp_lift @@ loc - ) + ) ] in error ~data title message @@ -63,13 +63,13 @@ open Errors type 'a parser = (Lexing.lexbuf -> LexToken.token) -> Lexing.lexbuf -> 'a -let parse (parser: 'a parser) lexbuf = +let parse (parser: 'a parser) lexbuf = let Lexer.{read ; close ; _} = Lexer.open_token_stream None in - let result = + let result = try ok (parser read lexbuf) - with - | SyntaxError.Error (WrongFunctionArguments e) -> + with + | SyntaxError.Error (WrongFunctionArguments e) -> fail @@ (wrong_function_arguments e) | Parser.Error -> let start = Lexing.lexeme_start_p lexbuf in @@ -86,7 +86,7 @@ let parse (parser: 'a parser) lexbuf = close (); result -let parse_file (source: string) : AST.t result = +let parse_file (source: string) : AST.t result = let pp_input = let prefix = Filename.(source |> basename |> remove_extension) and suffix = ".pp.religo" @@ -107,5 +107,5 @@ let parse_string (s:string) : AST.t result = parse (Parser.contract) lexbuf let parse_expression (s:string) : AST.expr result = - let lexbuf = Lexing.from_string s in + let lexbuf = Lexing.from_string s in parse (Parser.interactive_expr) lexbuf diff --git a/src/passes/1-parser/reasonligo/LexToken.mli b/src/passes/1-parser/reasonligo/LexToken.mli index b5fc9e74d..47f012427 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mli +++ b/src/passes/1-parser/reasonligo/LexToken.mli @@ -135,15 +135,17 @@ type ident_err = Reserved_name type nat_err = Invalid_natural | Non_canonical_zero_nat type sym_err = Invalid_symbol +type kwd_err = Invalid_keyword -val mk_string : lexeme -> Region.t -> token -val mk_bytes : lexeme -> Region.t -> token 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_constr : lexeme -> Region.t -> token 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 +val mk_bytes : lexeme -> Region.t -> token +val mk_constr : lexeme -> Region.t -> token val eof : Region.t -> token (* Predicates *) diff --git a/src/passes/1-parser/reasonligo/LexToken.mll b/src/passes/1-parser/reasonligo/LexToken.mll index 8525bfce4..4bf6bd8d6 100644 --- a/src/passes/1-parser/reasonligo/LexToken.mll +++ b/src/passes/1-parser/reasonligo/LexToken.mll @@ -1,4 +1,6 @@ { +(* START OF HEADER *) + type lexeme = string let sprintf = Printf.sprintf @@ -91,116 +93,117 @@ type t = | EOF of Region.t (* End of file *) + type token = t let proj_token = function - | CAT region -> region, "CAT" - | MINUS region -> region, "MINUS" - | PLUS region -> region, "PLUS" - | SLASH region -> region, "SLASH" - | TIMES region -> region, "TIMES" - | LPAR region -> region, "LPAR" - | RPAR region -> region, "RPAR" - | LBRACKET region -> region, "LBRACKET" - | RBRACKET region -> region, "RBRACKET" - | LBRACE region -> region, "LBRACE" - | RBRACE region -> region, "RBRACE" - | COMMA region -> region, "COMMA" - | SEMI region -> region, "SEMI" - | VBAR region -> region, "VBAR" - | COLON region -> region, "COLON" - | DOT region -> region, "DOT" - | ELLIPSIS region -> region, "ELLIPSIS" - | WILD region -> region, "WILD" - | EQ region -> region, "EQ" - | EQEQ region -> region, "EQEQ" - | NE region -> region, "NE" - | LT region -> region, "LT" - | GT region -> region, "GT" - | LE region -> region, "LE" - | GE region -> region, "GE" - | ARROW region -> region, "ARROW" - | BOOL_OR region -> region, "BOOL_OR" - | BOOL_AND region -> region, "BOOL_AND" - | Ident Region.{region; value} -> + CAT region -> region, "CAT" +| MINUS region -> region, "MINUS" +| PLUS region -> region, "PLUS" +| SLASH region -> region, "SLASH" +| TIMES region -> region, "TIMES" +| LPAR region -> region, "LPAR" +| RPAR region -> region, "RPAR" +| LBRACKET region -> region, "LBRACKET" +| RBRACKET region -> region, "RBRACKET" +| LBRACE region -> region, "LBRACE" +| RBRACE region -> region, "RBRACE" +| COMMA region -> region, "COMMA" +| SEMI region -> region, "SEMI" +| VBAR region -> region, "VBAR" +| COLON region -> region, "COLON" +| DOT region -> region, "DOT" +| ELLIPSIS region -> region, "ELLIPSIS" +| WILD region -> region, "WILD" +| EQ region -> region, "EQ" +| EQEQ region -> region, "EQEQ" +| NE region -> region, "NE" +| LT region -> region, "LT" +| GT region -> region, "GT" +| LE region -> region, "LE" +| GE region -> region, "GE" +| ARROW region -> region, "ARROW" +| BOOL_OR region -> region, "BOOL_OR" +| BOOL_AND region -> region, "BOOL_AND" +| Ident Region.{region; value} -> region, sprintf "Ident %s" value - | Constr Region.{region; value} -> +| Constr Region.{region; value} -> region, sprintf "Constr %s" value - | Int Region.{region; value = s,n} -> +| Int Region.{region; value = s,n} -> region, sprintf "Int (\"%s\", %s)" s (Z.to_string n) - | Nat Region.{region; value = s,n} -> +| Nat Region.{region; value = s,n} -> region, sprintf "Nat (\"%s\", %s)" s (Z.to_string n) - | Mutez Region.{region; value = s,n} -> +| Mutez Region.{region; value = s,n} -> region, sprintf "Mutez (\"%s\", %s)" s (Z.to_string n) - | String Region.{region; value} -> +| String Region.{region; value} -> region, sprintf "String %s" value - | Bytes Region.{region; value = s,b} -> +| Bytes Region.{region; value = s,b} -> region, sprintf "Bytes (\"%s\", \"0x%s\")" s (Hex.to_string b) - | Else region -> region, "Else" - | False region -> region, "False" - | If region -> region, "If" - | Let region -> region, "Let" - | Switch region -> region, "Switch" - | Mod region -> region, "Mod" - | NOT region -> region, "!" - | Or region -> region, "Or" - | True region -> region, "True" - | Type region -> region, "Type" - | C_None region -> region, "C_None" - | C_Some region -> region, "C_Some" - | EOF region -> region, "EOF" +| Else region -> region, "Else" +| False region -> region, "False" +| If region -> region, "If" +| Let region -> region, "Let" +| Switch region -> region, "Switch" +| Mod region -> region, "Mod" +| NOT region -> region, "!" +| Or region -> region, "Or" +| True region -> region, "True" +| Type region -> region, "Type" +| C_None region -> region, "C_None" +| C_Some region -> region, "C_Some" +| EOF region -> region, "EOF" let to_lexeme = function - | CAT _ -> "++" - | MINUS _ -> "-" - | PLUS _ -> "+" - | SLASH _ -> "/" - | TIMES _ -> "*" - | LPAR _ -> "(" - | RPAR _ -> ")" - | LBRACKET _ -> "[" - | RBRACKET _ -> "]" - | LBRACE _ -> "{" - | RBRACE _ -> "}" - | COMMA _ -> "," - | SEMI _ -> ";" - | VBAR _ -> "|" - | COLON _ -> ":" - | DOT _ -> "." - | ELLIPSIS _ -> "..." - | WILD _ -> "_" - | EQ _ -> "=" - | EQEQ _ -> "==" - | NE _ -> "!=" - | LT _ -> "<" - | GT _ -> ">" - | LE _ -> "<=" - | GE _ -> ">=" - | ARROW _ -> "=>" - | BOOL_OR _ -> "||" - | BOOL_AND _ -> "&&" - | Ident id -> id.Region.value - | Constr id -> id.Region.value - | Int i - | Nat i - | Mutez i -> fst i.Region.value - | String s -> s.Region.value - | Bytes b -> fst b.Region.value - | Else _ -> "else" - | False _ -> "false" - | If _ -> "if" - | Let _ -> "let" - | Mod _ -> "mod" - | NOT _ -> "!" - | Or _ -> "or" - | Switch _ -> "switch" - | True _ -> "true" - | Type _ -> "type" - | C_None _ -> "None" - | C_Some _ -> "Some" - | EOF _ -> "" + CAT _ -> "++" +| MINUS _ -> "-" +| PLUS _ -> "+" +| SLASH _ -> "/" +| TIMES _ -> "*" +| LPAR _ -> "(" +| RPAR _ -> ")" +| LBRACKET _ -> "[" +| RBRACKET _ -> "]" +| LBRACE _ -> "{" +| RBRACE _ -> "}" +| COMMA _ -> "," +| SEMI _ -> ";" +| VBAR _ -> "|" +| COLON _ -> ":" +| DOT _ -> "." +| ELLIPSIS _ -> "..." +| WILD _ -> "_" +| EQ _ -> "=" +| EQEQ _ -> "==" +| NE _ -> "!=" +| LT _ -> "<" +| GT _ -> ">" +| LE _ -> "<=" +| GE _ -> ">=" +| ARROW _ -> "=>" +| BOOL_OR _ -> "||" +| BOOL_AND _ -> "&&" +| Ident id -> id.Region.value +| Constr id -> id.Region.value +| Int i +| Nat i +| Mutez i -> fst i.Region.value +| String s -> s.Region.value +| Bytes b -> fst b.Region.value +| Else _ -> "else" +| False _ -> "false" +| If _ -> "if" +| Let _ -> "let" +| Mod _ -> "mod" +| NOT _ -> "!" +| Or _ -> "or" +| Switch _ -> "switch" +| True _ -> "true" +| Type _ -> "type" +| C_None _ -> "None" +| C_Some _ -> "Some" +| EOF _ -> "" let to_string token ?(offsets=true) mode = let region, val_str = proj_token token in @@ -216,20 +219,20 @@ type ident_err = Reserved_name type nat_err = Invalid_natural | Non_canonical_zero_nat type sym_err = Invalid_symbol +type kwd_err = Invalid_keyword (* LEXIS *) let keywords = [ - (fun reg -> Else reg); - (fun reg -> False reg); - (fun reg -> If reg); - (fun reg -> Let reg); + (fun reg -> Else reg); + (fun reg -> False reg); + (fun reg -> If reg); + (fun reg -> Let reg); (fun reg -> Switch reg); - (fun reg -> Mod reg); - (fun reg -> Or reg); - (fun reg -> True reg); - (fun reg -> Type reg); -] + (fun reg -> Mod reg); + (fun reg -> Or reg); + (fun reg -> True reg); + (fun reg -> Type reg)] (* See: http://caml.inria.fr/pub/docs/manual-ocaml/lex.html#sec86 and https://github.com/facebook/reason/blob/master/src/reason-parser/reason_parser.mly *) @@ -305,6 +308,14 @@ let lexicon : lexis = cstr = build constructors; res = reserved} +(* Keywords *) + +let mk_kwd ident region = + match SMap.find_opt ident lexicon.kwd with + Some mk_kwd -> Ok (mk_kwd region) + | None -> Error Invalid_keyword + +(* END OF HEADER *) } (* START LEXER DEFINITION *) @@ -380,40 +391,47 @@ let mk_mutez lexeme region = let eof region = EOF region +(* Making symbols *) + let mk_sym lexeme region = match lexeme with - "-" -> Ok (MINUS region) - | "+" -> Ok (PLUS region) - | "/" -> Ok (SLASH region) - | "*" -> Ok (TIMES region) - | "[" -> Ok (LBRACKET region) - | "]" -> Ok (RBRACKET region) - | "{" -> Ok (LBRACE region) - | "}" -> Ok (RBRACE region) - | "," -> Ok (COMMA region) - | ";" -> Ok (SEMI region) - | "|" -> Ok (VBAR region) - | ":" -> Ok (COLON region) - | "." -> Ok (DOT region) - | "_" -> Ok (WILD region) - | "=" -> Ok (EQ region) - | "!=" -> Ok (NE region) - | "<" -> Ok (LT region) - | ">" -> Ok (GT region) - | "<=" -> Ok (LE region) - | ">=" -> Ok (GE region) - | "||" -> Ok (BOOL_OR region) - | "&&" -> Ok (BOOL_AND region) - | "(" -> Ok (LPAR region) - | ")" -> Ok (RPAR region) + "-" -> Ok (MINUS region) + | "+" -> Ok (PLUS region) + | "/" -> Ok (SLASH region) + | "*" -> Ok (TIMES region) + | "[" -> Ok (LBRACKET region) + | "]" -> Ok (RBRACKET region) + | "{" -> Ok (LBRACE region) + | "}" -> Ok (RBRACE region) + | "," -> Ok (COMMA region) + | ";" -> Ok (SEMI region) + | "|" -> Ok (VBAR region) + | ":" -> Ok (COLON region) + | "." -> Ok (DOT region) + | "_" -> Ok (WILD region) + | "=" -> Ok (EQ region) + | "!=" -> Ok (NE region) + | "<" -> Ok (LT region) + | ">" -> Ok (GT region) + | "<=" -> Ok (LE region) + | ">=" -> Ok (GE region) + | "||" -> Ok (BOOL_OR region) + | "&&" -> Ok (BOOL_AND region) + | "(" -> Ok (LPAR region) + | ")" -> Ok (RPAR region) (* Symbols specific to ReasonLIGO *) - | "..."-> Ok (ELLIPSIS region) - | "=>" -> Ok (ARROW region) - | "==" -> Ok (EQEQ region) - | "!" -> Ok (NOT region) - | "++" -> Ok (CAT region) - | _ -> Error Invalid_symbol + + | "..." -> Ok (ELLIPSIS region) + | "=>" -> Ok (ARROW region) + | "==" -> Ok (EQEQ region) + | "!" -> Ok (NOT region) + | "++" -> Ok (CAT region) + + (* Invalid symbols *) + + | _ -> Error Invalid_symbol + (* Identifiers *) @@ -448,26 +466,26 @@ let is_ident = function | _ -> false let is_kwd = function - | Else _ - | False _ - | If _ - | Let _ - | Switch _ - | Mod _ - | Or _ - | True _ - | Type _ - | _ -> false + Else _ +| False _ +| If _ +| Let _ +| Switch _ +| Mod _ +| Or _ +| True _ +| Type _ -> true +| _ -> false let is_constr = function -| Constr _ + Constr _ | Ident _ | False _ -| True _ -> true -| _ -> false +| True _ -> true +| _ -> false let is_sym = function -| CAT _ + CAT _ | MINUS _ | PLUS _ | SLASH _ diff --git a/src/passes/1-parser/reasonligo/Parser.mly b/src/passes/1-parser/reasonligo/Parser.mly index 223d35c65..14936a7ff 100644 --- a/src/passes/1-parser/reasonligo/Parser.mly +++ b/src/passes/1-parser/reasonligo/Parser.mly @@ -370,7 +370,7 @@ ptuple: in PTuple {value=$1; region} } unit: - "(" ")" { {region = cover $1 $2; value = ghost, ghost} } + "(" ")" { {region = cover $1 $2; value = $1, $2} } (* Expressions *) @@ -790,7 +790,7 @@ sequence_or_record_in: sequence_or_record: "{" sequence_or_record_in "}" { - let compound = Braces($1, $3) in + let compound = Braces ($1,$3) in let region = cover $1 $3 in match $2 with PaSequence s -> diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index ee7d562de..94f437f9d 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -19,9 +19,26 @@ module ExtParserLog = include ParserLog end -module M = ParserUnit.Make (IO) - (Lexer.Make (LexToken)) - (AST) - (ExtParser) - (ParErr) - (ExtParserLog) +module MyLexer = Lexer.Make (LexToken) + +module Unit = + ParserUnit.Make (IO)(MyLexer)(AST)(ExtParser)(ParErr)(ExtParserLog) + +(* Main *) + +let () = + try Unit.run () with + (* Ad hoc errors from the parsers *) + + 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 diff --git a/src/passes/1-parser/reasonligo/SyntaxError.mli b/src/passes/1-parser/reasonligo/SyntaxError.mli index befbb27c2..f0cc1ca6e 100644 --- a/src/passes/1-parser/reasonligo/SyntaxError.mli +++ b/src/passes/1-parser/reasonligo/SyntaxError.mli @@ -1,4 +1,4 @@ -type error = +type error = | WrongFunctionArguments of AST.expr -exception Error of error \ No newline at end of file +exception Error of error diff --git a/src/passes/1-parser/shared/ParserAPI.ml b/src/passes/1-parser/shared/ParserAPI.ml index e24be2b48..f8d1520f8 100644 --- a/src/passes/1-parser/shared/ParserAPI.ml +++ b/src/passes/1-parser/shared/ParserAPI.ml @@ -1,5 +1,7 @@ (* Generic parser for LIGO *) +module Region = Simple_utils.Region + module type PARSER = sig (* The type of tokens, abstract syntax trees and expressions *) @@ -104,17 +106,22 @@ module Make (Lexer: Lexer.S) let trailer = match valid_opt with None -> - if Lexer.Token.is_eof invalid then "" - else let invalid_lexeme = Lexer.Token.to_lexeme invalid in - Printf.sprintf ", before \"%s\"" invalid_lexeme + if Lexer.Token.is_eof invalid then "" + else let invalid_lexeme = Lexer.Token.to_lexeme invalid in + Printf.sprintf ", before \"%s\"" invalid_lexeme | Some valid -> - let valid_lexeme = Lexer.Token.to_lexeme valid in - let s = Printf.sprintf ", after \"%s\"" valid_lexeme in - if Lexer.Token.is_eof invalid then s - else - let invalid_lexeme = Lexer.Token.to_lexeme invalid in - Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in + let valid_lexeme = Lexer.Token.to_lexeme valid in + let s = Printf.sprintf ", after \"%s\"" valid_lexeme in + if Lexer.Token.is_eof invalid then s + else + let invalid_lexeme = Lexer.Token.to_lexeme invalid in + Printf.sprintf "%s and before \"%s\"" s invalid_lexeme in let header = header ^ trailer in header ^ (if msg = "" then ".\n" else ":\n" ^ msg) + let short_error ?(offsets=true) mode msg (invalid_region: Region.t) = + let () = assert (not (invalid_region#is_ghost)) in + let header = + "Parse error " ^ invalid_region#to_string ~offsets mode in + header ^ (if msg = "" then ".\n" else ":\n" ^ msg) end diff --git a/src/passes/1-parser/shared/ParserAPI.mli b/src/passes/1-parser/shared/ParserAPI.mli index 79ca137c4..2c9da70cd 100644 --- a/src/passes/1-parser/shared/ParserAPI.mli +++ b/src/passes/1-parser/shared/ParserAPI.mli @@ -1,5 +1,7 @@ (* Generic parser API for LIGO *) +module Region = Simple_utils.Region + module type PARSER = sig (* The type of tokens. *) @@ -56,5 +58,9 @@ module Make (Lexer: Lexer.S) exception Point of error - val format_error : ?offsets:bool -> [`Byte | `Point] -> error -> string + val format_error : + ?offsets:bool -> [`Byte | `Point] -> error -> string + + val short_error : + ?offsets:bool -> [`Byte | `Point] -> message -> Region.t -> string end diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index fe1af9559..23e36f494 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -14,7 +14,8 @@ module type Pretty = state -> ast -> unit val mk_state : offsets:bool -> mode:[`Point|`Byte] -> buffer:Buffer.t -> state - val print_tokens : state -> ast -> unit + val print_tokens : + state -> ast -> unit end module Make (IO: S) @@ -85,6 +86,9 @@ module Make (IO: S) module ParserFront = ParserAPI.Make (Lexer) (Parser) (ParErr) + let format_error = ParserFront.format_error + let short_error = ParserFront.short_error + let lexer_inst = Lexer.open_token_stream (Some pp_input) let Lexer.{read; buffer; get_win; get_pos; get_last; close} = lexer_inst @@ -103,7 +107,7 @@ module Make (IO: S) (* Main *) - let () = + let run () = try let ast = if IO.options#mono @@ -131,37 +135,41 @@ module Make (IO: S) end with (* Lexing errors *) + Lexer.Error err -> - close_all (); - let msg = - Lexer.format_error ~offsets:IO.options#offsets - IO.options#mode err ~file - in prerr_string msg + close_all (); + let msg = + Lexer.format_error ~offsets:IO.options#offsets + IO.options#mode err ~file + in prerr_string msg (* Incremental API of Menhir *) + | ParserFront.Point point -> - let () = close_all () in - let error = - ParserFront.format_error ~offsets:IO.options#offsets - IO.options#mode point - in eprintf "\027[31m%s\027[0m%!" error + let () = close_all () in + let error = + ParserFront.format_error ~offsets:IO.options#offsets + IO.options#mode point + in eprintf "\027[31m%s\027[0m%!" error (* Monolithic API of Menhir *) + | Parser.Error -> - let () = close_all () in - let invalid, valid_opt = + let () = close_all () in + let invalid, valid_opt = match get_win () with Lexer.Nil -> assert false (* Safe: There is always at least EOF. *) | Lexer.One invalid -> invalid, None | Lexer.Two (invalid, valid) -> invalid, Some valid in - let point = "", valid_opt, invalid in - let error = - ParserFront.format_error ~offsets:IO.options#offsets + let point = "", valid_opt, invalid in + let error = + ParserFront.format_error ~offsets:IO.options#offsets IO.options#mode point - in eprintf "\027[31m%s\027[0m%!" error + in eprintf "\027[31m%s\027[0m%!" error (* I/O errors *) + | Sys_error msg -> Utils.highlight msg end diff --git a/src/test/contracts/chain_id.ligo b/src/test/contracts/chain_id.ligo index e7283adf2..7372d8ecc 100644 --- a/src/test/contracts/chain_id.ligo +++ b/src/test/contracts/chain_id.ligo @@ -1,5 +1,5 @@ -function get_chain_id (const tt : chain_id) : chain_id is +function chain_id (const tt : chain_id) : chain_id is block { var toto : chain_id := get_chain_id ; } with ( toto ) \ No newline at end of file diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index caa4c7c01..9ad2d5026 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -870,7 +870,7 @@ let map_ type_f path : unit result = let make_expected = fun _ -> e_some @@ e_int 4 in expect_eq_n program "get_" make_input make_expected in - let%bind () = + let%bind () = let input_map = ez [(23, 10) ; (42, 4)] in expect_eq program "mem" (e_tuple [(e_int 23) ; input_map]) (e_bool true) in @@ -1057,27 +1057,27 @@ let loop () : unit result = let make_input = e_nat in let make_expected = fun n -> e_nat (n * (n + 1) / 2) in expect_eq_n_pos_mid program "while_sum" make_input make_expected in - let%bind () = + let%bind () = let make_input = e_nat in let make_expected = fun n -> e_int (n * (n + 1) / 2) in expect_eq_n_pos_mid program "for_sum" make_input make_expected in let input = e_unit () in - let%bind () = + let%bind () = let expected = e_pair (e_int 3) (e_string "totototo") in expect_eq program "for_collection_list" input expected in - let%bind () = + let%bind () = let expected = e_pair (e_int 6) (e_string "totototo") in expect_eq program "for_collection_set" input expected in - let%bind () = + let%bind () = let expected = e_pair (e_int 6) (e_string "123") in expect_eq program "for_collection_map_kv" input expected in - let%bind () = + let%bind () = let expected = (e_string "123") in expect_eq program "for_collection_map_k" input expected in - let%bind () = + let%bind () = let expected = (e_int 0) in expect_eq program "for_collection_empty" input expected in - let%bind () = + let%bind () = let expected = (e_int 13) in expect_eq program "for_collection_if_and_local_var" input expected in let%bind () = @@ -1680,12 +1680,12 @@ let implicit_account_religo () : unit result = ok () let tuples_sequences_functions_religo () : unit result = - let%bind _ = retype_file "./contracts/tuples_sequences_functions.religo" in + let%bind _ = retype_file "./contracts/tuples_sequences_functions.religo" in ok () let is_nat () : unit result = let%bind program = type_file "./contracts/isnat.ligo" in - let%bind () = + let%bind () = let input = e_int 10 in let expected = e_some (e_nat 10) in expect_eq program "main" input expected @@ -1698,7 +1698,7 @@ let is_nat () : unit result = let is_nat_mligo () : unit result = let%bind program = mtype_file "./contracts/isnat.mligo" in - let%bind () = + let%bind () = let input = e_int 10 in let expected = e_some (e_nat 10) in expect_eq program "main" input expected @@ -1711,7 +1711,7 @@ let is_nat_mligo () : unit result = let is_nat_religo () : unit result = let%bind program = retype_file "./contracts/isnat.religo" in - let%bind () = + let%bind () = let input = e_int 10 in let expected = e_some (e_nat 10) in expect_eq program "main" input expected @@ -1745,7 +1745,7 @@ let deep_access_ligo () : unit result = let make_expected = e_string "one" in expect_eq program "nested_record" make_input make_expected in ok () - + let entrypoints_ligo () : unit result = let%bind _program = type_file "./contracts/entrypoints.ligo" in @@ -1759,7 +1759,7 @@ let chain_id () : unit result = Tezos_base__TzPervasives.Chain_id.zero in let make_input = e_chain_id pouet in let make_expected = e_chain_id pouet in - let%bind () = expect_eq program "get_chain_id" make_input make_expected in + let%bind () = expect_eq program "chain_id" make_input make_expected in ok () let key_hash () : unit result = @@ -1830,46 +1830,46 @@ let bytes_unpack () : unit result = let%bind () = expect_eq program "id_address" (e_address addr) (e_some (e_address addr)) in ok () -let empty_case () : unit result = +let empty_case () : unit result = let%bind program = type_file "./contracts/empty_case.ligo" in let%bind () = let input _ = e_constructor "Bar" (e_int 1) in - let expected _ = e_int 1 in + let expected _ = e_int 1 in expect_eq_n program "main" input expected - in + in let%bind () = let input _ = e_constructor "Baz" (e_unit ()) in - let expected _ = e_int (-1) in + let expected _ = e_int (-1) in expect_eq_n program "main" input expected - in + in ok () -let empty_case_mligo () : unit result = +let empty_case_mligo () : unit result = let%bind program = mtype_file "./contracts/empty_case.mligo" in let%bind () = let input _ = e_constructor "Bar" (e_int 1) in - let expected _ = e_int 1 in + let expected _ = e_int 1 in expect_eq_n program "main" input expected - in + in let%bind () = let input _ = e_constructor "Baz" (e_unit ()) in - let expected _ = e_int (-1) in + let expected _ = e_int (-1) in expect_eq_n program "main" input expected - in + in ok () -let empty_case_religo () : unit result = +let empty_case_religo () : unit result = let%bind program = retype_file "./contracts/empty_case.religo" in let%bind () = let input _ = e_constructor "Bar" (e_int 1) in - let expected _ = e_int 1 in + let expected _ = e_int 1 in expect_eq_n program "main" input expected - in + in let%bind () = let input _ = e_constructor "Baz" (e_unit ()) in - let expected _ = e_int (-1) in + let expected _ = e_int (-1) in expect_eq_n program "main" input expected - in + in ok () let main = test_suite "Integration (End to End)" [ From cfe54946088d2153349bd111f4ffae3305943849 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Wed, 8 Jan 2020 17:16:09 +0100 Subject: [PATCH 4/4] Fixed the examples in Markdown after my last MR forbidding the shadowing of predefined values (like [balance] here). --- .../docs/language-basics/maps-records.md | 48 +++++++++---------- 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/gitlab-pages/docs/language-basics/maps-records.md b/gitlab-pages/docs/language-basics/maps-records.md index 93bf51fde..26b8abeb5 100644 --- a/gitlab-pages/docs/language-basics/maps-records.md +++ b/gitlab-pages/docs/language-basics/maps-records.md @@ -63,7 +63,7 @@ let moves: moveset = Map.literal ```reasonligo -let moves: moveset = +let moves : moveset = Map.literal([ ("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address, (1, 2)), ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, (0, 3)), @@ -82,19 +82,19 @@ If we want to access a move from our moveset above, we can use the `[]` operator ```pascaligo -const balance: option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)]; +const my_balance : option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)]; ``` ```cameligo -let balance: move option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves +let my_balance : move option = Map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves ``` ```reasonligo -let balance: option(move) = +let my_balance : option(move) = Map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); ``` @@ -106,19 +106,19 @@ Accessing a value in a map yields an option, however you can also get the value ```pascaligo -const balance: move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves); +const my_balance : move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves); ``` ```cameligo -let balance: move = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves +let my_balance : move = Map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves ``` ```reasonligo -let balance: move = +let my_balance : move = Map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); ``` @@ -134,8 +134,8 @@ The values of a PascaLIGO map can be updated using the ordinary assignment synta ```pascaligo -function set_ (var m: moveset) : moveset is - block { +function set_ (var m: moveset) : moveset is + block { m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9); } with m ``` @@ -266,7 +266,7 @@ entries, potentially millions or billions. The cost of loading these entries int the environment each time a user executes the contract would eventually become too expensive were it not for big maps. Big maps are a data structure offered by Tezos which handles the scaling concerns for us. In LIGO, the interface for big -maps is analogous to the one used for ordinary maps. +maps is analogous to the one used for ordinary maps. Here's how we define a big map: @@ -341,19 +341,19 @@ If we want to access a move from our moveset above, we can use the `[]` operator ```pascaligo -const balance: option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)]; +const my_balance : option(move) = moves[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)]; ``` ```cameligo -let balance: move option = Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves +let my_balance : move option = Big_map.find_opt ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves ``` ```reasonligo -let balance: option(move) = +let my_balance : option(move) = Big_map.find_opt("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); ``` @@ -365,19 +365,19 @@ Accessing a value in a map yields an option, however you can also get the value ```pascaligo -const balance: move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves); +const my_balance : move = get_force(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), moves); ``` ```cameligo -let balance: move = Big_map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves +let my_balance : move = Big_map.find ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) moves ``` ```reasonligo -let balance: move = Big_map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); +let my_balance : move = Big_map.find("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address, moves); ``` @@ -392,8 +392,8 @@ The values of a PascaLIGO big map can be updated using the ordinary assignment s ```pascaligo -function set_ (var m: moveset) : moveset is - block { +function set_ (var m : moveset) : moveset is + block { m[("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address)] := (4,9); } with m ``` @@ -404,7 +404,7 @@ We can update a big map in CameLIGO using the `Big_map.update` built-in: ```cameligo -let updated_map: moveset = +let updated_map : moveset = Big_map.update ("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) (Some (4,9)) moves ``` @@ -428,7 +428,7 @@ Here's how a custom record type is defined: ```pascaligo -type user is record +type user is record id: nat; is_admin: bool; name: string; @@ -479,8 +479,8 @@ let user: user = { ```reasonligo let user: user = { - id: 1n, - is_admin: true, + id: 1n, + is_admin: true, name: "Alice" }; ``` @@ -494,12 +494,12 @@ If we want to obtain a value from a record for a given key, we can do the follow ```pascaligo -const is_admin: bool = user.is_admin; +const is_admin : bool = user.is_admin; ``` ```cameligo -let is_admin: bool = user.is_admin +let is_admin : bool = user.is_admin ```