Improved slightly the formatting of some error messages.

Fixed the bug in the parser: I wrongly closed [stdout].
This commit is contained in:
Christian Rinderknecht 2020-01-24 14:03:25 +01:00
parent 41d6956b66
commit e85486eae4
5 changed files with 81 additions and 87 deletions

View File

@ -24,11 +24,9 @@ let syntax_to_variant : s_syntax -> string option -> v_syntax result =
| _ -> simple_fail "unrecognized parser" | _ -> simple_fail "unrecognized parser"
let parsify_pascaligo source = let parsify_pascaligo source =
let () = prerr_endline "Helpers.parsify_pascaligo: BEFORE" in
let%bind raw = let%bind raw =
trace (simple_error "parsing") @@ trace (simple_error "parsing") @@
Parser.Pascaligo.parse_file source in Parser.Pascaligo.parse_file source in
let () = prerr_endline "Helpers.parsify_pascaligo: AFTER" in
let%bind simplified = let%bind simplified =
trace (simple_error "simplifying") @@ trace (simple_error "simplifying") @@
Simplify.Pascaligo.simpl_program raw Simplify.Pascaligo.simpl_program raw
@ -84,9 +82,7 @@ let parsify = fun (syntax : v_syntax) source_filename ->
| Pascaligo -> ok parsify_pascaligo | Pascaligo -> ok parsify_pascaligo
| Cameligo -> ok parsify_cameligo | Cameligo -> ok parsify_cameligo
| ReasonLIGO -> ok parsify_reasonligo in | ReasonLIGO -> ok parsify_reasonligo in
let () = prerr_endline "Helpers.parsify: BEFORE" in
let%bind parsified = parsify source_filename in let%bind parsified = parsify source_filename in
let () = prerr_endline "Helpers.parsify: AFTER" in
let%bind applied = Self_ast_simplified.all_program parsified in let%bind applied = Self_ast_simplified.all_program parsified in
ok applied ok applied

View File

@ -221,10 +221,8 @@ let parse_file (source: string) =
match Lexer.open_token_stream (Lexer.File pp_input) with match Lexer.open_token_stream (Lexer.File pp_input) with
Ok instance -> instance Ok instance -> instance
| Stdlib.Error _ -> assert false (* No file opening *) in | Stdlib.Error _ -> assert false (* No file opening *) in
let thunk () = Unit.apply instance Unit.parse_contract in let thunk () = Unit.apply instance Unit.parse_contract
let res = parse (module IO) thunk in in parse (module IO) thunk
let () = prerr_endline "Pascaligo.parse_file: Leaving." in
res
let parse_string (s: string) = let parse_string (s: string) =
let module IO = let module IO =

View File

@ -70,8 +70,7 @@ module Make (Lexer: Lexer.S)
ParserLog.mk_state ~offsets:IO.options#offsets ParserLog.mk_state ~offsets:IO.options#offsets
~mode:IO.options#mode ~mode:IO.options#mode
~buffer:output in ~buffer:output in
let close_all () = let close () = lexer_inst.Lexer.close () in
lexer_inst.Lexer.close (); close_out stdout in
let expr = let expr =
try try
if IO.options#mono then if IO.options#mono then
@ -80,7 +79,7 @@ module Make (Lexer: Lexer.S)
in Front.mono_expr tokeniser lexbuf in Front.mono_expr tokeniser lexbuf
else else
Front.incr_expr lexer_inst Front.incr_expr lexer_inst
with exn -> close_all (); raise exn in with exn -> close (); raise exn in
let () = let () =
if SSet.mem "ast-tokens" IO.options#verbose then if SSet.mem "ast-tokens" IO.options#verbose then
begin begin
@ -95,7 +94,7 @@ module Make (Lexer: Lexer.S)
ParserLog.pp_expr state expr; ParserLog.pp_expr state expr;
Buffer.output_buffer stdout output Buffer.output_buffer stdout output
end end
in close_all (); Ok expr in close (); Ok expr
(* Parsing a contract *) (* Parsing a contract *)
@ -106,8 +105,7 @@ module Make (Lexer: Lexer.S)
ParserLog.mk_state ~offsets:IO.options#offsets ParserLog.mk_state ~offsets:IO.options#offsets
~mode:IO.options#mode ~mode:IO.options#mode
~buffer:output in ~buffer:output in
let close_all () = let close () = lexer_inst.Lexer.close () in
lexer_inst.Lexer.close (); close_out stdout in
let ast = let ast =
try try
if IO.options#mono then if IO.options#mono then
@ -116,7 +114,7 @@ module Make (Lexer: Lexer.S)
in Front.mono_contract tokeniser lexbuf in Front.mono_contract tokeniser lexbuf
else else
Front.incr_contract lexer_inst Front.incr_contract lexer_inst
with exn -> close_all (); raise exn in with exn -> close (); raise exn in
let () = let () =
if SSet.mem "ast-tokens" IO.options#verbose then if SSet.mem "ast-tokens" IO.options#verbose then
begin begin
@ -131,7 +129,7 @@ module Make (Lexer: Lexer.S)
ParserLog.pp_ast state ast; ParserLog.pp_ast state ast;
Buffer.output_buffer stdout output Buffer.output_buffer stdout output
end end
in close_all (); Ok ast in close (); Ok ast
(* Wrapper for the parsers above *) (* Wrapper for the parsers above *)

