A lowercase vec, ptr, option or map over types in a return slot is a near miss for its constructor, and a bare && is written back as the (and) that compiles
This commit is contained in:
parent
b181003695
commit
f629123561
25
lib/check.ml
25
lib/check.ml
@ -429,14 +429,14 @@ let alias_fix flan (args : Ast.expr list) =
|
|||||||
let arity_ok =
|
let arity_ok =
|
||||||
match flan with
|
match flan with
|
||||||
| "not" -> n = 1
|
| "not" -> n = 1
|
||||||
| "and" | "or" -> n >= 1
|
| "and" | "or" -> true
|
||||||
| _ -> n >= 2
|
| _ -> n >= 2
|
||||||
in
|
in
|
||||||
if not arity_ok then
|
if not arity_ok then
|
||||||
Printf.sprintf "It is called as %s"
|
Printf.sprintf "It is called as %s"
|
||||||
(if flan = "not" then "(not x)" else "(" ^ flan ^ " x y)")
|
(if flan = "not" then "(not x)" else "(" ^ flan ^ " x y)")
|
||||||
else if List.mem "" spelled then Printf.sprintf "Write %s in its place" flan
|
else if List.mem "" spelled then Printf.sprintf "Write %s in its place" flan
|
||||||
else Printf.sprintf "Write (%s %s)" flan (String.concat " " spelled)
|
else Printf.sprintf "Write (%s)" (String.concat " " (flan :: spelled))
|
||||||
|
|
||||||
(* What a [break] or a [continue] may be talking about, innermost first.
|
(* What a [break] or a [continue] may be talking about, innermost first.
|
||||||
|
|
||||||
@ -1466,13 +1466,32 @@ let is_type_name env n =
|
|||||||
[(Vect i32)] and [(Pair i32)]. *)
|
[(Vect i32)] and [(Pair i32)]. *)
|
||||||
let missing_return_type env (fn : Ast.fn) =
|
let missing_return_type env (fn : Ast.fn) =
|
||||||
match fn.Ast.ret with
|
match fn.Ast.ret with
|
||||||
| Some { Ast.t = Ast.Tapp (head, _); tloc } ->
|
| Some { Ast.t = Ast.Tapp (head, args); tloc } ->
|
||||||
let lowercase =
|
let lowercase =
|
||||||
head <> "" && not (head.[0] >= 'A' && head.[0] <= 'Z')
|
head <> "" && not (head.[0] >= 'A' && head.[0] <= 'Z')
|
||||||
in
|
in
|
||||||
let constructor =
|
let constructor =
|
||||||
List.mem head [ "Ptr"; "Option"; "Vec"; "Map"; "Result" ]
|
List.mem head [ "Ptr"; "Option"; "Vec"; "Map"; "Result" ]
|
||||||
in
|
in
|
||||||
|
(* [(vec i32)] is the constructor with the wrong case, not a body form —
|
||||||
|
but only while every argument is a type, since [(map inc xs)] is a
|
||||||
|
body form whose head is a function. *)
|
||||||
|
let args_are_types =
|
||||||
|
List.for_all
|
||||||
|
(fun (a : Ast.texpr) ->
|
||||||
|
match a.Ast.t with Ast.Tname n -> is_type_name env n | _ -> true)
|
||||||
|
args
|
||||||
|
in
|
||||||
|
(match
|
||||||
|
List.find_opt
|
||||||
|
(fun c -> String.lowercase_ascii c = String.lowercase_ascii head
|
||||||
|
&& c <> head)
|
||||||
|
[ "Ptr"; "Option"; "Vec"; "Map" ]
|
||||||
|
with
|
||||||
|
| Some c when args_are_types && not (is_type_name env head) ->
|
||||||
|
Loc.failk "check/unknown-type" tloc
|
||||||
|
"unknown type %s — did you mean %s?" head c
|
||||||
|
| _ -> ());
|
||||||
if (not constructor) && (not (is_type_name env head))
|
if (not constructor) && (not (is_type_name env head))
|
||||||
&& (lowercase || Hashtbl.mem env.fns head
|
&& (lowercase || Hashtbl.mem env.fns head
|
||||||
|| List.mem head !builtin_names)
|
|| List.mem head !builtin_names)
|
||||||
|
|||||||
@ -2470,6 +2470,9 @@ let () =
|
|||||||
"(defn f [a bool] bool (! a))" ~needle:"Write (not a)";
|
"(defn f [a bool] bool (! a))" ~needle:"Write (not a)";
|
||||||
rejects_check "a ! at an arity not does not take gets not's shape"
|
rejects_check "a ! at an arity not does not take gets not's shape"
|
||||||
"(defn f [a bool b bool] bool (! a b))" ~needle:"called as (not x)";
|
"(defn f [a bool b bool] bool (! a b))" ~needle:"called as (not x)";
|
||||||
|
rejects_check "a bare && is written back as the and that compiles"
|
||||||
|
"(defn f [] bool (&&))" ~needle:"Write (and)";
|
||||||
|
accepts "and it does" "(defn f [] bool (and))";
|
||||||
accepts "a program's own not= is its own"
|
accepts "a program's own not= is its own"
|
||||||
"(defn not= [a i32 b i32] bool (!= a b)) \
|
"(defn not= [a i32 b i32] bool (!= a b)) \
|
||||||
(defn f [a i32 b i32] bool (not= a b))";
|
(defn f [a i32 b i32] bool (not= a b))";
|
||||||
@ -2490,6 +2493,17 @@ let () =
|
|||||||
"(defn f [] (Option i32) None)";
|
"(defn f [] (Option i32) None)";
|
||||||
rejects_check "a misspelled constructor is a near miss"
|
rejects_check "a misspelled constructor is a near miss"
|
||||||
"(defn f [] (Optoin i32) None)" ~needle:"unknown type Optoin — did you mean Option?";
|
"(defn f [] (Optoin i32) None)" ~needle:"unknown type Optoin — did you mean Option?";
|
||||||
|
rejects_check "a lowercase vec is Vec"
|
||||||
|
"(defn f [] (vec i32) (vec-new i32))" ~needle:"unknown type vec — did you mean Vec?";
|
||||||
|
rejects_check "a lowercase ptr is Ptr"
|
||||||
|
"(defn f [p (Ptr i32)] (ptr i32) p)" ~needle:"unknown type ptr — did you mean Ptr?";
|
||||||
|
rejects_check "a lowercase option is Option"
|
||||||
|
"(defn f [] (option i32) None)" ~needle:"unknown type option — did you mean Option?";
|
||||||
|
rejects_check "a lowercase map is Map"
|
||||||
|
"(defn f [] (map i32 i32) (map-new i32 i32))"
|
||||||
|
~needle:"unknown type map — did you mean Map?";
|
||||||
|
rejects_check "a map over values in the slot is a body form"
|
||||||
|
"(defn f [inc i32 xs i32] (map inc xs))" ~needle:"f has no return type";
|
||||||
rejects_check "an unknown capitalised head keeps the generics sentence"
|
rejects_check "an unknown capitalised head keeps the generics sentence"
|
||||||
"(defn f [] (Pair i32) 0)" ~needle:"Pair takes no type arguments";
|
"(defn f [] (Pair i32) 0)" ~needle:"Pair takes no type arguments";
|
||||||
rejects_check "a misspelled plain return type is still an unknown type"
|
rejects_check "a misspelled plain return type is still an unknown type"
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user