From e85486eae4f6ef09f5aca144dca4bb489ebba6d9 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Fri, 24 Jan 2020 14:03:25 +0100 Subject: [PATCH] Improved slightly the formatting of some error messages. Fixed the bug in the parser: I wrongly closed [stdout]. --- src/main/compile/helpers.ml | 4 - src/passes/1-parser/pascaligo.ml | 6 +- src/passes/1-parser/shared/ParserUnit.ml | 14 ++-- src/passes/2-simplify/cameligo.ml | 99 ++++++++++++------------ src/passes/2-simplify/pascaligo.ml | 45 +++++------ 5 files changed, 81 insertions(+), 87 deletions(-) diff --git a/src/main/compile/helpers.ml b/src/main/compile/helpers.ml index 11250cb73..a8ec052ae 100644 --- a/src/main/compile/helpers.ml +++ b/src/main/compile/helpers.ml @@ -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 diff --git a/src/passes/1-parser/pascaligo.ml b/src/passes/1-parser/pascaligo.ml index 5f41853ba..c6eac2258 100644 --- a/src/passes/1-parser/pascaligo.ml +++ b/src/passes/1-parser/pascaligo.ml @@ -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 = diff --git a/src/passes/1-parser/shared/ParserUnit.ml b/src/passes/1-parser/shared/ParserUnit.ml index 36af01395..ae03d0d32 100644 --- a/src/passes/1-parser/shared/ParserUnit.ml +++ b/src/passes/1-parser/shared/ParserUnit.ml @@ -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 *) diff --git a/src/passes/2-simplify/cameligo.ml b/src/passes/2-simplify/cameligo.ml index 917d001bf..1e210880c 100644 --- a/src/passes/2-simplify/cameligo.ml +++ b/src/passes/2-simplify/cameligo.ml @@ -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; _} -> diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 00b97ed7f..ce8f8c7be 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -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