Commits

camlspotter committed d06fa25 Merge

merge

Comments (0)

Files changed (6)

-.*\.(cm.*|annot|o)$
+.*\.(cm.*|annot|o|opt)$
 .*~$
 ocamlspot$
 
 
 module SAbs = Spot.Abstraction
 
-(*
-type binary_annots =
-  | Packed of Types.signature * string list
-  | Implementation of structure
-  | Interface of signature
-  | Partial_implementation of binary_part array
-  | Partial_interface of binary_part array
-
-and binary_part =
-  | Partial_structure of structure
-  | Partial_structure_item of structure_item
-  | Partial_expression of expression
-  | Partial_pattern of pattern
-  | Partial_class_expr of class_expr
-  | Partial_signature of signature
-  | Partial_signature_item of signature_item
-  | Partial_module_type of module_type
-*)
-
 module Dump = struct
   (* mainly debugging purpose *)
 
      same name *) 
 
   and structure_item = 
-    | AStr_value     of Ident.t
-    | AStr_type      of Ident.t
-    | AStr_exception of Ident.t
-    | AStr_module    of Ident.t * module_expr
-    | AStr_modtype   of Ident.t * module_expr
-    | AStr_class     of Ident.t
-    | AStr_cltype    of Ident.t
-    | AStr_include   of module_expr * (Ident.t * (Kind.t * Ident.t)) list
-    | AStr_included  of Ident.t * module_expr * Kind.t * Ident.t
+    | AStr_value      of Ident.t
+    | AStr_type       of Ident.t
+    | AStr_exception  of Ident.t
+    | AStr_module     of Ident.t * module_expr
+    | AStr_modtype    of Ident.t * module_expr
+    | AStr_class      of Ident.t
+    | AStr_class_type of Ident.t
+    | AStr_include    of module_expr * (Ident.t * (Kind.t * Ident.t)) list
+    | AStr_included   of Ident.t * module_expr * Kind.t * Ident.t
 
   let rec format_module_expr ppf = function
     | AMod_ident p -> fprintf ppf "%s" (Path.name p)
           (Ident.name id)
           format_module_expr mexp
     | AStr_class id -> fprintf ppf "class %s" (Ident.name id)
-    | AStr_cltype id -> fprintf ppf "class type %s" (Ident.name id)
+    | AStr_class_type id -> fprintf ppf "class type %s" (Ident.name id)
     | AStr_include (mexp, aliases) ->
         fprintf ppf "@[<v4>include %a@ { @[<v>%a@] }@]"
           format_module_expr mexp
     | AStr_module (id, _)  -> Some (Kind.Module, id)
     | AStr_modtype (id, _) -> Some (Kind.Module_type, id)
     | AStr_class id        -> Some (Kind.Class, id)
-    | AStr_cltype id       -> Some (Kind.Class_type, id)
+    | AStr_class_type id       -> Some (Kind.Class_type, id)
     | AStr_include _       -> None
     | AStr_included (id, _, kind, _) -> Some (kind, id)
 
 	| AStr_type id1, AStr_type id2
 	| AStr_exception id1, AStr_exception id2
 	| AStr_class id1, AStr_class id2
-	| AStr_cltype id1, AStr_cltype id2 -> id1 = id2
+	| AStr_class_type id1, AStr_class_type id2 -> id1 = id2
 	| AStr_module (id1, mexp1) , AStr_module (id2, mexp2) ->
 	    id1 = id2 && Module_expr.equal mexp1 mexp2
 	| AStr_modtype (id1, mty1), AStr_modtype (id2, mty2) ->
             id1 = id2 && kind1 = kind2 && id1' = id2'
             && Module_expr.equal mexp1 mexp2
 	| (AStr_value _ | AStr_type _ | AStr_exception _ | AStr_modtype _ 
-	  | AStr_class _ | AStr_cltype _ | AStr_module _ | AStr_include _ | AStr_included _),
+	  | AStr_class _ | AStr_class_type _ | AStr_module _ | AStr_include _ | AStr_included _),
 	  (AStr_value _ | AStr_type _ | AStr_exception _ | AStr_modtype _ 
-	  | AStr_class _ | AStr_cltype _ | AStr_module _ | AStr_include _ | AStr_included _) -> false
+	  | AStr_class _ | AStr_class_type _ | AStr_module _ | AStr_include _ | AStr_included _) -> false
 
       let hash = Hashtbl.hash
     end
   open Typedtree
   open Asttypes
 
