Error narrowing for class type lookups.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10422 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

typing/typeclass.ml

@@ -31,7 +31,6 @@ type error =
   | Pattern_type_clash of type_expr
   | Repeated_parameter
   | Unbound_class_2 of Longident.t
-  | Unbound_class_type of Longident.t
   | Unbound_class_type_2 of Longident.t
   | Abbrev_type_clash of type_expr * type_expr * type_expr
   | Constructor_type_mismatch of string * (type_expr * type_expr) list
@@ -389,10 +388,7 @@ and class_signature env sty sign =
 and class_type env scty =
   match scty.pcty_desc with
     Pcty_constr (lid, styl) ->
-      let (path, decl) =
-        try Env.lookup_cltype lid env with Not_found ->
-          raise(Error(scty.pcty_loc, Unbound_class_type lid))
-      in
+      let (path, decl) = Typetexp.find_cltype env scty.pcty_loc lid in
       if Path.same decl.clty_path unbound_class then
         raise(Error(scty.pcty_loc, Unbound_class_type_2 lid));
       let (params, clty) =
@@ -1490,9 +1486,6 @@ let report_error ppf = function
   | Unbound_class_2 cl ->
       fprintf ppf "@[The class@ %a@ is not yet completely defined@]"
       Printtyp.longident cl
-  | Unbound_class_type cl ->
-      fprintf ppf "@[Unbound class type@ %a@]"
-      Printtyp.longident cl
   | Unbound_class_type_2 cl ->
       fprintf ppf "@[The class type@ %a@ is not yet completely defined@]"
       Printtyp.longident cl

typing/typeclass.mli

@@ -56,7 +56,6 @@ type error =
   | Pattern_type_clash of type_expr
   | Repeated_parameter
   | Unbound_class_2 of Longident.t
-  | Unbound_class_type of Longident.t
   | Unbound_class_type_2 of Longident.t
   | Abbrev_type_clash of type_expr * type_expr * type_expr
   | Constructor_type_mismatch of string * (type_expr * type_expr) list

typing/typetexp.ml

@@ -46,6 +46,7 @@ type error =
   | Unbound_module of Longident.t
   | Unbound_class of Longident.t
   | Unbound_modtype of Longident.t
+  | Unbound_cltype of Longident.t
   | Ill_typed_functor_application of Longident.t
 
 exception Error of Location.t * error
@@ -92,6 +93,8 @@ let find_module = find_component Env.lookup_module (fun lid -> Unbound_module li
 
 let find_modtype = find_component Env.lookup_modtype (fun lid -> Unbound_modtype lid)
 
+let find_cltype = find_component Env.lookup_cltype (fun lid -> Unbound_cltype lid)
+
 (* Support for first-class modules. *)
 
 let transl_modtype_longident = ref (fun _ -> assert false)
@@ -651,5 +654,7 @@ let report_error ppf = function
       fprintf ppf "Unbound class %a" longident lid
   | Unbound_modtype lid ->
       fprintf ppf "Unbound module type %a" longident lid
+  | Unbound_cltype lid ->
+      fprintf ppf "Unbound class type %a" longident lid
   | Ill_typed_functor_application lid ->
       fprintf ppf "Ill-typed functor application %a" longident lid

typing/typetexp.mli

@@ -61,6 +61,7 @@ type error =
   | Unbound_module of Longident.t
   | Unbound_class of Longident.t
   | Unbound_modtype of Longident.t
+  | Unbound_cltype of Longident.t
   | Ill_typed_functor_application of Longident.t
 
 exception Error of Location.t * error
@@ -79,3 +80,4 @@ val find_value: Env.t -> Location.t -> Longident.t -> Path.t * Types.value_descr
 val find_class:  Env.t -> Location.t -> Longident.t -> Path.t * Types.class_declaration
 val find_module: Env.t -> Location.t -> Longident.t -> Path.t * Types.module_type
 val find_modtype: Env.t -> Location.t -> Longident.t -> Path.t * Types.modtype_declaration
+val find_cltype: Env.t -> Location.t -> Longident.t -> Path.t * Types.cltype_declaration