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
parent
41d6956b66
commit
e85486eae4
@ -24,11 +24,9 @@ let syntax_to_variant : s_syntax -> string option -> v_syntax result =
|
||||
| _ -> simple_fail "unrecognized parser"
|
||||
|
||||
let parsify_pascaligo source =
|
||||
let () = prerr_endline "Helpers.parsify_pascaligo: BEFORE" in
|
||||
let%bind raw =
|
||||
trace (simple_error "parsing") @@
|
||||
Parser.Pascaligo.parse_file source in
|
||||
let () = prerr_endline "Helpers.parsify_pascaligo: AFTER" in
|
||||
let%bind simplified =
|
||||
trace (simple_error "simplifying") @@
|
||||
Simplify.Pascaligo.simpl_program raw
|
||||
@ -84,9 +82,7 @@ let parsify = fun (syntax : v_syntax) source_filename ->
|
||||
| Pascaligo -> ok parsify_pascaligo
|
||||
| Cameligo -> ok parsify_cameligo
|
||||
| ReasonLIGO -> ok parsify_reasonligo in
|
||||
let () = prerr_endline "Helpers.parsify: BEFORE" 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
|
||||
ok applied
|
||||
|
||||
|
||||
@ -221,10 +221,8 @@ let parse_file (source: string) =
|
||||
match Lexer.open_token_stream (Lexer.File pp_input) with
|
||||
Ok instance -> instance
|
||||
| Stdlib.Error _ -> assert false (* No file opening *) in
|
||||
let thunk () = Unit.apply instance Unit.parse_contract in
|
||||
let res = parse (module IO) thunk in
|
||||
let () = prerr_endline "Pascaligo.parse_file: Leaving." in
|
||||
res
|
||||
let thunk () = Unit.apply instance Unit.parse_contract
|
||||
in parse (module IO) thunk
|
||||
|
||||
let parse_string (s: string) =
|
||||
let module IO =
|
||||
|
||||
@ -70,8 +70,7 @@ module Make (Lexer: Lexer.S)
|
||||
ParserLog.mk_state ~offsets:IO.options#offsets
|
||||
~mode:IO.options#mode
|
||||
~buffer:output in
|
||||
let close_all () =
|
||||
lexer_inst.Lexer.close (); close_out stdout in
|
||||
let close () = lexer_inst.Lexer.close () in
|
||||
let expr =
|
||||
try
|
||||
if IO.options#mono then
|
||||
@ -80,7 +79,7 @@ module Make (Lexer: Lexer.S)
|
||||
in Front.mono_expr tokeniser lexbuf
|
||||
else
|
||||
Front.incr_expr lexer_inst
|
||||
with exn -> close_all (); raise exn in
|
||||
with exn -> close (); raise exn in
|
||||
let () =
|
||||
if SSet.mem "ast-tokens" IO.options#verbose then
|
||||
begin
|
||||
@ -95,7 +94,7 @@ module Make (Lexer: Lexer.S)
|
||||
ParserLog.pp_expr state expr;
|
||||
Buffer.output_buffer stdout output
|
||||
end
|
||||
in close_all (); Ok expr
|
||||
in close (); Ok expr
|
||||
|
||||
(* Parsing a contract *)
|
||||
|
||||
@ -106,8 +105,7 @@ module Make (Lexer: Lexer.S)
|
||||
ParserLog.mk_state ~offsets:IO.options#offsets
|
||||
~mode:IO.options#mode
|
||||
~buffer:output in
|
||||
let close_all () =
|
||||
lexer_inst.Lexer.close (); close_out stdout in
|
||||
let close () = lexer_inst.Lexer.close () in
|
||||
let ast =
|
||||
try
|
||||
if IO.options#mono then
|
||||
@ -116,7 +114,7 @@ module Make (Lexer: Lexer.S)
|
||||
in Front.mono_contract tokeniser lexbuf
|
||||
else
|
||||
Front.incr_contract lexer_inst
|
||||
with exn -> close_all (); raise exn in
|
||||
with exn -> close (); raise exn in
|
||||
let () =
|
||||
if SSet.mem "ast-tokens" IO.options#verbose then
|
||||
begin
|
||||
@ -131,7 +129,7 @@ module Make (Lexer: Lexer.S)
|
||||
ParserLog.pp_ast state ast;
|
||||
Buffer.output_buffer stdout output
|
||||
end
|
||||
in close_all (); Ok ast
|
||||
in close (); Ok ast
|
||||
|
||||
(* Wrapper for the parsers above *)
|
||||
|
||||
|
||||
@ -32,46 +32,48 @@ module Errors = struct
|
||||
in
|
||||
let data = [
|
||||
("expected", fun () -> expected_name);
|
||||
("location" , fun () -> Format.asprintf "%a" Location.pp_lift @@ Raw.pattern_to_region actual)
|
||||
] in
|
||||
error ~data title message
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@
|
||||
Raw.pattern_to_region actual)]
|
||||
in error ~data title message
|
||||
|
||||
let unsupported_let_in_function (patterns : Raw.pattern list) =
|
||||
let title () = "unsupported 'let ... in' function" in
|
||||
let message () = "defining functions via 'let ... in' is not supported yet" in
|
||||
let title () = "" in
|
||||
let message () = "\nDefining functions with \"let ... in\" \
|
||||
is not supported yet.\n" in
|
||||
let patterns_loc =
|
||||
List.fold_left (fun a p -> Region.cover a (Raw.pattern_to_region p))
|
||||
Region.ghost patterns in
|
||||
let data = [
|
||||
("location", fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc)
|
||||
] in
|
||||
error ~data title message
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ patterns_loc)]
|
||||
in error ~data title message
|
||||
|
||||
let unknown_predefined_type name =
|
||||
let title () = "type constants" in
|
||||
let title () = "Type constants" in
|
||||
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 = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)
|
||||
] in
|
||||
error ~data title message
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)]
|
||||
in error ~data title message
|
||||
|
||||
let untyped_fun_param var =
|
||||
let title () = "function parameter" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)
|
||||
] in
|
||||
error ~data title message
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ param_loc)]
|
||||
in error ~data title message
|
||||
|
||||
let unsupported_tuple_pattern p =
|
||||
let title () = "tuple pattern" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
@ -80,21 +82,20 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let unsupported_cst_constr p =
|
||||
let title () = "constant constructor" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)
|
||||
] in
|
||||
error ~data title message
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ pattern_loc)]
|
||||
in error ~data title message
|
||||
|
||||
let unsupported_non_var_pattern p =
|
||||
let title () = "pattern is not a variable" in
|
||||
let title () = "" in
|
||||
let message () =
|
||||
Format.asprintf "non-variable patterns in constructors \
|
||||
are not supported yet" in
|
||||
Format.asprintf "\nNon-variable patterns in constructors \
|
||||
are not supported yet.\n" in
|
||||
let pattern_loc = Raw.pattern_to_region p in
|
||||
let data = [
|
||||
("location",
|
||||
@ -103,20 +104,20 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let simplifying_expr t =
|
||||
let title () = "simplifying expression" in
|
||||
let title () = "Simplifying expression" in
|
||||
let message () = "" in
|
||||
let data = [
|
||||
("expression" ,
|
||||
(** TODO: The labelled arguments should be flowing from the CLI. *)
|
||||
thunk @@ Parser.Cameligo.ParserLog.expr_to_string
|
||||
~offsets:true ~mode:`Point t)
|
||||
] in
|
||||
error ~data title message
|
||||
~offsets:true ~mode:`Point t)]
|
||||
in error ~data title message
|
||||
|
||||
let only_constructors p =
|
||||
let title () = "constructors in patterns" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
@ -125,18 +126,18 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let unsupported_sugared_lists region =
|
||||
let title () = "lists in patterns" in
|
||||
let title () = "" in
|
||||
let message () =
|
||||
Format.asprintf "currently, only empty lists and constructors (::) \
|
||||
are supported in patterns" in
|
||||
Format.asprintf "\nCurrently, only empty lists and \
|
||||
constructors (::) \
|
||||
are supported in patterns.\n" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)
|
||||
] in
|
||||
error ~data title message
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ region)]
|
||||
in error ~data title message
|
||||
|
||||
let corner_case description =
|
||||
let title () = "corner case" in
|
||||
let title () = "Corner case" in
|
||||
let message () = description in
|
||||
error title message
|
||||
|
||||
|
||||
@ -68,9 +68,9 @@ let detect_free_variables (for_body : expression) (local_decl_names : expression
|
||||
|
||||
module Errors = struct
|
||||
let unsupported_cst_constr p =
|
||||
let title () = "constant constructor" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
@ -79,11 +79,11 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let corner_case ~loc message =
|
||||
let title () = "corner case" in
|
||||
let content () = "We don't have a good error message for this case. \
|
||||
let title () = "\nCorner case" in
|
||||
let content () = "We do not have a good error message for this case. \
|
||||
We are striving find ways to better report them and \
|
||||
find the use-cases that generate them. \
|
||||
Please report this to the developers." in
|
||||
Please report this to the developers.\n" in
|
||||
let data = [
|
||||
("location" , fun () -> loc) ;
|
||||
("message" , fun () -> message) ;
|
||||
@ -91,9 +91,9 @@ module Errors = struct
|
||||
error ~data title content
|
||||
|
||||
let unknown_predefined_type name =
|
||||
let title () = "type constants" in
|
||||
let title () = "\nType constants" in
|
||||
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 = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ name.Region.region)
|
||||
@ -101,10 +101,10 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let unsupported_non_var_pattern p =
|
||||
let title () = "pattern is not a variable" in
|
||||
let title () = "" in
|
||||
let message () =
|
||||
Format.asprintf "non-variable patterns in constructors \
|
||||
are not supported yet" in
|
||||
Format.asprintf "\nNon-variable patterns in constructors \
|
||||
are not supported yet.\n" in
|
||||
let pattern_loc = Raw.pattern_to_region p in
|
||||
let data = [
|
||||
("location",
|
||||
@ -113,9 +113,10 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let only_constructors p =
|
||||
let title () = "constructors in patterns" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
@ -124,9 +125,9 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let unsupported_tuple_pattern p =
|
||||
let title () = "tuple pattern" in
|
||||
let title () = "" in
|
||||
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 data = [
|
||||
("location",
|
||||
@ -139,10 +140,10 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let unsupported_deep_Some_patterns pattern =
|
||||
let title () = "option patterns" in
|
||||
let title () = "" in
|
||||
let message () =
|
||||
Format.asprintf "currently, only variables in Some constructors \
|
||||
in patterns are supported" in
|
||||
Format.asprintf "\nCurrently, only variables in constructors \
|
||||
\"Some\" in patterns are supported.\n" in
|
||||
let pattern_loc = Raw.pattern_to_region pattern in
|
||||
let data = [
|
||||
("location",
|
||||
@ -151,10 +152,10 @@ module Errors = struct
|
||||
error ~data title message
|
||||
|
||||
let unsupported_deep_list_patterns cons =
|
||||
let title () = "lists in patterns" in
|
||||
let title () = "" in
|
||||
let message () =
|
||||
Format.asprintf "currently, only empty lists and x::y \
|
||||
are supported in patterns" in
|
||||
Format.asprintf "\nCurrently, only empty lists and x::y \
|
||||
are supported in patterns.\n" in
|
||||
let data = [
|
||||
("location",
|
||||
fun () -> Format.asprintf "%a" Location.pp_lift @@ cons.Region.region)
|
||||
@ -164,7 +165,7 @@ module Errors = struct
|
||||
(* Logging *)
|
||||
|
||||
let simplifying_instruction t =
|
||||
let title () = "simplifiying instruction" in
|
||||
let title () = "\nSimplifiying instruction" in
|
||||
let message () = "" in
|
||||
(** TODO: The labelled arguments should be flowing from the CLI. *)
|
||||
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`
|
||||
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
|
||||
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`
|
||||
|
||||
5) Append the return value to the body
|
||||
|
||||
Loading…
Reference in New Issue
Block a user