balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Shared more code in ParserUnit.ml

Browse Source 
Rewrite of the integration of the preprocessor.
Compiles bt DOES NOT PASS THE CI.
This commit is contained in:
Christian Rinderknecht 2020-04-03 19:08:14 +02:00
parent 6c1a1f91e2
commit 1941f9ae4b
21 changed files with 448 additions and 466 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/dune
View File

@ -1,14 +1,13 @@
(dirs (:standard \ toto))
(dirs (:standard))
(library
(name ligo)
(public_name ligo)
(libraries
Preprocessor
simple-utils
tezos-utils
tezos-micheline
main
)
main)
(preprocess
(pps ppx_let bisect_ppx --conditional)
)
)
(pps ppx_let bisect_ppx --conditional)))

144
src/passes/1-parser/cameligo.ml
View File

@ -4,26 +4,46 @@ module Lexer = Lexer.Make(LexToken)
module Scoping = Parser_cameligo.Scoping
module Region = Simple_utils.Region
module ParErr = Parser_cameligo.ParErr
module SSet = Utils.String.Set
module SSet = Set.Make (String)
(* Mock IOs TODO: Fill them with CLI options *)
module type IO =
sig
val ext : string
val options : EvalOpt.options
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
module SubIO =
struct
type options = <
libs : string list;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".mligo" *)
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
>
let options : options =
object
method libs = []
method verbose = SSet.empty
method offsets = true
method lang = `CameLIGO
method ext = ".mligo"
method mode = `Point
method cmd = EvalOpt.Quiet
method mono = false
end
module PreIO =
struct
let ext = ".ligo"
let pre_options =
EvalOpt.make ~libs:[]
~verbose:SSet.empty
~offsets:true
~mode:`Point
~cmd:EvalOpt.Quiet
~mono:false
let make =
EvalOpt.make ~libs:options#libs
~verbose:options#verbose
~offsets:options#offsets
~lang:options#lang
~ext:options#ext
~mode:options#mode
~cmd:options#cmd
~mono:options#mono
end
module Parser =
@ -40,34 +60,33 @@ module ParserLog =
include Parser_cameligo.ParserLog
end
module PreUnit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
module Errors =
struct
(* let data =
[("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] *)
let generic message =
let title () = ""
and message () = message.Region.value
in Trace.error ~data:[] title message
end
let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in
let apply parser =
let local_fail error =
Trace.fail
@@ Errors.generic
@@ Unit.format_error ~offsets:IO.options#offsets
IO.options#mode error in
@@ Unit.format_error ~offsets:SubIO.options#offsets
SubIO.options#mode error in
match parser () with
Stdlib.Ok semantic_value -> Trace.ok semantic_value
(* Lexing and parsing errors *)
| Stdlib.Error error -> Trace.fail @@ Errors.generic error
(* System errors *)
| exception Sys_error msg ->
Trace.fail @@ Errors.generic (Region.wrap_ghost msg)
(* Scoping errors *)
| exception Scoping.Error (Scoping.Reserved_name name) ->
@ -110,71 +129,14 @@ let parse (module IO : IO) parser =
Hint: Change the name.\n",
None, invalid))
let parse_file (source: string) =
let module IO =
struct
let ext = PreIO.ext
let options =
PreIO.pre_options ~input:(Some source) ~expr:false
end in
let lib_path =
match IO.options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in
let prefix =
match IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(remove_extension @@ basename file) in
let suffix = ".pp" ^ IO.ext in
let pp_input =
if SSet.mem "cpp" IO.options#verbose
then prefix ^ suffix
else let pp_input, pp_out =
Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in
let cpp_cmd =
match IO.options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
| Some file ->
Printf.sprintf "cpp -traditional-cpp%s %s > %s"
lib_path file pp_input in
let open Trace in
let%bind () = sys_command cpp_cmd in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ File pp_input) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
(* Parsing a contract in a file *)
let parse_string (s: string) =
let module IO =
struct
let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:false
end in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
let parse_file source = apply (fun () -> Unit.parse_file source)
let parse_expression (s: string) =
let module IO =
struct
let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:true
end in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
(* Parsing a contract in a string *)
let parse_string source = apply (fun () -> Unit.parse_string source)
(* Parsing an expression in a string *)
let parse_expression source = apply (fun () -> Unit.parse_expression source)

145
src/passes/1-parser/pascaligo.ml
View File

@ -4,26 +4,46 @@ module Lexer = Lexer.Make(LexToken)
module Scoping = Parser_pascaligo.Scoping
module Region = Simple_utils.Region
module ParErr = Parser_pascaligo.ParErr
module SSet = Utils.String.Set
module SSet = Set.Make (String)
(* Mock IOs TODO: Fill them with CLI options *)
module type IO =
sig
val ext : string
val options : EvalOpt.options
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
module SubIO =
struct
type options = <
libs : string list;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo" *)
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
>
let options : options =
object
method libs = []
method verbose = SSet.empty
method offsets = true
method lang = `PascaLIGO
method ext = ".ligo"
method mode = `Point
method cmd = EvalOpt.Quiet
method mono = false
end
module PreIO =
struct
let ext = ".ligo"
let pre_options =
EvalOpt.make ~libs:[]
~verbose:SSet.empty
~offsets:true
~mode:`Point
~cmd:EvalOpt.Quiet
~mono:false
let make =
EvalOpt.make ~libs:options#libs
~verbose:options#verbose
~offsets:options#offsets
~lang:options#lang
~ext:options#ext
~mode:options#mode
~cmd:options#cmd
~mono:options#mono
end
module Parser =
@ -40,34 +60,34 @@ module ParserLog =
include Parser_pascaligo.ParserLog
end
module PreUnit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
module Errors =
struct
(* let data =
[("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ loc)] *)
let generic message =
let title () = ""
and message () = message.Region.value
in Trace.error ~data:[] title message
end
let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in
let apply parser =
let local_fail error =
Trace.fail
@@ Errors.generic
@@ Unit.format_error ~offsets:IO.options#offsets
IO.options#mode error in
@@ Unit.format_error ~offsets:SubIO.options#offsets
SubIO.options#mode error in
match parser () with
Stdlib.Ok semantic_value -> Trace.ok semantic_value
(* Lexing and parsing errors *)
| Stdlib.Error error -> Trace.fail @@ Errors.generic error
(* System errors *)
| exception Sys_error msg ->
Trace.fail @@ Errors.generic (Region.wrap_ghost msg)
(* Scoping errors *)
| exception Scoping.Error (Scoping.Reserved_name name) ->
@ -121,71 +141,14 @@ let parse (module IO : IO) parser =
Hint: Change the name.\n",
None, invalid))
let parse_file source =
let module IO =
struct
let ext = PreIO.ext
let options =
PreIO.pre_options ~input:(Some source) ~expr:false
end in
let module Unit = PreUnit (IO) in
let lib_path =
match IO.options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in
let prefix =
match IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(remove_extension @@ basename file) in
let suffix = ".pp" ^ IO.ext in
let pp_input =
if SSet.mem "cpp" IO.options#verbose
then prefix ^ suffix
else let pp_input, pp_out =
Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in
let cpp_cmd =
match IO.options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
| Some file ->
Printf.sprintf "cpp -traditional-cpp%s %s > %s"
lib_path file pp_input in
let open Trace in
let%bind () = sys_command cpp_cmd in
match Lexer.(open_token_stream @@ File pp_input) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
(* Parsing a contract in a file *)
let parse_string (s: string) =
let module IO =
struct
let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:false
end in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
let parse_file source = apply (fun () -> Unit.parse_file source)
let parse_expression (s: string) =
let module IO =
struct
let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:true
end in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
(* Parsing a contract in a string *)
let parse_string source = apply (fun () -> Unit.parse_string source)
(* Parsing an expression in a string *)
let parse_expression source = apply (fun () -> Unit.parse_expression source)

2
src/passes/1-parser/pascaligo/.links
View File

@ -5,6 +5,8 @@ $HOME/git/ligo/vendors/ligo-utils/simple-utils/pos.ml
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.mli
$HOME/git/ligo/vendors/ligo-utils/simple-utils/region.ml
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.mli PP_EvalOpt.mli
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml PP_EvalOpt.ml
$HOME/git/ligo/vendors/Preprocessor/E_AST.ml
$HOME/git/ligo/vendors/Preprocessor/E_Lexer.mll
$HOME/git/ligo/vendors/Preprocessor/EvalOpt.ml

4
src/passes/1-parser/pascaligo/LexToken.mll
View File

@ -11,8 +11,8 @@ let sprintf = Printf.sprintf
module Region = Simple_utils.Region
module Pos = Simple_utils.Pos
module SMap = Utils.String.Map
module SSet = Utils.String.Set
module SMap = Map.Make (String)
module SSet = Set.Make (String)
(* Hack to roll back one lexeme in the current semantic action *)
(*

4
src/passes/1-parser/pascaligo/LexerMain.ml
View File

@ -4,7 +4,7 @@ module Region = Simple_utils.Region
module IO =
struct
let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo")
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
end
module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
@ -12,4 +12,4 @@ module M = LexerUnit.Make (IO) (Lexer.Make (LexToken))
let () =
match M.trace () with
Stdlib.Ok () -> ()
| Error Region.{value; _} -> Utils.highlight value
| Error Region.{value; _} -> Printf.eprintf "\027[31m%s\027[0m%!" value

61
src/passes/1-parser/pascaligo/ParserMain.ml
View File

@ -2,7 +2,7 @@
module IO =
struct
let options = EvalOpt.(read ~lang:PascaLIGO ~ext:".ligo")
let options = EvalOpt.(read ~lang:`PascaLIGO ~ext:".ligo")
end
module Parser =
@ -24,6 +24,8 @@ module Lexer = Lexer.Make (LexToken)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(IO)
module SSet = Set.Make (String)
(* Main *)
let issue_error error : ('a, string Region.reg) Stdlib.result =
@ -38,8 +40,8 @@ let parse parser : ('a, string Region.reg) Stdlib.result =
let token =
Lexer.Token.mk_ident name.Region.value name.Region.region in
(match token with
(* Cannot fail because [name] is a not a
reserved name for the lexer. *)
(* Cannot fail because [name] is not a reserved name for the
lexer. *)
Stdlib.Error _ -> assert false
| Ok invalid ->
issue_error ("Duplicate parameter.\nHint: Change the name.\n",
@ -49,8 +51,8 @@ let parse parser : ('a, string Region.reg) Stdlib.result =
let token =
Lexer.Token.mk_ident name.Region.value name.Region.region in
(match token with
(* Cannot fail because [name] is a not a
reserved name for the lexer. *)
(* Cannot fail because [name] is not a reserved name for the
lexer. *)
Stdlib.Error _ -> assert false
| Ok invalid ->
issue_error
@ -68,8 +70,8 @@ let parse parser : ('a, string Region.reg) Stdlib.result =
let token =
Lexer.Token.mk_ident var.Region.value var.Region.region in
(match token with
(* Cannot fail because [var] is a not a
reserved name for the lexer. *)
(* Cannot fail because [var] is not a reserved name for the
lexer. *)
Stdlib.Error _ -> assert false
| Ok invalid ->
let point = "Repeated variable in this pattern.\n\
@ -93,49 +95,6 @@ let parse parser : ('a, string Region.reg) Stdlib.result =
(* Preprocessing the input source *)
(*
module SSet = Utils.String.Set
let sprintf = Printf.sprintf
(* Path for CPP inclusions (#include) *)
let lib_path =
match IO.options#libs with
[] -> ""
| libs -> let mk_I dir path = sprintf " -I %s%s" dir path
in List.fold_right mk_I libs ""
let prefix =
match IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(file |> basename |> remove_extension)
let suffix = ".pp" ^ IO.options#ext
let pp_input =
if SSet.mem "cpp" IO.options#verbose
then prefix ^ suffix
else let pp_input, pp_out =
Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input
let cpp_cmd =
match IO.options#input with
None | Some "-" ->
sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
| Some file ->
sprintf "cpp -traditional-cpp%s %s > %s"
lib_path file pp_input
let () =
if Sys.command cpp_cmd <> 0 then
Printf.eprintf "External error: \"%s\" failed." cpp_cmd
*)
(* Preprocessing the input source *)
let preproc cin : unit =
let close () = flush_all (); close_in cin in
let buffer = Lexing.from_channel cin in
@ -147,7 +106,7 @@ let preproc cin : unit =
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
match Preproc.lex IO.options buffer with
Stdlib.Error (pp_buffer, err) ->
if Utils.String.Set.mem "preproc" IO.options#verbose then
if SSet.mem "preproc" IO.options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
let Region.{value; _} =
Preproc.format ~offsets:IO.options#offsets ~file:true err

1
src/passes/1-parser/pascaligo/Stubs/Preprocessor.ml
View File

@ -1 +1,2 @@
module Preproc = Preproc
module EvalOpt = PP_EvalOpt

144
src/passes/1-parser/reasonligo.ml
View File

@ -2,31 +2,51 @@ open Trace
module AST = Parser_cameligo.AST
module LexToken = Parser_reasonligo.LexToken
module Lexer = Lexer.Make(LexToken)
module Lexer = Lexer.Make (LexToken)
module Scoping = Parser_cameligo.Scoping
module Region = Simple_utils.Region
module ParErr = Parser_reasonligo.ParErr
module SyntaxError = Parser_reasonligo.SyntaxError
module SSet = Utils.String.Set
module SSet = Set.Make (String)
(* Mock IOs TODO: Fill them with CLI options *)
module type IO =
sig
val ext : string
val options : EvalOpt.options
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
module SubIO =
struct
type options = <
libs : string list;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".religo" *)
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
>
let options : options =
object
method libs = []
method verbose = SSet.empty
method offsets = true
method lang = `ReasonLIGO
method ext = ".religo"
method mode = `Point
method cmd = EvalOpt.Quiet
method mono = false
end
module PreIO =
struct
let ext = ".ligo"
let pre_options =
EvalOpt.make ~libs:[]
~verbose:SSet.empty
~offsets:true
~mode:`Point
~cmd:EvalOpt.Quiet
~mono:false
let make =
EvalOpt.make ~libs:options#libs
~verbose:options#verbose
~offsets:options#offsets
~lang:options#lang
~ext:options#ext
~mode:options#mode
~cmd:options#cmd
~mono:options#mono
end
module Parser =
@ -43,8 +63,8 @@ module ParserLog =
include Parser_cameligo.ParserLog
end
module PreUnit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)
module Unit =
ParserUnit.Make (Lexer)(AST)(Parser)(ParErr)(ParserLog)(SubIO)
module Errors =
struct
@ -55,14 +75,14 @@ module Errors =
let wrong_function_arguments (expr: AST.expr) =
let title () = "" in
let message () = "It looks like you are defining a function, \
let message () =
"It looks like you are defining a function, \
however we do not\n\
understand the parameters declaration.\n\
Examples of valid functions:\n\
let x = (a: string, b: int) : int => 3;\n\
let tuple = ((a, b): (int, int)) => a + b; \n\
let x = (a: string) : string => \"Hello, \" ++ a;\n"
in
let x = (a: string) : string => \"Hello, \" ++ a;\n" in
let expression_loc = AST.expr_to_region expr in
let data = [
("location",
@ -70,13 +90,12 @@ module Errors =
in error ~data title message
end
let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in
let apply parser =
let local_fail error =
Trace.fail
@@ Errors.generic
@@ Unit.format_error ~offsets:IO.options#offsets
IO.options#mode error in
@@ Unit.format_error ~offsets:SubIO.options#offsets
SubIO.options#mode error in
match parser () with
Stdlib.Ok semantic_value -> Trace.ok semantic_value
@ -128,71 +147,14 @@ let parse (module IO : IO) parser =
| exception SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) ->
Trace.fail @@ Errors.wrong_function_arguments expr
let parse_file (source: string) =
let module IO =
struct
let ext = PreIO.ext
let options =
PreIO.pre_options ~input:(Some source) ~expr:false
end in
let lib_path =
match IO.options#libs with
[] -> ""
| libs -> let mk_I dir path = Printf.sprintf " -I %s%s" dir path
in List.fold_right mk_I libs "" in
let prefix =
match IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(remove_extension @@ basename file) in
let suffix = ".pp" ^ IO.ext in
let pp_input =
if SSet.mem "cpp" IO.options#verbose
then prefix ^ suffix
else let pp_input, pp_out =
Filename.open_temp_file prefix suffix
in close_out pp_out; pp_input in
let cpp_cmd =
match IO.options#input with
None | Some "-" ->
Printf.sprintf "cpp -traditional-cpp%s - > %s"
lib_path pp_input
| Some file ->
Printf.sprintf "cpp -traditional-cpp%s %s > %s"
lib_path file pp_input in
let open Trace in
let%bind () = sys_command cpp_cmd in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ File pp_input) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
(* Parsing a contract in a file *)
let parse_string (s: string) =
let module IO =
struct
let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:false
end in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
let parse_file source = apply (fun () -> Unit.parse_file source)
let parse_expression (s: string) =
let module IO =
struct
let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:true
end in
let module Unit = PreUnit (IO) in
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr
in parse (module IO) thunk
| Stdlib.Error (Lexer.File_opening msg) ->
Trace.fail @@ Errors.generic @@ Region.wrap_ghost msg
(* Parsing a contract in a string *)
let parse_string source = apply (fun () -> Unit.parse_string source)
(* Parsing an expression in a string *)
let parse_expression source = apply (fun () -> Unit.parse_expression source)

28
src/passes/1-parser/shared/EvalOpt.ml
View File

@ -5,19 +5,21 @@
type command = Quiet | Copy | Units | Tokens
type language = PascaLIGO | CameLIGO | ReasonLIGO
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
let lang_to_string = function
PascaLIGO -> "PascaLIGO"
| CameLIGO -> "CameLIGO"
| ReasonLIGO -> "ReasonLIGO"
`PascaLIGO -> "PascaLIGO"
| `CameLIGO -> "CameLIGO"
| `ReasonLIGO -> "ReasonLIGO"
(* The type [options] gathers the command-line options. *)
module SSet = Set.Make (String)
type options = <
input : string option;
libs : string list;
verbose : Utils.String.Set.t;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
@ -47,8 +49,12 @@ let printf = Printf.printf
let sprintf = Printf.sprintf
let print = print_endline
(* Printing a string in red to standard error *)
let highlight msg = Printf.eprintf "\027[31m%s\027[0m%!" msg
let abort msg =
Utils.highlight (sprintf "Command-line error: %s\n" msg); exit 1
highlight (sprintf "Command-line error: %s\n" msg); exit 1
(* Help *)
@ -83,7 +89,7 @@ and units = ref false
and quiet = ref false
and columns = ref false
and bytes = ref false
and verbose = ref Utils.String.Set.empty
and verbose = ref SSet.empty
and input = ref None
and libs = ref []
and verb_str = ref ""
@ -95,7 +101,7 @@ let split_at_colon = Str.(split (regexp ":"))
let add_path p = libs := !libs @ split_at_colon p
let add_verbose d =
verbose := List.fold_left (Utils.swap Utils.String.Set.add)
verbose := List.fold_left (fun x y -> SSet.add y x)
!verbose
(split_at_colon d)
@ -152,7 +158,7 @@ let print_opt () =
let check lang ext =
let () =
if Utils.String.Set.mem "cli" !verbose then print_opt () in
if SSet.mem "cli" !verbose then print_opt () in
let input =
match !input with
@ -178,7 +184,7 @@ let check lang ext =
and libs = !libs in
let () =
if Utils.String.Set.mem "cli" verbose then
if SSet.mem "cli" verbose then
begin
printf "\nEXPORTED COMMAND LINE\n";
printf "copy = %b\n" copy;
@ -213,6 +219,6 @@ let read ~lang ~ext =
(verb_str :=
let apply e a =
if a = "" then e else Printf.sprintf "%s, %s" e a
in Utils.String.Set.fold apply !verbose "");
in SSet.fold apply !verbose "");
check lang ext
with Getopt.Error msg -> abort msg

8
src/passes/1-parser/shared/EvalOpt.mli
View File

@ -49,14 +49,16 @@ type command = Quiet | Copy | Units | Tokens
expected.}
} *)
type language = PascaLIGO | CameLIGO | ReasonLIGO
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
val lang_to_string : language -> string
module SSet : Set.S with type elt = string and type t = Set.Make(String).t
type options = <
input : string option;
libs : string list;
verbose : Utils.String.Set.t;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
@ -69,7 +71,7 @@ type options = <
val make :
input:string option ->
libs:string list ->
verbose:Utils.String.Set.t ->
verbose:SSet.t ->
offsets:bool ->
lang:language ->
ext:string ->

18
src/passes/1-parser/shared/Lexer.mli
View File

@ -135,7 +135,15 @@ module type S =
val slide : token -> window -> window
type input =
File of file_path (* "-" means stdin *)
| Stdin
| String of string
| Channel of in_channel
| Buffer of Lexing.lexbuf
type instance = {
input : input;
read : log:logger -> Lexing.lexbuf -> token;
buffer : Lexing.lexbuf;
get_win : unit -> window;
@ -145,15 +153,11 @@ module type S =
close : unit -> unit
}
type input =
File of file_path (* "-" means stdin *)
| Stdin
| String of string
| Channel of in_channel
| Buffer of Lexing.lexbuf
type open_err = File_opening of string
val lexbuf_from_input :
input -> (Lexing.lexbuf * (unit -> unit), open_err) Stdlib.result
val open_token_stream : input -> (instance, open_err) Stdlib.result
(* Error reporting *)

75
src/passes/1-parser/shared/Lexer.mll
View File

@ -157,7 +157,15 @@ module type S =
val slide : token -> window -> window
type input =
File of file_path (* "-" means stdin *)
| Stdin
| String of string
| Channel of in_channel
| Buffer of Lexing.lexbuf
type instance = {
input : input;
read : log:logger -> Lexing.lexbuf -> token;
buffer : Lexing.lexbuf;
get_win : unit -> window;
@ -167,15 +175,11 @@ module type S =
close : unit -> unit
}
type input =
File of file_path (* "-" means stdin *)
| Stdin
| String of string
| Channel of in_channel
| Buffer of Lexing.lexbuf
type open_err = File_opening of string
val lexbuf_from_input :
input -> (Lexing.lexbuf * (unit -> unit), open_err) Stdlib.result
val open_token_stream : input -> (instance, open_err) Stdlib.result
(* Error reporting *)
@ -865,7 +869,15 @@ and scan_utf8 thread state = parse
type logger = Markup.t list -> token -> unit
type input =
File of file_path (* "-" means stdin *)
| Stdin
| String of string
| Channel of in_channel
| Buffer of Lexing.lexbuf
type instance = {
input : input;
read : log:logger -> Lexing.lexbuf -> token;
buffer : Lexing.lexbuf;
get_win : unit -> window;
@ -875,15 +887,28 @@ type instance = {
close : unit -> unit
}
type input =
File of file_path (* "-" means stdin *)
| Stdin
| String of string
| Channel of in_channel
| Buffer of Lexing.lexbuf
type open_err = File_opening of string
let lexbuf_from_input = function
File "" | File "-" | Stdin ->
Ok (Lexing.from_channel stdin, fun () -> close_in stdin)
| File path ->
(try
let chan = open_in path in
let close () = close_in chan in
let lexbuf = Lexing.from_channel chan in
let () =
let open Lexing in
lexbuf.lex_curr_p <- {lexbuf.lex_curr_p with pos_fname = path}
in Ok (lexbuf, close)
with Sys_error msg -> Stdlib.Error (File_opening msg))
| String s ->
Ok (Lexing.from_string s, fun () -> ())
| Channel chan ->
let close () = close_in chan in
Ok (Lexing.from_channel chan, close)
| Buffer b -> Ok (b, fun () -> ())
let open_token_stream input =
let file_path = match input with
File file_path ->
@ -968,32 +993,14 @@ let open_token_stream input =
check_right_context token buffer;
patch_buffer (Token.to_region token)#byte_pos buffer;
token in
let buf_close_res =
match input with
File "" | File "-" | Stdin ->
Ok (Lexing.from_channel stdin, fun () -> close_in stdin)
| File path ->
(try
let chan = open_in path in
let close () = close_in chan in
Ok (Lexing.from_channel chan, close)
with
Sys_error msg -> Stdlib.Error (File_opening msg))
| String s ->
Ok (Lexing.from_string s, fun () -> ())
| Channel chan ->
let close () = close_in chan in
Ok (Lexing.from_channel chan, close)
| Buffer b -> Ok (b, fun () -> ()) in
match buf_close_res with
match lexbuf_from_input input with
Ok (buffer, close) ->
let () =
match input with
File path when path <> "" -> reset ~file:path buffer
| _ -> () in
let instance = {
read; buffer; get_win; get_pos; get_last; get_file; close}
input; read; buffer; get_win; get_pos; get_last; get_file; close}
in Ok instance
| Error _ as e -> e

15
src/passes/1-parser/shared/LexerUnit.ml
View File

@ -1,7 +1,8 @@
(* Functor to build a standalone LIGO lexer *)
(* Functor to build a LIGO lexer *)
module Region = Simple_utils.Region
module Preproc = Preprocessor.Preproc
module SSet = Set.Make (String)
module type IO =
sig
@ -27,9 +28,10 @@ module Make (IO: IO) (Lexer: Lexer.S) =
None | Some "-" -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
match Preproc.lex IO.options buffer with
let opt = (IO.options :> Preprocessor.EvalOpt.options) in
match Preproc.lex opt buffer with
Stdlib.Error (pp_buffer, err) ->
if Utils.String.Set.mem "preproc" IO.options#verbose then
if SSet.mem "preproc" IO.options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
let formatted =
Preproc.format ~offsets:IO.options#offsets ~file:true err
@ -80,16 +82,17 @@ module Make (IO: IO) (Lexer: Lexer.S) =
None | Some "-" -> ()
| Some pos_fname ->
buffer.lex_curr_p <- {buffer.lex_curr_p with pos_fname} in
match Preproc.lex IO.options buffer with
let opt = (IO.options :> Preprocessor.EvalOpt.options) in
match Preproc.lex opt buffer with
Stdlib.Error (pp_buffer, err) ->
if Utils.String.Set.mem "preproc" IO.options#verbose then
if SSet.mem "preproc" IO.options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
let formatted =
Preproc.format ~offsets:IO.options#offsets ~file:true err
in Stdlib.Error formatted
| Stdlib.Ok pp_buffer ->
let preproc_str = Buffer.contents pp_buffer in
if Utils.String.Set.mem "preproc" IO.options#verbose then
if SSet.mem "preproc" IO.options#verbose then
begin
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
Stdlib.Ok ()

13
src/passes/1-parser/shared/ParserAPI.ml
View File

@ -2,9 +2,15 @@
module Region = Simple_utils.Region
type options = <
offsets : bool;
mode : [`Byte | `Point];
cmd : EvalOpt.command
>
module type IO =
sig
val options : EvalOpt.options (* CLI options *)
val options : options
end
module type PARSER =
@ -49,7 +55,7 @@ module type PARSER =
(* Main functor *)
module Make (IO : IO)
module Make (IO: IO)
(Lexer: Lexer.S)
(Parser: PARSER with type token = Lexer.Token.token)
(ParErr: sig val message : int -> string end) =
@ -132,7 +138,8 @@ module Make (IO : IO)
module Incr = Parser.Incremental
module Log = LexerLog.Make (Lexer)
let log = Log.output_token ~offsets:IO.options#offsets
let log = Log.output_token
~offsets:IO.options#offsets
IO.options#mode IO.options#cmd stdout
let incr_contract Lexer.{read; buffer; get_win; close; _} =

8
src/passes/1-parser/shared/ParserAPI.mli
View File

@ -2,9 +2,15 @@
module Region = Simple_utils.Region
type options = <
offsets : bool;
mode : [`Byte | `Point];
cmd : EvalOpt.command
>
module type IO =
sig
val options : EvalOpt.options (* CLI options *)
val options : options
end
(* The signature generated by Menhir with additional type definitions

137
src/passes/1-parser/shared/ParserUnit.ml
View File

@ -1,10 +1,26 @@
(* Functor to build a standalone LIGO parser *)
(* Functor to build a LIGO parser *)
module Region = Simple_utils.Region
module Preproc = Preprocessor.Preproc
module SSet = Set.Make (String)
module type IO =
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
module type SubIO =
sig
val options : EvalOpt.options (* CLI options *)
type options = <
libs : string list;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
>
val options : options
val make : input:string option -> expr:bool -> EvalOpt.options
end
module type Pretty =
@ -31,18 +47,18 @@ module Make (Lexer: Lexer.S)
(ParErr: sig val message : int -> string end)
(ParserLog: Pretty with type ast = AST.t
and type expr = AST.expr)
(IO: IO) =
(SubIO: SubIO) =
struct
open Printf
module SSet = Utils.String.Set
module SSet = Set.Make (String)
(* Log of the lexer *)
module Log = LexerLog.Make (Lexer)
let log =
Log.output_token ~offsets:IO.options#offsets
IO.options#mode IO.options#cmd stdout
Log.output_token ~offsets:SubIO.options#offsets
SubIO.options#mode SubIO.options#cmd stdout
(* Error handling (reexported from [ParserAPI]) *)
@ -53,7 +69,12 @@ module Make (Lexer: Lexer.S)
(* Instantiating the parser *)
module Front = ParserAPI.Make (IO)(Lexer)(Parser)(ParErr)
module API_IO =
struct
let options = (SubIO.options :> ParserAPI.options)
end
module Front = ParserAPI.Make (API_IO)(Lexer)(Parser)(ParErr)
let format_error = Front.format_error
@ -66,13 +87,13 @@ module Make (Lexer: Lexer.S)
(AST.expr, message Region.reg) Stdlib.result =
let output = Buffer.create 131 in
let state =
ParserLog.mk_state ~offsets:IO.options#offsets
~mode:IO.options#mode
ParserLog.mk_state ~offsets:SubIO.options#offsets
~mode:SubIO.options#mode
~buffer:output in
let close () = lexer_inst.Lexer.close () in
let expr =
try
if IO.options#mono then
if SubIO.options#mono then
let tokeniser = lexer_inst.Lexer.read ~log
and lexbuf = lexer_inst.Lexer.buffer
in Front.mono_expr tokeniser lexbuf
@ -80,14 +101,14 @@ module Make (Lexer: Lexer.S)
Front.incr_expr lexer_inst
with exn -> close (); raise exn in
let () =
if SSet.mem "ast-tokens" IO.options#verbose then
if SSet.mem "ast-tokens" SubIO.options#verbose then
begin
Buffer.clear output;
ParserLog.print_expr state expr;
Buffer.output_buffer stdout output
end in
let () =
if SSet.mem "ast" IO.options#verbose then
if SSet.mem "ast" SubIO.options#verbose then
begin
Buffer.clear output;
ParserLog.pp_expr state expr;
@ -101,13 +122,13 @@ module Make (Lexer: Lexer.S)
(AST.t, message Region.reg) Stdlib.result =
let output = Buffer.create 131 in
let state =
ParserLog.mk_state ~offsets:IO.options#offsets
~mode:IO.options#mode
ParserLog.mk_state ~offsets:SubIO.options#offsets
~mode:SubIO.options#mode
~buffer:output in
let close () = lexer_inst.Lexer.close () in
let ast =
try
if IO.options#mono then
if SubIO.options#mono then
let tokeniser = lexer_inst.Lexer.read ~log
and lexbuf = lexer_inst.Lexer.buffer
in Front.mono_contract tokeniser lexbuf
@ -115,14 +136,14 @@ module Make (Lexer: Lexer.S)
Front.incr_contract lexer_inst
with exn -> close (); raise exn in
let () =
if SSet.mem "ast-tokens" IO.options#verbose then
if SSet.mem "ast-tokens" SubIO.options#verbose then
begin
Buffer.clear output;
ParserLog.print_tokens state ast;
Buffer.output_buffer stdout output
end in
let () =
if SSet.mem "ast" IO.options#verbose then
if SSet.mem "ast" SubIO.options#verbose then
begin
Buffer.clear output;
ParserLog.pp_ast state ast;
@ -130,9 +151,16 @@ module Make (Lexer: Lexer.S)
end
in flush_all (); close (); Ok ast
(* Wrapper for the parsers above *)
(* Checking if a lexer input is a file *)
type 'a parser = Lexer.instance -> ('a, message Region.reg) result
let is_file input =
let open Lexer in
match input with
File "-" | File "" -> false
| File _ -> true
| Stdin | String _ | Channel _ | Buffer _ -> false
(* Wrapper for the parsers above *)
let apply lexer_inst parser =
(* Calling the parser and filtering errors *)
@ -144,21 +172,18 @@ module Make (Lexer: Lexer.S)
(* Lexing errors *)
| exception Lexer.Error err ->
let file =
match IO.options#input with
None | Some "-" -> false
| Some _ -> true in
let file = is_file lexer_inst.Lexer.input in
let error =
Lexer.format_error ~offsets:IO.options#offsets
IO.options#mode err ~file
Lexer.format_error ~offsets:SubIO.options#offsets
SubIO.options#mode err ~file
in Stdlib.Error error
(* Incremental API of Menhir *)
| exception Front.Point point ->
let error =
Front.format_error ~offsets:IO.options#offsets
IO.options#mode point
Front.format_error ~offsets:SubIO.options#offsets
SubIO.options#mode point
in Stdlib.Error error
(* Monolithic API of Menhir *)
@ -172,12 +197,64 @@ module Make (Lexer: Lexer.S)
| Lexer.Two (invalid, valid) -> invalid, Some valid in
let point = "", valid_opt, invalid in
let error =
Front.format_error ~offsets:IO.options#offsets
IO.options#mode point
Front.format_error ~offsets:SubIO.options#offsets
SubIO.options#mode point
in Stdlib.Error error
(* I/O errors *)
| exception Sys_error error ->
flush_all (); Stdlib.Error (Region.wrap_ghost error)
(* Preprocessing the input source *)
let preproc options lexbuf =
Preproc.lex (options :> Preprocessor.EvalOpt.options) lexbuf
(* Parsing a contract *)
let gen_parser options input parser =
match Lexer.lexbuf_from_input input with
Stdlib.Error (Lexer.File_opening msg) ->
Stdlib.Error (Region.wrap_ghost msg)
| Ok (lexbuf, close) ->
(* Preprocessing the input source *)
match preproc options lexbuf with
Stdlib.Error (pp_buffer, err) ->
if SSet.mem "preproc" options#verbose then
Printf.printf "%s\n%!" (Buffer.contents pp_buffer);
let formatted =
Preproc.format ~offsets:options#offsets
~file:(is_file input)
err
in close (); Stdlib.Error formatted
| Stdlib.Ok buffer ->
(* Lexing and parsing the preprocessed input source *)
let () = close () in
let input' = Lexer.String (Buffer.contents buffer) in
match Lexer.open_token_stream input' with
Ok instance -> apply instance parser
| Stdlib.Error (Lexer.File_opening msg) ->
Stdlib.Error (Region.wrap_ghost msg)
(* Parsing a contract in a file *)
let parse_file (source : string) =
let options = SubIO.make ~input:(Some source) ~expr:false
in gen_parser options (Lexer.File source) parse_contract
(* Parsing a contract in a string *)
let parse_string (source : string) =
let options = SubIO.make ~input:None ~expr:false in
gen_parser options (Lexer.String source) parse_contract
(* Parsing an expression in a string *)
let parse_expression (source : string) =
let options = SubIO.make ~input:None ~expr:true in
gen_parser options (Lexer.String source) parse_expr
end

32
src/passes/1-parser/shared/ParserUnit.mli
View File

@ -2,9 +2,25 @@
module Region = Simple_utils.Region
module type IO =
type language = [`PascaLIGO | `CameLIGO | `ReasonLIGO]
module SSet : Set.S with type elt = string and type t = Set.Make(String).t
module type SubIO =
sig
val options : EvalOpt.options (* CLI options *)
type options = <
libs : string list;
verbose : SSet.t;
offsets : bool;
lang : language;
ext : string; (* ".ligo", ".mligo", ".religo" *)
mode : [`Byte | `Point];
cmd : EvalOpt.command;
mono : bool
>
val options : options
val make : input:string option -> expr:bool -> EvalOpt.options
end
module type Pretty =
@ -31,7 +47,7 @@ module Make (Lexer : Lexer.S)
(ParErr : sig val message : int -> string end)
(ParserLog : Pretty with type ast = AST.t
and type expr = AST.expr)
(IO: IO) :
(SubIO: SubIO) :
sig
(* Error handling reexported from [ParserAPI] without the
exception [Point] *)
@ -49,10 +65,12 @@ module Make (Lexer : Lexer.S)
(* Parsers *)
type 'a parser = Lexer.instance -> ('a, message Region.reg) result
val parse_file :
string -> (AST.t, message Region.reg) Stdlib.result
val apply : Lexer.instance -> 'a parser -> ('a, message Region.reg) result
val parse_string :
string -> (AST.t, message Region.reg) Stdlib.result
val parse_contract : AST.t parser
val parse_expr : AST.expr parser
val parse_expression :
string -> (AST.expr, message Region.reg) Stdlib.result
end

