Skip to content

Commit

Permalink
teach IR typechecker to reject refutable import patterns
Browse files Browse the repository at this point in the history
  • Loading branch information
ggreif committed Jan 28, 2022
1 parent b109d6d commit 4c94e00
Show file tree
Hide file tree
Showing 9 changed files with 28 additions and 1 deletion.
5 changes: 4 additions & 1 deletion src/ir_def/check_ir.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1057,7 +1057,10 @@ and check_dec env dec =
| LetD (pat, exp) ->
ignore (check_pat_exhaustive env pat);
check_exp env exp;
typ exp <: pat.note
typ exp <: pat.note;
check env pat.at
Ir_utils.(expected_irrefutable dec ==> is_irrefutable pat)
"refutable pattern in import"
| VarD (id, t, exp) ->
check_exp env exp;
typ exp <: t
Expand Down
5 changes: 5 additions & 0 deletions src/ir_def/ir_utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -7,3 +7,8 @@ let rec is_irrefutable p = match p.it with
| WildP | VarP _ -> true
| TagP _ | LitP _ | OptP _ -> false


let expected_irrefutable : dec -> bool = function
| { it = LetD (_, { it = VarE id; _ }); _ } ->
Lib.String.starts_with "file$" id
| _ -> false
5 changes: 5 additions & 0 deletions src/lib/lib.ml
Original file line number Diff line number Diff line change
Expand Up @@ -195,6 +195,11 @@ struct
else
None

let starts_with prefix s = (* in OCaml 4.13 *)
match chop_prefix prefix s with
| Some _ -> true
| _ -> false

let chop_suffix suffix s =
let suffix_len = String.length suffix in
let s_len = String.length s in
Expand Down
1 change: 1 addition & 0 deletions src/lib/lib.mli
Original file line number Diff line number Diff line change
Expand Up @@ -154,6 +154,7 @@ sig
val split : string -> char -> string list
val breakup : string -> int -> string list
val find_from_opt : (char -> bool) -> string -> int -> int option
val starts_with : string -> string -> bool
val chop_prefix : string -> string -> string option
val chop_suffix : string -> string -> string option
val lightweight_escaped : string -> string
Expand Down
1 change: 1 addition & 0 deletions test/fail/nat-module.mo
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
module { public let why = 42 }
2 changes: 2 additions & 0 deletions test/fail/ok/refutable-import.run-ir.ok
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
Ill-typed intermediate code after Desugaring (use -v to see dumped IR):
refutable-import.mo:1.8-1.20: IR type error [M0000], refutable pattern in import
1 change: 1 addition & 0 deletions test/fail/ok/refutable-import.run-ir.ret.ok
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
Return code 1
4 changes: 4 additions & 0 deletions test/fail/ok/refutable-import.tc.ok
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
refutable-import.mo:1.8-1.20: warning [M0145], this pattern of type
module {why : Nat}
does not cover value
{why = 0 or 1 or _}
5 changes: 5 additions & 0 deletions test/fail/refutable-import.mo
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
import { why = 42 } = "nat-module";

//SKIP run
//SKIP run-low
//SKIP comp

0 comments on commit 4c94e00

Please sign in to comment.