View File

@ -32,46 +32,48 @@ module Errors = struct
in in
let data = [ let data = [
("expected", fun () -> expected_name); ("expected", fun () -> expected_name);
("location" , fun () -> Format.asprintf "%a" Location.pp_lift @@ Raw.pattern_to_region actual) ("location",
] in fun () -> Format.asprintf "%a" Location.pp_lift @@
error ~data title message Raw.pattern_to_region actual)]
in error ~data title message
let unsupported_let_in_function (patterns : Raw.pattern list) = let unsupported_let_in_function (patterns : Raw.pattern list) =
let title () = "unsupported 'let ... in' function" in let title () = "" in
let message () = "defining functions via 'let ... in' is not supported yet" in let message () = "\nDefining functions with \"let ... in\" \
is not supported yet.\n" in
let patterns_loc = let patterns_loc =
List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p)) List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p))
Region.ghost patterns in Region.ghost patterns in
let data = [ let data = [
("location", fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc) ("location",
] in fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc)]
error ~data title message in error ~data title message
let unknown_predefined_type name = let unknown_predefined_type name =
let title () = "type constants" in let title () = "Type constants" in
let message () = let message () =
Format.asprintf "unknown predefined type \"%s\"" name.Region.value in Format.asprintf "Unknown predefined type \"%s\".\n"
name.Region.value in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region) fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)]
] in in error ~data title message
error ~data title message
let untyped_fun_param var = let untyped_fun_param var =
let title () = "function parameter" in let title () = "" in
let message () = let message () =
Format.asprintf "untyped function parameters are not supported yet" in Format.asprintf "\nUntyped function parameters \
are not supported yet.\n" in
let param_loc = var.Region.region in let param_loc = var.Region.region in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc) fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)]
] in in error ~data title message
error ~data title message
let unsupported_tuple_pattern p = let unsupported_tuple_pattern p =
let title () = "tuple pattern" in let title () = "" in
let message () = let message () =
Format.asprintf "tuple patterns are not supported yet" in Format.asprintf "\nTuple patterns are not supported yet.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -80,21 +82,20 @@ module Errors = struct
error ~data title message error ~data title message
let unsupported_cst_constr p = let unsupported_cst_constr p =
let title () = "constant constructor" in let title () = "" in
let message () = let message () =
Format.asprintf "constant constructors are not supported yet" in Format.asprintf "\nConstant constructors are not supported yet.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc) fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)]
] in in error ~data title message
error ~data title message
let unsupported_non_var_pattern p = let unsupported_non_var_pattern p =
let title () = "pattern is not a variable" in let title () = "" in
let message () = let message () =
Format.asprintf "non-variable patterns in constructors \ Format.asprintf "\nNon-variable patterns in constructors \
are not supported yet" in are not supported yet.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -103,20 +104,20 @@ module Errors = struct
error ~data title message error ~data title message
let simplifying_expr t = let simplifying_expr t =
let title () = "simplifying expression" in let title () = "Simplifying expression" in
let message () = "" in let message () = "" in
let data = [ let data = [
("expression" , ("expression" ,
(** TODO: The labelled arguments should be flowing from the CLI. *) (** TODO: The labelled arguments should be flowing from the CLI. *)
thunk @@ Parser.Cameligo.ParserLog.expr_to_string thunk @@ Parser.Cameligo.ParserLog.expr_to_string
~offsets:true ~mode:`Point t) ~offsets:true ~mode:`Point t)]
] in in error ~data title message
error ~data title message
let only_constructors p = let only_constructors p =
let title () = "constructors in patterns" in let title () = "" in
let message () = let message () =
Format.asprintf "currently, only constructors are supported in patterns" in Format.asprintf "\nCurrently, only constructors are \
supported in patterns.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -125,18 +126,18 @@ module Errors = struct
error ~data title message error ~data title message
let unsupported_sugared_lists region = let unsupported_sugared_lists region =
let title () = "lists in patterns" in let title () = "" in
let message () = let message () =
Format.asprintf "currently, only empty lists and constructors (::) \ Format.asprintf "\nCurrently, only empty lists and \
are supported in patterns" in constructors (::) \
are supported in patterns.\n" in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ region) fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
] in in error ~data title message
error ~data title message
let corner_case description = let corner_case description =
let title () = "corner case" in let title () = "Corner case" in
let message () = description in let message () = description in
error title message error title message

View File

