From 1941f9ae4b5cc3a6b256b94260ea89c645a127e2 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Fri, 3 Apr 2020 19:08:14 +0200 Subject: [PATCH] Shared more code in ParserUnit.ml Rewrite of the integration of the preprocessor. Compiles bt DOES NOT PASS THE CI. --- src/dune | 17 +- src/passes/1-parser/cameligo.ml | 144 ++++++---------- src/passes/1-parser/pascaligo.ml | 145 ++++++----------- src/passes/1-parser/pascaligo/.links | 2 + src/passes/1-parser/pascaligo/LexToken.mll | 4 +- src/passes/1-parser/pascaligo/LexerMain.ml | 4 +- src/passes/1-parser/pascaligo/ParserMain.ml | 61 ++----- .../1-parser/pascaligo/Stubs/Preprocessor.ml | 1 + src/passes/1-parser/reasonligo.ml | 154 +++++++----------- src/passes/1-parser/shared/EvalOpt.ml | 28 ++-- src/passes/1-parser/shared/EvalOpt.mli | 8 +- src/passes/1-parser/shared/Lexer.mli | 18 +- src/passes/1-parser/shared/Lexer.mll | 75 +++++---- src/passes/1-parser/shared/LexerUnit.ml | 17 +- src/passes/1-parser/shared/ParserAPI.ml | 15 +- src/passes/1-parser/shared/ParserAPI.mli | 8 +- src/passes/1-parser/shared/ParserUnit.ml | 143 ++++++++++++---- src/passes/1-parser/shared/ParserUnit.mli | 32 +++- src/passes/1-parser/shared/dune | 4 +- vendors/UnionFind/UnionFind.install | 32 ++-- vendors/UnionFind/dune | 2 +- 21 files changed, 448 insertions(+), 466 deletions(-) diff --git a/src/dune b/src/dune index 0bfd1396c..21ec7d115 100644 --- a/src/dune +++ b/src/dune @@ -1,14 +1,13 @@ -(dirs (:standard \ toto)) +(dirs (:standard)) + (library (name ligo) (public_name ligo) (libraries - simple-utils - tezos-utils - tezos-micheline - main - ) + Preprocessor + simple-utils + tezos-utils + tezos-micheline + main) (preprocess - (pps ppx_let bisect_ppx --conditional) - ) -) + (pps ppx_let bisect_ppx --conditional))) diff --git a/src/passes/1-parser/cameligo.ml b/src/passes/1-parser/cameligo.ml index 575445a0a..ce86f1413 100644 --- a/src/passes/1-parser/cameligo.ml +++ b/src/passes/1-parser/cameligo.ml @@ -4,26 +4,46 @@ module Lexer = Lexer.Make(LexToken) module Scoping = Parser_cameligo.Scoping module Region = Simple_utils.Region module ParErr = Parser_cameligo.ParErr -module SSet = Utils.String.Set +module SSet = Set.Make (String) (* Mock IOs TODO: Fill them with CLI options *) -module type IO = - sig - val ext : string - val options : EvalOpt.options - end +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] -module PreIO = +module SubIO = struct - let ext = ".ligo" - let pre_options = - EvalOpt.make ~libs:[] - ~verbose:SSet.empty - ~offsets:true - ~mode:`Point - ~cmd:EvalOpt.Quiet - ~mono:false + type options = < + libs : string list; + verbose : SSet.t; + offsets : bool; + lang : language; + ext : string; (* ".mligo" *) + mode : [`Byte | `Point]; + cmd : EvalOpt.command; + mono : bool + > + + let options : options = + object + method libs = [] + method verbose = SSet.empty + method offsets = true + method lang = `CameLIGO + method ext = ".mligo" + method mode = `Point + method cmd = EvalOpt.Quiet + method mono = false + end + + let make = + EvalOpt.make ~libs:options#libs + ~verbose:options#verbose + ~offsets:options#offsets + ~lang:options#lang + ~ext:options#ext + ~mode:options#mode + ~cmd:options#cmd + ~mono:options#mono end module Parser = @@ -40,34 +60,33 @@ module ParserLog = include Parser_cameligo.ParserLog end -module PreUnit = - ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog) +module Unit = + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) module Errors = struct - (* let data = - [("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] *) - let generic message = let title () = "" and message () = message.Region.value in Trace.error ~data:[] title message end -let parse (module IO : IO) parser = - let module Unit = PreUnit (IO) in +let apply parser = let local_fail error = Trace.fail @@ Errors.generic - @@ Unit.format_error ~offsets:IO.options#offsets - IO.options#mode error in + @@ Unit.format_error ~offsets:SubIO.options#offsets + SubIO.options#mode error in match parser () with Stdlib.Ok semantic_value -> Trace.ok semantic_value (* Lexing and parsing errors *) | Stdlib.Error error -> Trace.fail @@ Errors.generic error + (* System errors *) + + | exception Sys_error msg -> + Trace.fail @@ Errors.generic (Region.wrap_ghost msg) (* Scoping errors *) | exception Scoping.Error (Scoping.Reserved_name name) -> @@ -110,71 +129,14 @@ let parse (module IO : IO) parser = Hint: Change the name.\n", None, invalid)) -let parse_file (source: string) = - let module IO = - struct - let ext = PreIO.ext - let options = - PreIO.pre_options ~input:(Some source) ~expr:false - end in - let lib_path = - match IO.options#libs with - [] -> "" - | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" in - let prefix = - match IO.options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(remove_extension @@ basename file) in - let suffix = ".pp" ^ IO.ext in - let pp_input = - if SSet.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 in - let cpp_cmd = - match IO.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 in - let open Trace in - let%bind () = sys_command cpp_cmd in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ File pp_input) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_contract - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +(* Parsing a contract in a file *) -let parse_string (s: string) = - let module IO = - struct - let ext = PreIO.ext - let options = PreIO.pre_options ~input:None ~expr:false - end in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ String s) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_contract - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +let parse_file source = apply (fun () -> Unit.parse_file source) -let parse_expression (s: string) = - let module IO = - struct - let ext = PreIO.ext - let options = PreIO.pre_options ~input:None ~expr:true - end in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ String s) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_expr - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +(* Parsing a contract in a string *) + +let parse_string source = apply (fun () -> Unit.parse_string source) + +(* Parsing an expression in a string *) + +let parse_expression source = apply (fun () -> Unit.parse_expression source) diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 10eeaa30d..bb679c6a3 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -4,26 +4,46 @@ module Lexer = Lexer.Make(LexToken) module Scoping = Parser_pascaligo.Scoping module Region = Simple_utils.Region module ParErr = Parser_pascaligo.ParErr -module SSet = Utils.String.Set +module SSet = Set.Make (String) (* Mock IOs TODO: Fill them with CLI options *) -module type IO = - sig - val ext : string - val options : EvalOpt.options - end +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] -module PreIO = +module SubIO = struct - let ext = ".ligo" - let pre_options = - EvalOpt.make ~libs:[] - ~verbose:SSet.empty - ~offsets:true - ~mode:`Point - ~cmd:EvalOpt.Quiet - ~mono:false + type options = < + libs : string list; + verbose : SSet.t; + offsets : bool; + lang : language; + ext : string; (* ".ligo" *) + mode : [`Byte | `Point]; + cmd : EvalOpt.command; + mono : bool + > + + let options : options = + object + method libs = [] + method verbose = SSet.empty + method offsets = true + method lang = `PascaLIGO + method ext = ".ligo" + method mode = `Point + method cmd = EvalOpt.Quiet + method mono = false + end + + let make = + EvalOpt.make ~libs:options#libs + ~verbose:options#verbose + ~offsets:options#offsets + ~lang:options#lang + ~ext:options#ext + ~mode:options#mode + ~cmd:options#cmd + ~mono:options#mono end module Parser = @@ -40,34 +60,34 @@ module ParserLog = include Parser_pascaligo.ParserLog end -module PreUnit = - ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog) +module Unit = + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) module Errors = struct - (* let data = - [("location", - fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] *) - let generic message = let title () = "" and message () = message.Region.value in Trace.error ~data:[] title message end -let parse (module IO : IO) parser = - let module Unit = PreUnit (IO) in +let apply parser = let local_fail error = Trace.fail @@ Errors.generic - @@ Unit.format_error ~offsets:IO.options#offsets - IO.options#mode error in + @@ Unit.format_error ~offsets:SubIO.options#offsets + SubIO.options#mode error in match parser () with Stdlib.Ok semantic_value -> Trace.ok semantic_value (* Lexing and parsing errors *) | Stdlib.Error error -> Trace.fail @@ Errors.generic error + + (* System errors *) + + | exception Sys_error msg -> + Trace.fail @@ Errors.generic (Region.wrap_ghost msg) (* Scoping errors *) | exception Scoping.Error (Scoping.Reserved_name name) -> @@ -121,71 +141,14 @@ let parse (module IO : IO) parser = Hint: Change the name.\n", None, invalid)) -let parse_file source = - let module IO = - struct - let ext = PreIO.ext - let options = - PreIO.pre_options ~input:(Some source) ~expr:false - end in - let module Unit = PreUnit (IO) in - let lib_path = - match IO.options#libs with - [] -> "" - | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" in - let prefix = - match IO.options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(remove_extension @@ basename file) in - let suffix = ".pp" ^ IO.ext in - let pp_input = - if SSet.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 in - let cpp_cmd = - match IO.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 in - let open Trace in - let%bind () = sys_command cpp_cmd in - match Lexer.(open_token_stream @@ File pp_input) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_contract - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +(* Parsing a contract in a file *) -let parse_string (s: string) = - let module IO = - struct - let ext = PreIO.ext - let options = PreIO.pre_options ~input:None ~expr:false - end in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ String s) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_contract - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +let parse_file source = apply (fun () -> Unit.parse_file source) -let parse_expression (s: string) = - let module IO = - struct - let ext = PreIO.ext - let options = PreIO.pre_options ~input:None ~expr:true - end in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ String s) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_expr - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +(* Parsing a contract in a string *) + +let parse_string source = apply (fun () -> Unit.parse_string source) + +(* Parsing an expression in a string *) + +let parse_expression source = apply (fun () -> Unit.parse_expression source) diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index 36babbfbf..98bcabc90 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -5,6 +5,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli PP_EvalOpt.mli +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml PP_EvalOpt.ml $HOME/git/ligo/vendors/Preprocessor/E_AST.ml $HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll $HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index 5711bbac6..24c44ab71 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -11,8 +11,8 @@ let sprintf = Printf.sprintf module Region = Simple_utils.Region module Pos = Simple_utils.Pos -module SMap = Utils.String.Map -module SSet = Utils.String.Set +module SMap = Map.Make (String) +module SSet = Set.Make (String) (* Hack to roll back one lexeme in the current semantic action *) (* diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml index 803939842..3c8d7c642 100644 --- a/src/passes/1-parser/pascaligo/LexerMain.ml +++ b/src/passes/1-parser/pascaligo/LexerMain.ml @@ -4,7 +4,7 @@ module Region = Simple_utils.Region module IO = struct - let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo") + let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo") end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) @@ -12,4 +12,4 @@ module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) let () = match M.trace () with Stdlib.Ok () -> () - | Error Region.{value; _} -> Utils.highlight value + | Error Region.{value; _} -> Printf.eprintf "\027[31m%s\027[0m%!" value diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 795a16c4b..aa26d78ea 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -2,7 +2,7 @@ module IO = struct - let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo") + let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo") end module Parser = @@ -24,6 +24,8 @@ module Lexer = Lexer.Make (LexToken) module Unit = ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO) +module SSet = Set.Make (String) + (* Main *) let issue_error error : ('a, string Region.reg) Stdlib.result = @@ -38,8 +40,8 @@ let parse parser : ('a, string Region.reg) Stdlib.result = let token = Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - (* Cannot fail because [name] is a not a - reserved name for the lexer. *) + (* Cannot fail because [name] is not a reserved name for the + lexer. *) Stdlib.Error _ -> assert false | Ok invalid -> issue_error ("Duplicate parameter.\nHint: Change the name.\n", @@ -49,8 +51,8 @@ let parse parser : ('a, string Region.reg) Stdlib.result = let token = Lexer.Token.mk_ident name.Region.value name.Region.region in (match token with - (* Cannot fail because [name] is a not a - reserved name for the lexer. *) + (* Cannot fail because [name] is not a reserved name for the + lexer. *) Stdlib.Error _ -> assert false | Ok invalid -> issue_error @@ -68,8 +70,8 @@ let parse parser : ('a, string Region.reg) Stdlib.result = let token = Lexer.Token.mk_ident var.Region.value var.Region.region in (match token with - (* Cannot fail because [var] is a not a - reserved name for the lexer. *) + (* Cannot fail because [var] is not a reserved name for the + lexer. *) Stdlib.Error _ -> assert false | Ok invalid -> let point = "Repeated variable in this pattern.\n\ @@ -93,49 +95,6 @@ let parse parser : ('a, string Region.reg) Stdlib.result = (* Preprocessing the input source *) -(* -module SSet = Utils.String.Set -let sprintf = Printf.sprintf - -(* 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.options#ext - -let pp_input = - if SSet.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 Sys.command cpp_cmd <> 0 then - Printf.eprintf "External error: \"%s\" failed." cpp_cmd - *) - - -(* Preprocessing the input source *) - let preproc cin : unit = let close () = flush_all (); close_in cin in let buffer = Lexing.from_channel cin in @@ -147,7 +106,7 @@ let preproc cin : unit = buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in match Preproc.lex IO.options buffer with Stdlib.Error (pp_buffer, err) -> - if Utils.String.Set.mem "preproc" IO.options#verbose then + if SSet.mem "preproc" IO.options#verbose then Printf.printf "%s\n%!" (Buffer.contents pp_buffer); let Region.{value; _} = Preproc.format ~offsets:IO.options#offsets ~file:true err diff --git a/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml b/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml index 7391fb5e8..c9a418bef 100644 --- a/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml +++ b/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml @@ -1 +1,2 @@ module Preproc = Preproc +module EvalOpt = PP_EvalOpt diff --git a/src/passes/1-parser/reasonligo.ml b/src/passes/1-parser/reasonligo.ml index 5254018e8..dd902360b 100644 --- a/src/passes/1-parser/reasonligo.ml +++ b/src/passes/1-parser/reasonligo.ml @@ -2,31 +2,51 @@ open Trace module AST = Parser_cameligo.AST module LexToken = Parser_reasonligo.LexToken -module Lexer = Lexer.Make(LexToken) +module Lexer = Lexer.Make (LexToken) module Scoping = Parser_cameligo.Scoping module Region = Simple_utils.Region module ParErr = Parser_reasonligo.ParErr module SyntaxError = Parser_reasonligo.SyntaxError -module SSet = Utils.String.Set +module SSet = Set.Make (String) (* Mock IOs TODO: Fill them with CLI options *) -module type IO = - sig - val ext : string - val options : EvalOpt.options - end +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] -module PreIO = +module SubIO = struct - let ext = ".ligo" - let pre_options = - EvalOpt.make ~libs:[] - ~verbose:SSet.empty - ~offsets:true - ~mode:`Point - ~cmd:EvalOpt.Quiet - ~mono:false + type options = < + libs : string list; + verbose : SSet.t; + offsets : bool; + lang : language; + ext : string; (* ".religo" *) + mode : [`Byte | `Point]; + cmd : EvalOpt.command; + mono : bool + > + + let options : options = + object + method libs = [] + method verbose = SSet.empty + method offsets = true + method lang = `ReasonLIGO + method ext = ".religo" + method mode = `Point + method cmd = EvalOpt.Quiet + method mono = false + end + + let make = + EvalOpt.make ~libs:options#libs + ~verbose:options#verbose + ~offsets:options#offsets + ~lang:options#lang + ~ext:options#ext + ~mode:options#mode + ~cmd:options#cmd + ~mono:options#mono end module Parser = @@ -43,8 +63,8 @@ module ParserLog = include Parser_cameligo.ParserLog end -module PreUnit = - ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog) +module Unit = + ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO) module Errors = struct @@ -55,14 +75,14 @@ module Errors = let wrong_function_arguments (expr: AST.expr) = let title () = "" in - let message () = "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 tuple = ((a, b): (int, int)) => a + b; \n\ - let x = (a: string) : string => \"Hello, \" ++ a;\n" - in + let message () = + "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 tuple = ((a, b): (int, int)) => a + b; \n\ + let x = (a: string) : string => \"Hello, \" ++ a;\n" in let expression_loc = AST.expr_to_region expr in let data = [ ("location", @@ -70,13 +90,12 @@ module Errors = in error ~data title message end -let parse (module IO : IO) parser = - let module Unit = PreUnit (IO) in +let apply parser = let local_fail error = Trace.fail @@ Errors.generic - @@ Unit.format_error ~offsets:IO.options#offsets - IO.options#mode error in + @@ Unit.format_error ~offsets:SubIO.options#offsets + SubIO.options#mode error in match parser () with Stdlib.Ok semantic_value -> Trace.ok semantic_value @@ -128,71 +147,14 @@ let parse (module IO : IO) parser = | exception SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) -> Trace.fail @@ Errors.wrong_function_arguments expr -let parse_file (source: string) = - let module IO = - struct - let ext = PreIO.ext - let options = - PreIO.pre_options ~input:(Some source) ~expr:false - end in - let lib_path = - match IO.options#libs with - [] -> "" - | libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path - in List.fold_right mk_I libs "" in - let prefix = - match IO.options#input with - None | Some "-" -> "temp" - | Some file -> Filename.(remove_extension @@ basename file) in - let suffix = ".pp" ^ IO.ext in - let pp_input = - if SSet.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 in - let cpp_cmd = - match IO.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 in - let open Trace in - let%bind () = sys_command cpp_cmd in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ File pp_input) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_contract - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +(* Parsing a contract in a file *) -let parse_string (s: string) = - let module IO = - struct - let ext = PreIO.ext - let options = PreIO.pre_options ~input:None ~expr:false - end in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ String s) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_contract - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +let parse_file source = apply (fun () -> Unit.parse_file source) -let parse_expression (s: string) = - let module IO = - struct - let ext = PreIO.ext - let options = PreIO.pre_options ~input:None ~expr:true - end in - let module Unit = PreUnit (IO) in - match Lexer.(open_token_stream @@ String s) with - Ok instance -> - let thunk () = Unit.apply instance Unit.parse_expr - in parse (module IO) thunk - | Stdlib.Error (Lexer.File_opening msg) -> - Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg +(* Parsing a contract in a string *) + +let parse_string source = apply (fun () -> Unit.parse_string source) + +(* Parsing an expression in a string *) + +let parse_expression source = apply (fun () -> Unit.parse_expression source) diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 9f2b641d5..15ddfc2e6 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -5,19 +5,21 @@ type command = Quiet | Copy | Units | Tokens -type language = PascaLIGO | CameLIGO | ReasonLIGO +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] let lang_to_string = function - PascaLIGO -> "PascaLIGO" -| CameLIGO -> "CameLIGO" -| ReasonLIGO -> "ReasonLIGO" + `PascaLIGO -> "PascaLIGO" +| `CameLIGO -> "CameLIGO" +| `ReasonLIGO -> "ReasonLIGO" (* The type [options] gathers the command-line options. *) +module SSet = Set.Make (String) + type options = < input : string option; libs : string list; - verbose : Utils.String.Set.t; + verbose : SSet.t; offsets : bool; lang : language; ext : string; (* ".ligo", ".mligo", ".religo" *) @@ -47,8 +49,12 @@ let printf = Printf.printf let sprintf = Printf.sprintf let print = print_endline +(* Printing a string in red to standard error *) + +let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg + let abort msg = - Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1 + highlight (sprintf "Command-line error: %s\n" msg); exit 1 (* Help *) @@ -83,7 +89,7 @@ and units = ref false and quiet = ref false and columns = ref false and bytes = ref false -and verbose = ref Utils.String.Set.empty +and verbose = ref SSet.empty and input = ref None and libs = ref [] and verb_str = ref "" @@ -95,7 +101,7 @@ let split_at_colon = Str.(split (regexp ":")) let add_path p = libs := !libs @ split_at_colon p let add_verbose d = - verbose := List.fold_left (Utils.swap Utils.String.Set.add) + verbose := List.fold_left (fun x y -> SSet.add y x) !verbose (split_at_colon d) @@ -152,7 +158,7 @@ let print_opt () = let check lang ext = let () = - if Utils.String.Set.mem "cli" !verbose then print_opt () in + if SSet.mem "cli" !verbose then print_opt () in let input = match !input with @@ -178,7 +184,7 @@ let check lang ext = and libs = !libs in let () = - if Utils.String.Set.mem "cli" verbose then + if SSet.mem "cli" verbose then begin printf "\nEXPORTED COMMAND LINE\n"; printf "copy = %b\n" copy; @@ -213,6 +219,6 @@ let read ~lang ~ext = (verb_str := let apply e a = if a = "" then e else Printf.sprintf "%s, %s" e a - in Utils.String.Set.fold apply !verbose ""); + in SSet.fold apply !verbose ""); check lang ext with Getopt.Error msg -> abort msg diff --git a/src/passes/1-parser/shared/EvalOpt.mli b/src/passes/1-parser/shared/EvalOpt.mli index b71ede371..6ffd0ffce 100644 --- a/src/passes/1-parser/shared/EvalOpt.mli +++ b/src/passes/1-parser/shared/EvalOpt.mli @@ -49,14 +49,16 @@ type command = Quiet | Copy | Units | Tokens expected.} } *) -type language = PascaLIGO | CameLIGO | ReasonLIGO +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] val lang_to_string : language -> string +module SSet : Set.S with type elt = string and type t = Set.Make(String).t + type options = < input : string option; libs : string list; - verbose : Utils.String.Set.t; + verbose : SSet.t; offsets : bool; lang : language; ext : string; (* ".ligo", ".mligo", ".religo" *) @@ -69,7 +71,7 @@ type options = < val make : input:string option -> libs:string list -> - verbose:Utils.String.Set.t -> + verbose:SSet.t -> offsets:bool -> lang:language -> ext:string -> diff --git a/src/passes/1-parser/shared/Lexer.mli b/src/passes/1-parser/shared/Lexer.mli index 1d6180104..ef2c01ce1 100644 --- a/src/passes/1-parser/shared/Lexer.mli +++ b/src/passes/1-parser/shared/Lexer.mli @@ -135,7 +135,15 @@ module type S = val slide : token -> window -> window + type input = + File of file_path (* "-" means stdin *) + | Stdin + | String of string + | Channel of in_channel + | Buffer of Lexing.lexbuf + type instance = { + input : input; read : log:logger -> Lexing.lexbuf -> token; buffer : Lexing.lexbuf; get_win : unit -> window; @@ -145,15 +153,11 @@ module type S = close : unit -> unit } - type input = - File of file_path (* "-" means stdin *) - | Stdin - | String of string - | Channel of in_channel - | Buffer of Lexing.lexbuf - type open_err = File_opening of string + val lexbuf_from_input : + input -> (Lexing.lexbuf * (unit -> unit), open_err) Stdlib.result + val open_token_stream : input -> (instance, open_err) Stdlib.result (* Error reporting *) diff --git a/src/passes/1-parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll index 90ba832d5..8e7ce915f 100644 --- a/src/passes/1-parser/shared/Lexer.mll +++ b/src/passes/1-parser/shared/Lexer.mll @@ -157,7 +157,15 @@ module type S = val slide : token -> window -> window + type input = + File of file_path (* "-" means stdin *) + | Stdin + | String of string + | Channel of in_channel + | Buffer of Lexing.lexbuf + type instance = { + input : input; read : log:logger -> Lexing.lexbuf -> token; buffer : Lexing.lexbuf; get_win : unit -> window; @@ -167,15 +175,11 @@ module type S = close : unit -> unit } - type input = - File of file_path (* "-" means stdin *) - | Stdin - | String of string - | Channel of in_channel - | Buffer of Lexing.lexbuf - type open_err = File_opening of string + val lexbuf_from_input : + input -> (Lexing.lexbuf * (unit -> unit), open_err) Stdlib.result + val open_token_stream : input -> (instance, open_err) Stdlib.result (* Error reporting *) @@ -865,7 +869,15 @@ and scan_utf8 thread state = parse type logger = Markup.t list -> token -> unit +type input = + File of file_path (* "-" means stdin *) +| Stdin +| String of string +| Channel of in_channel +| Buffer of Lexing.lexbuf + type instance = { + input : input; read : log:logger -> Lexing.lexbuf -> token; buffer : Lexing.lexbuf; get_win : unit -> window; @@ -875,15 +887,28 @@ type instance = { close : unit -> unit } -type input = - File of file_path (* "-" means stdin *) -| Stdin -| String of string -| Channel of in_channel -| Buffer of Lexing.lexbuf - type open_err = File_opening of string +let lexbuf_from_input = function + File "" | File "-" | Stdin -> + Ok (Lexing.from_channel stdin, fun () -> close_in stdin) +| File path -> + (try + let chan = open_in path in + let close () = close_in chan in + let lexbuf = Lexing.from_channel chan in + let () = + let open Lexing in + lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = path} + in Ok (lexbuf, close) + with Sys_error msg -> Stdlib.Error (File_opening msg)) +| String s -> + Ok (Lexing.from_string s, fun () -> ()) +| Channel chan -> + let close () = close_in chan in + Ok (Lexing.from_channel chan, close) +| Buffer b -> Ok (b, fun () -> ()) + let open_token_stream input = let file_path = match input with File file_path -> @@ -968,32 +993,14 @@ let open_token_stream input = check_right_context token buffer; patch_buffer (Token.to_region token)#byte_pos buffer; token in - - let buf_close_res = - match input with - File "" | File "-" | Stdin -> - Ok (Lexing.from_channel stdin, fun () -> close_in stdin) - | File path -> - (try - let chan = open_in path in - let close () = close_in chan in - Ok (Lexing.from_channel chan, close) - with - Sys_error msg -> Stdlib.Error (File_opening msg)) - | String s -> - Ok (Lexing.from_string s, fun () -> ()) - | Channel chan -> - let close () = close_in chan in - Ok (Lexing.from_channel chan, close) - | Buffer b -> Ok (b, fun () -> ()) in - match buf_close_res with + match lexbuf_from_input input with Ok (buffer, close) -> let () = match input with File path when path <> "" -> reset ~file:path buffer | _ -> () in let instance = { - read; buffer; get_win; get_pos; get_last; get_file; close} + input; read; buffer; get_win; get_pos; get_last; get_file; close} in Ok instance | Error _ as e -> e diff --git a/src/passes/1-parser/shared/LexerUnit.ml b/src/passes/1-parser/shared/LexerUnit.ml index 0016450b8..8b6d427e1 100644 --- a/src/passes/1-parser/shared/LexerUnit.ml +++ b/src/passes/1-parser/shared/LexerUnit.ml @@ -1,7 +1,8 @@ -(* Functor to build a standalone LIGO lexer *) +(* Functor to build a LIGO lexer *) module Region = Simple_utils.Region module Preproc = Preprocessor.Preproc +module SSet = Set.Make (String) module type IO = sig @@ -27,9 +28,10 @@ module Make (IO: IO) (Lexer: Lexer.S) = None | Some "-" -> () | Some pos_fname -> buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in - match Preproc.lex IO.options buffer with + let opt = (IO.options :> Preprocessor.EvalOpt.options) in + match Preproc.lex opt buffer with Stdlib.Error (pp_buffer, err) -> - if Utils.String.Set.mem "preproc" IO.options#verbose then + if SSet.mem "preproc" IO.options#verbose then Printf.printf "%s\n%!" (Buffer.contents pp_buffer); let formatted = Preproc.format ~offsets:IO.options#offsets ~file:true err @@ -79,17 +81,18 @@ module Make (IO: IO) (Lexer: Lexer.S) = match IO.options#input with None | Some "-" -> () | Some pos_fname -> - buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in - match Preproc.lex IO.options buffer with + buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in + let opt = (IO.options :> Preprocessor.EvalOpt.options) in + match Preproc.lex opt buffer with Stdlib.Error (pp_buffer, err) -> - if Utils.String.Set.mem "preproc" IO.options#verbose then + if SSet.mem "preproc" IO.options#verbose then Printf.printf "%s\n%!" (Buffer.contents pp_buffer); let formatted = Preproc.format ~offsets:IO.options#offsets ~file:true err in Stdlib.Error formatted | Stdlib.Ok pp_buffer -> let preproc_str = Buffer.contents pp_buffer in - if Utils.String.Set.mem "preproc" IO.options#verbose then + if SSet.mem "preproc" IO.options#verbose then begin Printf.printf "%s\n%!" (Buffer.contents pp_buffer); Stdlib.Ok () diff --git a/src/passes/1-parser/shared/ParserAPI.ml b/src/passes/1-parser/shared/ParserAPI.ml index 5e248b2c8..ad525c1a9 100644 --- a/src/passes/1-parser/shared/ParserAPI.ml +++ b/src/passes/1-parser/shared/ParserAPI.ml @@ -2,9 +2,15 @@ module Region = Simple_utils.Region +type options = < + offsets : bool; + mode : [`Byte | `Point]; + cmd : EvalOpt.command +> + module type IO = sig - val options : EvalOpt.options (* CLI options *) + val options : options end module type PARSER = @@ -49,7 +55,7 @@ module type PARSER = (* Main functor *) -module Make (IO : IO) +module Make (IO: IO) (Lexer: Lexer.S) (Parser: PARSER with type token = Lexer.Token.token) (ParErr: sig val message : int -> string end) = @@ -132,8 +138,9 @@ module Make (IO : IO) module Incr = Parser.Incremental module Log = LexerLog.Make (Lexer) - let log = Log.output_token ~offsets:IO.options#offsets - IO.options#mode IO.options#cmd stdout + let log = Log.output_token + ~offsets:IO.options#offsets + IO.options#mode IO.options#cmd stdout let incr_contract Lexer.{read; buffer; get_win; close; _} = let supplier = I.lexer_lexbuf_to_supplier (read ~log) buffer diff --git a/src/passes/1-parser/shared/ParserAPI.mli b/src/passes/1-parser/shared/ParserAPI.mli index ccfc8c214..e801db79c 100644 --- a/src/passes/1-parser/shared/ParserAPI.mli +++ b/src/passes/1-parser/shared/ParserAPI.mli @@ -2,9 +2,15 @@ module Region = Simple_utils.Region +type options = < + offsets : bool; + mode : [`Byte | `Point]; + cmd : EvalOpt.command +> + module type IO = sig - val options : EvalOpt.options (* CLI options *) + val options : options end (* The signature generated by Menhir with additional type definitions diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index 4f965499e..89bb03a61 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -1,10 +1,26 @@ -(* Functor to build a standalone LIGO parser *) +(* Functor to build a LIGO parser *) -module Region = Simple_utils.Region +module Region = Simple_utils.Region +module Preproc = Preprocessor.Preproc +module SSet = Set.Make (String) -module type IO = +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] + +module type SubIO = sig - val options : EvalOpt.options (* CLI options *) + type options = < + libs : string list; + verbose : SSet.t; + offsets : bool; + lang : language; + ext : string; (* ".ligo", ".mligo", ".religo" *) + mode : [`Byte | `Point]; + cmd : EvalOpt.command; + mono : bool + > + + val options : options + val make : input:string option -> expr:bool -> EvalOpt.options end module type Pretty = @@ -31,18 +47,18 @@ module Make (Lexer: Lexer.S) (ParErr: sig val message : int -> string end) (ParserLog: Pretty with type ast = AST.t and type expr = AST.expr) - (IO: IO) = + (SubIO: SubIO) = struct open Printf - module SSet = Utils.String.Set + module SSet = Set.Make (String) (* Log of the lexer *) module Log = LexerLog.Make (Lexer) let log = - Log.output_token ~offsets:IO.options#offsets - IO.options#mode IO.options#cmd stdout + Log.output_token ~offsets:SubIO.options#offsets + SubIO.options#mode SubIO.options#cmd stdout (* Error handling (reexported from [ParserAPI]) *) @@ -53,7 +69,12 @@ module Make (Lexer: Lexer.S) (* Instantiating the parser *) - module Front = ParserAPI.Make (IO)(Lexer)(Parser)(ParErr) + module API_IO = + struct + let options = (SubIO.options :> ParserAPI.options) + end + + module Front = ParserAPI.Make (API_IO)(Lexer)(Parser)(ParErr) let format_error = Front.format_error @@ -66,13 +87,13 @@ module Make (Lexer: Lexer.S) (AST.expr, message Region.reg) Stdlib.result = let output = Buffer.create 131 in let state = - ParserLog.mk_state ~offsets:IO.options#offsets - ~mode:IO.options#mode + ParserLog.mk_state ~offsets:SubIO.options#offsets + ~mode:SubIO.options#mode ~buffer:output in let close () = lexer_inst.Lexer.close () in let expr = try - if IO.options#mono then + if SubIO.options#mono then let tokeniser = lexer_inst.Lexer.read ~log and lexbuf = lexer_inst.Lexer.buffer in Front.mono_expr tokeniser lexbuf @@ -80,14 +101,14 @@ module Make (Lexer: Lexer.S) Front.incr_expr lexer_inst with exn -> close (); raise exn in let () = - if SSet.mem "ast-tokens" IO.options#verbose then + if SSet.mem "ast-tokens" SubIO.options#verbose then begin Buffer.clear output; ParserLog.print_expr state expr; Buffer.output_buffer stdout output end in let () = - if SSet.mem "ast" IO.options#verbose then + if SSet.mem "ast" SubIO.options#verbose then begin Buffer.clear output; ParserLog.pp_expr state expr; @@ -101,13 +122,13 @@ module Make (Lexer: Lexer.S) (AST.t, message Region.reg) Stdlib.result = let output = Buffer.create 131 in let state = - ParserLog.mk_state ~offsets:IO.options#offsets - ~mode:IO.options#mode + ParserLog.mk_state ~offsets:SubIO.options#offsets + ~mode:SubIO.options#mode ~buffer:output in let close () = lexer_inst.Lexer.close () in let ast = try - if IO.options#mono then + if SubIO.options#mono then let tokeniser = lexer_inst.Lexer.read ~log and lexbuf = lexer_inst.Lexer.buffer in Front.mono_contract tokeniser lexbuf @@ -115,14 +136,14 @@ module Make (Lexer: Lexer.S) Front.incr_contract lexer_inst with exn -> close (); raise exn in let () = - if SSet.mem "ast-tokens" IO.options#verbose then + if SSet.mem "ast-tokens" SubIO.options#verbose then begin Buffer.clear output; ParserLog.print_tokens state ast; Buffer.output_buffer stdout output end in let () = - if SSet.mem "ast" IO.options#verbose then + if SSet.mem "ast" SubIO.options#verbose then begin Buffer.clear output; ParserLog.pp_ast state ast; @@ -130,9 +151,16 @@ module Make (Lexer: Lexer.S) end in flush_all (); close (); Ok ast - (* Wrapper for the parsers above *) + (* Checking if a lexer input is a file *) - type 'a parser = Lexer.instance -> ('a, message Region.reg) result + let is_file input = + let open Lexer in + match input with + File "-" | File "" -> false + | File _ -> true + | Stdin | String _ | Channel _ | Buffer _ -> false + + (* Wrapper for the parsers above *) let apply lexer_inst parser = (* Calling the parser and filtering errors *) @@ -144,21 +172,18 @@ module Make (Lexer: Lexer.S) (* Lexing errors *) | exception Lexer.Error err -> - let file = - match IO.options#input with - None | Some "-" -> false - | Some _ -> true in + let file = is_file lexer_inst.Lexer.input in let error = - Lexer.format_error ~offsets:IO.options#offsets - IO.options#mode err ~file + Lexer.format_error ~offsets:SubIO.options#offsets + SubIO.options#mode err ~file in Stdlib.Error error (* Incremental API of Menhir *) | exception Front.Point point -> let error = - Front.format_error ~offsets:IO.options#offsets - IO.options#mode point + Front.format_error ~offsets:SubIO.options#offsets + SubIO.options#mode point in Stdlib.Error error (* Monolithic API of Menhir *) @@ -168,16 +193,68 @@ module Make (Lexer: Lexer.S) match lexer_inst.Lexer.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 + | Lexer.One invalid -> invalid, None + | Lexer.Two (invalid, valid) -> invalid, Some valid in let point = "", valid_opt, invalid in let error = - Front.format_error ~offsets:IO.options#offsets - IO.options#mode point + Front.format_error ~offsets:SubIO.options#offsets + SubIO.options#mode point in Stdlib.Error error (* I/O errors *) | exception Sys_error error -> flush_all (); Stdlib.Error (Region.wrap_ghost error) + + (* Preprocessing the input source *) + + let preproc options lexbuf = + Preproc.lex (options :> Preprocessor.EvalOpt.options) lexbuf + + (* Parsing a contract *) + + let gen_parser options input parser = + match Lexer.lexbuf_from_input input with + Stdlib.Error (Lexer.File_opening msg) -> + Stdlib.Error (Region.wrap_ghost msg) + | Ok (lexbuf, close) -> + (* Preprocessing the input source *) + + match preproc options lexbuf with + Stdlib.Error (pp_buffer, err) -> + if SSet.mem "preproc" options#verbose then + Printf.printf "%s\n%!" (Buffer.contents pp_buffer); + let formatted = + Preproc.format ~offsets:options#offsets + ~file:(is_file input) + err + in close (); Stdlib.Error formatted + | Stdlib.Ok buffer -> + (* Lexing and parsing the preprocessed input source *) + + let () = close () in + let input' = Lexer.String (Buffer.contents buffer) in + match Lexer.open_token_stream input' with + Ok instance -> apply instance parser + | Stdlib.Error (Lexer.File_opening msg) -> + Stdlib.Error (Region.wrap_ghost msg) + + (* Parsing a contract in a file *) + + let parse_file (source : string) = + let options = SubIO.make ~input:(Some source) ~expr:false + in gen_parser options (Lexer.File source) parse_contract + + (* Parsing a contract in a string *) + + let parse_string (source : string) = + let options = SubIO.make ~input:None ~expr:false in + gen_parser options (Lexer.String source) parse_contract + + (* Parsing an expression in a string *) + + let parse_expression (source : string) = + let options = SubIO.make ~input:None ~expr:true in + gen_parser options (Lexer.String source) parse_expr + end diff --git a/src/passes/1-parser/shared/ParserUnit.mli b/src/passes/1-parser/shared/ParserUnit.mli index 34ba30dc5..54cbc4847 100644 --- a/src/passes/1-parser/shared/ParserUnit.mli +++ b/src/passes/1-parser/shared/ParserUnit.mli @@ -2,9 +2,25 @@ module Region = Simple_utils.Region -module type IO = +type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO] + +module SSet : Set.S with type elt = string and type t = Set.Make(String).t + +module type SubIO = sig - val options : EvalOpt.options (* CLI options *) + type options = < + libs : string list; + verbose : SSet.t; + offsets : bool; + lang : language; + ext : string; (* ".ligo", ".mligo", ".religo" *) + mode : [`Byte | `Point]; + cmd : EvalOpt.command; + mono : bool + > + + val options : options + val make : input:string option -> expr:bool -> EvalOpt.options end module type Pretty = @@ -31,7 +47,7 @@ module Make (Lexer : Lexer.S) (ParErr : sig val message : int -> string end) (ParserLog : Pretty with type ast = AST.t and type expr = AST.expr) - (IO: IO) : + (SubIO: SubIO) : sig (* Error handling reexported from [ParserAPI] without the exception [Point] *) @@ -49,10 +65,12 @@ module Make (Lexer : Lexer.S) (* Parsers *) - type 'a parser = Lexer.instance -> ('a, message Region.reg) result + val parse_file : + string -> (AST.t, message Region.reg) Stdlib.result - val apply : Lexer.instance -> 'a parser -> ('a, message Region.reg) result + val parse_string : + string -> (AST.t, message Region.reg) Stdlib.result - val parse_contract : AST.t parser - val parse_expr : AST.expr parser + val parse_expression : + string -> (AST.expr, message Region.reg) Stdlib.result end diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune index ecc9ff6fb..870ddb3c6 100644 --- a/src/passes/1-parser/shared/dune +++ b/src/passes/1-parser/shared/dune @@ -9,7 +9,7 @@ uutf getopt zarith - Preproc) + Preprocessor) (preprocess (pps bisect_ppx --conditional)) (modules @@ -18,8 +18,8 @@ ParserAPI Lexer LexerLog - Utils Markup + Utils FQueue EvalOpt Version)) diff --git a/vendors/UnionFind/UnionFind.install b/vendors/UnionFind/UnionFind.install index 692984e20..cc7a1853e 100644 --- a/vendors/UnionFind/UnionFind.install +++ b/vendors/UnionFind/UnionFind.install @@ -1,23 +1,9 @@ lib: [ "_build/install/default/lib/UnionFind/META" - "_build/install/default/lib/UnionFind/Partition.cmi" - "_build/install/default/lib/UnionFind/Partition.cmti" "_build/install/default/lib/UnionFind/Partition.mli" - "_build/install/default/lib/UnionFind/Partition0.cmi" - "_build/install/default/lib/UnionFind/Partition0.cmt" - "_build/install/default/lib/UnionFind/Partition0.cmx" "_build/install/default/lib/UnionFind/Partition0.ml" - "_build/install/default/lib/UnionFind/Partition1.cmi" - "_build/install/default/lib/UnionFind/Partition1.cmt" - "_build/install/default/lib/UnionFind/Partition1.cmx" "_build/install/default/lib/UnionFind/Partition1.ml" - "_build/install/default/lib/UnionFind/Partition2.cmi" - "_build/install/default/lib/UnionFind/Partition2.cmt" - "_build/install/default/lib/UnionFind/Partition2.cmx" "_build/install/default/lib/UnionFind/Partition2.ml" - "_build/install/default/lib/UnionFind/Partition3.cmi" - "_build/install/default/lib/UnionFind/Partition3.cmt" - "_build/install/default/lib/UnionFind/Partition3.cmx" "_build/install/default/lib/UnionFind/Partition3.ml" "_build/install/default/lib/UnionFind/UnionFind.a" "_build/install/default/lib/UnionFind/UnionFind.cma" @@ -29,6 +15,24 @@ lib: [ "_build/install/default/lib/UnionFind/unionFind.cmt" "_build/install/default/lib/UnionFind/unionFind.cmx" "_build/install/default/lib/UnionFind/unionFind.ml" + "_build/install/default/lib/UnionFind/unionFind__.cmi" + "_build/install/default/lib/UnionFind/unionFind__.cmt" + "_build/install/default/lib/UnionFind/unionFind__.cmx" + "_build/install/default/lib/UnionFind/unionFind__.ml" + "_build/install/default/lib/UnionFind/unionFind__Partition.cmi" + "_build/install/default/lib/UnionFind/unionFind__Partition.cmti" + "_build/install/default/lib/UnionFind/unionFind__Partition0.cmi" + "_build/install/default/lib/UnionFind/unionFind__Partition0.cmt" + "_build/install/default/lib/UnionFind/unionFind__Partition0.cmx" + "_build/install/default/lib/UnionFind/unionFind__Partition1.cmi" + "_build/install/default/lib/UnionFind/unionFind__Partition1.cmt" + "_build/install/default/lib/UnionFind/unionFind__Partition1.cmx" + "_build/install/default/lib/UnionFind/unionFind__Partition2.cmi" + "_build/install/default/lib/UnionFind/unionFind__Partition2.cmt" + "_build/install/default/lib/UnionFind/unionFind__Partition2.cmx" + "_build/install/default/lib/UnionFind/unionFind__Partition3.cmi" + "_build/install/default/lib/UnionFind/unionFind__Partition3.cmt" + "_build/install/default/lib/UnionFind/unionFind__Partition3.cmx" ] doc: [ "_build/install/default/doc/UnionFind/LICENSE" diff --git a/vendors/UnionFind/dune b/vendors/UnionFind/dune index 192e35c79..cec9da6ac 100644 --- a/vendors/UnionFind/dune +++ b/vendors/UnionFind/dune @@ -1,6 +1,6 @@ (library (name UnionFind) (public_name UnionFind) - (wrapped false) + (wrapped true) (modules Partition0 Partition1 Partition2 Partition3 Partition UnionFind) (modules_without_implementation Partition))