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
|
||||
|
||||
@ -286,9 +287,9 @@ let rec simpl_expression :
|
||||
let simpl_update = fun (u:Raw.update Region.reg) ->
|
||||
let (u, loc) = r_split u in
|
||||
let (name, path) = simpl_path u.record in
|
||||
let record = match path with
|
||||
let record = match path with
|
||||
| [] -> e_variable (Var.of_name name)
|
||||
| _ -> e_accessor (e_variable (Var.of_name name)) path in
|
||||
| _ -> e_accessor (e_variable (Var.of_name name)) path in
|
||||
let updates = u.updates.value.ne_elements in
|
||||
let%bind updates' =
|
||||
let aux (f:Raw.field_assign Raw.reg) =
|
||||
@ -296,7 +297,7 @@ let rec simpl_expression :
|
||||
let%bind expr = simpl_expression f.field_expr in
|
||||
ok (f.field_name.value, expr)
|
||||
in
|
||||
bind_map_list aux @@ npseq_to_list updates
|
||||
bind_map_list aux @@ npseq_to_list updates
|
||||
in
|
||||
return @@ e_update ~loc record updates'
|
||||
in
|
||||
@ -347,7 +348,7 @@ let rec simpl_expression :
|
||||
| hd :: tl ->
|
||||
e_let_in hd
|
||||
inline
|
||||
(e_accessor rhs_b_expr [Access_tuple ((List.length prep_vars) - (List.length tl) - 1)])
|
||||
(e_accessor rhs_b_expr [Access_tuple ((List.length prep_vars) - (List.length tl) - 1)])
|
||||
(chain_let_in tl body)
|
||||
| [] -> body (* Precluded by corner case assertion above *)
|
||||
in
|
||||
@ -724,7 +725,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
|
||||
match v_type with
|
||||
| Some v_type -> ok (to_option (simpl_type_expression v_type))
|
||||
| None -> ok None
|
||||
in
|
||||
in
|
||||
let%bind simpl_rhs_expr = simpl_expression rhs_expr in
|
||||
ok @@ loc x @@ Declaration_constant (Var.of_name v.value, v_type_expression, inline, simpl_rhs_expr) )
|
||||
in let%bind variables = ok @@ npseq_to_list pt.value
|
||||
@ -825,9 +826,9 @@ and simpl_cases : type a . (Raw.pattern * a) list -> (a, unit) matching result =
|
||||
| PConstr v ->
|
||||
let const, pat_opt =
|
||||
match v with
|
||||
PConstrApp {value; _} ->
|
||||
PConstrApp {value; _} ->
|
||||
(match value with
|
||||
| constr, None ->
|
||||
| constr, None ->
|
||||
constr, Some (PVar {value = "unit"; region = Region.ghost})
|
||||
| _ -> value)
|
||||
| PSomeApp {value=region,pat; _} ->
|
||||
|
||||
@ -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