Add errors for properly handling let x = _ cases.

This commit is contained in:
Sander Spies 2020-04-01 18:08:31 +02:00
parent ec7c6e8ad9
commit 86de9d27e7
5 changed files with 38 additions and 2 deletions

View File

@ -68,6 +68,18 @@ module Errors =
("location", ("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)] fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)]
in error ~data title message in error ~data title message
let invalid_wild (expr: AST.expr) =
let title () = "" in
let message () =
"It looks you are using a wild pattern where it cannot be used."
in
let expression_loc = AST.expr_to_region expr in
let data = [
("location",
fun () -> Format.asprintf "%a" Location.pp_lift @@ expression_loc)]
in error ~data title message
end end
let parse (module IO : IO) parser = let parse (module IO : IO) parser =
@ -127,6 +139,8 @@ let parse (module IO : IO) parser =
| exception SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) -> | exception SyntaxError.Error (SyntaxError.WrongFunctionArguments expr) ->
Trace.fail @@ Errors.wrong_function_arguments expr Trace.fail @@ Errors.wrong_function_arguments expr
| exception SyntaxError.Error (SyntaxError.InvalidWild expr) ->
Trace.fail @@ Errors.wrong_function_arguments expr
let parse_file (source: string) = let parse_file (source: string) =
let module IO = let module IO =

View File

@ -40,6 +40,13 @@ let rec curry hd = function
in TFun {value; region} in TFun {value; region}
| [] -> hd | [] -> hd
let wild_error e =
match e with
| EVar { value = "_"; _} as e ->
let open! SyntaxError in
raise (Error (InvalidWild e))
| _ -> ()
(* END HEADER *) (* END HEADER *)
%} %}
@ -262,24 +269,30 @@ let_declaration:
let_binding: let_binding:
"<ident>" type_annotation? "=" expr { "<ident>" type_annotation? "=" expr {
wild_error $4;
Scoping.check_reserved_name $1; Scoping.check_reserved_name $1;
{binders = PVar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} {binders = PVar $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
} }
| "_" type_annotation? "=" expr { | "_" type_annotation? "=" expr {
wild_error $4;
{binders = PWild $1, []; lhs_type=$2; eq=$3; let_rhs=$4} {binders = PWild $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
} }
| unit type_annotation? "=" expr { | unit type_annotation? "=" expr {
wild_error $4;
{binders = PUnit $1, []; lhs_type=$2; eq=$3; let_rhs=$4} {binders = PUnit $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
} }
| record_pattern type_annotation? "=" expr { | record_pattern type_annotation? "=" expr {
wild_error $4;
Scoping.check_pattern (PRecord $1); Scoping.check_pattern (PRecord $1);
{binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4} {binders = PRecord $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
} }
| par(closed_irrefutable) type_annotation? "=" expr { | par(closed_irrefutable) type_annotation? "=" expr {
wild_error $4;
Scoping.check_pattern $1.value.inside; Scoping.check_pattern $1.value.inside;
{binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4} {binders = PPar $1, []; lhs_type=$2; eq=$3; let_rhs=$4}
} }
| tuple(sub_irrefutable) type_annotation? "=" expr { | tuple(sub_irrefutable) type_annotation? "=" expr {
wild_error $4;
Utils.nsepseq_iter Scoping.check_pattern $1; Utils.nsepseq_iter Scoping.check_pattern $1;
let hd, tl = $1 in let hd, tl = $1 in
let start = pattern_to_region hd in let start = pattern_to_region hd in
@ -408,7 +421,9 @@ expr:
base_cond__open(expr) | switch_expr(base_cond) { $1 } base_cond__open(expr) | switch_expr(base_cond) { $1 }
base_cond__open(x): base_cond__open(x):
base_expr(x) | conditional(expr_with_let_expr) { $1 } base_expr(x) | conditional(expr_with_let_expr) {
wild_error $1;
$1 }
base_cond: base_cond:
base_cond__open(base_cond) { $1 } base_cond__open(base_cond) { $1 }

View File

@ -48,7 +48,12 @@ let parse parser : ('a, string Region.reg) Stdlib.result =
in Stdlib.Error Region.{value=error; region} in Stdlib.Error Region.{value=error; region}
(* Scoping errors *) (* Scoping errors *)
| SyntaxError.Error (SyntaxError.InvalidWild expr) ->
let msg = "It looks you are using a wild pattern where it cannot be used.\n"
and region = AST.expr_to_region expr in
let error = Unit.short_error ~offsets:IO.options#offsets
IO.options#mode msg region
in Stdlib.Error Region.{value=error; region}
| Scoping.Error (Scoping.Reserved_name name) -> | Scoping.Error (Scoping.Reserved_name name) ->
let token = let token =
Lexer.Token.mk_ident name.Region.value name.Region.region in Lexer.Token.mk_ident name.Region.value name.Region.region in

View File

@ -1,4 +1,5 @@
type error = type error =
| WrongFunctionArguments of AST.expr | WrongFunctionArguments of AST.expr
| InvalidWild of AST.expr
exception Error of error exception Error of error

View File

@ -1,4 +1,5 @@
type error = type error =
| WrongFunctionArguments of AST.expr | WrongFunctionArguments of AST.expr
| InvalidWild of AST.expr
exception Error of error exception Error of error