balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improved slightly the formatting of some error messages.

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/main/compile/helpers.ml
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

6
src/passes/1-parser/pascaligo.ml
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 =

14
src/passes/1-parser/shared/ParserUnit.ml
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 *)

99
src/passes/2-simplify/cameligo.ml
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
@ -286,9 +287,9 @@ let rec simpl_expression :
let simpl_update = fun (u:Raw.update Region.reg) -> let simpl_update = fun (u:Raw.update Region.reg) ->
let (u, loc) = r_split u in let (u, loc) = r_split u in
let (name, path) = simpl_path u.record 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_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 updates = u.updates.value.ne_elements in
let%bind updates' = let%bind updates' =
let aux (f:Raw.field_assign Raw.reg) = 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 let%bind expr = simpl_expression f.field_expr in
ok (f.field_name.value, expr) ok (f.field_name.value, expr)
in in
bind_map_list aux @@ npseq_to_list updates bind_map_list aux @@ npseq_to_list updates
in in
return @@ e_update ~loc record updates' return @@ e_update ~loc record updates'
in in
@ -347,7 +348,7 @@ let rec simpl_expression :
| hd :: tl -> | hd :: tl ->
e_let_in hd e_let_in hd
inline 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) (chain_let_in tl body)
| [] -> body (* Precluded by corner case assertion above *) | [] -> body (* Precluded by corner case assertion above *)
in in
@ -724,7 +725,7 @@ and simpl_declaration : Raw.declaration -> declaration Location.wrap list result
match v_type with match v_type with
| Some v_type -> ok (to_option (simpl_type_expression v_type)) | Some v_type -> ok (to_option (simpl_type_expression v_type))
| None -> ok None | None -> ok None
in in
let%bind simpl_rhs_expr = simpl_expression rhs_expr 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) ) 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 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 -> | PConstr v ->
let const, pat_opt = let const, pat_opt =
match v with match v with
PConstrApp {value; _} -> PConstrApp {value; _} ->
(match value with (match value with
| constr, None -> | constr, None ->
constr, Some (PVar {value = "unit"; region = Region.ghost}) constr, Some (PVar {value = "unit"; region = Region.ghost})
| _ -> value) | _ -> value)
| PSomeApp {value=region,pat; _} -> | PSomeApp {value=region,pat; _} ->

45
src/passes/2-simplify/pascaligo.ml
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