@ -68,9 +68,9 @@ let detect_free_variables (for_body : expression) (local_decl_names : expression
module Errors = struct module Errors = struct
let unsupported_cst_constr p = let unsupported_cst_constr p =
let title () = "constant constructor" in let title () = "" in
let message () = let message () =
Format.asprintf "constant constructors are not supported yet" in Format.asprintf "\nConstant constructors are not supported yet.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -79,11 +79,11 @@ module Errors = struct
error ~data title message error ~data title message
let corner_case ~loc message = let corner_case ~loc message =
let title () = "corner case" in let title () = "\nCorner case" in
let content () = "We don't have a good error message for this case. \ let content () = "We do not have a good error message for this case. \
We are striving find ways to better report them and \ We are striving find ways to better report them and \
find the use-cases that generate them. \ find the use-cases that generate them. \
Please report this to the developers." in Please report this to the developers.\n" in
let data = [ let data = [
("location" , fun () -> loc) ; ("location" , fun () -> loc) ;
("message" , fun () -> message) ; ("message" , fun () -> message) ;
@ -91,9 +91,9 @@ module Errors = struct
error ~data title content error ~data title content
let unknown_predefined_type name = let unknown_predefined_type name =
let title () = "type constants" in let title () = "\nType constants" in
let message () = let message () =
Format.asprintf "unknown predefined type \"%s\"" name.Region.value in Format.asprintf "Unknown predefined type \"%s\".\n" name.Region.value in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region) fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)
@ -101,10 +101,10 @@ module Errors = struct
error ~data title message error ~data title message
let unsupported_non_var_pattern p = let unsupported_non_var_pattern p =
let title () = "pattern is not a variable" in let title () = "" in
let message () = let message () =
Format.asprintf "non-variable patterns in constructors \ Format.asprintf "\nNon-variable patterns in constructors \
are not supported yet" in are not supported yet.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -113,9 +113,10 @@ module Errors = struct
error ~data title message error ~data title message
let only_constructors p = let only_constructors p =
let title () = "constructors in patterns" in let title () = "" in
let message () = let message () =
Format.asprintf "currently, only constructors are supported in patterns" in Format.asprintf "\nCurrently, only constructors \
are supported in patterns.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -124,9 +125,9 @@ module Errors = struct
error ~data title message error ~data title message
let unsupported_tuple_pattern p = let unsupported_tuple_pattern p =
let title () = "tuple pattern" in let title () = "" in
let message () = let message () =
Format.asprintf "tuple patterns are not supported yet" in Format.asprintf "\nTuple patterns are not supported yet.\n" in
let pattern_loc = Raw.pattern_to_region p in let pattern_loc = Raw.pattern_to_region p in
let data = [ let data = [
("location", ("location",
@ -139,10 +140,10 @@ module Errors = struct
error ~data title message error ~data title message
let unsupported_deep_Some_patterns pattern = let unsupported_deep_Some_patterns pattern =
let title () = "option patterns" in let title () = "" in
let message () = let message () =
Format.asprintf "currently, only variables in Some constructors \ Format.asprintf "\nCurrently, only variables in constructors \
in patterns are supported" in \"Some\" in patterns are supported.\n" in
let pattern_loc = Raw.pattern_to_region pattern in let pattern_loc = Raw.pattern_to_region pattern in
let data = [ let data = [
("location", ("location",
@ -151,10 +152,10 @@ module Errors = struct
error ~data title message error ~data title message
let unsupported_deep_list_patterns cons = let unsupported_deep_list_patterns cons =
let title () = "lists in patterns" in let title () = "" in
let message () = let message () =
Format.asprintf "currently, only empty lists and x::y \ Format.asprintf "\nCurrently, only empty lists and x::y \
are supported in patterns" in are supported in patterns.\n" in
let data = [ let data = [
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ cons.Region.region) fun () -> Format.asprintf "%a" Location.pp_lift @@ cons.Region.region)
@ -164,7 +165,7 @@ module Errors = struct
(* Logging *) (* Logging *)
let simplifying_instruction t = let simplifying_instruction t =
let title () = "simplifiying instruction" in let title () = "\nSimplifiying instruction" in
let message () = "" in let message () = "" in
(** TODO: The labelled arguments should be flowing from the CLI. *) (** TODO: The labelled arguments should be flowing from the CLI. *)
let data = [ let data = [
@ -1176,7 +1177,7 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
- references to the iterated value ==> variable `#COMPILER#elt_X` - references to the iterated value ==> variable `#COMPILER#elt_X`
Note: In the case of an inner loop capturing variable from an outer loop Note: In the case of an inner loop capturing variable from an outer loop
the free variable name can be `#COMPILER#acc.Y` and because we do not the free variable name can be `#COMPILER#acc.Y` and because we do not
capture the accumulator record in the inner loop, we don't want to capture the accumulator record in the inner loop, we do not want to
generate `#COMPILER#acc.#COMPILER#acc.Y` but `#COMPILER#acc.Y` generate `#COMPILER#acc.#COMPILER#acc.Y` but `#COMPILER#acc.Y`
5) Append the return value to the body 5) Append the return value to the body