+  (* CR jfuruse: cache never cleaned! *)
   let cache_module_expr = Module_expr.Table.create 31
   let cache_structure_item = Structure_item.Table.create 31
 
-  let included_sig_identifier_table = Hashtbl.create 31
+  let clear_cache () = 
+    Module_expr.Table.clear cache_module_expr;
+    Structure_item.Table.clear cache_structure_item
 
   module T = struct
     let kident_of_sigitem = function
       | Sig_module (id, mty, _) -> AStr_module (id, module_type mty)
       | Sig_modtype (id, mdtd) -> AStr_modtype (id, modtype_declaration mdtd)
       | Sig_class (id, _, _) -> AStr_class id
-      | Sig_class_type (id, _, _) -> AStr_cltype id
+      | Sig_class_type (id, _, _) -> AStr_class_type id
 
     and module_type = function
       | Mty_ident p -> AMod_ident p
       | Modtype_manifest mty -> module_type mty
   end
 
-  module TT = struct
-    let kident_of_sigitem = function
-      | Tsig_value (id, _, _)     -> [Kind.Value, id]
-      | Tsig_exception (id, _, _) -> [Kind.Exception, id]
-      | Tsig_module (id, _, _) -> [Kind.Module, id]
-      | Tsig_type typs -> 
-          List.map (fun (id, _, _) -> Kind.Type, id) typs
-      | Tsig_modtype (id, _, _)   -> [Kind.Module_type, id]
-      | Tsig_class clses -> 
-          List.concat_map (fun cls -> 
-            [Kind.Class, cls.ci_id_class; 
-             Kind.Class_type, cls.ci_id_class_type;
-             Kind.Type, cls.ci_id_object;
-             Kind.Type, cls.ci_id_typesharp]
-            ) clses
-      | Tsig_class_type clses ->
-          List.map (fun cls -> 
-            Kind.Class_type, cls.ci_id_class) clses
-      | Tsig_recmodule _ -> assert false
-      | Tsig_open _ -> assert false
-      | Tsig_include _ -> assert false
-  end
-
   let aliases_of_include' no_value_is_not_in_ids sg ids =
     (* We cannot use kind directly since it does not distinguish normal values and primitives *)
     Debug.format "@[<2>DEBUG alias: ids=[ @[%a@] ]@ + sg=[ @[%a@] ]@]@."
     | Tstr_class classdescs ->
 	List.map (fun (cls, _names, _) -> AStr_class cls.ci_id_class) classdescs
     | Tstr_class_type iddecls ->
-	List.map (fun (id, _, _) -> AStr_cltype id) iddecls
+	List.map (fun (id, _, _) -> AStr_class_type id) iddecls
     | Tstr_include (mexp, ids) ->
         let aliases = try aliases_of_include mexp ids with _ -> assert false in
         [AStr_include (module_expr mexp, aliases)]
         (* CR jfuruse: still not sure which one is which *)
         List.concat_map (fun cls -> 
           [ AStr_class cls.ci_id_class; 
-            AStr_cltype  cls.ci_id_class_type;
+            AStr_class_type  cls.ci_id_class_type;
             AStr_type cls.ci_id_object;
             AStr_type cls.ci_id_typesharp]
         ) clses
