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

View File

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

View File

@ -55,12 +55,13 @@ module Errors =
in Trace.error ~data:[] title message in Trace.error ~data:[] title message
end end
let parse (module Unit : ParserUnit.S) parser = let parse (module IO : IO) parser =
let module Unit = PreUnit (IO) in
let local_fail error = let local_fail error =
Trace.fail Trace.fail
@@ Errors.generic @@ Errors.generic
@@ Unit.format_error ~offsets:Unit.IO.options#offsets @@ Unit.format_error ~offsets:IO.options#offsets
Unit.IO.options#mode error in IO.options#mode error in
match parser () with match parser () with
Stdlib.Ok semantic_value -> Trace.ok semantic_value Stdlib.Ok semantic_value -> Trace.ok semantic_value
@ -120,32 +121,71 @@ let parse (module Unit : ParserUnit.S) parser =
Hint: Change the name.\n", Hint: Change the name.\n",
None, invalid)) None, invalid))
let parse_file : let parse_file source =
string -> (Unit.Parser.ast, string Region.reg) Stdlib.result =
fun source ->
let module IO = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = let options =
PreIO.pre_options ~input:(Some source) ~expr:false PreIO.pre_options ~input:(Some source) ~expr:false
end in end in
let module Unit = PreUnit (IO) let module Unit = PreUnit (IO) in
in Wrapper.parse_file Errors.generic (module Unit : ParserUnit.S) parse 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 = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:false let options = PreIO.pre_options ~input:None ~expr:false
end in end in
let module Unit = PreUnit (IO) let module Unit = PreUnit (IO) in
in Wrapper.parse_string Errors.generic (module Unit : ParserUnit.S) parse 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 = let module IO =
struct struct
let ext = PreIO.ext let ext = PreIO.ext
let options = PreIO.pre_options ~input:None ~expr:true let options = PreIO.pre_options ~input:None ~expr:true
end in end in
let module Unit = PreUnit (IO) let module Unit = PreUnit (IO) in
in Wrapper.parse_expression Errors.generic (module Unit : ParserUnit.S) parse 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 in Trace.error ~data:[] title message
let wrong_function_arguments (expr: AST.expr) = let wrong_function_arguments (expr: AST.expr) =
let title () = "\nWrong function arguments" in let title () = "" in
let message () = "" in let message () = "Wrong function arguments.\n" in
let expression_loc = AST.expr_to_region expr in let expression_loc = AST.expr_to_region expr in
let data = [ let data = [
("location", ("location",
@ -155,7 +155,7 @@ let parse_file (source: string) =
let open Trace in let open Trace in
let%bind () = sys_command cpp_cmd in let%bind () = sys_command cpp_cmd in
let module Unit = PreUnit (IO) 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 -> Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk in parse (module IO) thunk
@ -169,7 +169,7 @@ let parse_string (s: string) =
let options = PreIO.pre_options ~input:None ~expr:false let options = PreIO.pre_options ~input:None ~expr:false
end in end in
let module Unit = PreUnit (IO) 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 -> Ok instance ->
let thunk () = Unit.apply instance Unit.parse_contract let thunk () = Unit.apply instance Unit.parse_contract
in parse (module IO) thunk in parse (module IO) thunk
@ -183,7 +183,7 @@ let parse_expression (s: string) =
let options = PreIO.pre_options ~input:None ~expr:true let options = PreIO.pre_options ~input:None ~expr:true
end in end in
let module Unit = PreUnit (IO) 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 -> Ok instance ->
let thunk () = Unit.apply instance Unit.parse_expr let thunk () = Unit.apply instance Unit.parse_expr
in parse (module IO) thunk in parse (module IO) thunk

View File

@ -23,41 +23,6 @@ module type Pretty =
val print_expr : state -> expr -> unit val print_expr : state -> expr -> unit
end 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) module Make (Lexer: Lexer.S)
(AST: sig type t type expr end) (AST: sig type t type expr end)
(Parser: ParserAPI.PARSER (Parser: ParserAPI.PARSER
@ -69,11 +34,6 @@ module Make (Lexer: Lexer.S)
and type expr = AST.expr) and type expr = AST.expr)
(IO: IO) = (IO: IO) =
struct struct
module IO = IO
module Lexer = Lexer
module AST = AST
module Parser = Parser
open Printf open Printf
module SSet = Utils.String.Set module SSet = Utils.String.Set

View File

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