4
src/passes/1-parser/shared/dune
View File

@ -9,7 +9,7 @@
uutf
getopt
zarith
Preproc)
Preprocessor)
(preprocess
(pps bisect_ppx --conditional))
(modules
@ -18,8 +18,8 @@
ParserAPI
Lexer
LexerLog
Utils
Markup
Utils
FQueue
EvalOpt
Version))

32
vendors/UnionFind/UnionFind.install vendored
View File

@ -1,23 +1,9 @@
lib: [
"_build/install/default/lib/UnionFind/META"
"_build/install/default/lib/UnionFind/Partition.cmi"
"_build/install/default/lib/UnionFind/Partition.cmti"
"_build/install/default/lib/UnionFind/Partition.mli"
"_build/install/default/lib/UnionFind/Partition0.cmi"
"_build/install/default/lib/UnionFind/Partition0.cmt"
"_build/install/default/lib/UnionFind/Partition0.cmx"
"_build/install/default/lib/UnionFind/Partition0.ml"
"_build/install/default/lib/UnionFind/Partition1.cmi"
"_build/install/default/lib/UnionFind/Partition1.cmt"
"_build/install/default/lib/UnionFind/Partition1.cmx"
"_build/install/default/lib/UnionFind/Partition1.ml"
"_build/install/default/lib/UnionFind/Partition2.cmi"
"_build/install/default/lib/UnionFind/Partition2.cmt"
"_build/install/default/lib/UnionFind/Partition2.cmx"
"_build/install/default/lib/UnionFind/Partition2.ml"
"_build/install/default/lib/UnionFind/Partition3.cmi"
"_build/install/default/lib/UnionFind/Partition3.cmt"
"_build/install/default/lib/UnionFind/Partition3.cmx"
"_build/install/default/lib/UnionFind/Partition3.ml"
"_build/install/default/lib/UnionFind/UnionFind.a"
"_build/install/default/lib/UnionFind/UnionFind.cma"
@ -29,6 +15,24 @@ lib: [
"_build/install/default/lib/UnionFind/unionFind.cmt"
"_build/install/default/lib/UnionFind/unionFind.cmx"
"_build/install/default/lib/UnionFind/unionFind.ml"
"_build/install/default/lib/UnionFind/unionFind__.cmi"
"_build/install/default/lib/UnionFind/unionFind__.cmt"
"_build/install/default/lib/UnionFind/unionFind__.cmx"
"_build/install/default/lib/UnionFind/unionFind__.ml"
"_build/install/default/lib/UnionFind/unionFind__Partition.cmi"
"_build/install/default/lib/UnionFind/unionFind__Partition.cmti"
"_build/install/default/lib/UnionFind/unionFind__Partition0.cmi"
"_build/install/default/lib/UnionFind/unionFind__Partition0.cmt"
"_build/install/default/lib/UnionFind/unionFind__Partition0.cmx"
"_build/install/default/lib/UnionFind/unionFind__Partition1.cmi"
"_build/install/default/lib/UnionFind/unionFind__Partition1.cmt"
"_build/install/default/lib/UnionFind/unionFind__Partition1.cmx"
"_build/install/default/lib/UnionFind/unionFind__Partition2.cmi"
"_build/install/default/lib/UnionFind/unionFind__Partition2.cmt"
"_build/install/default/lib/UnionFind/unionFind__Partition2.cmx"
"_build/install/default/lib/UnionFind/unionFind__Partition3.cmi"
"_build/install/default/lib/UnionFind/unionFind__Partition3.cmt"
"_build/install/default/lib/UnionFind/unionFind__Partition3.cmx"
]
doc: [
"_build/install/default/doc/UnionFind/LICENSE"

2
vendors/UnionFind/dune vendored
View File

@ -1,6 +1,6 @@
(library
(name UnionFind)
(public_name UnionFind)
(wrapped false)
(wrapped true)
(modules Partition0 Partition1 Partition2 Partition3 Partition UnionFind)
(modules_without_implementation Partition))