Finished refactoring the front-end.

This commit is contained in:
Christian Rinderknecht 2020-01-27 17:28:31 +01:00
parent 8047e98124
commit a29b5acb31
7 changed files with 162 additions and 238 deletions

View File

@ -18,56 +18,56 @@ let%expect_test _ =
Dump the LIGO changelog to stdout.
compile-contract
Subcommand: compile a contract.
Subcommand: Compile a contract.
compile-expression
Subcommand: compile to a michelson value.
Subcommand: Compile to a michelson value.
compile-parameter
Subcommand: compile parameters to a michelson expression. The
resulting michelson expression can be passed as an argument in a
Subcommand: Compile parameters to a Michelson expression. The
resulting Michelson expression can be passed as an argument in a
transaction which calls a contract.
compile-storage
Subcommand: compile an initial storage in ligo syntax to a
michelson expression. The resulting michelson expression can be
Subcommand: Compile an initial storage in ligo syntax to a
Michelson expression. The resulting Michelson expression can be
passed as an argument in a transaction which originates a
contract.
dry-run
Subcommand: run a smart-contract with the given storage and input.
Subcommand: Run a smart-contract with the given storage and input.
evaluate-value
Subcommand: evaluate a given definition.
Subcommand: Evaluate a given definition.
interpret
Subcommand: interpret the expression in the context initialized by
Subcommand: Interpret the expression in the context initialized by
the provided source file.
list-declarations
Subcommand: list all the top-level decalarations.
Subcommand: List all the top-level declarations.
measure-contract
Subcommand: measure a contract's compiled size in bytes.
Subcommand: Measure a contract's compiled size in bytes.
print-ast
Subcommand: print the ast. Warning: intended for development of
Subcommand: Print the AST. Warning: Intended for development of
LIGO and can break at any time.
print-cst
Subcommand: print the cst. Warning: intended for development of
Subcommand: Print the CST. Warning: Intended for development of
LIGO and can break at any time.
print-mini-c
Subcommand: print mini c. Warning: intended for development of
Subcommand: Print Mini-C. Warning: Intended for development of
LIGO and can break at any time.
print-typed-ast
Subcommand: print the typed ast. Warning: intended for development
Subcommand: Print the typed AST. Warning: Intended for development
of LIGO and can break at any time.
run-function
Subcommand: run a function with the given parameter.
Subcommand: Run a function with the given parameter.
OPTIONS
--help[=FMT] (default=auto)
@ -94,56 +94,56 @@ let%expect_test _ =
Dump the LIGO changelog to stdout.
compile-contract
Subcommand: compile a contract.
Subcommand: Compile a contract.
compile-expression
Subcommand: compile to a michelson value.
Subcommand: Compile to a michelson value.
compile-parameter
Subcommand: compile parameters to a michelson expression. The
resulting michelson expression can be passed as an argument in a
Subcommand: Compile parameters to a Michelson expression. The
resulting Michelson expression can be passed as an argument in a
transaction which calls a contract.
compile-storage
Subcommand: compile an initial storage in ligo syntax to a
michelson expression. The resulting michelson expression can be
Subcommand: Compile an initial storage in ligo syntax to a
Michelson expression. The resulting Michelson expression can be
passed as an argument in a transaction which originates a
contract.
dry-run
Subcommand: run a smart-contract with the given storage and input.
Subcommand: Run a smart-contract with the given storage and input.
evaluate-value
Subcommand: evaluate a given definition.
Subcommand: Evaluate a given definition.
interpret
Subcommand: interpret the expression in the context initialized by
Subcommand: Interpret the expression in the context initialized by
the provided source file.
list-declarations
Subcommand: list all the top-level decalarations.
Subcommand: List all the top-level declarations.
measure-contract
Subcommand: measure a contract's compiled size in bytes.
Subcommand: Measure a contract's compiled size in bytes.
print-ast
Subcommand: print the ast. Warning: intended for development of
Subcommand: Print the AST. Warning: Intended for development of
LIGO and can break at any time.
print-cst
Subcommand: print the cst. Warning: intended for development of
Subcommand: Print the CST. Warning: Intended for development of
LIGO and can break at any time.
print-mini-c
Subcommand: print mini c. Warning: intended for development of
Subcommand: Print Mini-C. Warning: Intended for development of
LIGO and can break at any time.
print-typed-ast
Subcommand: print the typed ast. Warning: intended for development
Subcommand: Print the typed AST. Warning: Intended for development
of LIGO and can break at any time.
run-function
Subcommand: run a function with the given parameter.
Subcommand: Run a function with the given parameter.
OPTIONS
--help[=FMT] (default=auto)
@ -157,7 +157,7 @@ let%expect_test _ =
run_ligo_good [ "compile-contract" ; "--help" ] ;
[%expect {|
NAME
ligo-compile-contract - Subcommand: compile a contract.
ligo-compile-contract - Subcommand: Compile a contract.
SYNOPSIS
ligo compile-contract [OPTION]... SOURCE_FILE ENTRY_POINT
@ -167,8 +167,7 @@ let%expect_test _ =
ENTRY_POINT is entry-point that will be compiled.
SOURCE_FILE (required)
SOURCE_FILE is the path to the .ligo or .mligo file of the
contract.
SOURCE_FILE is the path to the smart contract file.
OPTIONS
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
@ -191,8 +190,9 @@ let%expect_test _ =
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
guessed from the extension (.ligo and .mligo, respectively).
syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,
the syntax is guessed from the extension (.ligo, .mligo, .religo
respectively).
--version
Show version information. |} ] ;
@ -200,8 +200,8 @@ let%expect_test _ =
run_ligo_good [ "compile-parameter" ; "--help" ] ;
[%expect {|
NAME
ligo-compile-parameter - Subcommand: compile parameters to a michelson
expression. The resulting michelson expression can be passed as an
ligo-compile-parameter - Subcommand: Compile parameters to a Michelson
expression. The resulting Michelson expression can be passed as an
argument in a transaction which calls a contract.
SYNOPSIS
@ -216,12 +216,11 @@ let%expect_test _ =
PARAMETER_EXPRESSION is the expression that will be compiled.
SOURCE_FILE (required)
SOURCE_FILE is the path to the .ligo or .mligo file of the
contract.
SOURCE_FILE is the path to the smart contract file.
OPTIONS
--amount=AMOUNT (absent=0)
AMOUNT is the amount the michelson interpreter will use.
AMOUNT is the amount the Michelson interpreter will use.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable)
@ -242,21 +241,22 @@ let%expect_test _ =
are 'text' (default), 'json' and 'hex'.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
PREDECESSOR_TIMESTAMP is the predecessor_timestamp (now value
minus one minute) the Michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
guessed from the extension (.ligo and .mligo, respectively).
syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,
the syntax is guessed from the extension (.ligo, .mligo, .religo
respectively).
--sender=SENDER
SENDER is the sender the michelson interpreter transaction will
SENDER is the sender the Michelson interpreter transaction will
use.
--source=SOURCE
SOURCE is the source the michelson interpreter transaction will
SOURCE is the source the Michelson interpreter transaction will
use.
--version
@ -265,8 +265,8 @@ let%expect_test _ =
run_ligo_good [ "compile-storage" ; "--help" ] ;
[%expect {|
NAME
ligo-compile-storage - Subcommand: compile an initial storage in ligo
syntax to a michelson expression. The resulting michelson expression
ligo-compile-storage - Subcommand: Compile an initial storage in ligo
syntax to a Michelson expression. The resulting Michelson expression
can be passed as an argument in a transaction which originates a
contract.
@ -279,15 +279,14 @@ let%expect_test _ =
ENTRY_POINT is entry-point that will be compiled.
SOURCE_FILE (required)
SOURCE_FILE is the path to the .ligo or .mligo file of the
contract.
SOURCE_FILE is the path to the smart contract file.
STORAGE_EXPRESSION (required)
STORAGE_EXPRESSION is the expression that will be compiled.
OPTIONS
--amount=AMOUNT (absent=0)
AMOUNT is the amount the michelson interpreter will use.
AMOUNT is the amount the Michelson interpreter will use.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable)
@ -308,21 +307,22 @@ let%expect_test _ =
are 'text' (default), 'json' and 'hex'.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
PREDECESSOR_TIMESTAMP is the predecessor_timestamp (now value
minus one minute) the Michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
guessed from the extension (.ligo and .mligo, respectively).
syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,
the syntax is guessed from the extension (.ligo, .mligo, .religo
respectively).
--sender=SENDER
SENDER is the sender the michelson interpreter transaction will
SENDER is the sender the Michelson interpreter transaction will
use.
--source=SOURCE
SOURCE is the source the michelson interpreter transaction will
SOURCE is the source the Michelson interpreter transaction will
use.
--version
@ -331,7 +331,7 @@ let%expect_test _ =
run_ligo_good [ "dry-run" ; "--help" ] ;
[%expect {|
NAME
ligo-dry-run - Subcommand: run a smart-contract with the given storage
ligo-dry-run - Subcommand: Run a smart-contract with the given storage
and input.
SYNOPSIS
@ -346,15 +346,14 @@ let%expect_test _ =
PARAMETER_EXPRESSION is the expression that will be compiled.
SOURCE_FILE (required)
SOURCE_FILE is the path to the .ligo or .mligo file of the
contract.
SOURCE_FILE is the path to the smart contract file.
STORAGE_EXPRESSION (required)
STORAGE_EXPRESSION is the expression that will be compiled.
OPTIONS
--amount=AMOUNT (absent=0)
AMOUNT is the amount the michelson interpreter will use.
AMOUNT is the amount the Michelson interpreter will use.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable)
@ -370,21 +369,22 @@ let%expect_test _ =
`plain' whenever the TERM env var is `dumb' or undefined.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
PREDECESSOR_TIMESTAMP is the predecessor_timestamp (now value
minus one minute) the Michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
guessed from the extension (.ligo and .mligo, respectively).
syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,
the syntax is guessed from the extension (.ligo, .mligo, .religo
respectively).
--sender=SENDER
SENDER is the sender the michelson interpreter transaction will
SENDER is the sender the Michelson interpreter transaction will
use.
--source=SOURCE
SOURCE is the source the michelson interpreter transaction will
SOURCE is the source the Michelson interpreter transaction will
use.
--version
@ -393,7 +393,7 @@ let%expect_test _ =
run_ligo_good [ "run-function" ; "--help" ] ;
[%expect {|
NAME
ligo-run-function - Subcommand: run a function with the given
ligo-run-function - Subcommand: Run a function with the given
parameter.
SYNOPSIS
@ -408,12 +408,11 @@ let%expect_test _ =
PARAMETER_EXPRESSION is the expression that will be compiled.
SOURCE_FILE (required)
SOURCE_FILE is the path to the .ligo or .mligo file of the
contract.
SOURCE_FILE is the path to the smart contract file.
OPTIONS
--amount=AMOUNT (absent=0)
AMOUNT is the amount the michelson interpreter will use.
AMOUNT is the amount the Michelson interpreter will use.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable)
@ -429,21 +428,22 @@ let%expect_test _ =
`plain' whenever the TERM env var is `dumb' or undefined.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
PREDECESSOR_TIMESTAMP is the predecessor_timestamp (now value
minus one minute) the Michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
guessed from the extension (.ligo and .mligo, respectively).
syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,
the syntax is guessed from the extension (.ligo, .mligo, .religo
respectively).
--sender=SENDER
SENDER is the sender the michelson interpreter transaction will
SENDER is the sender the Michelson interpreter transaction will
use.
--source=SOURCE
SOURCE is the source the michelson interpreter transaction will
SOURCE is the source the Michelson interpreter transaction will
use.
--version
@ -452,7 +452,7 @@ let%expect_test _ =
run_ligo_good [ "evaluate-value" ; "--help" ] ;
[%expect {|
NAME
ligo-evaluate-value - Subcommand: evaluate a given definition.
ligo-evaluate-value - Subcommand: Evaluate a given definition.
SYNOPSIS
ligo evaluate-value [OPTION]... SOURCE_FILE ENTRY_POINT
@ -462,12 +462,11 @@ let%expect_test _ =
ENTRY_POINT is entry-point that will be compiled.
SOURCE_FILE (required)
SOURCE_FILE is the path to the .ligo or .mligo file of the
contract.
SOURCE_FILE is the path to the smart contract file.
OPTIONS
--amount=AMOUNT (absent=0)
AMOUNT is the amount the michelson interpreter will use.
AMOUNT is the amount the Michelson interpreter will use.
--format=DISPLAY_FORMAT, --display-format=DISPLAY_FORMAT
(absent=human-readable)
@ -483,21 +482,22 @@ let%expect_test _ =
`plain' whenever the TERM env var is `dumb' or undefined.
--predecessor-timestamp=PREDECESSOR_TIMESTAMP
PREDECESSOR_TIMESTAMP is the pedecessor_timestamp (now value minus
one minute) the michelson interpreter will use (e.g.
PREDECESSOR_TIMESTAMP is the predecessor_timestamp (now value
minus one minute) the Michelson interpreter will use (e.g.
'2000-01-01T10:10:10Z')
-s SYNTAX, --syntax=SYNTAX (absent=auto)
SYNTAX is the syntax that will be used. Currently supported
syntaxes are "pascaligo" and "cameligo". By default, the syntax is
guessed from the extension (.ligo and .mligo, respectively).
syntaxes are "pascaligo", "cameligo" and "reasonligo". By default,
the syntax is guessed from the extension (.ligo, .mligo, .religo
respectively).
--sender=SENDER
SENDER is the sender the michelson interpreter transaction will
SENDER is the sender the Michelson interpreter transaction will
use.
--source=SOURCE
SOURCE is the source the michelson interpreter transaction will
SOURCE is the source the Michelson interpreter transaction will
use.
--version
@ -506,7 +506,7 @@ let%expect_test _ =
run_ligo_good [ "compile-expression" ; "--help" ] ;
[%expect {|
NAME
ligo-compile-expression - Subcommand: compile to a michelson value.
ligo-compile-expression - Subcommand: Compile to a michelson value.
SYNOPSIS
ligo compile-expression [OPTION]... SYNTAX _EXPRESSION

View File

@ -144,7 +144,7 @@ let parse_file (source: string) =
let open Trace in
let%bind () = sys_command cpp_cmd in
let module Unit = PreUnit (IO) in
match Lexer.open_token_stream (Lexer.File pp_input) with
match Lexer.(open_token_stream @@ File pp_input) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
@ -158,7 +158,7 @@ let parse_string (s: string) =
let options = PreIO.pre_options ~input:None ~expr:false
end in
let module Unit = PreUnit (IO) in
match Lexer.open_token_stream (Lexer.String s) with
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
@ -172,7 +172,7 @@ let parse_expression (s: string) =
let options = PreIO.pre_options ~input:None ~expr:true
end in
let module Unit = PreUnit (IO) in
match Lexer.open_token_stream (Lexer.String s) with
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr
in parse (module IO) thunk

View File

@ -55,12 +55,13 @@ module Errors =
in Trace.error ~data:[] title message
end
let parse (module Unit : ParserUnit.S) parser =
let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in
let local_fail error =
Trace.fail
@@ Errors.generic
@@ Unit.format_error ~offsets:Unit.IO.options#offsets
Unit.IO.options#mode error in
@@ Unit.format_error ~offsets:IO.options#offsets
IO.options#mode error in
match parser () with
Stdlib.Ok semantic_value -> Trace.ok semantic_value
@ -120,32 +121,71 @@ let parse (module Unit : ParserUnit.S) parser =
Hint: Change the name.\n",
None, invalid))
let parse_file :
string -> (Unit.Parser.ast, string Region.reg) Stdlib.result =
fun source ->
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 Wrapper.parse_file Errors.generic (module Unit : ParserUnit.S) parse
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
let parse_string =
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 Wrapper.parse_string Errors.generic (module Unit : ParserUnit.S) parse
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_expression =
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 Wrapper.parse_expression Errors.generic (module Unit : ParserUnit.S) parse
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

View File

@ -54,8 +54,8 @@ module Errors =
in Trace.error ~data:[] title message
let wrong_function_arguments (expr: AST.expr) =
let title () = "\nWrong function arguments" in
let message () = "" in
let title () = "" in
let message () = "Wrong function arguments.\n" in
let expression_loc = AST.expr_to_region expr in
let data = [
("location",
@ -155,7 +155,7 @@ let parse_file (source: string) =
let open Trace in
let%bind () = sys_command cpp_cmd in
let module Unit = PreUnit (IO) in
match Lexer.open_token_stream (Lexer.File pp_input) with
match Lexer.(open_token_stream @@ File pp_input) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
@ -169,7 +169,7 @@ let parse_string (s: string) =
let options = PreIO.pre_options ~input:None ~expr:false
end in
let module Unit = PreUnit (IO) in
match Lexer.open_token_stream (Lexer.String s) with
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk
@ -183,7 +183,7 @@ let parse_expression (s: string) =
let options = PreIO.pre_options ~input:None ~expr:true
end in
let module Unit = PreUnit (IO) in
match Lexer.open_token_stream (Lexer.String s) with
match Lexer.(open_token_stream @@ String s) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr
in parse (module IO) thunk

View File

@ -23,41 +23,6 @@ module type Pretty =
val print_expr : state -> expr -> unit
end
module type S =
sig
module IO : IO
module Lexer : Lexer.S
module AST : sig type t type expr end
module Parser : ParserAPI.PARSER
with type ast = AST.t
and type expr = AST.expr
and type token = Lexer.token
(* Error handling reexported from [ParserAPI] without the
exception [Point] *)
type message = string
type valid = Parser.token
type invalid = Parser.token
type error = message * valid option * invalid
val format_error :
?offsets:bool -> [`Byte | `Point] -> error -> string Region.reg
val short_error :
?offsets:bool -> [`Point | `Byte] -> message -> Region.t -> string
(* Parsers *)
type 'a parser = Lexer.instance -> ('a, message Region.reg) result
val apply : Lexer.instance -> 'a parser -> ('a, message Region.reg) result
val parse_contract : AST.t parser
val parse_expr : AST.expr parser
end
module Make (Lexer: Lexer.S)
(AST: sig type t type expr end)
(Parser: ParserAPI.PARSER
@ -69,11 +34,6 @@ module Make (Lexer: Lexer.S)
and type expr = AST.expr)
(IO: IO) =
struct
module IO = IO
module Lexer = Lexer
module AST = AST
module Parser = Parser
open Printf
module SSet = Utils.String.Set

View File

@ -23,17 +23,17 @@ module type Pretty =
val print_expr : state -> expr -> unit
end
module type S =
sig
module IO : IO
module Lexer : Lexer.S
module AST : sig type t type expr end
module Parser : ParserAPI.PARSER
module Make (Lexer : Lexer.S)
(AST : sig type t type expr end)
(Parser : ParserAPI.PARSER
with type ast = AST.t
and type expr = AST.expr
and type token = Lexer.token
and type token = Lexer.token)
(ParErr : sig val message : int -> string end)
(ParserLog : Pretty with type ast = AST.t
and type expr = AST.expr)
(IO: IO) :
sig
(* Error handling reexported from [ParserAPI] without the
exception [Point] *)
@ -57,17 +57,3 @@ module type S =
val parse_contract : AST.t parser
val parse_expr : AST.expr parser
end
module Make (Lexer : Lexer.S)
(AST : sig type t type expr end)
(Parser : ParserAPI.PARSER
with type ast = AST.t
and type expr = AST.expr
and type token = Lexer.token)
(ParErr : sig val message : int -> string end)
(ParserLog : Pretty with type ast = AST.t
and type expr = AST.expr)
(IO: IO) : S with module IO = IO
and module Lexer = Lexer
and module AST = AST
and module Parser = Parser

View File

@ -1,62 +0,0 @@
module SSet = Utils.String.Set
module type IO =
sig
val ext : string
val options : EvalOpt.options
end
let parse_file generic_error
(module Unit : ParserUnit.S)
(parse: unit -> (Unit.Parser.ast, string Region.reg) Stdlib.result)
: (Unit.Parser.ast, string Region.reg) Stdlib.result =
let lib_path =
match Unit.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 Unit.IO.options#input with
None | Some "-" -> "temp"
| Some file -> Filename.(remove_extension @@ basename file) in
let suffix = ".pp" ^ Unit.IO.ext in
let pp_input =
if SSet.mem "cpp" Unit.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 Unit.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 Unit.Lexer.(open_token_stream (File pp_input)) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module Unit.IO : IO) thunk
| Stdlib.Error (Unit.Lexer.File_opening msg) ->
Trace.fail @@ generic_error @@ Region.wrap_ghost msg
let parse_string generic_error
(module Unit : ParserUnit.S) parse (s: string) =
match Unit.Lexer.(open_token_stream (String s)) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract
in parse (module Unit.IO : IO) thunk
| Stdlib.Error (Unit.Lexer.File_opening msg) ->
Trace.fail @@ generic_error @@ Region.wrap_ghost msg
let parse_expression generic_error
(module Unit : ParserUnit.S) parse (s: string) =
match Unit.Lexer.(open_token_stream (String s)) with
Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr
in parse (module Unit.IO : IO) thunk
| Stdlib.Error (Unit.Lexer.File_opening msg) ->
Trace.fail @@ generic_error @@ Region.wrap_ghost msg