-    | Tsig_class_type clses -> List.map (fun cls -> AStr_cltype cls.ci_id_class) clses
+    | Tsig_class_type clses -> List.map (fun cls -> AStr_class_type cls.ci_id_class) clses
 
     | Tsig_recmodule lst -> 
         List.map (fun (id, _, mty) -> AStr_module (id, module_type mty)) lst
         let aliases = try aliases_of_include' false sg0 ids with _ -> assert false in
         [AStr_include (module_type mty, aliases)]
         
-	
   and modtype_declaration = function
     | Tmodtype_abstract -> AMod_abstract
     | Tmodtype_manifest mty -> module_type mty
 
-(* This is wrong. This only flatten module related things and 
-   non modules like patterns are never flattened. 
-
-
-  let rec flatten str = List.concat_map flatten_item str
-
-  and flatten_item item = match item with
-    | AStr_value     _
-    | AStr_type      _
-    | AStr_exception _
-    | AStr_class     _
-    | AStr_cltype    _ -> [item]
-    | AStr_module  (_, mexp)
-    | AStr_modtype (_, mexp) -> item :: flatten_module_expr mexp
-    | AStr_include (mexp, aliases) ->
-        let flats = flatten_module_expr mexp in
-(* mexp can be just M, so we dont try expanding it
-        List.map (fun (id, ((k,id') as kid)) ->
-          try
-            Some (List.find (fun sitem -> ident_of_structure_item sitem = Some kid) flats)
-          with
-          | Not_found ->
-              Format.eprintf "@[<2>%s %a not found in@ @[%a@]@]@." 
-                (Kind.name k) Ident.format id'
-                format_structure flats;
-              None
-        )
-          aliases
-*)
-        item :: flats
-
-  and flatten_module_expr = function
-    | AMod_ident _ -> []
-    | AMod_packed _ -> []
-    | AMod_structure str -> flatten str
-    | AMod_functor (_, _, mexp) -> flatten_module_expr mexp
-    | AMod_apply (_, m) -> flatten_module_expr m
-    | AMod_constraint (m, _) -> flatten_module_expr m
-    | AMod_unpack m -> flatten_module_expr m
-    | AMod_abstract -> []
-*)
-
-
   and type_declaration td = match td.typ_kind with
     | Ttype_abstract -> []
     | Ttype_variant lst -> List.map (fun (id, {loc=_loc}, _, _) -> AStr_type id) lst
     | Ttype_record lst -> List.map (fun (id, {loc=_loc}, _, _, _) -> AStr_type id) lst
 end
 
-let protect name f v = try f v with e ->
-  Format.eprintf "Error: %s: %s@." name (Printexc.to_string e)
-    
 let protect' name f v = try f v with e ->
   Format.eprintf "Error: %s: %s@." name (Printexc.to_string e); raise e
     
     open Asttypes
     open Typedtree
     open Abstraction
+    module K = Kind
 
     (* CR jfuruse: A Location.t contains a filename, though it is always
        unique. Waste of 4xn bytes. *)
       let open Types in
       let open Ctype in
       match (repr typ).desc with
-      | Tconstr (path, _, _) -> record tbl loc (Use (Kind.Type, path)) 
+      | Tconstr (path, _, _) -> record tbl loc (Use (K.Type, path)) 
       | _ -> (* strange.. *) ()
 
-    class fold tbl = let record = record tbl in object 
+    class fold tbl = 
+      let record = record tbl in 
+      let record_def loc sitem = record loc (Str sitem)
+      and record_use loc kind path = record loc (Use (kind, path)) in
+    object 
       inherit Ttfold.fold as super
 
       method! pattern p = 
       method! pattern_desc pd = 
         begin match pd with 
         | Tpat_var (id, {loc})
-        | Tpat_alias (_, id, {loc}) 
-          -> record loc (Str (AStr_value id))
+        | Tpat_alias (_, id, {loc}) -> record_def loc (AStr_value id)
         | Tpat_construct (path, {loc}, cdesc, _, _) -> 
             let kind = match cdesc.Types.cstr_tag with
-              | Types.Cstr_exception _ -> Kind.Exception            
-              | _ -> Kind.Type
+              | Types.Cstr_exception _ -> K.Exception            
+              | _ -> K.Type
             in
             record loc (Use (kind, path))
         | Tpat_record (lst , _) ->
             List.iter (fun (path, {loc}, _, _) -> 
-              record loc (Use (Kind.Type, path))) lst
+              record_use loc K.Type path) lst
         | Tpat_any | Tpat_constant _ | Tpat_tuple _
         | Tpat_variant _ | Tpat_array _ | Tpat_or _ | Tpat_lazy _ -> ()
         end;
       method! exp_extra ee =
         begin match ee with 
         | Texp_constraint _ -> ()
-        | Texp_open (path, {loc}, _) -> record loc (Use (Kind.Module, path))
+        | Texp_open (path, {loc}, _) -> record_use loc K.Module path
         end;
         super#exp_extra ee
 
       method !expression_desc ed =
         begin match ed with
         | Texp_ident (path, {loc}, _) -> 
-            record loc (Use (Kind.Value, path))
+            record_use loc K.Value path
         | Texp_construct (path, {loc}, cdesc, _, _) ->
             let kind = match cdesc.Types.cstr_tag with
-              | Types.Cstr_exception _ -> Kind.Exception            
-              | _ -> Kind.Type
+              | Types.Cstr_exception _ -> K.Exception            
+              | _ -> K.Type
             in
-            record loc (Use (kind, path))
+            record_use loc kind path
         | Texp_record (lst, _) ->
             List.iter (fun (path, {loc}, _, _) ->
-              record loc (Use (Kind.Type, path))) lst
+              record_use loc K.Type path) lst
         | Texp_field (_, path, {loc}, _) 
         | Texp_setfield (_, path, {loc}, _, _) -> 
-            record loc (Use (Kind.Type, path))
+            record_use loc K.Type path
         | Texp_for (id, {loc}, _, _, _, _) -> 
             (* CR jfuruse: add type int to id *)
-            record loc (Str (AStr_value id))
+            record_def loc (AStr_value id)
         | Texp_new (path, {loc}, _) -> 
-            record loc (Use (Kind.Class, path))
+            record_use loc K.Class path
         | Texp_instvar (_path, path, {loc}) (* CR jfuruse: not sure! *)
         | Texp_setinstvar (_path, path, {loc}, _) ->
-            record loc (Use (Kind.Value, path))
+            record_use loc K.Value path
         | Texp_override (_path, lst) ->  (* CR jfuruse: what todo with _path? *)
             List.iter (fun (path, {loc}, _) ->
-              record loc (Use (Kind.Type, path))) lst
+              record_use loc K.Type path) lst
         | Texp_letmodule (id, {loc}, mexp, _) -> 
