diff --git a/src/passes/1-parser/cameligo/.links b/src/passes/1-parser/cameligo/.links index a3ac060f6..1ec7a1fe9 100644 --- a/src/passes/1-parser/cameligo/.links +++ b/src/passes/1-parser/cameligo/.links @@ -1,8 +1,20 @@ $HOME/git/OCaml-build/Makefile + $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml + +$HOME/git/ligo/vendors/Preprocessor/E_AST.ml +$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml +$HOME/git/ligo/vendors/Preprocessor/Preproc.mli +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli +$HOME/git/ligo/vendors/Preprocessor/Preproc.mll +$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mli +$HOME/git/ligo/vendors/Preprocessor/E_Parser.mly +$HOME/git/ligo/vendors/Preprocessor/.E_Parser.mly.tag + ../shared/Lexer.mli ../shared/Lexer.mll ../shared/EvalOpt.ml @@ -17,7 +29,12 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/Utils.ml ../shared/ParserAPI.mli ../shared/ParserAPI.ml +../shared/LexerUnit.mli ../shared/LexerUnit.ml +../shared/ParserUnit.mli ../shared/ParserUnit.ml + Stubs/Simple_utils.ml +Stubs/Preprocessor.ml + $HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml \ No newline at end of file diff --git a/src/passes/1-parser/cameligo/LexerMain.ml b/src/passes/1-parser/cameligo/LexerMain.ml index 60874bda0..830e574f8 100644 --- a/src/passes/1-parser/cameligo/LexerMain.ml +++ b/src/passes/1-parser/cameligo/LexerMain.ml @@ -4,8 +4,7 @@ module Region = Simple_utils.Region module IO = struct - let ext = ".mligo" - let options = EvalOpt.read "CameLIGO" ext + let options = EvalOpt.(read ~lang:CameLIGO ~ext:".mligo") end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) diff --git a/src/passes/1-parser/cameligo/ParserMain.ml b/src/passes/1-parser/cameligo/ParserMain.ml index 9c481f178..89c5a002c 100644 --- a/src/passes/1-parser/cameligo/ParserMain.ml +++ b/src/passes/1-parser/cameligo/ParserMain.ml @@ -2,8 +2,7 @@ module IO = struct - let ext = ".mligo" - let options = EvalOpt.read "CameLIGO" ext + let options = EvalOpt.(read ~lang:CameLIGO ~ext:".mligo") end module Parser = @@ -98,7 +97,7 @@ let prefix = None | Some "-" -> "temp" | Some file -> Filename.(file |> basename |> remove_extension) -let suffix = ".pp" ^ IO.ext +let suffix = ".pp" ^ IO.options#ext let pp_input = if SSet.mem "cpp" IO.options#verbose diff --git a/src/passes/1-parser/cameligo/Stubs/Preprocessor.ml b/src/passes/1-parser/cameligo/Stubs/Preprocessor.ml new file mode 100644 index 000000000..7391fb5e8 --- /dev/null +++ b/src/passes/1-parser/cameligo/Stubs/Preprocessor.ml @@ -0,0 +1 @@ +module Preproc = Preproc diff --git a/src/passes/1-parser/pascaligo/.links b/src/passes/1-parser/pascaligo/.links index 70b9b360f..36babbfbf 100644 --- a/src/passes/1-parser/pascaligo/.links +++ b/src/passes/1-parser/pascaligo/.links @@ -1,8 +1,20 @@ $HOME/git/OCaml-build/Makefile + $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml + +$HOME/git/ligo/vendors/Preprocessor/E_AST.ml +$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml +$HOME/git/ligo/vendors/Preprocessor/Preproc.mli +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli +$HOME/git/ligo/vendors/Preprocessor/Preproc.mll +$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mli +$HOME/git/ligo/vendors/Preprocessor/E_Parser.mly +$HOME/git/ligo/vendors/Preprocessor/.E_Parser.mly.tag + ../shared/Lexer.mli ../shared/Lexer.mll ../shared/EvalOpt.ml @@ -21,7 +33,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/LexerUnit.ml ../shared/ParserUnit.mli ../shared/ParserUnit.ml -../shared/Memo.mli -../shared/Memo.ml + Stubs/Simple_utils.ml -$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml \ No newline at end of file +Stubs/Preprocessor.ml + +$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml diff --git a/src/passes/1-parser/pascaligo/LexerMain.ml b/src/passes/1-parser/pascaligo/LexerMain.ml index 32606118a..803939842 100644 --- a/src/passes/1-parser/pascaligo/LexerMain.ml +++ b/src/passes/1-parser/pascaligo/LexerMain.ml @@ -4,8 +4,7 @@ module Region = Simple_utils.Region module IO = struct - let ext = ".ligo" - let options = EvalOpt.read "PascaLIGO" ext + let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo") end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index 464094f85..809673f86 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -2,8 +2,7 @@ module IO = struct - let ext = ".ligo" - let options = EvalOpt.read "PascaLIGO" ext + let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo") end module Parser = @@ -110,7 +109,7 @@ let prefix = None | Some "-" -> "temp" | Some file -> Filename.(file |> basename |> remove_extension) -let suffix = ".pp" ^ IO.ext +let suffix = ".pp" ^ IO.options#ext let pp_input = if SSet.mem "cpp" IO.options#verbose diff --git a/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml b/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml new file mode 100644 index 000000000..7391fb5e8 --- /dev/null +++ b/src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml @@ -0,0 +1 @@ +module Preproc = Preproc diff --git a/src/passes/1-parser/pascaligo/dune b/src/passes/1-parser/pascaligo/dune index d0d43f02f..a63252fe7 100644 --- a/src/passes/1-parser/pascaligo/dune +++ b/src/passes/1-parser/pascaligo/dune @@ -20,6 +20,7 @@ menhirLib parser_shared hex + Preprocessor simple-utils) (preprocess (pps bisect_ppx --conditional)) @@ -77,8 +78,8 @@ ; (targets error.messages) ; (deps Parser.mly ParToken.mly error.messages.checked-in) ; (action -; (with-stdout-to %{targets} -; (bash +; (with-stdout-to %{targets} +; (bash ; "menhir \ ; --unused-tokens \ ; --list-errors \ @@ -97,11 +98,11 @@ (targets error.messages) (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli) (action - (with-stdout-to %{targets} - (run + (with-stdout-to %{targets} + (run menhir --unused-tokens - --update-errors error.messages.checked-in + --update-errors error.messages.checked-in --table --strict --external-tokens LexToken.mli @@ -115,8 +116,8 @@ (rule (target error.messages.new) (action - (with-stdout-to %{target} - (run + (with-stdout-to %{target} + (run menhir --unused-tokens --list-errors @@ -135,7 +136,7 @@ (name runtest) (deps error.messages error.messages.new) (action - (run + (run menhir --unused-tokens --table @@ -156,8 +157,8 @@ (targets ParErr.ml) (deps Parser.mly ParToken.mly error.messages.checked-in LexToken.mli) (action - (with-stdout-to %{targets} - (run + (with-stdout-to %{targets} + (run menhir --unused-tokens --table @@ -170,4 +171,3 @@ ) )) ) - diff --git a/src/passes/1-parser/reasonligo/.links b/src/passes/1-parser/reasonligo/.links index d93e4b610..dd5eba1c3 100644 --- a/src/passes/1-parser/reasonligo/.links +++ b/src/passes/1-parser/reasonligo/.links @@ -1,8 +1,20 @@ $HOME/git/OCaml-build/Makefile + $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml + +$HOME/git/ligo/vendors/Preprocessor/E_AST.ml +$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml +$HOME/git/ligo/vendors/Preprocessor/Preproc.mli +$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli +$HOME/git/ligo/vendors/Preprocessor/Preproc.mll +$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mli +$HOME/git/ligo/vendors/Preprocessor/E_Parser.mly +$HOME/git/ligo/vendors/Preprocessor/.E_Parser.mly.tag + ../shared/Lexer.mli ../shared/Lexer.mll ../shared/EvalOpt.ml @@ -17,13 +29,19 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml ../shared/Utils.ml ../shared/ParserAPI.mli ../shared/ParserAPI.ml +../shared/LexerUnit.mli ../shared/LexerUnit.ml +../shared/ParserUnit.mli ../shared/ParserUnit.ml + Stubs/Simple_utils.ml Stubs/Parser_cameligo.ml +Stubs/Preprocessor.ml + ../cameligo/AST.ml ../cameligo/ParserLog.mli ../cameligo/ParserLog.ml ../cameligo/Scoping.mli ../cameligo/Scoping.ml -$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml \ No newline at end of file + +$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml diff --git a/src/passes/1-parser/reasonligo/LexerMain.ml b/src/passes/1-parser/reasonligo/LexerMain.ml index 7e8e063da..3ef81d69d 100644 --- a/src/passes/1-parser/reasonligo/LexerMain.ml +++ b/src/passes/1-parser/reasonligo/LexerMain.ml @@ -4,8 +4,7 @@ module Region = Simple_utils.Region module IO = struct - let ext = ".religo" - let options = EvalOpt.read "ReasonLIGO" ext + let options = EvalOpt.(read ~lang:ReasonLIGO ~ext:".religo") end module M = LexerUnit.Make (IO) (Lexer.Make (LexToken)) diff --git a/src/passes/1-parser/reasonligo/ParserMain.ml b/src/passes/1-parser/reasonligo/ParserMain.ml index 6d27665a2..ae036f336 100644 --- a/src/passes/1-parser/reasonligo/ParserMain.ml +++ b/src/passes/1-parser/reasonligo/ParserMain.ml @@ -2,8 +2,7 @@ module IO = struct - let ext = ".religo" - let options = EvalOpt.read "ReasonLIGO" ext + let options = EvalOpt.(read ~lang:ReasonLIGO ~ext:".religo") end module Parser = @@ -113,7 +112,7 @@ let prefix = None | Some "-" -> "temp" | Some file -> Filename.(file |> basename |> remove_extension) -let suffix = ".pp" ^ IO.ext +let suffix = ".pp" ^ IO.options#ext let pp_input = if SSet.mem "cpp" IO.options#verbose diff --git a/src/passes/1-parser/reasonligo/Stubs/Preprocessor.ml b/src/passes/1-parser/reasonligo/Stubs/Preprocessor.ml new file mode 100644 index 000000000..7391fb5e8 --- /dev/null +++ b/src/passes/1-parser/reasonligo/Stubs/Preprocessor.ml @@ -0,0 +1 @@ +module Preproc = Preproc diff --git a/src/passes/1-parser/shared/.links b/src/passes/1-parser/shared/.links index c366f9924..df8a82cd9 100644 --- a/src/passes/1-parser/shared/.links +++ b/src/passes/1-parser/shared/.links @@ -1,7 +1,7 @@ $HOME/git/OCaml-build/Makefile $HOME/git/OCaml-build/Makefile.cfg + $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml -$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 30277f72f..9f2b641d5 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -1,36 +1,47 @@ -(** Parsing command-line options *) +(* Parsing command-line options *) + +(* The type [command] denotes some possible behaviours of the + compiler. *) -(** The type [command] denotes some possible behaviours of the - compiler. -*) type command = Quiet | Copy | Units | Tokens -(** The type [options] gathers the command-line options. -*) +type language = PascaLIGO | CameLIGO | ReasonLIGO + +let lang_to_string = function + PascaLIGO -> "PascaLIGO" +| CameLIGO -> "CameLIGO" +| ReasonLIGO -> "ReasonLIGO" + +(* The type [options] gathers the command-line options. *) + type options = < input : string option; libs : string list; verbose : Utils.String.Set.t; offsets : bool; + lang : language; + ext : string; (* ".ligo", ".mligo", ".religo" *) mode : [`Byte | `Point]; cmd : command; mono : bool; expr : bool > -let make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr = +let make ~input ~libs ~verbose ~offsets ~lang ~ext ~mode ~cmd ~mono ~expr : options = object method input = input method libs = libs method verbose = verbose method offsets = offsets + method lang = lang + method ext = ext method mode = mode method cmd = cmd method mono = mono method expr = expr end -(** {1 Auxiliary functions} *) +(* Auxiliary functions *) let printf = Printf.printf let sprintf = Printf.sprintf @@ -39,7 +50,7 @@ let print = print_endline let abort msg = Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1 -(** {1 Help} *) +(* Help *) let help language extension () = let file = Filename.basename Sys.argv.(0) in @@ -55,16 +66,16 @@ let help language extension () = print " --bytes Bytes for source locations"; print " --mono Use Menhir monolithic API"; print " --expr Parse an expression"; - print " --verbose= cli, cpp, ast-tokens, ast (colon-separated)"; + print " --verbose= cli, preproc, ast-tokens, ast (colon-separated)"; print " --version Commit hash on stdout"; print " -h, --help This help"; exit 0 -(** {1 Version} *) +(* Version *) let version () = printf "%s\n" Version.version; exit 0 -(** {1 Specifying the command-line options a la GNU} *) +(* Specifying the command-line options a la GNU *) let copy = ref false and tokens = ref false @@ -89,6 +100,7 @@ let add_verbose d = (split_at_colon d) let specs language extension = + let language = lang_to_string language in let open! Getopt in [ 'I', nolong, None, Some add_path; 'c', "copy", set copy true, None; @@ -105,17 +117,15 @@ let specs language extension = ] ;; -(** Handler of anonymous arguments -*) +(* Handler of anonymous arguments *) + let anonymous arg = match !input with None -> input := Some arg - | Some s -> Printf.printf "s=%s\n" s; - abort (sprintf "Multiple inputs") -;; + | Some _ -> abort (sprintf "Multiple inputs") + +(* Checking options and exporting them as non-mutable values *) -(** Checking options and exporting them as non-mutable values -*) let string_of convert = function None -> "None" | Some s -> sprintf "Some %s" (convert s) @@ -139,9 +149,8 @@ let print_opt () = printf "verbose = %s\n" !verb_str; printf "input = %s\n" (string_of quote !input); printf "libs = %s\n" (string_of_path !libs) -;; -let check extension = +let check lang ext = let () = if Utils.String.Set.mem "cli" !verbose then print_opt () in @@ -149,11 +158,11 @@ let check extension = match !input with None | Some "-" -> !input | Some file_path -> - if Filename.check_suffix file_path extension + if Filename.check_suffix file_path ext then if Sys.file_exists file_path then Some file_path else abort "Source file not found." - else abort ("Source file lacks the extension " ^ extension ^ ".") in + else abort ("Source file lacks the extension " ^ ext ^ ".") in (* Exporting remaining options as non-mutable values *) @@ -194,16 +203,16 @@ let check extension = | false, false, false, true -> Tokens | _ -> abort "Choose one of -q, -c, -u, -t." - in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr + in make ~input ~libs ~verbose ~offsets ~mode ~cmd ~mono ~expr ~lang ~ext -(** {1 Parsing the command-line options} *) +(* Parsing the command-line options *) -let read language extension = +let read ~lang ~ext = try - Getopt.parse_cmdline (specs language extension) anonymous; + Getopt.parse_cmdline (specs lang ext) anonymous; (verb_str := let apply e a = if a = "" then e else Printf.sprintf "%s, %s" e a in Utils.String.Set.fold apply !verbose ""); - check extension + 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 95363469c..b71ede371 100644 --- a/src/passes/1-parser/shared/EvalOpt.mli +++ b/src/passes/1-parser/shared/EvalOpt.mli @@ -48,11 +48,18 @@ type command = Quiet | Copy | Units | Tokens expressions is used, otherwise a full-fledged contract is expected.} } *) + +type language = PascaLIGO | CameLIGO | ReasonLIGO + +val lang_to_string : language -> string + type options = < input : string option; libs : string list; verbose : Utils.String.Set.t; offsets : bool; + lang : language; + ext : string; (* ".ligo", ".mligo", ".religo" *) mode : [`Byte | `Point]; cmd : command; mono : bool; @@ -64,6 +71,8 @@ val make : libs:string list -> verbose:Utils.String.Set.t -> offsets:bool -> + lang:language -> + ext:string -> mode:[`Byte | `Point] -> cmd:command -> mono:bool -> @@ -71,7 +80,7 @@ val make : options (** Parsing the command-line options on stdin. The first parameter is - the name of the concrete syntax, e.g., "pascaligo", and the second - is the file extension, e.g., ".ligo". - *) -val read : string -> string -> options + the name of the concrete syntax, e.g., [PascaLIGO], and the second + is the expected file extension, e.g., ".ligo". *) + +val read : lang:language -> ext:string -> options diff --git a/src/passes/1-parser/shared/Lexer.mll b/src/passes/1-parser/shared/Lexer.mll index 569486ef7..45d924769 100644 --- a/src/passes/1-parser/shared/Lexer.mll +++ b/src/passes/1-parser/shared/Lexer.mll @@ -254,7 +254,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) = Nil -> One token | One t | Two (t,_) -> Two (token,t) - (** Beyond tokens, the result of lexing is a state. The type + (* Beyond tokens, the result of lexing is a state. The type [state] represents the logical state of the lexing engine, that is, a value which is threaded during scanning and which denotes useful, high-level information beyond what the type @@ -292,6 +292,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) = it to [decoder]. See the documentation of the third-party library Uutf. *) + type state = { units : (Markup.t list * token) FQueue.t; markup : Markup.t list; @@ -648,21 +649,22 @@ and scan state = parse let state = scan_line thread state lexbuf |> push_line in scan state lexbuf } - (* Management of #include CPP directives + (* Management of #include preprocessing directives - An input LIGO program may contain GNU CPP (C preprocessor) - directives, and the entry modules (named *Main.ml) run CPP on them - in traditional mode: + An input LIGO program may contain preprocessing directives, and + the entry modules (named *Main.ml) run the preprocessor on them, + as if using the GNU C preprocessor in traditional mode: https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html - The main interest in using CPP is that it can stand for a poor - man's (flat) module system for LIGO thanks to #include - directives, and the traditional mode leaves the markup mostly - undisturbed. + The main interest in using a preprocessor is that it can stand + for a poor man's (flat) module system for LIGO thanks to #include + directives, and the equivalent of the traditional mode leaves the + markup undisturbed. - Some of the #line resulting from processing #include directives - deal with system file headers and thus have to be ignored for our + Contrary to the C preprocessor, our preprocessor does not + generate #line resulting from processing #include directives deal + with system file headers and thus have to be ignored for our purpose. Moreover, these #line directives may also carry some additional flags: @@ -671,7 +673,7 @@ and scan state = parse of which 1 and 2 indicate, respectively, the start of a new file and the return from a file (after its inclusion has been processed). - *) + *) | '#' blank* ("line" blank+)? (natural as line) blank+ '"' (string as file) '"' { diff --git a/src/passes/1-parser/shared/LexerLog.ml b/src/passes/1-parser/shared/LexerLog.ml index bf0cf6dde..5d1260f73 100644 --- a/src/passes/1-parser/shared/LexerLog.ml +++ b/src/passes/1-parser/shared/LexerLog.ml @@ -15,7 +15,7 @@ module type S = val trace : ?offsets:bool -> [`Byte | `Point] -> - file_path option -> EvalOpt.command -> + Lexer.input -> EvalOpt.command -> (unit, string Region.reg) Stdlib.result end @@ -49,16 +49,12 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) = type file_path = string - let trace ?(offsets=true) mode file_path_opt command : + let trace ?(offsets=true) mode input command : (unit, string Region.reg) Stdlib.result = - let input = - match file_path_opt with - Some file_path -> Lexer.File file_path - | None -> Lexer.Stdin in match Lexer.open_token_stream input with Ok Lexer.{read; buffer; close; _} -> let log = output_token ~offsets mode command stdout - and close_all () = close (); close_out stdout in + and close_all () = flush_all (); close () in let rec iter () = match read ~log buffer with token -> @@ -67,14 +63,14 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) = else iter () | exception Lexer.Error error -> let file = - match file_path_opt with - None | Some "-" -> false - | Some _ -> true in + match input with + Lexer.File name -> name <> "-" + | _ -> false in let msg = Lexer.format_error ~offsets mode ~file error in Stdlib.Error msg in let result = iter () in close_all (); result | Stdlib.Error (Lexer.File_opening msg) -> - close_out stdout; Stdlib.Error (Region.wrap_ghost msg) + flush_all (); Stdlib.Error (Region.wrap_ghost msg) end diff --git a/src/passes/1-parser/shared/LexerLog.mli b/src/passes/1-parser/shared/LexerLog.mli index 3e4776889..9e2bbce85 100644 --- a/src/passes/1-parser/shared/LexerLog.mli +++ b/src/passes/1-parser/shared/LexerLog.mli @@ -13,7 +13,7 @@ module type S = val trace : ?offsets:bool -> [`Byte | `Point] -> - file_path option -> EvalOpt.command -> + Lexer.input -> EvalOpt.command -> (unit, string Region.reg) Stdlib.result end diff --git a/src/passes/1-parser/shared/LexerUnit.ml b/src/passes/1-parser/shared/LexerUnit.ml index 6088ceb27..cb67f4038 100644 --- a/src/passes/1-parser/shared/LexerUnit.ml +++ b/src/passes/1-parser/shared/LexerUnit.ml @@ -1,110 +1,106 @@ (* Functor to build a standalone LIGO lexer *) module Region = Simple_utils.Region +module Preproc = Preprocessor.Preproc module type IO = sig - val ext : string (* LIGO file extension *) val options : EvalOpt.options (* CLI options *) end module Make (IO: IO) (Lexer: Lexer.S) = struct - open Printf - module SSet = Utils.String.Set - (* Error printing and exception tracing *) let () = Printexc.record_backtrace 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 - - (* Running the lexer on the input file *) + (* Preprocessing and lexing the input source *) let scan () : (Lexer.token list, string Region.reg) Stdlib.result = - (* Preprocessing the input *) + (* Preprocessing the input source *) - if SSet.mem "cpp" IO.options#verbose - then eprintf "%s\n%!" cpp_cmd - else (); + let preproc cin = + let buffer = Lexing.from_channel cin in + let open Lexing in + let () = + 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 + Stdlib.Error (pp_buffer, err) -> + if Utils.String.Set.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 -> + (* Running the lexer on the preprocessed input *) - if Sys.command cpp_cmd <> 0 then - let msg = - sprintf "External error: the command \"%s\" failed." cpp_cmd - in Stdlib.Error (Region.wrap_ghost msg) - else - match Lexer.open_token_stream (Lexer.File pp_input) with - Ok Lexer.{read; buffer; close; _} -> - let close_all () = close (); close_out stdout in - let rec read_tokens tokens = - match read ~log:(fun _ _ -> ()) buffer with - token -> - if Lexer.Token.is_eof token - then Stdlib.Ok (List.rev tokens) - else read_tokens (token::tokens) - | exception Lexer.Error error -> - let file = - match IO.options#input with - None | Some "-" -> false - | Some _ -> true in - let msg = - Lexer.format_error ~offsets:IO.options#offsets - IO.options#mode ~file error - in Stdlib.Error msg in - let result = read_tokens [] - in close_all (); result - | Stdlib.Error (Lexer.File_opening msg) -> - close_out stdout; Stdlib.Error (Region.wrap_ghost msg) + let preproc_str = Buffer.contents pp_buffer in + match Lexer.open_token_stream (Lexer.String preproc_str) with + Ok Lexer.{read; buffer; close; _} -> + let close_all () = flush_all (); close () in + let rec read_tokens tokens = + match read ~log:(fun _ _ -> ()) buffer with + token -> + if Lexer.Token.is_eof token + then Stdlib.Ok (List.rev tokens) + else read_tokens (token::tokens) + | exception Lexer.Error error -> + let file = + match IO.options#input with + None | Some "-" -> false + | Some _ -> true in + let msg = + Lexer.format_error ~offsets:IO.options#offsets + IO.options#mode ~file error + in Stdlib.Error msg in + let result = read_tokens [] + in close_all (); result + | Stdlib.Error (Lexer.File_opening msg) -> + flush_all (); Stdlib.Error (Region.wrap_ghost msg) in + match IO.options#input with + Some "-" | None -> preproc stdin + | Some file_path -> + try open_in file_path |> preproc with + Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg) - (* Tracing the lexing (effectful) *) + (* Tracing the lexing *) module Log = LexerLog.Make (Lexer) let trace () : (unit, string Region.reg) Stdlib.result = (* Preprocessing the input *) - - if SSet.mem "cpp" IO.options#verbose - then eprintf "%s\n%!" cpp_cmd - else (); - - if Sys.command cpp_cmd <> 0 then - let msg = - sprintf "External error: the command \"%s\" failed." cpp_cmd - in Stdlib.Error (Region.wrap_ghost msg) - else - Log.trace ~offsets:IO.options#offsets - IO.options#mode - (Some pp_input) - IO.options#cmd - + let preproc cin = + let buffer = Lexing.from_channel cin in + let open Lexing in + let () = + 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 + Stdlib.Error (pp_buffer, err) -> + if Utils.String.Set.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 + begin + Printf.printf "%s\n%!" (Buffer.contents pp_buffer); + Stdlib.Ok () + end + else Log.trace ~offsets:IO.options#offsets + IO.options#mode + (Lexer.String preproc_str) + IO.options#cmd + in match IO.options#input with + Some "-" | None -> preproc stdin + | Some file_path -> + try open_in file_path |> preproc with + Sys_error msg -> Stdlib.Error (Region.wrap_ghost msg) end diff --git a/src/passes/1-parser/shared/LexerUnit.mli b/src/passes/1-parser/shared/LexerUnit.mli index 988785e45..804182515 100644 --- a/src/passes/1-parser/shared/LexerUnit.mli +++ b/src/passes/1-parser/shared/LexerUnit.mli @@ -4,7 +4,6 @@ module Region = Simple_utils.Region module type IO = sig - val ext : string (* LIGO file extension *) val options : EvalOpt.options (* CLI options *) end diff --git a/src/passes/1-parser/shared/ParserAPI.ml b/src/passes/1-parser/shared/ParserAPI.ml index a991c8da5..5e248b2c8 100644 --- a/src/passes/1-parser/shared/ParserAPI.ml +++ b/src/passes/1-parser/shared/ParserAPI.ml @@ -4,7 +4,6 @@ module Region = Simple_utils.Region module type IO = sig - val ext : string (* LIGO file extension *) val options : EvalOpt.options (* CLI options *) end @@ -110,9 +109,9 @@ module Make (IO : IO) let failure get_win checkpoint = let message = ParErr.message (state checkpoint) in - let message = if message = "\n" then + let message = if message = "\n" then (string_of_int (state checkpoint)) ^ ": " - else + else message in match get_win () with @@ -141,12 +140,12 @@ module Make (IO : IO) and failure = failure get_win in let parser = Incr.contract buffer.Lexing.lex_curr_p in let ast = I.loop_handle success failure supplier parser - in close (); ast + in flush_all (); close (); ast let incr_expr Lexer.{read; buffer; get_win; close; _} = let supplier = I.lexer_lexbuf_to_supplier (read ~log) buffer and failure = failure get_win in let parser = Incr.interactive_expr buffer.Lexing.lex_curr_p in let expr = I.loop_handle success failure supplier parser - in close (); expr + in flush_all (); close (); expr end diff --git a/src/passes/1-parser/shared/ParserAPI.mli b/src/passes/1-parser/shared/ParserAPI.mli index d4a3791ee..ccfc8c214 100644 --- a/src/passes/1-parser/shared/ParserAPI.mli +++ b/src/passes/1-parser/shared/ParserAPI.mli @@ -4,7 +4,6 @@ module Region = Simple_utils.Region module type IO = sig - val ext : string (* LIGO file extension *) val options : EvalOpt.options (* CLI options *) end diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index a0aced070..4f965499e 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -4,7 +4,6 @@ module Region = Simple_utils.Region module type IO = sig - val ext : string (* LIGO file extension *) val options : EvalOpt.options (* CLI options *) end @@ -94,7 +93,7 @@ module Make (Lexer: Lexer.S) ParserLog.pp_expr state expr; Buffer.output_buffer stdout output end - in close (); Ok expr + in flush_all (); close (); Ok expr (* Parsing a contract *) @@ -129,7 +128,7 @@ module Make (Lexer: Lexer.S) ParserLog.pp_ast state ast; Buffer.output_buffer stdout output end - in close (); Ok ast + in flush_all (); close (); Ok ast (* Wrapper for the parsers above *) @@ -180,5 +179,5 @@ module Make (Lexer: Lexer.S) (* I/O errors *) | exception Sys_error error -> - Stdlib.Error (Region.wrap_ghost error) + flush_all (); Stdlib.Error (Region.wrap_ghost error) end diff --git a/src/passes/1-parser/shared/ParserUnit.mli b/src/passes/1-parser/shared/ParserUnit.mli index 645808757..34ba30dc5 100644 --- a/src/passes/1-parser/shared/ParserUnit.mli +++ b/src/passes/1-parser/shared/ParserUnit.mli @@ -4,7 +4,6 @@ module Region = Simple_utils.Region module type IO = sig - val ext : string (* LIGO file extension *) val options : EvalOpt.options (* CLI options *) end diff --git a/src/passes/1-parser/shared/dune b/src/passes/1-parser/shared/dune index 10e377a93..ecc9ff6fb 100644 --- a/src/passes/1-parser/shared/dune +++ b/src/passes/1-parser/shared/dune @@ -8,7 +8,8 @@ simple-utils uutf getopt - zarith) + zarith + Preproc) (preprocess (pps bisect_ppx --conditional)) (modules diff --git a/vendors/Preproc/E_LexerMain.ml b/vendors/Preproc/E_LexerMain.ml deleted file mode 100644 index 3ffed4506..000000000 --- a/vendors/Preproc/E_LexerMain.ml +++ /dev/null @@ -1,23 +0,0 @@ -module Region = Simple_utils.Region - -let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg - -let options = EvalOpt.read ();; - -match open_in options#input with - exception Sys_error msg -> highlight msg -| cin -> - let buffer = Lexing.from_channel cin in - let open Lexing in - let () = - buffer.lex_curr_p <- - {buffer.lex_curr_p with pos_fname = options#input} in - let rec iter () = - match E_Lexer.scan buffer with - token -> Printf.printf "%s\n" (E_Lexer.string_of_token token); - if token <> E_Parser.EOL then iter () - | exception E_Lexer.Error err -> - let formatted = - E_Lexer.format ~offsets:options#offsets ~file:true err - in highlight formatted.Region.value - in iter (); close_in cin diff --git a/vendors/Preproc/PreprocMain.ml b/vendors/Preproc/PreprocMain.ml deleted file mode 100644 index 42f8cbdfe..000000000 --- a/vendors/Preproc/PreprocMain.ml +++ /dev/null @@ -1,24 +0,0 @@ -module Region = Simple_utils.Region - -let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg - -let options = EvalOpt.read ();; - -match open_in options#input with - exception Sys_error msg -> highlight msg -| cin -> - let buffer = Lexing.from_channel cin in - let open Lexing in - let () = - buffer.lex_curr_p <- - {buffer.lex_curr_p with pos_fname = options#input} in - match Preproc.lex options buffer with - Stdlib.Ok pp_buffer -> print_string (Buffer.contents pp_buffer) - | Stdlib.Error (pp_buffer, err) -> - let formatted = - Preproc.format ~offsets:options#offsets ~file:true err in - begin - if EvalOpt.SSet.mem "preproc" options#verbose then - Printf.printf "%s\n%!" (Buffer.contents pp_buffer); - highlight formatted.Region.value - end diff --git a/vendors/Preproc/.E_LexerMain.tag b/vendors/Preprocessor/.E_LexerMain.tag similarity index 100% rename from vendors/Preproc/.E_LexerMain.tag rename to vendors/Preprocessor/.E_LexerMain.tag diff --git a/vendors/Preproc/.E_Parser.mly.tag b/vendors/Preprocessor/.E_Parser.mly.tag similarity index 100% rename from vendors/Preproc/.E_Parser.mly.tag rename to vendors/Preprocessor/.E_Parser.mly.tag diff --git a/vendors/Preproc/.E_ParserMain.tag b/vendors/Preprocessor/.E_ParserMain.tag similarity index 100% rename from vendors/Preproc/.E_ParserMain.tag rename to vendors/Preprocessor/.E_ParserMain.tag diff --git a/vendors/Preproc/.PreprocMain.ml b/vendors/Preprocessor/.PreprocMain.ml similarity index 100% rename from vendors/Preproc/.PreprocMain.ml rename to vendors/Preprocessor/.PreprocMain.ml diff --git a/vendors/Preproc/.PreprocMain.tag b/vendors/Preprocessor/.PreprocMain.tag similarity index 100% rename from vendors/Preproc/.PreprocMain.tag rename to vendors/Preprocessor/.PreprocMain.tag diff --git a/vendors/Preproc/.links b/vendors/Preprocessor/.links similarity index 100% rename from vendors/Preproc/.links rename to vendors/Preprocessor/.links diff --git a/vendors/Preproc/E_AST.ml b/vendors/Preprocessor/E_AST.ml similarity index 100% rename from vendors/Preproc/E_AST.ml rename to vendors/Preprocessor/E_AST.ml diff --git a/vendors/Preproc/E_Lexer.mli b/vendors/Preprocessor/E_Lexer.mli similarity index 100% rename from vendors/Preproc/E_Lexer.mli rename to vendors/Preprocessor/E_Lexer.mli diff --git a/vendors/Preproc/E_Lexer.mll b/vendors/Preprocessor/E_Lexer.mll similarity index 100% rename from vendors/Preproc/E_Lexer.mll rename to vendors/Preprocessor/E_Lexer.mll diff --git a/vendors/Preprocessor/E_LexerMain.ml b/vendors/Preprocessor/E_LexerMain.ml new file mode 100644 index 000000000..b1d47c253 --- /dev/null +++ b/vendors/Preprocessor/E_LexerMain.ml @@ -0,0 +1,33 @@ +(* Standalone lexer for booleans expression of preprocessing + directives for PascaLIGO *) + +module Region = Simple_utils.Region + +let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg + +let options = EvalOpt.read ~lang:EvalOpt.PascaLIGO ~ext:".ligo" + +let lex in_chan = + let buffer = Lexing.from_channel in_chan in + let open Lexing in + let () = + match options#input with + Some "-" | None -> () + | Some pos_fname -> + buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in + let rec iter () = + match E_Lexer.scan buffer with + token -> Printf.printf "%s\n" (E_Lexer.string_of_token token); + if token <> E_Parser.EOL then iter () + | exception E_Lexer.Error err -> + let formatted = + E_Lexer.format ~offsets:options#offsets ~file:true err + in highlight formatted.Region.value + in iter (); close_in in_chan + +let () = + match options#input with + Some "-" | None -> lex stdin + | Some file_path -> + try open_in file_path |> lex with + Sys_error msg -> highlight msg diff --git a/vendors/Preproc/E_Parser.mly b/vendors/Preprocessor/E_Parser.mly similarity index 100% rename from vendors/Preproc/E_Parser.mly rename to vendors/Preprocessor/E_Parser.mly diff --git a/vendors/Preproc/E_ParserMain.ml b/vendors/Preprocessor/E_ParserMain.ml similarity index 52% rename from vendors/Preproc/E_ParserMain.ml rename to vendors/Preprocessor/E_ParserMain.ml index 8a6b6b1ff..4ea6817f5 100644 --- a/vendors/Preproc/E_ParserMain.ml +++ b/vendors/Preprocessor/E_ParserMain.ml @@ -1,17 +1,20 @@ +(* Standalone parser for booleans expression of preprocessing + directives for PascaLIGO *) + module Region = Simple_utils.Region let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg -let options = EvalOpt.read ();; +let options = EvalOpt.read ~lang:EvalOpt.PascaLIGO ~ext:".ligo" -match open_in options#input with - exception Sys_error msg -> highlight msg -| cin -> - let buffer = Lexing.from_channel cin in - let open Lexing in - let () = - buffer.lex_curr_p <- - {buffer.lex_curr_p with pos_fname = options#input} in +let parse in_chan = + let buffer = Lexing.from_channel in_chan in + let open Lexing in + let () = + match options#input with + Some "-" | None -> () + | Some pos_fname -> + buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in let () = try let tree = E_Parser.expr E_Lexer.scan buffer in @@ -20,8 +23,7 @@ match open_in options#input with with E_Lexer.Error error -> let formatted = - E_Lexer.format - ~offsets:options#offsets ~file:true error + E_Lexer.format ~offsets:options#offsets ~file:true error in highlight formatted.Region.value | E_Parser.Error -> let region = Preproc.mk_reg buffer @@ -31,4 +33,11 @@ match open_in options#input with Preproc.format ~offsets:options#offsets ~file:true error in highlight formatted.Region.value - in close_in cin + in close_in in_chan + +let () = + match options#input with + Some "-" | None -> parse stdin + | Some file_path -> + try open_in file_path |> parse with + Sys_error msg -> highlight msg diff --git a/vendors/Preproc/EvalOpt.ml b/vendors/Preprocessor/EvalOpt.ml similarity index 65% rename from vendors/Preproc/EvalOpt.ml rename to vendors/Preprocessor/EvalOpt.ml index c2ce869f6..ed6927960 100644 --- a/vendors/Preproc/EvalOpt.ml +++ b/vendors/Preprocessor/EvalOpt.ml @@ -2,25 +2,32 @@ (* The type [options] gathers the command-line options. *) -type language = PascaLIGO | CameLIGO | ReasonLIGO - module SSet = Set.Make (String) +type language = PascaLIGO | CameLIGO | ReasonLIGO + +let lang_to_string = function + PascaLIGO -> "PascaLIGO" +| CameLIGO -> "CameLIGO" +| ReasonLIGO -> "ReasonLIGO" + type options = < - input : string; + input : string option; libs : string list; - lang : language; + verbose : SSet.t; offsets : bool; - verbose : SSet.t + lang : language; + ext : string (* ".ligo", ".mligo", ".religo" *) > -let make ~input ~libs ~lang ~offsets ~verbose = +let make ~input ~libs ~lang ~offsets ~verbose ~ext : options = object method input = input method libs = libs method lang = lang method offsets = offsets method verbose = verbose + method ext = ext end (* Auxiliary functions and modules *) @@ -40,10 +47,10 @@ let abort msg = (* Help *) -let help () = +let help lang ext () = let file = Filename.basename Sys.argv.(0) in - printf "Usage: %s [