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