-            record loc (Str (AStr_module (id, module_expr mexp)))
+            record_def loc (AStr_module (id, module_expr mexp))
         | Texp_newtype (_string, _expr) (* CR jfuruse: ? *) -> ()
         | Texp_constant _ | Texp_let _ | Texp_function _
         | Texp_apply _ | Texp_match _ | Texp_try _
 
       method! class_expr_desc ced =
         begin match ced with
-        | Tcl_ident (path, {loc}, _) -> record loc (Use (Kind.Value, path)) 
+        | Tcl_ident (path, {loc}, _) -> record_use loc K.Value path 
         | Tcl_structure _ -> ()
         | Tcl_fun (_, _, lst , _, _) 
         | Tcl_let (_, _, lst, _) -> 
-            List.iter (fun (id, {loc}, _) -> record loc (Str (AStr_value id))) lst
+            List.iter (fun (id, {loc}, _) -> record_def loc (AStr_value id)) lst
         | Tcl_apply _ -> ()
         | Tcl_constraint _ -> ()
         end;
               | Tcl_let (_, _, _, ce) -> find ce
             in
             let loc = (find ce).cl_loc in
-            List.iter (fun (_, id) -> record loc (Str (AStr_value id))) ivars;
-            List.iter (fun (_, id) -> record loc (Str (AStr_value id))) cmethods
-        | Tcf_val (_name, {loc}, _, id, _, _) -> record loc (Str (AStr_value id))
+            List.iter (fun (_, id) -> record_def loc (AStr_value id)) ivars;
+            List.iter (fun (_, id) -> record_def loc (AStr_value id)) cmethods
+        | Tcf_val (_name, {loc}, _, id, _, _) -> record_def loc (AStr_value id)
         | Tcf_meth (_name, {loc=_loc}, _, _, _) -> ()
         | Tcf_constr _ -> ()
         | Tcf_init _ -> ()
       method! module_expr_desc med = 
         begin match med with
         | Tmod_ident (path, {loc}) -> 
