Integrated the library for preprocessing.
The build with Makefile works. Dune build to be tested.
This commit is contained in:
parent
ebff258882
commit
968e73b342
@ -1,8 +1,20 @@
|
|||||||
$HOME/git/OCaml-build/Makefile
|
$HOME/git/OCaml-build/Makefile
|
||||||
|
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
|
$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/pos.ml
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
|
$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
|
||||||
|
|
||||||
|
$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.mli
|
||||||
../shared/Lexer.mll
|
../shared/Lexer.mll
|
||||||
../shared/EvalOpt.ml
|
../shared/EvalOpt.ml
|
||||||
@ -17,7 +29,12 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
|
|||||||
../shared/Utils.ml
|
../shared/Utils.ml
|
||||||
../shared/ParserAPI.mli
|
../shared/ParserAPI.mli
|
||||||
../shared/ParserAPI.ml
|
../shared/ParserAPI.ml
|
||||||
|
../shared/LexerUnit.mli
|
||||||
../shared/LexerUnit.ml
|
../shared/LexerUnit.ml
|
||||||
|
../shared/ParserUnit.mli
|
||||||
../shared/ParserUnit.ml
|
../shared/ParserUnit.ml
|
||||||
|
|
||||||
Stubs/Simple_utils.ml
|
Stubs/Simple_utils.ml
|
||||||
|
Stubs/Preprocessor.ml
|
||||||
|
|
||||||
$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml
|
$HOME/git/ligo/_build/default/src/passes/1-parser/cameligo/ParErr.ml
|
@ -4,8 +4,7 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module IO =
|
module IO =
|
||||||
struct
|
struct
|
||||||
let ext = ".mligo"
|
let options = EvalOpt.(read ~lang:CameLIGO ~ext:".mligo")
|
||||||
let options = EvalOpt.read "CameLIGO" ext
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
|
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
|
||||||
|
@ -2,8 +2,7 @@
|
|||||||
|
|
||||||
module IO =
|
module IO =
|
||||||
struct
|
struct
|
||||||
let ext = ".mligo"
|
let options = EvalOpt.(read ~lang:CameLIGO ~ext:".mligo")
|
||||||
let options = EvalOpt.read "CameLIGO" ext
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Parser =
|
module Parser =
|
||||||
@ -98,7 +97,7 @@ let prefix =
|
|||||||
None | Some "-" -> "temp"
|
None | Some "-" -> "temp"
|
||||||
| Some file -> Filename.(file |> basename |> remove_extension)
|
| Some file -> Filename.(file |> basename |> remove_extension)
|
||||||
|
|
||||||
let suffix = ".pp" ^ IO.ext
|
let suffix = ".pp" ^ IO.options#ext
|
||||||
|
|
||||||
let pp_input =
|
let pp_input =
|
||||||
if SSet.mem "cpp" IO.options#verbose
|
if SSet.mem "cpp" IO.options#verbose
|
||||||
|
1
src/passes/1-parser/cameligo/Stubs/Preprocessor.ml
Normal file
1
src/passes/1-parser/cameligo/Stubs/Preprocessor.ml
Normal file
@ -0,0 +1 @@
|
|||||||
|
module Preproc = Preproc
|
@ -1,8 +1,20 @@
|
|||||||
$HOME/git/OCaml-build/Makefile
|
$HOME/git/OCaml-build/Makefile
|
||||||
|
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
|
$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/pos.ml
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
|
$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
|
||||||
|
|
||||||
|
$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.mli
|
||||||
../shared/Lexer.mll
|
../shared/Lexer.mll
|
||||||
../shared/EvalOpt.ml
|
../shared/EvalOpt.ml
|
||||||
@ -21,7 +33,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
|
|||||||
../shared/LexerUnit.ml
|
../shared/LexerUnit.ml
|
||||||
../shared/ParserUnit.mli
|
../shared/ParserUnit.mli
|
||||||
../shared/ParserUnit.ml
|
../shared/ParserUnit.ml
|
||||||
../shared/Memo.mli
|
|
||||||
../shared/Memo.ml
|
|
||||||
Stubs/Simple_utils.ml
|
Stubs/Simple_utils.ml
|
||||||
|
Stubs/Preprocessor.ml
|
||||||
|
|
||||||
$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml
|
$HOME/git/ligo/_build/default/src/passes/1-parser/pascaligo/ParErr.ml
|
@ -4,8 +4,7 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module IO =
|
module IO =
|
||||||
struct
|
struct
|
||||||
let ext = ".ligo"
|
let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo")
|
||||||
let options = EvalOpt.read "PascaLIGO" ext
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
|
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
|
||||||
|
@ -2,8 +2,7 @@
|
|||||||
|
|
||||||
module IO =
|
module IO =
|
||||||
struct
|
struct
|
||||||
let ext = ".ligo"
|
let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo")
|
||||||
let options = EvalOpt.read "PascaLIGO" ext
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Parser =
|
module Parser =
|
||||||
@ -110,7 +109,7 @@ let prefix =
|
|||||||
None | Some "-" -> "temp"
|
None | Some "-" -> "temp"
|
||||||
| Some file -> Filename.(file |> basename |> remove_extension)
|
| Some file -> Filename.(file |> basename |> remove_extension)
|
||||||
|
|
||||||
let suffix = ".pp" ^ IO.ext
|
let suffix = ".pp" ^ IO.options#ext
|
||||||
|
|
||||||
let pp_input =
|
let pp_input =
|
||||||
if SSet.mem "cpp" IO.options#verbose
|
if SSet.mem "cpp" IO.options#verbose
|
||||||
|
1
src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml
Normal file
1
src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml
Normal file
@ -0,0 +1 @@
|
|||||||
|
module Preproc = Preproc
|
@ -20,6 +20,7 @@
|
|||||||
menhirLib
|
menhirLib
|
||||||
parser_shared
|
parser_shared
|
||||||
hex
|
hex
|
||||||
|
Preprocessor
|
||||||
simple-utils)
|
simple-utils)
|
||||||
(preprocess
|
(preprocess
|
||||||
(pps bisect_ppx --conditional))
|
(pps bisect_ppx --conditional))
|
||||||
@ -170,4 +171,3 @@
|
|||||||
)
|
)
|
||||||
))
|
))
|
||||||
)
|
)
|
||||||
|
|
||||||
|
@ -1,8 +1,20 @@
|
|||||||
$HOME/git/OCaml-build/Makefile
|
$HOME/git/OCaml-build/Makefile
|
||||||
|
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.mli
|
$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/pos.ml
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
|
$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
|
||||||
|
|
||||||
|
$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.mli
|
||||||
../shared/Lexer.mll
|
../shared/Lexer.mll
|
||||||
../shared/EvalOpt.ml
|
../shared/EvalOpt.ml
|
||||||
@ -17,13 +29,19 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
|
|||||||
../shared/Utils.ml
|
../shared/Utils.ml
|
||||||
../shared/ParserAPI.mli
|
../shared/ParserAPI.mli
|
||||||
../shared/ParserAPI.ml
|
../shared/ParserAPI.ml
|
||||||
|
../shared/LexerUnit.mli
|
||||||
../shared/LexerUnit.ml
|
../shared/LexerUnit.ml
|
||||||
|
../shared/ParserUnit.mli
|
||||||
../shared/ParserUnit.ml
|
../shared/ParserUnit.ml
|
||||||
|
|
||||||
Stubs/Simple_utils.ml
|
Stubs/Simple_utils.ml
|
||||||
Stubs/Parser_cameligo.ml
|
Stubs/Parser_cameligo.ml
|
||||||
|
Stubs/Preprocessor.ml
|
||||||
|
|
||||||
../cameligo/AST.ml
|
../cameligo/AST.ml
|
||||||
../cameligo/ParserLog.mli
|
../cameligo/ParserLog.mli
|
||||||
../cameligo/ParserLog.ml
|
../cameligo/ParserLog.ml
|
||||||
../cameligo/Scoping.mli
|
../cameligo/Scoping.mli
|
||||||
../cameligo/Scoping.ml
|
../cameligo/Scoping.ml
|
||||||
|
|
||||||
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml
|
$HOME/git/ligo/_build/default/src/passes/1-parser/reasonligo/ParErr.ml
|
@ -4,8 +4,7 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module IO =
|
module IO =
|
||||||
struct
|
struct
|
||||||
let ext = ".religo"
|
let options = EvalOpt.(read ~lang:ReasonLIGO ~ext:".religo")
|
||||||
let options = EvalOpt.read "ReasonLIGO" ext
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
|
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
|
||||||
|
@ -2,8 +2,7 @@
|
|||||||
|
|
||||||
module IO =
|
module IO =
|
||||||
struct
|
struct
|
||||||
let ext = ".religo"
|
let options = EvalOpt.(read ~lang:ReasonLIGO ~ext:".religo")
|
||||||
let options = EvalOpt.read "ReasonLIGO" ext
|
|
||||||
end
|
end
|
||||||
|
|
||||||
module Parser =
|
module Parser =
|
||||||
@ -113,7 +112,7 @@ let prefix =
|
|||||||
None | Some "-" -> "temp"
|
None | Some "-" -> "temp"
|
||||||
| Some file -> Filename.(file |> basename |> remove_extension)
|
| Some file -> Filename.(file |> basename |> remove_extension)
|
||||||
|
|
||||||
let suffix = ".pp" ^ IO.ext
|
let suffix = ".pp" ^ IO.options#ext
|
||||||
|
|
||||||
let pp_input =
|
let pp_input =
|
||||||
if SSet.mem "cpp" IO.options#verbose
|
if SSet.mem "cpp" IO.options#verbose
|
||||||
|
1
src/passes/1-parser/reasonligo/Stubs/Preprocessor.ml
Normal file
1
src/passes/1-parser/reasonligo/Stubs/Preprocessor.ml
Normal file
@ -0,0 +1 @@
|
|||||||
|
module Preproc = Preproc
|
@ -1,7 +1,7 @@
|
|||||||
$HOME/git/OCaml-build/Makefile
|
$HOME/git/OCaml-build/Makefile
|
||||||
$HOME/git/OCaml-build/Makefile.cfg
|
$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.mli
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
|
$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.mli
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
|
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
|
||||||
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.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
|
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 = <
|
type options = <
|
||||||
input : string option;
|
input : string option;
|
||||||
libs : string list;
|
libs : string list;
|
||||||
verbose : Utils.String.Set.t;
|
verbose : Utils.String.Set.t;
|
||||||
offsets : bool;
|
offsets : bool;
|
||||||
|
lang : language;
|
||||||
|
ext : string; (* ".ligo", ".mligo", ".religo" *)
|
||||||
mode : [`Byte | `Point];
|
mode : [`Byte | `Point];
|
||||||
cmd : command;
|
cmd : command;
|
||||||
mono : bool;
|
mono : bool;
|
||||||
expr : 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
|
object
|
||||||
method input = input
|
method input = input
|
||||||
method libs = libs
|
method libs = libs
|
||||||
method verbose = verbose
|
method verbose = verbose
|
||||||
method offsets = offsets
|
method offsets = offsets
|
||||||
|
method lang = lang
|
||||||
|
method ext = ext
|
||||||
method mode = mode
|
method mode = mode
|
||||||
method cmd = cmd
|
method cmd = cmd
|
||||||
method mono = mono
|
method mono = mono
|
||||||
method expr = expr
|
method expr = expr
|
||||||
end
|
end
|
||||||
|
|
||||||
(** {1 Auxiliary functions} *)
|
(* Auxiliary functions *)
|
||||||
|
|
||||||
let printf = Printf.printf
|
let printf = Printf.printf
|
||||||
let sprintf = Printf.sprintf
|
let sprintf = Printf.sprintf
|
||||||
@ -39,7 +50,7 @@ let print = print_endline
|
|||||||
let abort msg =
|
let abort msg =
|
||||||
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
|
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
|
||||||
|
|
||||||
(** {1 Help} *)
|
(* Help *)
|
||||||
|
|
||||||
let help language extension () =
|
let help language extension () =
|
||||||
let file = Filename.basename Sys.argv.(0) in
|
let file = Filename.basename Sys.argv.(0) in
|
||||||
@ -55,16 +66,16 @@ let help language extension () =
|
|||||||
print " --bytes Bytes for source locations";
|
print " --bytes Bytes for source locations";
|
||||||
print " --mono Use Menhir monolithic API";
|
print " --mono Use Menhir monolithic API";
|
||||||
print " --expr Parse an expression";
|
print " --expr Parse an expression";
|
||||||
print " --verbose=<stages> cli, cpp, ast-tokens, ast (colon-separated)";
|
print " --verbose=<stages> cli, preproc, ast-tokens, ast (colon-separated)";
|
||||||
print " --version Commit hash on stdout";
|
print " --version Commit hash on stdout";
|
||||||
print " -h, --help This help";
|
print " -h, --help This help";
|
||||||
exit 0
|
exit 0
|
||||||
|
|
||||||
(** {1 Version} *)
|
(* Version *)
|
||||||
|
|
||||||
let version () = printf "%s\n" Version.version; exit 0
|
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
|
let copy = ref false
|
||||||
and tokens = ref false
|
and tokens = ref false
|
||||||
@ -89,6 +100,7 @@ let add_verbose d =
|
|||||||
(split_at_colon d)
|
(split_at_colon d)
|
||||||
|
|
||||||
let specs language extension =
|
let specs language extension =
|
||||||
|
let language = lang_to_string language in
|
||||||
let open! Getopt in [
|
let open! Getopt in [
|
||||||
'I', nolong, None, Some add_path;
|
'I', nolong, None, Some add_path;
|
||||||
'c', "copy", set copy true, None;
|
'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 =
|
let anonymous arg =
|
||||||
match !input with
|
match !input with
|
||||||
None -> input := Some arg
|
None -> input := Some arg
|
||||||
| Some s -> Printf.printf "s=%s\n" s;
|
| Some _ -> abort (sprintf "Multiple inputs")
|
||||||
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
|
let string_of convert = function
|
||||||
None -> "None"
|
None -> "None"
|
||||||
| Some s -> sprintf "Some %s" (convert s)
|
| Some s -> sprintf "Some %s" (convert s)
|
||||||
@ -139,9 +149,8 @@ let print_opt () =
|
|||||||
printf "verbose = %s\n" !verb_str;
|
printf "verbose = %s\n" !verb_str;
|
||||||
printf "input = %s\n" (string_of quote !input);
|
printf "input = %s\n" (string_of quote !input);
|
||||||
printf "libs = %s\n" (string_of_path !libs)
|
printf "libs = %s\n" (string_of_path !libs)
|
||||||
;;
|
|
||||||
|
|
||||||
let check extension =
|
let check lang ext =
|
||||||
let () =
|
let () =
|
||||||
if Utils.String.Set.mem "cli" !verbose then print_opt () in
|
if Utils.String.Set.mem "cli" !verbose then print_opt () in
|
||||||
|
|
||||||
@ -149,11 +158,11 @@ let check extension =
|
|||||||
match !input with
|
match !input with
|
||||||
None | Some "-" -> !input
|
None | Some "-" -> !input
|
||||||
| Some file_path ->
|
| 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 if Sys.file_exists file_path
|
||||||
then Some file_path
|
then Some file_path
|
||||||
else abort "Source file not found."
|
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 *)
|
(* Exporting remaining options as non-mutable values *)
|
||||||
|
|
||||||
@ -194,16 +203,16 @@ let check extension =
|
|||||||
| false, false, false, true -> Tokens
|
| false, false, false, true -> Tokens
|
||||||
| _ -> abort "Choose one of -q, -c, -u, -t."
|
| _ -> 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
|
try
|
||||||
Getopt.parse_cmdline (specs language extension) anonymous;
|
Getopt.parse_cmdline (specs lang ext) anonymous;
|
||||||
(verb_str :=
|
(verb_str :=
|
||||||
let apply e a =
|
let apply e a =
|
||||||
if a = "" then e else Printf.sprintf "%s, %s" e a
|
if a = "" then e else Printf.sprintf "%s, %s" e a
|
||||||
in Utils.String.Set.fold apply !verbose "");
|
in Utils.String.Set.fold apply !verbose "");
|
||||||
check extension
|
check lang ext
|
||||||
with Getopt.Error msg -> abort msg
|
with Getopt.Error msg -> abort msg
|
||||||
|
@ -48,11 +48,18 @@ type command = Quiet | Copy | Units | Tokens
|
|||||||
expressions is used, otherwise a full-fledged contract is
|
expressions is used, otherwise a full-fledged contract is
|
||||||
expected.}
|
expected.}
|
||||||
} *)
|
} *)
|
||||||
|
|
||||||
|
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
||||||
|
|
||||||
|
val lang_to_string : language -> string
|
||||||
|
|
||||||
type options = <
|
type options = <
|
||||||
input : string option;
|
input : string option;
|
||||||
libs : string list;
|
libs : string list;
|
||||||
verbose : Utils.String.Set.t;
|
verbose : Utils.String.Set.t;
|
||||||
offsets : bool;
|
offsets : bool;
|
||||||
|
lang : language;
|
||||||
|
ext : string; (* ".ligo", ".mligo", ".religo" *)
|
||||||
mode : [`Byte | `Point];
|
mode : [`Byte | `Point];
|
||||||
cmd : command;
|
cmd : command;
|
||||||
mono : bool;
|
mono : bool;
|
||||||
@ -64,6 +71,8 @@ val make :
|
|||||||
libs:string list ->
|
libs:string list ->
|
||||||
verbose:Utils.String.Set.t ->
|
verbose:Utils.String.Set.t ->
|
||||||
offsets:bool ->
|
offsets:bool ->
|
||||||
|
lang:language ->
|
||||||
|
ext:string ->
|
||||||
mode:[`Byte | `Point] ->
|
mode:[`Byte | `Point] ->
|
||||||
cmd:command ->
|
cmd:command ->
|
||||||
mono:bool ->
|
mono:bool ->
|
||||||
@ -71,7 +80,7 @@ val make :
|
|||||||
options
|
options
|
||||||
|
|
||||||
(** Parsing the command-line options on stdin. The first parameter is
|
(** Parsing the command-line options on stdin. The first parameter is
|
||||||
the name of the concrete syntax, e.g., "pascaligo", and the second
|
the name of the concrete syntax, e.g., [PascaLIGO], and the second
|
||||||
is the file extension, e.g., ".ligo".
|
is the expected file extension, e.g., ".ligo". *)
|
||||||
*)
|
|
||||||
val read : string -> string -> options
|
val read : lang:language -> ext:string -> options
|
||||||
|
@ -254,7 +254,7 @@ module Make (Token: TOKEN) : (S with module Token = Token) =
|
|||||||
Nil -> One token
|
Nil -> One token
|
||||||
| One t | Two (t,_) -> Two (token,t)
|
| 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
|
[state] represents the logical state of the lexing engine, that
|
||||||
is, a value which is threaded during scanning and which denotes
|
is, a value which is threaded during scanning and which denotes
|
||||||
useful, high-level information beyond what the type
|
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
|
it to [decoder]. See the documentation of the third-party
|
||||||
library Uutf.
|
library Uutf.
|
||||||
*)
|
*)
|
||||||
|
|
||||||
type state = {
|
type state = {
|
||||||
units : (Markup.t list * token) FQueue.t;
|
units : (Markup.t list * token) FQueue.t;
|
||||||
markup : Markup.t list;
|
markup : Markup.t list;
|
||||||
@ -648,21 +649,22 @@ and scan state = parse
|
|||||||
let state = scan_line thread state lexbuf |> push_line
|
let state = scan_line thread state lexbuf |> push_line
|
||||||
in scan state lexbuf }
|
in scan state lexbuf }
|
||||||
|
|
||||||
(* Management of #include CPP directives
|
(* Management of #include preprocessing directives
|
||||||
|
|
||||||
An input LIGO program may contain GNU CPP (C preprocessor)
|
An input LIGO program may contain preprocessing directives, and
|
||||||
directives, and the entry modules (named *Main.ml) run CPP on them
|
the entry modules (named *Main.ml) run the preprocessor on them,
|
||||||
in traditional mode:
|
as if using the GNU C preprocessor in traditional mode:
|
||||||
|
|
||||||
https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html
|
https://gcc.gnu.org/onlinedocs/cpp/Traditional-Mode.html
|
||||||
|
|
||||||
The main interest in using CPP is that it can stand for a poor
|
The main interest in using a preprocessor is that it can stand
|
||||||
man's (flat) module system for LIGO thanks to #include
|
for a poor man's (flat) module system for LIGO thanks to #include
|
||||||
directives, and the traditional mode leaves the markup mostly
|
directives, and the equivalent of the traditional mode leaves the
|
||||||
undisturbed.
|
markup undisturbed.
|
||||||
|
|
||||||
Some of the #line resulting from processing #include directives
|
Contrary to the C preprocessor, our preprocessor does not
|
||||||
deal with system file headers and thus have to be ignored for our
|
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
|
purpose. Moreover, these #line directives may also carry some
|
||||||
additional flags:
|
additional flags:
|
||||||
|
|
||||||
|
@ -15,7 +15,7 @@ module type S =
|
|||||||
|
|
||||||
val trace :
|
val trace :
|
||||||
?offsets:bool -> [`Byte | `Point] ->
|
?offsets:bool -> [`Byte | `Point] ->
|
||||||
file_path option -> EvalOpt.command ->
|
Lexer.input -> EvalOpt.command ->
|
||||||
(unit, string Region.reg) Stdlib.result
|
(unit, string Region.reg) Stdlib.result
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -49,16 +49,12 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
|
|||||||
|
|
||||||
type file_path = string
|
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 =
|
(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
|
match Lexer.open_token_stream input with
|
||||||
Ok Lexer.{read; buffer; close; _} ->
|
Ok Lexer.{read; buffer; close; _} ->
|
||||||
let log = output_token ~offsets mode command stdout
|
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 () =
|
let rec iter () =
|
||||||
match read ~log buffer with
|
match read ~log buffer with
|
||||||
token ->
|
token ->
|
||||||
@ -67,14 +63,14 @@ module Make (Lexer: Lexer.S) : (S with module Lexer = Lexer) =
|
|||||||
else iter ()
|
else iter ()
|
||||||
| exception Lexer.Error error ->
|
| exception Lexer.Error error ->
|
||||||
let file =
|
let file =
|
||||||
match file_path_opt with
|
match input with
|
||||||
None | Some "-" -> false
|
Lexer.File name -> name <> "-"
|
||||||
| Some _ -> true in
|
| _ -> false in
|
||||||
let msg =
|
let msg =
|
||||||
Lexer.format_error ~offsets mode ~file error
|
Lexer.format_error ~offsets mode ~file error
|
||||||
in Stdlib.Error msg in
|
in Stdlib.Error msg in
|
||||||
let result = iter ()
|
let result = iter ()
|
||||||
in close_all (); result
|
in close_all (); result
|
||||||
| Stdlib.Error (Lexer.File_opening msg) ->
|
| Stdlib.Error (Lexer.File_opening msg) ->
|
||||||
close_out stdout; Stdlib.Error (Region.wrap_ghost msg)
|
flush_all (); Stdlib.Error (Region.wrap_ghost msg)
|
||||||
end
|
end
|
||||||
|
@ -13,7 +13,7 @@ module type S =
|
|||||||
|
|
||||||
val trace :
|
val trace :
|
||||||
?offsets:bool -> [`Byte | `Point] ->
|
?offsets:bool -> [`Byte | `Point] ->
|
||||||
file_path option -> EvalOpt.command ->
|
Lexer.input -> EvalOpt.command ->
|
||||||
(unit, string Region.reg) Stdlib.result
|
(unit, string Region.reg) Stdlib.result
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -1,71 +1,46 @@
|
|||||||
(* Functor to build a standalone LIGO lexer *)
|
(* Functor to build a standalone LIGO lexer *)
|
||||||
|
|
||||||
module Region = Simple_utils.Region
|
module Region = Simple_utils.Region
|
||||||
|
module Preproc = Preprocessor.Preproc
|
||||||
|
|
||||||
module type IO =
|
module type IO =
|
||||||
sig
|
sig
|
||||||
val ext : string (* LIGO file extension *)
|
|
||||||
val options : EvalOpt.options (* CLI options *)
|
val options : EvalOpt.options (* CLI options *)
|
||||||
end
|
end
|
||||||
|
|
||||||
module Make (IO: IO) (Lexer: Lexer.S) =
|
module Make (IO: IO) (Lexer: Lexer.S) =
|
||||||
struct
|
struct
|
||||||
open Printf
|
|
||||||
module SSet = Utils.String.Set
|
|
||||||
|
|
||||||
(* Error printing and exception tracing *)
|
(* Error printing and exception tracing *)
|
||||||
|
|
||||||
let () = Printexc.record_backtrace true
|
let () = Printexc.record_backtrace true
|
||||||
|
|
||||||
(* Preprocessing the input source and opening the input channels *)
|
(* Preprocessing and lexing the input source *)
|
||||||
|
|
||||||
(* 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 *)
|
|
||||||
|
|
||||||
let scan () : (Lexer.token list, string Region.reg) Stdlib.result =
|
let scan () : (Lexer.token list, string Region.reg) Stdlib.result =
|
||||||
(* Preprocessing the input *)
|
(* Preprocessing the input source *)
|
||||||
|
|
||||||
if SSet.mem "cpp" IO.options#verbose
|
let preproc cin =
|
||||||
then eprintf "%s\n%!" cpp_cmd
|
let buffer = Lexing.from_channel cin in
|
||||||
else ();
|
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 preproc_str = Buffer.contents pp_buffer in
|
||||||
let msg =
|
match Lexer.open_token_stream (Lexer.String preproc_str) with
|
||||||
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; _} ->
|
Ok Lexer.{read; buffer; close; _} ->
|
||||||
let close_all () = close (); close_out stdout in
|
let close_all () = flush_all (); close () in
|
||||||
let rec read_tokens tokens =
|
let rec read_tokens tokens =
|
||||||
match read ~log:(fun _ _ -> ()) buffer with
|
match read ~log:(fun _ _ -> ()) buffer with
|
||||||
token ->
|
token ->
|
||||||
@ -84,27 +59,48 @@ module Make (IO: IO) (Lexer: Lexer.S) =
|
|||||||
let result = read_tokens []
|
let result = read_tokens []
|
||||||
in close_all (); result
|
in close_all (); result
|
||||||
| Stdlib.Error (Lexer.File_opening msg) ->
|
| Stdlib.Error (Lexer.File_opening msg) ->
|
||||||
close_out stdout; Stdlib.Error (Region.wrap_ghost 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)
|
module Log = LexerLog.Make (Lexer)
|
||||||
|
|
||||||
let trace () : (unit, string Region.reg) Stdlib.result =
|
let trace () : (unit, string Region.reg) Stdlib.result =
|
||||||
(* Preprocessing the input *)
|
(* Preprocessing the input *)
|
||||||
|
let preproc cin =
|
||||||
if SSet.mem "cpp" IO.options#verbose
|
let buffer = Lexing.from_channel cin in
|
||||||
then eprintf "%s\n%!" cpp_cmd
|
let open Lexing in
|
||||||
else ();
|
let () =
|
||||||
|
match IO.options#input with
|
||||||
if Sys.command cpp_cmd <> 0 then
|
None | Some "-" -> ()
|
||||||
let msg =
|
| Some pos_fname ->
|
||||||
sprintf "External error: the command \"%s\" failed." cpp_cmd
|
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
|
||||||
in Stdlib.Error (Region.wrap_ghost msg)
|
match Preproc.lex IO.options buffer with
|
||||||
else
|
Stdlib.Error (pp_buffer, err) ->
|
||||||
Log.trace ~offsets:IO.options#offsets
|
if Utils.String.Set.mem "preproc" IO.options#verbose then
|
||||||
IO.options#mode
|
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
|
||||||
(Some pp_input)
|
let formatted =
|
||||||
IO.options#cmd
|
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
|
end
|
||||||
|
@ -4,7 +4,6 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module type IO =
|
module type IO =
|
||||||
sig
|
sig
|
||||||
val ext : string (* LIGO file extension *)
|
|
||||||
val options : EvalOpt.options (* CLI options *)
|
val options : EvalOpt.options (* CLI options *)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -4,7 +4,6 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module type IO =
|
module type IO =
|
||||||
sig
|
sig
|
||||||
val ext : string (* LIGO file extension *)
|
|
||||||
val options : EvalOpt.options (* CLI options *)
|
val options : EvalOpt.options (* CLI options *)
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -141,12 +140,12 @@ module Make (IO : IO)
|
|||||||
and failure = failure get_win in
|
and failure = failure get_win in
|
||||||
let parser = Incr.contract buffer.Lexing.lex_curr_p in
|
let parser = Incr.contract buffer.Lexing.lex_curr_p in
|
||||||
let ast = I.loop_handle success failure supplier parser
|
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 incr_expr Lexer.{read; buffer; get_win; close; _} =
|
||||||
let supplier = I.lexer_lexbuf_to_supplier (read ~log) buffer
|
let supplier = I.lexer_lexbuf_to_supplier (read ~log) buffer
|
||||||
and failure = failure get_win in
|
and failure = failure get_win in
|
||||||
let parser = Incr.interactive_expr buffer.Lexing.lex_curr_p in
|
let parser = Incr.interactive_expr buffer.Lexing.lex_curr_p in
|
||||||
let expr = I.loop_handle success failure supplier parser
|
let expr = I.loop_handle success failure supplier parser
|
||||||
in close (); expr
|
in flush_all (); close (); expr
|
||||||
end
|
end
|
||||||
|
@ -4,7 +4,6 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module type IO =
|
module type IO =
|
||||||
sig
|
sig
|
||||||
val ext : string (* LIGO file extension *)
|
|
||||||
val options : EvalOpt.options (* CLI options *)
|
val options : EvalOpt.options (* CLI options *)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -4,7 +4,6 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module type IO =
|
module type IO =
|
||||||
sig
|
sig
|
||||||
val ext : string (* LIGO file extension *)
|
|
||||||
val options : EvalOpt.options (* CLI options *)
|
val options : EvalOpt.options (* CLI options *)
|
||||||
end
|
end
|
||||||
|
|
||||||
@ -94,7 +93,7 @@ module Make (Lexer: Lexer.S)
|
|||||||
ParserLog.pp_expr state expr;
|
ParserLog.pp_expr state expr;
|
||||||
Buffer.output_buffer stdout output
|
Buffer.output_buffer stdout output
|
||||||
end
|
end
|
||||||
in close (); Ok expr
|
in flush_all (); close (); Ok expr
|
||||||
|
|
||||||
(* Parsing a contract *)
|
(* Parsing a contract *)
|
||||||
|
|
||||||
@ -129,7 +128,7 @@ module Make (Lexer: Lexer.S)
|
|||||||
ParserLog.pp_ast state ast;
|
ParserLog.pp_ast state ast;
|
||||||
Buffer.output_buffer stdout output
|
Buffer.output_buffer stdout output
|
||||||
end
|
end
|
||||||
in close (); Ok ast
|
in flush_all (); close (); Ok ast
|
||||||
|
|
||||||
(* Wrapper for the parsers above *)
|
(* Wrapper for the parsers above *)
|
||||||
|
|
||||||
@ -180,5 +179,5 @@ module Make (Lexer: Lexer.S)
|
|||||||
(* I/O errors *)
|
(* I/O errors *)
|
||||||
|
|
||||||
| exception Sys_error error ->
|
| exception Sys_error error ->
|
||||||
Stdlib.Error (Region.wrap_ghost error)
|
flush_all (); Stdlib.Error (Region.wrap_ghost error)
|
||||||
end
|
end
|
||||||
|
@ -4,7 +4,6 @@ module Region = Simple_utils.Region
|
|||||||
|
|
||||||
module type IO =
|
module type IO =
|
||||||
sig
|
sig
|
||||||
val ext : string (* LIGO file extension *)
|
|
||||||
val options : EvalOpt.options (* CLI options *)
|
val options : EvalOpt.options (* CLI options *)
|
||||||
end
|
end
|
||||||
|
|
||||||
|
@ -8,7 +8,8 @@
|
|||||||
simple-utils
|
simple-utils
|
||||||
uutf
|
uutf
|
||||||
getopt
|
getopt
|
||||||
zarith)
|
zarith
|
||||||
|
Preproc)
|
||||||
(preprocess
|
(preprocess
|
||||||
(pps bisect_ppx --conditional))
|
(pps bisect_ppx --conditional))
|
||||||
(modules
|
(modules
|
||||||
|
23
vendors/Preproc/E_LexerMain.ml
vendored
23
vendors/Preproc/E_LexerMain.ml
vendored
@ -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
|
|
24
vendors/Preproc/PreprocMain.ml
vendored
24
vendors/Preproc/PreprocMain.ml
vendored
@ -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
|
|
33
vendors/Preprocessor/E_LexerMain.ml
vendored
Normal file
33
vendors/Preprocessor/E_LexerMain.ml
vendored
Normal file
@ -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
|
@ -1,17 +1,20 @@
|
|||||||
|
(* Standalone parser for booleans expression of preprocessing
|
||||||
|
directives for PascaLIGO *)
|
||||||
|
|
||||||
module Region = Simple_utils.Region
|
module Region = Simple_utils.Region
|
||||||
|
|
||||||
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
|
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
|
let parse in_chan =
|
||||||
exception Sys_error msg -> highlight msg
|
let buffer = Lexing.from_channel in_chan in
|
||||||
| cin ->
|
|
||||||
let buffer = Lexing.from_channel cin in
|
|
||||||
let open Lexing in
|
let open Lexing in
|
||||||
let () =
|
let () =
|
||||||
buffer.lex_curr_p <-
|
match options#input with
|
||||||
{buffer.lex_curr_p with pos_fname = options#input} in
|
Some "-" | None -> ()
|
||||||
|
| Some pos_fname ->
|
||||||
|
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
|
||||||
let () =
|
let () =
|
||||||
try
|
try
|
||||||
let tree = E_Parser.expr E_Lexer.scan buffer in
|
let tree = E_Parser.expr E_Lexer.scan buffer in
|
||||||
@ -20,8 +23,7 @@ match open_in options#input with
|
|||||||
with
|
with
|
||||||
E_Lexer.Error error ->
|
E_Lexer.Error error ->
|
||||||
let formatted =
|
let formatted =
|
||||||
E_Lexer.format
|
E_Lexer.format ~offsets:options#offsets ~file:true error
|
||||||
~offsets:options#offsets ~file:true error
|
|
||||||
in highlight formatted.Region.value
|
in highlight formatted.Region.value
|
||||||
| E_Parser.Error ->
|
| E_Parser.Error ->
|
||||||
let region = Preproc.mk_reg buffer
|
let region = Preproc.mk_reg buffer
|
||||||
@ -31,4 +33,11 @@ match open_in options#input with
|
|||||||
Preproc.format ~offsets:options#offsets
|
Preproc.format ~offsets:options#offsets
|
||||||
~file:true error
|
~file:true error
|
||||||
in highlight formatted.Region.value
|
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
|
@ -2,25 +2,32 @@
|
|||||||
|
|
||||||
(* The type [options] gathers the command-line options. *)
|
(* The type [options] gathers the command-line options. *)
|
||||||
|
|
||||||
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
|
||||||
|
|
||||||
module SSet = Set.Make (String)
|
module SSet = Set.Make (String)
|
||||||
|
|
||||||
|
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
||||||
|
|
||||||
|
let lang_to_string = function
|
||||||
|
PascaLIGO -> "PascaLIGO"
|
||||||
|
| CameLIGO -> "CameLIGO"
|
||||||
|
| ReasonLIGO -> "ReasonLIGO"
|
||||||
|
|
||||||
type options = <
|
type options = <
|
||||||
input : string;
|
input : string option;
|
||||||
libs : string list;
|
libs : string list;
|
||||||
lang : language;
|
verbose : SSet.t;
|
||||||
offsets : bool;
|
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
|
object
|
||||||
method input = input
|
method input = input
|
||||||
method libs = libs
|
method libs = libs
|
||||||
method lang = lang
|
method lang = lang
|
||||||
method offsets = offsets
|
method offsets = offsets
|
||||||
method verbose = verbose
|
method verbose = verbose
|
||||||
|
method ext = ext
|
||||||
end
|
end
|
||||||
|
|
||||||
(* Auxiliary functions and modules *)
|
(* Auxiliary functions and modules *)
|
||||||
@ -40,10 +47,10 @@ let abort msg =
|
|||||||
|
|
||||||
(* Help *)
|
(* Help *)
|
||||||
|
|
||||||
let help () =
|
let help lang ext () =
|
||||||
let file = Filename.basename Sys.argv.(0) in
|
let file = Filename.basename Sys.argv.(0) in
|
||||||
printf "Usage: %s [<option> ...] <input>\n" file;
|
printf "Usage: %s [<option> ...] [<input>%s | \"-\"]\n" file ext;
|
||||||
printf "where <input> is the source file,\n";
|
printf "where <input>%s is the %s source file (default: stdin),\n" ext lang;
|
||||||
print "and each <option> (if any) is one of the following:";
|
print "and each <option> (if any) is one of the following:";
|
||||||
print " -I <paths> Inclusion paths (colon-separated)";
|
print " -I <paths> Inclusion paths (colon-separated)";
|
||||||
print " --columns Columns for source locations";
|
print " --columns Columns for source locations";
|
||||||
@ -55,7 +62,6 @@ let help () =
|
|||||||
|
|
||||||
let input = ref None
|
let input = ref None
|
||||||
and libs = ref []
|
and libs = ref []
|
||||||
and lang = ref None
|
|
||||||
and columns = ref false
|
and columns = ref false
|
||||||
and verbose = ref SSet.empty
|
and verbose = ref SSet.empty
|
||||||
and verb_str = ref ""
|
and verb_str = ref ""
|
||||||
@ -68,10 +74,11 @@ let add_verbose d =
|
|||||||
verbose := List.fold_left (fun x y -> SSet.add y x)
|
verbose := List.fold_left (fun x y -> SSet.add y x)
|
||||||
!verbose
|
!verbose
|
||||||
(split_at_colon d)
|
(split_at_colon d)
|
||||||
let specs =
|
let specs lang ext =
|
||||||
|
let lang_str = lang_to_string lang in
|
||||||
let open!Getopt in [
|
let open!Getopt in [
|
||||||
'I', nolong, None, Some add_path;
|
'I', nolong, None, Some add_path;
|
||||||
'h', "help", Some help, None;
|
'h', "help", Some (help lang_str ext), None;
|
||||||
noshort, "columns", set columns true, None;
|
noshort, "columns", set columns true, None;
|
||||||
noshort, "verbose", None, Some add_verbose
|
noshort, "verbose", None, Some add_verbose
|
||||||
]
|
]
|
||||||
@ -80,44 +87,38 @@ let specs =
|
|||||||
|
|
||||||
let anonymous arg =
|
let anonymous arg =
|
||||||
match !input with
|
match !input with
|
||||||
None ->
|
None -> input := Some arg
|
||||||
(match Filename.extension arg with
|
| Some _ -> abort (sprintf "Multiple inputs")
|
||||||
".ligo" -> lang := Some PascaLIGO
|
|
||||||
| ".mligo" -> lang := Some CameLIGO
|
|
||||||
| ".religo" -> lang := Some ReasonLIGO
|
|
||||||
| _ -> abort (sprintf "Wrong file extension."));
|
|
||||||
input := Some arg
|
|
||||||
| Some _ -> abort (sprintf "Multiple inputs.")
|
|
||||||
|
|
||||||
(* Checking options and exporting them as non-mutable values *)
|
(* Checking options and exporting them as non-mutable values *)
|
||||||
|
|
||||||
let check () =
|
let check lang ext =
|
||||||
let libs = !libs
|
let libs = !libs
|
||||||
|
|
||||||
and offsets = not !columns
|
and offsets = not !columns
|
||||||
|
|
||||||
and verbose = !verbose
|
and verbose = !verbose
|
||||||
|
|
||||||
and lang =
|
|
||||||
match !lang with
|
|
||||||
Some lang -> lang
|
|
||||||
| None -> assert false
|
|
||||||
|
|
||||||
and input =
|
and input =
|
||||||
match !input with
|
match !input with
|
||||||
Some file -> file
|
None | Some "-" -> !input
|
||||||
| None -> abort "Missing input file."
|
| Some file_path ->
|
||||||
|
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 " ^ ext ^ ".")
|
||||||
|
|
||||||
in make ~input ~libs ~lang ~offsets ~verbose
|
in make ~input ~libs ~lang ~offsets ~verbose ~ext
|
||||||
|
|
||||||
(* Parsing the command-line options *)
|
(* Parsing the command-line options *)
|
||||||
|
|
||||||
let read () =
|
let read ~lang:(lang : language) ~ext:(ext : string) =
|
||||||
try
|
try
|
||||||
Getopt.parse_cmdline specs anonymous;
|
Getopt.parse_cmdline (specs lang ext) anonymous;
|
||||||
(verb_str :=
|
(verb_str :=
|
||||||
let apply e a =
|
let apply e a =
|
||||||
if a = "" then e else sprintf "%s, %s" e a
|
if a = "" then e else sprintf "%s, %s" e a
|
||||||
in SSet.fold apply !verbose "");
|
in SSet.fold apply !verbose "");
|
||||||
check ()
|
check lang ext
|
||||||
with Getopt.Error msg -> abort msg
|
with Getopt.Error msg -> abort msg
|
@ -3,27 +3,30 @@
|
|||||||
(* The type [options] gathers the command-line options. *)
|
(* The type [options] gathers the command-line options. *)
|
||||||
|
|
||||||
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
type language = PascaLIGO | CameLIGO | ReasonLIGO
|
||||||
|
val lang_to_string : language -> string
|
||||||
|
|
||||||
module SSet : Set.S with type elt = string
|
module SSet : Set.S with type elt = string
|
||||||
|
|
||||||
type options = <
|
type options = <
|
||||||
input : string;
|
input : string option;
|
||||||
libs : string list;
|
libs : string list;
|
||||||
lang : language;
|
verbose : SSet.t;
|
||||||
offsets : bool;
|
offsets : bool;
|
||||||
verbose : SSet.t
|
lang : language;
|
||||||
|
ext : string (* ".ligo", ".mligo", ".religo" *)
|
||||||
>
|
>
|
||||||
|
|
||||||
val make :
|
val make :
|
||||||
input:string ->
|
input:string option ->
|
||||||
libs:string list ->
|
libs:string list ->
|
||||||
lang:language ->
|
lang:language ->
|
||||||
offsets:bool ->
|
offsets:bool ->
|
||||||
verbose:SSet.t ->
|
verbose:SSet.t ->
|
||||||
|
ext:string ->
|
||||||
options
|
options
|
||||||
|
|
||||||
(* Parsing the command-line options on stdin. The first parameter is
|
(* Parsing the command-line options on stdin. The first parameter is
|
||||||
the name of the concrete syntax. This is needed to correctly handle
|
the name of the concrete syntax. This is needed to correctly handle
|
||||||
comments. *)
|
comments. *)
|
||||||
|
|
||||||
val read : unit -> options
|
val read : lang:language -> ext:string -> options
|
@ -484,7 +484,6 @@ rule scan state = parse
|
|||||||
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
|
let line = Lexing.(lexbuf.lex_curr_p.pos_lnum)
|
||||||
and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
|
and file = Lexing.(lexbuf.lex_curr_p.pos_fname) in
|
||||||
let base = Filename.basename file
|
let base = Filename.basename file
|
||||||
(* and dir = Filename.dirname file*)
|
|
||||||
and reg, incl_file = scan_inclusion state lexbuf in
|
and reg, incl_file = scan_inclusion state lexbuf in
|
||||||
let incl_dir = Filename.dirname incl_file in
|
let incl_dir = Filename.dirname incl_file in
|
||||||
let path = mk_path state in
|
let path = mk_path state in
|
33
vendors/Preprocessor/PreprocMain.ml
vendored
Normal file
33
vendors/Preprocessor/PreprocMain.ml
vendored
Normal file
@ -0,0 +1,33 @@
|
|||||||
|
(* Standalone preprocessor for PascaLIGO *)
|
||||||
|
|
||||||
|
module Region = Simple_utils.Region
|
||||||
|
|
||||||
|
let highlight msg = Printf.eprintf "\027[31m%s\027[0m\n%!" msg
|
||||||
|
|
||||||
|
let options = EvalOpt.read ~lang:EvalOpt.PascaLIGO ~ext:".ligo";;
|
||||||
|
|
||||||
|
let preproc cin =
|
||||||
|
let buffer = Lexing.from_channel cin in
|
||||||
|
let open Lexing in
|
||||||
|
let () =
|
||||||
|
match options#input with
|
||||||
|
None | Some "-" -> ()
|
||||||
|
| Some pos_fname ->
|
||||||
|
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} 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
|
||||||
|
|
||||||
|
let () =
|
||||||
|
match options#input with
|
||||||
|
Some "-" | None -> preproc stdin
|
||||||
|
| Some file_path ->
|
||||||
|
try open_in file_path |> preproc with
|
||||||
|
Sys_error msg -> highlight msg
|
@ -5,7 +5,7 @@
|
|||||||
(modules E_Parser))
|
(modules E_Parser))
|
||||||
|
|
||||||
(library
|
(library
|
||||||
(name Preproc)
|
(name Preprocessor)
|
||||||
(public_name ligo.preproc)
|
(public_name ligo.preproc)
|
||||||
(libraries
|
(libraries
|
||||||
getopt
|
getopt
|
Loading…
Reference in New Issue
Block a user