* Updated spellcheck patch
@ 2007-11-18 19:34 Edgar Friendly
2007-11-18 20:30 ` [Caml-list] " Julien Moutinho
0 siblings, 1 reply; 3+ messages in thread
From: Edgar Friendly @ 2007-11-18 19:34 UTC (permalink / raw)
To: caml-list
[-- Attachment #1: Type: text/plain, Size: 504 bytes --]
Here's an updated version of the spellcheck patch I posted before. It's
a patch to CVS's release310 branch.
With Julien Moutinho's help, many remaining missed catches for
Ident.Found_nearly have been found and plugged. The patch now covers
the ocaml toplevel, ocamldebug, and a few more places where the catch
probably isn't necessary but prudent nonetheless.
I don't expect any more uncaught exceptions to come out of this patch,
but let me know any problems attributable to the patch.
Enjoy,
Eric
[-- Attachment #2: ospellcheck-0.6.patch --]
[-- Type: text/x-patch, Size: 30506 bytes --]
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index 75da913..cf9f011 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -101,7 +101,7 @@ let mod_prim name =
transl_path
(fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
Env.empty))
- with Not_found ->
+ with Not_found | Ident.Nearly_found _ ->
fatal_error ("Primitive " ^ name ^ " not found.")
let undefined_location loc =
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index 285947a..2169002 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -24,7 +24,7 @@ let oo_prim name =
try
transl_path
(fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty))
- with Not_found ->
+ with Not_found | Ident.nearly_found _ ->
fatal_error ("Primitive " ^ name ^ " not found.")
(* Share blocks *)
diff --git a/debugger/eval.ml b/debugger/eval.ml
index 30f012f..3780484 100644
--- a/debugger/eval.ml
+++ b/debugger/eval.ml
@@ -21,10 +21,10 @@ open Types
open Parser_aux
type error =
- Unbound_identifier of Ident.t
+ Unbound_identifier of Ident.t * string list
| Not_initialized_yet of Path.t
- | Unbound_long_identifier of Longident.t
- | Unknown_name of int
+ | Unbound_long_identifier of Longident.t * string list
+ | Unknown_name of int
| Tuple_index of type_expr * int * int
| Array_index of int * int
| List_index of int * int
@@ -54,10 +54,12 @@ let rec path event = function
let pos = Ident.find_same id ev.ev_compenv.ce_heap in
Debugcom.Remote_value.from_environment pos
with Not_found ->
- raise(Error(Unbound_identifier id))
+ raise(Error(Unbound_identifier (id, [])))
+ | Ident.Found_nearly l ->
+ raise(Error(Unbound_identifier (id, l)))
end
| None ->
- raise(Error(Unbound_identifier id))
+ raise(Error(Unbound_identifier (id, [])))
end
| Pdot(root, fieldname, pos) ->
let v = path event root in
@@ -84,7 +86,9 @@ let rec expression event env = function
end,
Ctype.correct_levels valdesc.val_type)
with Not_found ->
- raise(Error(Unbound_long_identifier lid))
+ raise(Error(Unbound_long_identifier (lid, [])))
+ | Ident.Found_nearly l ->
+ raise(Error(Unbound_long_identifier (lid, l)))
end
| E_result ->
begin match event with
@@ -163,16 +167,20 @@ and find_label lbl env ty path tydesc pos = function
open Format
let report_error ppf = function
- | Unbound_identifier id ->
+ | Unbound_identifier (id,[]) ->
fprintf ppf "@[Unbound identifier %s@]@." (Ident.name id)
+ | Unbound_identifier (id, corr::_) ->
+ fprintf ppf "@[Unbound identifier %s, did you mean %s @]@." (Ident.name id) corr
| Not_initialized_yet path ->
fprintf ppf
"@[The module path %a is not yet initialized.@ \
Please run program forward@ \
until its initialization code is executed.@]@."
Printtyp.path path
- | Unbound_long_identifier lid ->
+ | Unbound_long_identifier (lid, []) ->
fprintf ppf "@[Unbound identifier %a@]@." Printtyp.longident lid
+ | Unbound_long_identifier (lid, corr::_) ->
+ fprintf ppf "@[Unbound identifier %a, did you mean %s @]@." Printtyp.longident lid corr
| Unknown_name n ->
fprintf ppf "@[Unknown value name $%i@]@." n
| Tuple_index(ty, len, pos) ->
diff --git a/debugger/eval.mli b/debugger/eval.mli
index 77a73f9..2027426 100644
--- a/debugger/eval.mli
+++ b/debugger/eval.mli
@@ -22,9 +22,9 @@ val expression :
Debugcom.Remote_value.t * type_expr
type error =
- | Unbound_identifier of Ident.t
+ | Unbound_identifier of Ident.t * string list
| Not_initialized_yet of Path.t
- | Unbound_long_identifier of Longident.t
+ | Unbound_long_identifier of Longident.t * string list
| Unknown_name of int
| Tuple_index of type_expr * int * int
| Array_index of int * int
diff --git a/debugger/loadprinter.ml b/debugger/loadprinter.ml
index c09d947..0b8cf85 100644
--- a/debugger/loadprinter.ml
+++ b/debugger/loadprinter.ml
@@ -24,7 +24,7 @@ open Types
type error =
| Load_failure of Dynlink.error
- | Unbound_identifier of Longident.t
+ | Unbound_identifier of Longident.t * string list
| Unavailable_module of string * Longident.t
| Wrong_type of Longident.t
| No_active_printer of Longident.t
@@ -101,7 +101,9 @@ let match_printer_type desc typename =
try
Env.lookup_type (Ldot(Lident "Topdirs", typename)) Env.empty
with Not_found ->
- raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename)))) in
+ raise (Error(Unbound_identifier((Ldot(Lident "Topdirs", typename)), [])))
+ | Ident.Found_nearly l ->
+ raise (Error(Unbound_identifier((Ldot(Lident "Topdirs", typename)),l))) in
Ctype.init_def(Ident.current_time());
Ctype.begin_def();
let ty_arg = Ctype.newvar() in
@@ -122,7 +124,8 @@ let find_printer_type lid =
(match_printer_type desc "printer_type_old", true) in
(ty_arg, path, is_old_style)
with
- | Not_found -> raise(Error(Unbound_identifier lid))
+ | Not_found -> raise(Error(Unbound_identifier (lid, [])))
+ | Ident.Found_nearly l -> raise(Error(Unbound_identifier (lid, l)))
| Ctype.Unify _ -> raise(Error(Wrong_type lid))
let install_printer ppf lid =
@@ -154,9 +157,12 @@ let report_error ppf = function
| Load_failure e ->
fprintf ppf "@[Error during code loading: %s@]@."
(Dynlink.error_message e)
- | Unbound_identifier lid ->
+ | Unbound_identifier (lid, []) ->
fprintf ppf "@[Unbound identifier %a@]@."
Printtyp.longident lid
+ | Unbound_identifier (lid, corr::_) ->
+ fprintf ppf "@[Unbound identifier %a, did you mean %s@]@."
+ Printtyp.longident lid corr
| Unavailable_module(md, lid) ->
fprintf ppf
"@[The debugger does not contain the code for@ %a.@ \
diff --git a/debugger/loadprinter.mli b/debugger/loadprinter.mli
index 6bf3064..700028f 100644
--- a/debugger/loadprinter.mli
+++ b/debugger/loadprinter.mli
@@ -24,7 +24,7 @@ val remove_printer : Longident.t -> unit
type error =
| Load_failure of Dynlink.error
- | Unbound_identifier of Longident.t
+ | Unbound_identifier of Longident.t * string list
| Unavailable_module of string * Longident.t
| Wrong_type of Longident.t
| No_active_printer of Longident.t
diff --git a/toplevel/genprintval.ml b/toplevel/genprintval.ml
index a0d88ef..b006abb 100644
--- a/toplevel/genprintval.ml
+++ b/toplevel/genprintval.ml
@@ -148,7 +148,7 @@ module Make(O : OBJ)(EVP : EVALPATH with type value = O.t) = struct
match (lookup_fun (Lident name) env).desc with
| Tconstr(ty_path', _, _) -> Path.same ty_path ty_path'
| _ -> false
- with Not_found -> false
+ with Not_found | Ident.Found_nearly _ -> false
then Oide_ident name
else Oide_dot (Printtyp.tree_of_path p, name)
| Papply(p1, p2) ->
diff --git a/toplevel/topdirs.ml b/toplevel/topdirs.ml
index df14627..2832c12 100644
--- a/toplevel/topdirs.ml
+++ b/toplevel/topdirs.ml
@@ -142,7 +142,7 @@ let match_printer_type ppf desc typename =
let (printer_type, _) =
try
Env.lookup_type (Ldot(Lident "Topdirs", typename)) !toplevel_env
- with Not_found ->
+ with Not_found | Ident.Found_nearly _ ->
fprintf ppf "Cannot find type Topdirs.%s.@." typename;
raise Exit in
Ctype.init_def(Ident.current_time());
@@ -165,7 +165,7 @@ let find_printer_type ppf lid =
(match_printer_type ppf desc "printer_type_old", true) in
(ty_arg, path, is_old_style)
with
- | Not_found ->
+ | Not_found | Ident.Found_nearly _ ->
fprintf ppf "Unbound value %a.@." Printtyp.longident lid;
raise Exit
| Ctype.Unify _ ->
@@ -242,7 +242,7 @@ let dir_trace ppf lid =
fprintf ppf "%a is now traced.@." Printtyp.longident lid
end else fprintf ppf "%a is not a function.@." Printtyp.longident lid
with
- | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+ | Not_found | Ident.Found_nearly _ -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
let dir_untrace ppf lid =
try
@@ -259,7 +259,7 @@ let dir_untrace ppf lid =
end else f :: remove rem in
traced_functions := remove !traced_functions
with
- | Not_found -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
+ | Not_found | Ident.Found_nearly _ -> fprintf ppf "Unbound value %a.@." Printtyp.longident lid
let dir_untrace_all ppf () =
List.iter
diff --git a/typing/env.ml b/typing/env.ml
index 21e8d4b..e8bb28b 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -357,7 +357,7 @@ and lookup_module lid env =
let lookup proj1 proj2 lid env =
match lid with
Lident s ->
- Ident.find_name s (proj1 env)
+ Ident.find_name_with_nearly s (proj1 env)
| Ldot(l, s) ->
let (p, desc) = lookup_module_descr l env in
begin match Lazy.force desc with
@@ -373,7 +373,7 @@ let lookup proj1 proj2 lid env =
let lookup_simple proj1 proj2 lid env =
match lid with
Lident s ->
- Ident.find_name s (proj1 env)
+ Ident.find_name_with_nearly s (proj1 env)
| Ldot(l, s) ->
let (p, desc) = lookup_module_descr l env in
begin match Lazy.force desc with
diff --git a/typing/ident.ml b/typing/ident.ml
index 9c7e5b0..ca7c8a0 100644
--- a/typing/ident.ml
+++ b/typing/ident.ml
@@ -56,6 +56,61 @@ let same i1 i2 = i1 = i2
then i1.stamp = i2.stamp
else i2.stamp = 0 && i1.name = i2.name *)
+(* does various heuristics to find spelling mistakes - algorithm from GNAT Ada compiler - Lots of code, but hopefully about as efficient as possible *)
+let nearly_equal s i =
+ let is_digit c = c >= '0' && c <= '9' in
+ let rec tails_equal s1 i1 s2 i2 = i1 >= String.length s1 || (s1.[i1] = s2.[i2] && tails_equal s1 (i1+1) s2 (i2+1)) in
+
+ let n1 = s and n2 = i.name in
+ let l1 = String.length n1 and l2 = String.length n2 in
+ if l1 = 0 then l2 = 0 (* both null -> equal *)
+ else if l2 = 0 then false (* one of n1 or n2 null -> not equal *)
+ else if n1.[0] != n2.[0] then false (* first characters don't match -> not *)
+ else if l1 < 3 && l2 < 3 then false (* short strings are all different *)
+ else if l1 = l2 then
+ (* look for single errors, transpositions *)
+ let rec find_diff c =
+ if c < (l1 - 1) then
+ if n1.[c] != n2.[c] then
+ (* mismatched digits -> not equal *)
+ if is_digit n1.[c] && is_digit n2.[c] then false
+ (* single error -> equal *)
+ else if n1.[c+1] = n2.[c+1] && tails_equal n1 (c+2) n2 (c+2)
+ then true
+ (* transposition -> equal *)
+ else if n1.[c] = n2.[c+1] && n1.[c+1] = n2.[c] &&
+ tails_equal n1 (c+2) n2 (c+2)
+ then true
+ else false
+ else find_diff (c+1)
+ else (* at the end of the strings *)
+ if is_digit n1.[c] && is_digit n2.[c]
+ && n1.[c] != n2.[c]
+ then false
+ else true
+ in
+ find_diff 1
+ else if l1 = l2 - 1 then (* short by one *)
+ let rec find_del c =
+ if c < l1 then
+ if n1.[c] != n2.[c] then
+ tails_equal n1 c n2 (c+1)
+ else find_del (c+1)
+ else true (* last character was deleted *)
+ in
+ find_del 1
+ else if l1 = l2 + 1 then (* too long by one *)
+ let rec find_add c =
+ if c < l2 then
+ if n1.[c] != n2.[c] then
+ tails_equal n1 (c+1) n2 c
+ else find_add (c+1)
+ else true (* last character added *)
+ in
+ find_add 1
+ else (* lengths totally different *)
+ false
+
let binding_time i = i.stamp
let current_time() = !currentstamp
@@ -97,6 +152,8 @@ and 'a data =
let empty = Empty
+exception Found_nearly of string list
+
(* Inline expansion of height for better speed
* let height = function
* Empty -> 0
@@ -182,3 +239,34 @@ let rec keys_aux stack accu = function
keys_aux (l :: stack) (k.ident :: accu) r
let keys tbl = keys_aux [] [] tbl
+
+let find_nearly_equal n tbl =
+(* List.filter (nearly_equal name) (keys tbl) -- optimized for your enjoyment*)
+ let rec find_nearly_equal_aux stack accu = function
+ Empty ->
+ begin match stack with
+ [] -> accu
+ | a :: l -> find_nearly_equal_aux l accu a
+ end
+ | Node(l, k, r, _) ->
+ let accu' =
+ if nearly_equal n k.ident
+ then k.ident.name :: accu
+ else accu
+ in
+ find_nearly_equal_aux (l :: stack) accu' r
+ in
+ find_nearly_equal_aux [] [] tbl
+
+let find_name_with_nearly name tbl =
+ try find_name name tbl
+ with Not_found ->
+(* prerr_string "FNE: "; prerr_endline name; *)
+ let nearlies = find_nearly_equal name tbl in
+(* let rec pr_list to_str = function [] -> prerr_endline "Empty" | [a] -> prerr_endline (to_str a) | h :: t -> prerr_string (to_str h); prerr_string ", "; pr_list to_str t
+ in
+ prerr_string "nearlies: ";
+ pr_list (fun i -> i) nearlies;
+ prerr_string "whole table: ";
+ pr_list (fun i -> i.name) (keys tbl); *)
+ raise (Found_nearly nearlies)
diff --git a/typing/ident.mli b/typing/ident.mli
index cbed46d..6efdd61 100644
--- a/typing/ident.mli
+++ b/typing/ident.mli
@@ -52,8 +52,12 @@ val print: Format.formatter -> t -> unit
type 'a tbl
(* Association tables from identifiers to type 'a. *)
+exception Found_nearly of string list
+
val empty: 'a tbl
val add: t -> 'a -> 'a tbl -> 'a tbl
val find_same: t -> 'a tbl -> 'a
val find_name: string -> 'a tbl -> 'a
val keys: 'a tbl -> t list
+
+val find_name_with_nearly: string -> 'a tbl -> 'a
diff --git a/typing/typecore.ml b/typing/typecore.ml
index 58ab7fa..7795bd5 100644
--- a/typing/typecore.ml
+++ b/typing/typecore.ml
@@ -23,9 +23,9 @@ open Btype
open Ctype
type error =
- Unbound_value of Longident.t
- | Unbound_constructor of Longident.t
- | Unbound_label of Longident.t
+ Unbound_value of Longident.t * string list
+ | Unbound_constructor of Longident.t * string list
+ | Unbound_label of Longident.t * string list
| Polymorphic_label of Longident.t
| Constructor_arity_mismatch of Longident.t * int * int
| Label_mismatch of Longident.t * (type_expr * type_expr) list
@@ -42,11 +42,11 @@ type error =
| Bad_conversion of string * int * char
| Undefined_method of type_expr * string
| Undefined_inherited_method of string
- | Unbound_class of Longident.t
+ | Unbound_class of Longident.t * string list
| Virtual_class of Longident.t
| Private_type of type_expr
| Private_label of Longident.t * type_expr
- | Unbound_instance_variable of string
+ | Unbound_instance_variable of string * string list
| Instance_variable_not_mutable of string
| Not_subtype of (type_expr * type_expr) list * (type_expr * type_expr) list
| Outside_class
@@ -293,7 +293,9 @@ let build_or_pat env loc lid =
let path, decl =
try Env.lookup_type lid env
with Not_found ->
- raise(Typetexp.Error(loc, Typetexp.Unbound_type_constructor lid))
+ raise(Typetexp.Error(loc, Typetexp.Unbound_type_constructor (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Typetexp.Error(loc, Typetexp.Unbound_type_constructor (lid,l)))
in
let tyl = List.map (fun _ -> newvar()) decl.type_params in
let row0 =
@@ -400,7 +402,10 @@ let rec type_pat env sp =
try
Env.lookup_constructor lid env
with Not_found ->
- raise(Error(sp.ppat_loc, Unbound_constructor lid)) in
+ raise(Error(sp.ppat_loc, Unbound_constructor (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sp.ppat_loc, Unbound_constructor (lid,l)))
+ in
let sargs =
match sarg with
None -> []
@@ -449,7 +454,10 @@ let rec type_pat env sp =
try
Env.lookup_label lid env
with Not_found ->
- raise(Error(sp.ppat_loc, Unbound_label lid)) in
+ raise(Error(sp.ppat_loc, Unbound_label (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sp.ppat_loc, Unbound_label (lid,l)))
+ in
begin_def ();
let (vars, ty_arg, ty_res) = instance_label false label in
if vars = [] then end_def ();
@@ -809,7 +817,7 @@ let rec approx_type env sty =
if List.length ctl <> decl.type_arity then raise Not_found;
let tyl = List.map (approx_type env) ctl in
newconstr path tyl
- with Not_found -> newvar ()
+ with Not_found | Ident.Found_nearly _ -> newvar ()
end
| _ -> newvar ()
@@ -926,7 +934,9 @@ let rec type_exp env sexp =
exp_type = instance desc.val_type;
exp_env = env }
with Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_value lid))
+ raise(Error(sexp.pexp_loc, Unbound_value (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_value (lid,l)))
end
| Pexp_constant cst ->
re {
@@ -1024,7 +1034,10 @@ let rec type_exp env sexp =
try
Env.lookup_label lid env
with Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_label lid)) in
+ raise(Error(sexp.pexp_loc, Unbound_label (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_label (lid,l)))
+ in
begin_def ();
if !Clflags.principal then begin_def ();
let (vars, ty_arg, ty_res) = instance_label true label in
@@ -1101,7 +1114,10 @@ let rec type_exp env sexp =
try
Env.lookup_label lid env
with Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_label lid)) in
+ raise(Error(sexp.pexp_loc, Unbound_label (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_label (lid,l)))
+ in
let (_, ty_arg, ty_res) = instance_label false label in
unify_exp env arg ty_res;
re {
@@ -1115,7 +1131,10 @@ let rec type_exp env sexp =
try
Env.lookup_label lid env
with Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_label lid)) in
+ raise(Error(sexp.pexp_loc, Unbound_label (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_label (lid,l)))
+ in
if label.lbl_mut = Immutable then
raise(Error(sexp.pexp_loc, Label_not_mutable lid));
begin_def ();
@@ -1335,7 +1354,9 @@ let rec type_exp env sexp =
| Pexp_new cl ->
let (cl_path, cl_decl) =
try Env.lookup_class cl env with Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_class cl))
+ raise(Error(sexp.pexp_loc, Unbound_class (cl,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_class (cl,l)))
in
begin match cl_decl.cty_new with
None ->
@@ -1364,10 +1385,13 @@ let rec type_exp env sexp =
| Val_ivar _ ->
raise(Error(sexp.pexp_loc, Instance_variable_not_mutable lab))
| _ ->
- raise(Error(sexp.pexp_loc, Unbound_instance_variable lab))
+ raise(Error(sexp.pexp_loc, Unbound_instance_variable (lab,[])))
with
Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_instance_variable lab))
+ raise(Error(sexp.pexp_loc, Unbound_instance_variable (lab,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_instance_variable (lab,l)))
+
end
| Pexp_override lst ->
let _ =
@@ -1383,7 +1407,7 @@ let rec type_exp env sexp =
try
Env.lookup_value (Longident.Lident "selfpat-*") env,
Env.lookup_value (Longident.Lident "self-*") env
- with Not_found ->
+ with Not_found | Ident.Found_nearly _ ->
raise(Error(sexp.pexp_loc, Outside_class))
with
(_, {val_type = self_ty; val_kind = Val_self (_, vars, _, _)}),
@@ -1394,7 +1418,9 @@ let rec type_exp env sexp =
(Path.Pident id, type_expect env snewval (instance ty))
with
Not_found ->
- raise(Error(sexp.pexp_loc, Unbound_instance_variable lab))
+ raise(Error(sexp.pexp_loc, Unbound_instance_variable (lab,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(sexp.pexp_loc, Unbound_instance_variable (lab,l)))
end
in
let modifs = List.map type_override lst in
@@ -1640,7 +1666,7 @@ and type_application env funct sargs =
may_warn sarg0.pexp_loc
(Warnings.Not_principal "commuting this argument");
(l', sarg0, sargs1 @ sargs2, more_sargs)
- with Not_found ->
+ with Not_found | Ident.Found_nearly _ ->
let (l', sarg0, sargs1, sargs2) =
extract_label name more_sargs in
if sargs1 <> [] || sargs <> [] then
@@ -1710,7 +1736,9 @@ and type_construct env loc lid sarg explicit_arity ty_expected =
try
Env.lookup_constructor lid env
with Not_found ->
- raise(Error(loc, Unbound_constructor lid)) in
+ raise(Error(loc, Unbound_constructor (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(loc, Unbound_constructor (lid,l))) in
let sargs =
match sarg with
None -> []
@@ -2023,12 +2051,18 @@ open Format
open Printtyp
let report_error ppf = function
- | Unbound_value lid ->
- fprintf ppf "Unbound value %a" longident lid
- | Unbound_constructor lid ->
+ | Unbound_value (lid,[]) ->
+ fprintf ppf "Unbound value %a" longident lid
+ | Unbound_value (lid,corr::_) ->
+ fprintf ppf "Unbound value %a, possible misspelling of %s" longident lid corr
+ | Unbound_constructor (lid,[]) ->
fprintf ppf "Unbound constructor %a" longident lid
- | Unbound_label lid ->
+ | Unbound_constructor (lid,corr::_) ->
+ fprintf ppf "Unbound constructor %a, possible misspelling of %s" longident lid corr
+ | Unbound_label (lid,[]) ->
fprintf ppf "Unbound record field label %a" longident lid
+ | Unbound_label (lid,corr::_) ->
+ fprintf ppf "Unbound record field label %a, possible misspelling of %s" longident lid corr
| Polymorphic_label lid ->
fprintf ppf "@[The record field label %a is polymorphic.@ %s@]"
longident lid "You cannot instantiate it in a pattern."
@@ -2103,13 +2137,17 @@ let report_error ppf = function
It has no method %s@]" type_expr ty me
| Undefined_inherited_method me ->
fprintf ppf "This expression has no method %s" me
- | Unbound_class cl ->
+ | Unbound_class (cl,[]) ->
fprintf ppf "Unbound class %a" longident cl
+ | Unbound_class (cl,corr::_) ->
+ fprintf ppf "Unbound class %a, possible misspelling of %s" longident cl corr
| Virtual_class cl ->
fprintf ppf "One cannot create instances of the virtual class %a"
longident cl
- | Unbound_instance_variable v ->
+ | Unbound_instance_variable (v,[]) ->
fprintf ppf "Unbound instance variable %s" v
+ | Unbound_instance_variable (v,corr::_) ->
+ fprintf ppf "Unbound instance variable %s, possible misspelling of %s" v corr
| Instance_variable_not_mutable v ->
fprintf ppf "The instance variable %s is not mutable" v
| Not_subtype(tr1, tr2) ->
diff --git a/typing/typecore.mli b/typing/typecore.mli
index 7c549de..67afa60 100644
--- a/typing/typecore.mli
+++ b/typing/typecore.mli
@@ -61,9 +61,9 @@ val force_delayed_checks: unit -> unit
val self_coercion : (Path.t * Location.t list ref) list ref
type error =
- Unbound_value of Longident.t
- | Unbound_constructor of Longident.t
- | Unbound_label of Longident.t
+ Unbound_value of Longident.t * string list
+ | Unbound_constructor of Longident.t * string list
+ | Unbound_label of Longident.t * string list
| Polymorphic_label of Longident.t
| Constructor_arity_mismatch of Longident.t * int * int
| Label_mismatch of Longident.t * (type_expr * type_expr) list
@@ -80,11 +80,11 @@ type error =
| Bad_conversion of string * int * char
| Undefined_method of type_expr * string
| Undefined_inherited_method of string
- | Unbound_class of Longident.t
+ | Unbound_class of Longident.t * string list
| Virtual_class of Longident.t
| Private_type of type_expr
| Private_label of Longident.t * type_expr
- | Unbound_instance_variable of string
+ | Unbound_instance_variable of string * string list
| Instance_variable_not_mutable of string
| Not_subtype of (type_expr * type_expr) list * (type_expr * type_expr) list
| Outside_class
diff --git a/typing/typetexp.ml b/typing/typetexp.ml
index 33583af..71bf014 100644
--- a/typing/typetexp.ml
+++ b/typing/typetexp.ml
@@ -22,14 +22,14 @@ open Ctype
exception Already_bound
type error =
- Unbound_type_variable of string
- | Unbound_type_constructor of Longident.t
+ Unbound_type_variable of string * string list
+ | Unbound_type_constructor of Longident.t * string list
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
- | Unbound_class of Longident.t
- | Unbound_row_variable of Longident.t
+ | Unbound_class of Longident.t * string list
+ | Unbound_row_variable of Longident.t * string list
| Type_mismatch of (type_expr * type_expr) list
| Alias_type_mismatch of (type_expr * type_expr) list
| Present_has_conjunction of string
@@ -78,7 +78,7 @@ let type_variable loc name =
try
Tbl.find name !type_variables
with Not_found ->
- raise(Error(loc, Unbound_type_variable ("'" ^ name)))
+ raise(Error(loc, Unbound_type_variable (("'" ^ name),[])))
let wrap_method ty =
match (Ctype.repr ty).desc with
@@ -99,7 +99,7 @@ let rec transl_type env policy styp =
Ptyp_any ->
if policy = Univars then new_pre_univar () else
if policy = Fixed then
- raise (Error (styp.ptyp_loc, Unbound_type_variable "_"))
+ raise (Error (styp.ptyp_loc, Unbound_type_variable ("_",[])))
else newvar ()
| Ptyp_var name ->
if name <> "" && name.[0] = '_' then
@@ -125,7 +125,9 @@ let rec transl_type env policy styp =
try
Env.lookup_type lid env
with Not_found ->
- raise(Error(styp.ptyp_loc, Unbound_type_constructor lid)) in
+ raise(Error(styp.ptyp_loc, Unbound_type_constructor (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(styp.ptyp_loc, Unbound_type_constructor (lid,l))) in
if List.length stl <> decl.type_arity then
raise(Error(styp.ptyp_loc, Type_arity_mismatch(lid, decl.type_arity,
List.length stl)));
@@ -178,7 +180,9 @@ let rec transl_type env policy styp =
let (path, decl) = Env.lookup_type lid2 env in
(path, decl, false)
with Not_found ->
- raise(Error(styp.ptyp_loc, Unbound_class lid))
+ raise(Error(styp.ptyp_loc, Unbound_class (lid,[])))
+ | Ident.Found_nearly l ->
+ raise(Error(styp.ptyp_loc, Unbound_class (lid,l)))
in
if List.length stl <> decl.type_arity then
raise(Error(styp.ptyp_loc, Type_arity_mismatch(lid, decl.type_arity,
@@ -352,7 +356,7 @@ let rec transl_type env policy styp =
if static then row else
match policy with
Fixed ->
- raise (Error (styp.ptyp_loc, Unbound_type_variable ".."))
+ raise (Error (styp.ptyp_loc, Unbound_type_variable ("..",[])))
| Extensible -> row
| Univars -> { row with row_more = new_pre_univar () }
in
@@ -430,7 +434,7 @@ let globalize_used_variables env fixed =
r := (loc, v, Tbl.find name !type_variables) :: !r
with Not_found ->
if fixed && (repr ty).desc = Tvar then
- raise(Error(loc, Unbound_type_variable ("'"^name)));
+ raise(Error(loc, Unbound_type_variable (("'"^name),[])));
let v2 = new_global_var () in
r := (loc, v, v2) :: !r;
type_variables := Tbl.add name v2 !type_variables)
@@ -495,10 +499,14 @@ open Format
open Printtyp
let report_error ppf = function
- | Unbound_type_variable name ->
+ | Unbound_type_variable (name,[]) ->
fprintf ppf "Unbound type parameter %s" name
- | Unbound_type_constructor lid ->
+ | Unbound_type_variable (name,corr::_) ->
+ fprintf ppf "Unbound type parameter %s, possible misspelling of %s" name corr
+ | Unbound_type_constructor (lid,[]) ->
fprintf ppf "Unbound type constructor %a" longident lid
+ | Unbound_type_constructor (lid,corr::_) ->
+ fprintf ppf "Unbound type constructor %a, possible misspelling of %s" longident lid corr
| Unbound_type_constructor_2 p ->
fprintf ppf "The type constructor@ %a@ is not yet completely defined"
path p
@@ -511,10 +519,14 @@ let report_error ppf = function
fprintf ppf "Already bound type parameter '%s" name
| Recursive_type ->
fprintf ppf "This type is recursive"
- | Unbound_class lid ->
+ | Unbound_class (lid,[]) ->
fprintf ppf "Unbound class %a" longident lid
- | Unbound_row_variable lid ->
+ | Unbound_class (lid,corr::_) ->
+ fprintf ppf "Unbound class %a, possible misspelling of %s" longident lid corr
+ | Unbound_row_variable (lid,[]) ->
fprintf ppf "Unbound row variable in #%a" longident lid
+ | Unbound_row_variable (lid,corr::_) ->
+ fprintf ppf "Unbound row variable in #%a, possible misspelling of %s" longident lid corr
| Type_mismatch trace ->
Printtyp.unification_error true trace
(function ppf ->
diff --git a/typing/typetexp.mli b/typing/typetexp.mli
index cfae61e..bf198b6 100644
--- a/typing/typetexp.mli
+++ b/typing/typetexp.mli
@@ -37,14 +37,14 @@ val widen: variable_context -> unit
exception Already_bound
type error =
- Unbound_type_variable of string
- | Unbound_type_constructor of Longident.t
+ Unbound_type_variable of string * string list
+ | Unbound_type_constructor of Longident.t * string list
| Unbound_type_constructor_2 of Path.t
| Type_arity_mismatch of Longident.t * int * int
| Bound_type_variable of string
| Recursive_type
- | Unbound_class of Longident.t
- | Unbound_row_variable of Longident.t
+ | Unbound_class of Longident.t * string list
+ | Unbound_row_variable of Longident.t * string list
| Type_mismatch of (Types.type_expr * Types.type_expr) list
| Alias_type_mismatch of (Types.type_expr * Types.type_expr) list
| Present_has_conjunction of string
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Caml-list] Updated spellcheck patch
2007-11-18 19:34 Updated spellcheck patch Edgar Friendly
@ 2007-11-18 20:30 ` Julien Moutinho
2007-11-18 21:48 ` Edgar Friendly
0 siblings, 1 reply; 3+ messages in thread
From: Julien Moutinho @ 2007-11-18 20:30 UTC (permalink / raw)
To: caml-list
[-- Attachment #1: Type: text/plain, Size: 437 bytes --]
On Sun, Nov 18, 2007 at 01:34:28PM -0600, Edgar Friendly wrote:
> Here's an updated version of the spellcheck patch I posted before. It's
> a patch to CVS's release310 branch.
You'd better check if someone had put a spell on you because
spell failures (from your experiments?) remain in the spell
checker patch 0.6 :D
A small patch to be applied after ospellcheck-0.6.patch is attached
to this mail.
Thanks for your work,
Julien.
[-- Attachment #2: apply_me_after_ospellcheck-0.6.patch --]
[-- Type: text/x-diff, Size: 941 bytes --]
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index 44e092e..31776f8 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -101,7 +101,7 @@ let mod_prim name =
transl_path
(fst (Env.lookup_value (Ldot (Lident "CamlinternalMod", name))
Env.empty))
- with Not_found | Ident.Nearly_found _ ->
+ with Not_found | Ident.Found_nearly _ ->
fatal_error ("Primitive " ^ name ^ " not found.")
let undefined_location loc =
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index c287fbc..3e1206d 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -24,7 +24,7 @@ let oo_prim name =
try
transl_path
(fst (Env.lookup_value (Ldot (Lident "CamlinternalOO", name)) Env.empty))
- with Not_found | Ident.nearly_found _ ->
+ with Not_found | Ident.Found_nearly _ ->
fatal_error ("Primitive " ^ name ^ " not found.")
(* Share blocks *)
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [Caml-list] Updated spellcheck patch
2007-11-18 20:30 ` [Caml-list] " Julien Moutinho
@ 2007-11-18 21:48 ` Edgar Friendly
0 siblings, 0 replies; 3+ messages in thread
From: Edgar Friendly @ 2007-11-18 21:48 UTC (permalink / raw)
To: Julien Moutinho; +Cc: caml-list
Julien Moutinho wrote:
> On Sun, Nov 18, 2007 at 01:34:28PM -0600, Edgar Friendly wrote:
>> Here's an updated version of the spellcheck patch I posted before. It's
>> a patch to CVS's release310 branch.
>
> You'd better check if someone had put a spell on you because
> spell failures (from your experiments?) remain in the spell
> checker patch 0.6 :D
>
> A small patch to be applied after ospellcheck-0.6.patch is attached
> to this mail.
>
> Thanks for your work,
> Julien.
>
I guess that'll teach me to make simple changes without running them
through the compiler - computer programs usually spell much better than
I. Thanks for trying it out.
E.
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2007-11-18 21:48 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2007-11-18 19:34 Updated spellcheck patch Edgar Friendly
2007-11-18 20:30 ` [Caml-list] " Julien Moutinho
2007-11-18 21:48 ` Edgar Friendly
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for NNTP newsgroup(s).