-            record loc (Use (Kind.Module, path))
+            record_use loc K.Module path
         | Tmod_functor (id, {loc}, _, _) ->
             (* CR jfuruse: must rethink *)
-            record loc (Str (AStr_module (id, AMod_functor_parameter)));
+            record_def loc (AStr_module (id, AMod_functor_parameter));
             record loc (Functor_parameter id); (* CR jfuruse: required? *)
         | Tmod_structure _
         | Tmod_apply _
             let id_kid_list = try aliases_of_include mexp idents with e -> prerr_endline "structure_item include failed!!!"; raise e in
             let m = module_expr mexp in
             List.iter (fun (id, (k, id')) -> 
-              record loc (Str (AStr_included (id, m, k, id')))) id_kid_list
+              record_def loc (AStr_included (id, m, k, id'))) id_kid_list
         | _ -> ()
         end;
         super#structure_item sitem
       method! structure_item_desc sid =
         begin match sid with
         | Tstr_primitive (id, {loc}, _) -> 
-            record loc (Str (AStr_value id))
+            record_def loc (AStr_value id)
         | Tstr_type lst ->
             List.iter (fun (id, {loc}, _) ->
-              record loc (Str (AStr_type id))) lst
+              record_def loc (AStr_type id)) lst
         | Tstr_exception (id, {loc}, _) -> 
-            record loc (Str (AStr_exception id))
+            record_def loc (AStr_exception id)
         | Tstr_exn_rebind (id, {loc}, path, {loc=loc'}) ->
-            record loc (Str (AStr_exception id));
-            record loc' (Use (Kind.Exception, path))
+            record_def loc (AStr_exception id);
+            record_use loc' K.Exception path
         | Tstr_module (id, {loc}, mexp) -> 
-            record loc (Str (AStr_module (id, module_expr mexp)))
+            record loc (Mod_type mexp.mod_type);
+            record_def loc (AStr_module (id, module_expr mexp))
         | Tstr_recmodule lst ->
             List.iter (fun (id, {loc}, _mty, mexp) ->
-              record loc (Str (AStr_module (id, module_expr mexp)))) lst
+              record loc (Mod_type mexp.mod_type);
+              record_def loc (AStr_module (id, module_expr mexp))) lst
         | Tstr_modtype (id, {loc}, mty) -> 
-            record loc (Str (AStr_modtype (id, module_type mty)))
+            record_def loc (AStr_modtype (id, module_type mty))
         | Tstr_open (path, {loc}) -> 
-            record loc (Use (Kind.Module, path))
+            record_use loc K.Module path
         | Tstr_class_type lst ->
             List.iter (fun (id, {loc}, _) -> 
-              record loc (Str (AStr_cltype id))) lst
+              record_def loc (AStr_class_type id)) lst
         | Tstr_include (_mexp, _idents) -> () (* done in #structure_item *)
         | Tstr_eval _ 
         | Tstr_value _ 
       method! module_type_desc mtd =
         begin match mtd with
         | Tmty_ident (path, {loc}) -> 
-            record loc (Use (Kind.Module_type, path))
+            record_use loc K.Module_type path
         | Tmty_functor (id, {loc}, mty, _mty) -> 
-            record loc (Str (AStr_module (id, module_type mty)))
+            record_def loc (AStr_module (id, module_type mty))
         | Tmty_with (_mty, lst) -> 
             List.iter (fun (path, {loc}, with_constraint) -> 
               record loc (Use ( (match with_constraint with
-                                 | Twith_type _ -> Kind.Type
-                                 | Twith_module _ -> Kind.Module
-                                 | Twith_typesubst _ -> Kind.Type
-                                 | Twith_modsubst _ -> Kind.Module),
+                                 | Twith_type _      -> K.Type
+                                 | Twith_module _    -> K.Module
+                                 | Twith_typesubst _ -> K.Type
+                                 | Twith_modsubst _  -> K.Module),
                                 path ))) lst
         | Tmty_typeof _
         | Tmty_signature _ -> ()
             let ids = List.map (fun si -> snd (T.kident_of_sigitem si)) sg in
             let aliases = try aliases_of_include' false sg0 ids with _ -> assert false in
             List.iter (fun (id, (k, id')) -> 
-              record loc (Str (AStr_included (id, m, k, id')))) aliases
+              record_def loc (AStr_included (id, m, k, id'))) aliases
         | _ -> ()
         end;
         super#signature_item si
 
       method! signature_item_desc sid =
         begin match sid with
-        | Tsig_value (id, {loc}, _) -> record loc (Str (AStr_value id))
+        | Tsig_value (id, {loc}, _) -> record_def loc (AStr_value id)
         | Tsig_type lst -> 
             List.iter (fun (id, {loc}, _) -> 
-              record loc (Str (AStr_type id))) lst
-        | Tsig_exception (id, {loc}, _) -> record loc (Str (AStr_exception id))
-        | Tsig_module (id, {loc}, mty) -> record loc (Str (AStr_module (id, module_type mty)))
+              record_def loc (AStr_type id)) lst
+        | Tsig_exception (id, {loc}, _) -> record_def loc (AStr_exception id)
+        | Tsig_module (id, {loc}, mty) -> 
+            record loc (Mod_type mty.mty_type);
+            record_def loc (AStr_module (id, module_type mty))
         | Tsig_recmodule lst -> 
             List.iter (fun (id, {loc}, mty) -> 
-              record loc (Str (AStr_module (id, module_type mty)))) lst
+              record loc (Mod_type mty.mty_type);
+              record_def loc (AStr_module (id, module_type mty))) lst
         | Tsig_modtype (id, {loc}, mtd) -> 
-            record loc (Str (AStr_modtype (id, modtype_declaration mtd)))
-        | Tsig_open (path, {loc}) -> record loc (Use (Kind.Module, path))
+            record_def loc (AStr_modtype (id, modtype_declaration mtd))
+        | Tsig_open (path, {loc}) -> record_use loc K.Module path
         | Tsig_include _ -> () (* done in #signature_item *)
         | Tsig_class _ -> ()
         | Tsig_class_type _ -> ()
 
       method! with_constraint wc = 
         begin match wc with 
-        | Twith_module (path, {loc}) -> record loc (Use (Kind.Module, path)) 
-        | Twith_modsubst (path, {loc}) -> record loc (Use (Kind.Module, path))  (*?*)
+        | Twith_module (path, {loc}) -> record_use loc K.Module path 
+        | Twith_modsubst (path, {loc}) -> record_use loc K.Module path  (*?*)
         | Twith_type _ -> ()
         | Twith_typesubst _ -> ()
         end;
       method! core_type_desc ctd =
         begin match ctd with
         | Ttyp_var _var -> () (* CR jfuruse: todo *)
-        | Ttyp_constr (path, {loc}, _) -> record loc (Use (Kind.Type, path))
-        | Ttyp_class (path, {loc}, _, _) -> record loc (Use (Kind.Class, path))
+        | Ttyp_constr (path, {loc}, _) -> record_use loc K.Type path
+        | Ttyp_class (path, {loc}, _, _) -> record_use loc K.Class path
             (* CR jfuruse: or class type? *)
         | Ttyp_alias (_core_type, _var) -> () (* CR jfuruse: todo *)
         | Ttyp_poly (_vars, _core_type) -> () (* CR jfuruse; todo *)
         super#core_type_desc ctd
 
       method! package_type pt =
-        record pt.pack_txt.loc (Use (Kind.Module_type, pt.pack_name));
+        record_use pt.pack_txt.loc K.Module_type pt.pack_name;
         super#package_type pt
 (*
 and package_type = {
         | Ttype_abstract -> ()
         | Ttype_variant lst -> 
             List.iter (fun (id, {loc}, _, _loc(*?*)) ->
-              record loc (Str (AStr_type id))) lst
+              record_def loc (AStr_type id)) lst
         | Ttype_record lst ->
             List.iter (fun (id, {loc}, _, _, _loc(*?*)) ->
-              record loc (Str (AStr_type id))) lst
+              record_def loc (AStr_type id)) lst
         end;
         super#type_kind tk
 
 
       method! class_type_desc ctd = 
         begin match ctd with
-        | Tcty_constr (path, {loc}, _) -> record loc (Use (Kind.Class_type, path))
+        | Tcty_constr (path, {loc}, _) -> record_use loc K.Class_type path
         | Tcty_signature _
         | Tcty_fun _ -> ()
         end;
       method! class_infos f ci =
         let loc = ci.ci_id_name.loc in
         (* CR jfuruse: are they correct? *)
-        record loc (Str (AStr_class ci.ci_id_class));
-        record loc (Str (AStr_cltype ci.ci_id_class_type));
-        record loc (Str (AStr_type ci.ci_id_object));
-        record loc (Str (AStr_type ci.ci_id_typesharp));
+        record_def loc (AStr_class ci.ci_id_class);
+        record_def loc (AStr_class_type ci.ci_id_class_type);
+        record_def loc (AStr_type ci.ci_id_object);
+        record_def loc (AStr_type ci.ci_id_typesharp);
         super#class_infos f ci
 
     end
       let tbl = Hashtbl.create 1023 in
       let o = new Record.fold tbl in
       ignore (o#structure str);
+      Debug.format "structure recorded: %d records@." (Hashtbl.length tbl);
       tbl)
       ()
 
       let tbl = Hashtbl.create 1023 in
       let o = new Record.fold tbl in
       ignore (o#signature sg);
+      Debug.format "signature recorded: %d records@." (Hashtbl.length tbl);
       tbl)
       ()
 
   let dummy = Use (Kind.Value, Path.Pident (Ident.create_persistent "dummy"))
 end
 
-module Top = struct
-  let recorded = ref None
-  let clear () = recorded := None
-
-  let record_structure str = 
-    if !Clflags.annotations then begin
-      assert (!recorded = None); 
-      recorded := Some (Abstraction.structure str)
-    end
-
-  let record_structure = protect "Spot.Top.record_structure" record_structure 
-    
-  let record_signature sg = 
-    if !Clflags.annotations then begin
-      assert (!recorded = None); 
-      recorded := Some (Abstraction.signature sg)
-    end
-
-  let record_signature = protect "Spot.Top.record_signature" record_signature
-    
-  let recorded () = !recorded
-end
-
 module Position = struct
   open Lexing
 
 
   let point pos = { start = pos; end_ = Position.next pos }
 
-  let none = { start = Position.none;
-	       end_ = Position.none }
-
   let length_in_bytes t =
     let bytes = function
       | { Position.bytes = Some bytes; _ } -> bytes
   and structure = structure_item list
 
   and structure_item = 
-    | AStr_value     of Ident.t
-    | AStr_type      of Ident.t
-    | AStr_exception of Ident.t
-    | AStr_module    of Ident.t * module_expr
-    | AStr_modtype   of Ident.t * module_expr
-    | AStr_class     of Ident.t
-    | AStr_cltype    of Ident.t
-    | AStr_include   of module_expr * (Ident.t * (Kind.t * Ident.t)) list
-    | AStr_included  of Ident.t * module_expr * Kind.t * Ident.t
+    | AStr_value      of Ident.t
+    | AStr_type       of Ident.t
+    | AStr_exception  of Ident.t
+    | AStr_module     of Ident.t * module_expr
+    | AStr_modtype    of Ident.t * module_expr
+    | AStr_class      of Ident.t
+    | AStr_class_type of Ident.t
+    | AStr_include    of module_expr * (Ident.t * (Kind.t * Ident.t)) list
+    | AStr_included   of Ident.t * module_expr * Kind.t * Ident.t
 
   val ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option
 
   val structure : Typedtree.structure -> module_expr
   val signature : Typedtree.signature -> module_expr
 
+  val clear_cache : unit -> unit
+
   open Format
   val format_module_expr : formatter -> module_expr -> unit
   val format_structure : formatter -> structure -> unit
   val dummy : t
 end
 
-module Top : sig
-  val record_structure : Typedtree.structure -> unit
-  val record_signature : Typedtree.signature -> unit
-
-  val recorded : unit -> Abstraction.module_expr option
-end
-
-(* Spot file *)
-(*
-module File : sig
-  type elem =
-    | Argv of string array
-    | Source_path of string option
-    | Cwd of string
-    | Load_paths of string list
-    | Top of Abstraction.structure option
-    | Annots of (Location.t * Annot.t) list
-
-  (* marshalled type *)
-  type t = elem list
-
-  val dump : source: string option -> string -> unit
-  val dump_package : prefix: string -> source: string -> string list -> unit
-
-  val set_argv : string array -> unit
-    (** override the original Sys.argv. Required for ocamlspot --recheck *)
-end
-*)
-
 module Position : sig
 
   type t = { line_column : (int * int) option; 
       | AStr_type      id
       | AStr_exception id
       | AStr_class     id
-      | AStr_cltype    id ->
+      | AStr_class_type    id ->
           (* CR jfuruse: not sure *)
           let pident = { PIdent.path = env0.Env.path; ident = Some id } in
           let v = Ident pident in
           (* CR jfuruse: use ident_of_structure_item *)
           let kind = match sitem with
-            | AStr_value     _ -> Kind.Value
-            | AStr_type      _ -> Kind.Type
-            | AStr_exception _ -> Kind.Exception
-            | AStr_modtype   _ -> Kind.Module_type
-            | AStr_class     _ -> Kind.Class
-            | AStr_cltype    _ -> Kind.Class_type
+            | AStr_value      _ -> Kind.Value
+            | AStr_type       _ -> Kind.Type
+            | AStr_exception  _ -> Kind.Exception
+            | AStr_modtype    _ -> Kind.Module_type
+            | AStr_class      _ -> Kind.Class
+            | AStr_class_type _ -> Kind.Class_type
             | AStr_included (_, _, kind, _) -> kind
             | AStr_module _ | AStr_include _ -> assert false
           in
     cty_path = path cldecl.cty_path;
     cty_new = Option.map cldecl.cty_new ~f:type_expr }
 
-let cltype_declaration _ = assert false
+let class_type_declaration ctd =
+  { ctd with clty_params = List.map type_expr ctd.clty_params;
+    clty_type = class_type ctd.clty_type;
+    clty_path = path ctd.clty_path }
 
 let rec module_type = function
   | Mty_ident p -> Mty_ident (path p)
   | Sig_class (id, cldecl, rec_status) ->
       Sig_class (ident id, class_declaration cldecl, rec_status)
   | Sig_class_type (id, cltdecl, rec_status) ->
-      Sig_class_type (ident id, cltype_declaration cltdecl, rec_status)
+      Sig_class_type (ident id, class_type_declaration cltdecl, rec_status)
 
 and modtype_declaration = function
   | Modtype_abstract -> Modtype_abstract