Commits

camlspotter committed bb34664

original tests recovered.

Comments (0)

Files changed (99)

 spot.cmi :
 spotconfig.cmi : spotconfig_intf.cmo
 spoteval.cmi : utils.cmi spot.cmi
-spotfile.cmi : spoteval.cmi spot.cmi
+spotfile.cmi : utils.cmi spoteval.cmi spotconfig_intf.cmo spot.cmi
 treeset.cmi : xset.cmi
 ttfold.cmi :
 typeFix.cmi :
 locident.cmx : locident.cmi
 name.cmo : name.cmi
 name.cmx : name.cmi
-ocamlspot.cmo : utils.cmi spotfile.cmi spoteval.cmi spotconfig.cmi spot.cmi \
-    ext.cmo
-ocamlspot.cmx : utils.cmx spotfile.cmx spoteval.cmx spotconfig.cmx spot.cmx \
-    ext.cmx
+ocamlspot.cmo : utils.cmi typeexpand.cmi spotfile.cmi spoteval.cmi \
+    spotconfig.cmi spot.cmi pathreparse.cmi ext.cmo command.cmi
+ocamlspot.cmx : utils.cmx typeexpand.cmx spotfile.cmx spoteval.cmx \
+    spotconfig.cmx spot.cmx pathreparse.cmx ext.cmx command.cmx
 pathreparse.cmo : utils.cmi spot.cmi locident.cmi ext.cmo pathreparse.cmi
 pathreparse.cmx : utils.cmx spot.cmx locident.cmx ext.cmx pathreparse.cmi
 spot.cmo : utils.cmi ttfold.cmi treeset.cmi ext.cmo spot.cmi
 ttfold.out.cmx :
 typeFix.cmo : utils.cmi name.cmi typeFix.cmi
 typeFix.cmx : utils.cmx name.cmx typeFix.cmi
-typedeclfold.cmo :
-typedeclfold.cmx :
 typedtreefold.cmo :
 typedtreefold.cmx :
 typeexpand.cmo : utils.cmi typeexpand.cmi
 
 module C = Spotconfig
 
-module File = Spotfile.Make(C)
+module File = struct
+  include Spotfile
+  include Spotfile.Make(C)
+end
 
 open Cmt_format
 
   | Partial_module_type of module_type
 *)
 
-let _ =
-  match C.mode with
-  | `Dump p ->
-      begin match File.load ~load_paths:["."] p with
-      | f ->
-          Spotfile.dump_file f;
-      end
-  | _ -> assert false
-
-
-(*
 module Dump = struct
   (* mainly debugging purpose *)
+
+  let file = File.dump_file
+
+  let rannots_full file = 
+    eprintf "@[<2>rannots =@ [ @[<v>%a@]@] ]@."
+      (Format.list ";@ " (Regioned.format Annot.format))
+      file.File.rannots
+  ;;
+  
+  let rannots_summary file = 
+    eprintf "@[<2>rannots =@ [ @[<v>%a@]@] ]@."
+      (Format.list ";@ " (Regioned.format Annot.summary))
+      file.File.rannots
+  ;;
+  
   let tree file = Tree.dump !!(file.File.tree)
   ;;
 
   ;;
 
   let info path =
-    let file = load (File.spot_of_file path) in
+    let file = load (File.cmt_of_file path) in
     printf "Compile: %s@."
       (String.concat " " 
          (List.map Command.escaped_for_shell 
-            (Array.to_list file.File.argv)));
+            (Array.to_list file.File.cmt.cmt_args)));
     printf "@[<v2>Included_dirs:@ %a@]@."
       (Format.list "" pp_print_string)
-      file.File.load_paths
+      file.File.cmt.cmt_loadpath
 
   let query_by_kind_path file kind path = 
     try Some (File.find_path_in_flat file (kind, path)) with Not_found -> None
 	(* Find the innermost module *)
         let rec find_module_path = function
           | [] -> []
-          | { Regioned.value = Annot.Str (Abstraction.Str_module (id, _)); _ } :: ls
-          | { Regioned.value = Annot.Str (Abstraction.Str_modtype (id, _)); _ } :: ls ->
+          | { Regioned.value = Annot.Str (Abstraction.AStr_module (id, _)); _ } :: ls
+          | { Regioned.value = Annot.Str (Abstraction.AStr_modtype (id, _)); _ } :: ls ->
               id :: find_module_path ls
           | _ :: ls -> find_module_path ls
         in
             | [] -> None
           in
           let rec find_str_value = function
-            | Annot.Str (Abstraction.Str_value id) :: _ -> Some id
+            | Annot.Str (Abstraction.AStr_value id) :: _ -> Some id
             | _::xs -> find_str_value xs
             | [] -> None
           in
           match List.filter (function Annot.Type _ -> true | _ -> false) annots with
           (* CR jfuruse: Sometimes more than one Annot.Type are found at the same place... *)
           | Annot.Type (typ, env, `Expr) :: _ -> 
-              printf "Expand: @[%a@]@." Typeexpand.format_as_expr (Typeexpand.expand file.File.load_paths env typ)
+              printf "Expand: @[%a@]@." Typeexpand.format_as_expr (Typeexpand.expand file.File.cmt.cmt_loadpath env typ)
           | Annot.Type (typ, env, `Pattern) :: _ -> 
-              printf "Expand: @[%a@]@." Typeexpand.format_as_pattern (Typeexpand.expand file.File.load_paths env typ)
+              printf "Expand: @[%a@]@." Typeexpand.format_as_pattern (Typeexpand.expand file.File.cmt.cmt_loadpath env typ)
           | Annot.Type (_typ, _env, `Val) :: _ -> ()
           | _ -> ()
         end;
     (* CR jfuruse: dup *)
     Debug.format "ocamlspot %s%s@." path (C.SearchSpec.to_string spec);
     Debug.format "cwd: %s@." (Sys.getcwd ());
-    let path = File.spot_of_file path in
+    let path = File.cmt_of_file path in
     let file = load path in
 
     let query_kind_path k path = print_query_result k (query_by_kind_path file k path) in
     | Failure s ->
         eprintf "Error: %s@." s;
         bye 1
-    | File.Old_spot (_spot, source) ->
+    | File.Old_cmt (_spot, source) ->
         eprintf "Error: source %s is newer than the spot@." source;
         bye 1
     | e ->
     (* CR jfuruse: dup *)
     Debug.format "ocamlspot %s%s@." path (C.SearchSpec.to_string spec);
     Debug.format "cwd: %s@." (Sys.getcwd ());
-    let path = File.spot_of_file path in
+    let path = File.cmt_of_file path in
     let file = load path in
 
     let find_by_kind_path k path found =
   let recheck files =
     let recheck mlpath =
       Debug.format "cwd: %s@." (Sys.getcwd ());
-      let path = File.spot_of_file mlpath in
+      let path = File.cmt_of_file mlpath in
       let file = File.load ~load_paths: ["."] path in
     
       printf "Compile: %s@."
 end
 
 let _ = Main.main ()
-*)
+
 	   module_expr is nicely cached. *)
 	structure str
     | Tmod_functor (id, _, mty, mexp) ->
-        let mty = Mtype.scrape mexp.mod_env mty.mty_type in
+        let mty = 
+          try Mtype.scrape mexp.mod_env mty.mty_type with _ -> assert false
+        in
 	AMod_functor(id, mty, module_expr mexp)
     | Tmod_apply (mexp1, mexp2, _mcoercion) -> (* CR jfuruse ? *)
 	AMod_apply (module_expr mexp1, module_expr mexp2)
     | Tmod_unpack (_expr, mty_) -> 
         AMod_unpack (T.module_type mty_) (* CR jfuruse: need to unpack, really? *)
           
-  and structure str = 
-    AMod_structure (List.concat_map structure_item str.str_items)
+  and structure str = AMod_structure (List.concat_map structure_item str.str_items)
 
   and structure_item sitem = 
     (* it may recompute the same thing, but it is cheap *)
     | Tstr_class_type iddecls ->
 	List.map (fun (id, _, _) -> AStr_cltype id) iddecls
     | Tstr_include (mexp, ids) ->
-        let aliases = aliases_of_include mexp ids in
+        let aliases = try aliases_of_include mexp ids with _ -> assert false in
         [AStr_include (module_expr mexp, aliases)]
 
   (* CR jfuruse: caching like module_expr_sub *)
   and signature sg = AMod_structure (List.concat_map signature_item sg.sig_items)
 
   and signature_item sitem = 
-      let aux id f =
-	  (* Sigitem might be defined by include, but it is not recorded
-	     in signature. We here try to recover it. *)
-	  (* CR jfuruse: included modules may listed more than once *)
-	  let sitem, recorded = Hashtbl.find included_sig_identifier_table id in
-          if !recorded then f ()
-          else begin
-            recorded := true;
-            sitem
-          end
-      in
-      match sitem.sig_desc with
-      | Tsig_value (id, _, _) -> [aux id (fun () -> AStr_value id)]
-      | Tsig_exception (id, _, _) -> [aux id (fun () -> AStr_exception id)]
-      | Tsig_module (id, _ , mty) ->
-          [aux id (fun () -> AStr_module (id, module_type mty))]
-      | Tsig_modtype (id, _, mty_decl) ->
-          [aux id (fun () -> 
-            (* todo *) AStr_modtype (id, modtype_declaration mty_decl) (* sitem.sig_final_env can be used? *)) ]
+    let aux id f = f ()
+(*
+        (* Sigitem might be defined by include, but it is not recorded
+           in signature. We here try to recover it. *)
+        (* CR jfuruse: included modules may listed more than once *)
+        let sitem, recorded = Hashtbl.find included_sig_identifier_table id in
+        if !recorded then f ()
+        else begin
+          recorded := true;
+          sitem
+        end
+*)
+    in
+    match sitem.sig_desc with
+    | Tsig_value (id, _, _) -> [aux id (fun () -> AStr_value id)]
+    | Tsig_exception (id, _, _) -> [aux id (fun () -> AStr_exception id)]
+    | Tsig_module (id, _ , mty) ->
+        [aux id (fun () -> AStr_module (id, module_type mty))]
+    | Tsig_modtype (id, _, mty_decl) ->
+        [aux id (fun () -> 
+          (* todo *) AStr_modtype (id, modtype_declaration mty_decl) (* sitem.sig_final_env can be used? *)) ]
 
-      | Tsig_type typs -> List.map (fun (id, _, _) -> aux id (fun () -> AStr_type id)) typs
-      | Tsig_class clses -> List.map (fun cls -> aux cls.ci_id_class (fun () -> AStr_class cls.ci_id_class)) clses
-      | Tsig_class_type clses -> List.map (fun cls -> aux cls.ci_id_class (fun () -> AStr_cltype cls.ci_id_class)) clses
+    | Tsig_type typs -> List.map (fun (id, _, _) -> aux id (fun () -> AStr_type id)) typs
+    | Tsig_class clses -> List.map (fun cls -> aux cls.ci_id_class (fun () -> AStr_class cls.ci_id_class)) clses
+    | Tsig_class_type clses -> List.map (fun cls -> aux cls.ci_id_class (fun () -> AStr_cltype cls.ci_id_class)) clses
 
-      | Tsig_recmodule _ -> assert false
-      | Tsig_open _ -> assert false
-      | Tsig_include _ -> assert false
+    | Tsig_recmodule _ -> assert false
+    | Tsig_open _ -> assert false
+    | Tsig_include _ -> assert false
 	
   and modtype_declaration = function
     | Tmodtype_abstract -> AMod_abstract
     | AStr_modtype (_, mexp) -> item :: flatten_module_expr mexp
     | AStr_include (mexp, aliases) ->
         let flats = flatten_module_expr mexp in
-        List.map (fun (id, kid) ->
-          List.find (fun sitem -> ident_of_structure_item sitem = Some kid) flats)
+(* 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
-        @ flats
+*)
+        item :: flats
 
   and flatten_module_expr = function
     | AMod_ident _ -> []
     | AMod_abstract -> []
 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)
+    
+let protect' name f v = try f v with e ->
+  Format.eprintf "Error: %s: %s@." name (Printexc.to_string e); raise e
     
 module Annot = struct
   type t =
   module Record = struct
     open Asttypes
     open Typedtree
-    module A = Abstraction
+    open Abstraction
 
     class fold = object (self)
       inherit Ttfold.fold as super
       method! pattern p = 
         record p.pat_loc (Type (p.pat_type, p.pat_env, `Pattern));
         super#pattern p
+
+    (* CR jfuruse: pat_extra *)
+          
+      method! pattern_desc pd = 
+        begin match pd with 
+        | Tpat_var (id, {loc})
+        | Tpat_alias (_, id, {loc}) 
+          -> record loc (Str (AStr_value id))
+        | Tpat_construct (path, {loc}, _, _, _) -> 
+            record loc (Use (Kind.Type, path))
+        | Tpat_record (lst , _) ->
+            List.iter (fun (path, {loc}, _, _) -> 
+              record loc (Use (Kind.Type, path))) lst
+        | Tpat_any | Tpat_constant _ | Tpat_tuple _
+        | Tpat_variant _ | Tpat_array _ | Tpat_or _ | Tpat_lazy _ -> ()
+        end;
+        super#pattern_desc pd
+      
+      method! expression e = 
+        record e.exp_loc (Type (e.exp_type, e.exp_env, `Expr));
+        super#expression e
+
+(*
+and exp_extra =
+  | Texp_constraint of core_type option * core_type option
+  | Texp_open of Path.t * Longident.t loc * Env.t
+*)
+
+      method !expression_desc ed =
+        begin match ed with
+        | Texp_ident (path, {loc}, _) -> 
+            record loc (Use (Kind.Value, path))
+        | Texp_construct (path, {loc}, _, _, _) -> 
+            record loc (Use (Kind.Type, path))
+        | Texp_record (lst, _) ->
+            List.iter (fun (path, {loc}, _, _) ->
+              record loc (Use (Kind.Type, path))) lst
+        | Texp_field (_, path, {loc}, _) 
+        | Texp_setfield (_, path, {loc}, _, _) -> 
+            record loc (Use (Kind.Type, path))
+        | Texp_for (id, {loc}, _, _, _, _) -> 
+            (* CR jfuruse: add type int to id *)
+            record loc (Str (AStr_value id))
+        | Texp_new (path, {loc}, _) -> 
+            record loc (Use (Kind.Class, path))
+        | Texp_instvar (_path, path, {loc}) (* CR jfuruse: not sure! *)
+        | Texp_setinstvar (_path, path, {loc}, _) ->
+            record loc (Use (Kind.Value, path))
+        | Texp_override (_path, lst) ->  (* CR jfuruse: what todo with _path? *)
+            List.iter (fun (path, {loc}, _) ->
+              record loc (Use (Kind.Type, path))) lst
+        | Texp_letmodule (id, {loc}, mexp, _) -> 
+            record loc (Str (AStr_module (id, module_expr mexp)))
+        | Texp_newtype (_string, _expr) (* CR jfuruse: ? *) -> ()
+        | Texp_constant _
+        | Texp_let _
+        | Texp_function _
+        | Texp_apply _
+        | Texp_match _
+        | Texp_try _
+        | Texp_tuple _
+        | Texp_variant _
+        | Texp_array _
+        | Texp_ifthenelse _
+        | Texp_sequence _
+        | Texp_while _
+        | Texp_when _
+        | Texp_send _
+        | Texp_assert _
+        | Texp_assertfalse
+        | Texp_lazy _
+        | Texp_poly _
+        | Texp_object _
+        | Texp_pack _ -> ()
+        end;
+        super#expression_desc ed
+(*          
+and meth =
+    Tmeth_name of string
+  | Tmeth_val of Ident.t
+
+(* Value expressions for the class language *)
+
+and class_expr =
+  { cl_desc: class_expr_desc;
+    cl_loc: Location.t;
+    cl_type: Types.class_type;
+    cl_env: Env.t }
+
+and class_expr_desc =
+    Tcl_ident of Path.t * Longident.t loc * core_type list (* Pcl_constr *)
+  | Tcl_structure of class_structure
+  | Tcl_fun of
+      label * pattern * (Ident.t * string loc * expression) list * class_expr *
+        partial
+  | Tcl_apply of class_expr * (label * expression option * optional) list
+  | Tcl_let of rec_flag *  (pattern * expression) list *
+                  (Ident.t * string loc * expression) list * class_expr
+  | Tcl_constraint of
+      class_expr * class_type option * string list * string list * Concr.t
+    (* Visible instance variables, methods and concretes methods *)
+
+and class_structure =
+  { cstr_pat : pattern;
+    cstr_fields: class_field list;
+    cstr_type : Types.class_signature;
+    cstr_meths: Ident.t Meths.t }
+
+and class_field =
+   {
+    cf_desc : class_field_desc;
+    cf_loc : Location.t;
+  }
+
+and class_field_kind =
+  Tcfk_virtual of core_type
+| Tcfk_concrete of expression
+
+and class_field_desc =
+    Tcf_inher of
+      override_flag * class_expr * string option * (string * Ident.t) list *
+        (string * Ident.t) list
+    (* Inherited instance variables and concrete methods *)
+  | Tcf_val of
+      string * string loc * mutable_flag * Ident.t * class_field_kind * bool
+        (* None = virtual, true = override *)
+  | Tcf_meth of string * string loc * private_flag * class_field_kind * bool
+  | Tcf_constr of core_type * core_type
+(*  | Tcf_let of rec_flag * (pattern * expression) list *
+              (Ident.t * string loc * expression) list *)
+  | Tcf_init of expression
+
+(* Value expressions for the module language *)
+
+and module_expr =
+  { mod_desc: module_expr_desc;
+    mod_loc: Location.t;
+    mod_type: Types.module_type;
+    mod_env: Env.t }
+
+and module_type_constraint =
+  Tmodtype_implicit
+| Tmodtype_explicit of module_type
+
+and module_expr_desc =
+    Tmod_ident of Path.t * Longident.t loc
+  | Tmod_structure of structure
+  | Tmod_functor of Ident.t * string loc * module_type * module_expr
+  | Tmod_apply of module_expr * module_expr * module_coercion
+  | Tmod_constraint of
+      module_expr * Types.module_type * module_type_constraint * module_coercion
+  | Tmod_unpack of expression * Types.module_type
+
+and structure = {
+  str_items : structure_item list;
+  str_type : Types.signature;
+  str_final_env : Env.t;
+}
+
+and structure_item =
+  { str_desc : structure_item_desc;
+    str_loc : Location.t;
+    str_env : Env.t
+  }
+
+and structure_item_desc =
+    Tstr_eval of expression
+  | Tstr_value of rec_flag * (pattern * expression) list
+  | Tstr_primitive of Ident.t * string loc * value_description
+  | Tstr_type of (Ident.t * string loc * type_declaration) list
+  | Tstr_exception of Ident.t * string loc * exception_declaration
+  | Tstr_exn_rebind of Ident.t * string loc * Path.t * Longident.t loc
+  | Tstr_module of Ident.t * string loc * module_expr
+  | Tstr_recmodule of (Ident.t * string loc * module_type * module_expr) list
+  | Tstr_modtype of Ident.t * string loc * module_type
+  | Tstr_open of Path.t * Longident.t loc
+  | Tstr_class of (class_declaration * string list * virtual_flag) list
+  | Tstr_class_type of (Ident.t * string loc * class_type_declaration) list
+  | Tstr_include of module_expr * Ident.t list
+
+and module_coercion =
+    Tcoerce_none
+  | Tcoerce_structure of (int * module_coercion) list
+  | Tcoerce_functor of module_coercion * module_coercion
+  | Tcoerce_primitive of Primitive.description
+
+and module_type =
+  { mty_desc: module_type_desc;
+    mty_type : Types.module_type;
+    mty_env : Env.t; (* BINANNOT ADDED *)
+    mty_loc: Location.t }
+
+and module_type_desc =
+    Tmty_ident of Path.t * Longident.t loc
+  | Tmty_signature of signature
+  | Tmty_functor of Ident.t * string loc * module_type * module_type
+  | Tmty_with of module_type * (Path.t * Longident.t loc * with_constraint) list
+  | Tmty_typeof of module_expr
+
+and signature = {
+  sig_items : signature_item list;
+  sig_type : Types.signature;
+  sig_final_env : Env.t;
+}
+
+and signature_item =
+  { sig_desc: signature_item_desc;
+    sig_env : Env.t; (* BINANNOT ADDED *)
+    sig_loc: Location.t }
+
+and signature_item_desc =
+    Tsig_value of Ident.t * string loc * value_description
+  | Tsig_type of (Ident.t * string loc * type_declaration) list
+  | Tsig_exception of Ident.t * string loc * exception_declaration
+  | Tsig_module of Ident.t * string loc * module_type
+  | Tsig_recmodule of (Ident.t * string loc * module_type) list
+  | Tsig_modtype of Ident.t * string loc * modtype_declaration
+  | Tsig_open of Path.t * Longident.t loc
+  | Tsig_include of module_type * Types.signature
+  | Tsig_class of class_description list
+  | Tsig_class_type of class_type_declaration list
+
+and modtype_declaration =
+    Tmodtype_abstract
+  | Tmodtype_manifest of module_type
+
+and with_constraint =
+    Twith_type of type_declaration
+  | Twith_module of Path.t * Longident.t loc
+  | Twith_typesubst of type_declaration
+  | Twith_modsubst of Path.t * Longident.t loc
+
+and core_type =
+(* mutable because of [Typeclass.declare_method] *)
+  { mutable ctyp_desc : core_type_desc;
+    mutable ctyp_type : type_expr;
+    ctyp_env : Env.t; (* BINANNOT ADDED *)
+    ctyp_loc : Location.t }
+
+and core_type_desc =
+    Ttyp_any
+  | Ttyp_var of string
+  | Ttyp_arrow of label * core_type * core_type
+  | Ttyp_tuple of core_type list
+  | Ttyp_constr of Path.t * Longident.t loc * core_type list
+  | Ttyp_object of core_field_type list
+  | Ttyp_class of Path.t * Longident.t loc * core_type list * label list
+  | Ttyp_alias of core_type * string
+  | Ttyp_variant of row_field list * bool * label list option
+  | Ttyp_poly of string list * core_type
+  | Ttyp_package of package_type
+
+and package_type = {
+  pack_name : Path.t;
+  pack_fields : (Longident.t loc * core_type) list;
+  pack_type : Types.module_type;
+  pack_txt : Longident.t loc;
+}
+
+and core_field_type =
+  { field_desc: core_field_desc;
+    field_loc: Location.t }
+
+and core_field_desc =
+    Tcfield of string * core_type
+  | Tcfield_var
+
+and row_field =
+    Ttag of label * bool * core_type list
+  | Tinherit of core_type
+
+and value_description =
+  { val_desc : core_type;
+    val_val : Types.value_description;
+    val_prim : string list;
+    val_loc : Location.t;
+    }
+
+and type_declaration =
+  { typ_params: string loc option list;
+    typ_type : Types.type_declaration;
+    typ_cstrs: (core_type * core_type * Location.t) list;
+    typ_kind: type_kind;
+    typ_private: private_flag;
+    typ_manifest: core_type option;
+    typ_variance: (bool * bool) list;
+    typ_loc: Location.t }
+
+and type_kind =
+    Ttype_abstract
+  | Ttype_variant of (Ident.t * string loc * core_type list * Location.t) list
+  | Ttype_record of
+      (Ident.t * string loc * mutable_flag * core_type * Location.t) list
+
+and exception_declaration =
+  { exn_params : core_type list;
+    exn_exn : Types.exception_declaration;
+    exn_loc : Location.t }
+
+and class_type =
+  { cltyp_desc: class_type_desc;
+    cltyp_type : Types.class_type;
+    cltyp_env : Env.t; (* BINANNOT ADDED *)
+    cltyp_loc: Location.t }
+
+and class_type_desc =
+    Tcty_constr of Path.t * Longident.t loc * core_type list
+  | Tcty_signature of class_signature
+  | Tcty_fun of label * core_type * class_type
+
+and class_signature = {
+    csig_self : core_type;
+    csig_fields : class_type_field list;
+    csig_type : Types.class_signature;
+    csig_loc : Location.t;
+  }
+
+and class_type_field = {
+    ctf_desc : class_type_field_desc;
+    ctf_loc : Location.t;
+  }
+
+and class_type_field_desc =
+    Tctf_inher of class_type
+  | Tctf_val of (string * mutable_flag * virtual_flag * core_type)
+  | Tctf_virt  of (string * private_flag * core_type)
+  | Tctf_meth  of (string * private_flag * core_type)
+  | Tctf_cstr  of (core_type * core_type)
+
+and class_declaration =
+  class_expr class_infos
+
+and class_description =
+  class_type class_infos
+
+and class_type_declaration =
+  class_type class_infos
+
+and 'a class_infos =
+  { ci_virt: virtual_flag;
+    ci_params: string loc list * Location.t;
+    ci_id_name : string loc;
+    ci_id_class: Ident.t;
+    ci_id_class_type : Ident.t;
+    ci_id_object : Ident.t;
+    ci_id_typesharp : Ident.t;
+    ci_expr: 'a;
+    ci_decl: Types.class_declaration;
+    ci_type_decl : Types.class_type_declaration;
+    ci_variance: (bool * bool) list;
+    ci_loc: Location.t }
+
+*)
+
     end
   end
 
     List.map (fun v -> k,v) vs @ st) recorded []
 
   let record_structure str = 
-    Hashtbl.clear recorded;
-    let o = new Record.fold in
-    ignore (o#structure str);
-    get_recorded ()
+    protect' "Spot.Annot.record_structure" (fun () ->
+      Hashtbl.clear recorded;
+      let o = new Record.fold in
+      ignore (o#structure str);
+      get_recorded ())
+      ()
 
   let record_signature sg = 
-    Hashtbl.clear recorded;
-    let o = new Record.fold in
-    ignore (o#signature sg);
-    get_recorded ()
+    protect' "Spot.Annot.record_signature" (fun () ->
+      Hashtbl.clear recorded;
+      let o = new Record.fold in
+      ignore (o#signature sg);
+      get_recorded ())
+      ()
 
   let string_of_at = function
     | `Expr -> "Expr"
     [ "--version", 
       Arg.Unit print_version, " : print version information";
 
-      "-version", 
-      Arg.Unit print_version, " : (deprecated)";
-
       "-n", 
       Arg.Set no_definition_analysis, " : no definition analysis";
 
       "--debug", 
       Arg.Set Debug.on, " : print debug information";
 
-      "-debug", 
-      Arg.Set Debug.on, " : (deprecated)";
-
       "--dump-file", 
       Arg.Set dump_file, " : dump spot file"; 
 
   flat           : Abstraction.structure;
   top            : Abstraction.structure;
   id_def_regions : (Ident.t, Region.t) Hashtbl.t;
+  rannots        : Annot.t Regioned.t list;
+  tree           : Tree.t lazy_t
 }
 
 let source_path_of_cmt file = match file.cmt_sourcefile with 
       | Abstraction.AMod_structure str -> str, loc_annots
       | _ -> assert false
       end
-  | Partial_implementation _parts | Partial_interface _parts ->
-      assert false
+  | Partial_implementation _parts | Partial_interface _parts -> assert false
   | _ -> assert false
 
+let abstraction_of_cmt cmt = 
+  try abstraction_of_cmt cmt with e -> 
+    Format.eprintf "AXXX %s@." (Printexc.to_string e);
+    raise e
+
 module Make(Spotconfig : Spotconfig_intf.S) = struct
   open Abstraction
 
       Debug.format "cmt loading from %s@." path;
       match load_cmt_file path with
       | Some cmt -> 
+          Debug.format "cmt loaded from %s@." path;
+          Debug.format "cmt loaded now extracting things from %s ...@." path;
           let str, loc_annots = abstraction_of_cmt cmt in
+          Debug.format "cmt loaded: abstraction extracted from %s@." path;
           let path = source_path_of_cmt cmt in
+          let rannots = List.map (fun (loc, annot) -> 
+            { Regioned.region = Region.of_parsing loc;  value = annot }) loc_annots
+          in
+          Debug.format "cmt loaded: rannots created from %s@." path;
+          let id_def_regions_list = 
+              List.filter_map (fun (loc, annot) -> match annot with
+              | Annot.Str sitem ->
+                  begin match Abstraction.ident_of_structure_item sitem with
+                  | None -> None
+                  | Some (_kind, id) -> 
+                      Some (id, Region.of_parsing loc)
+                  end
+              | _ -> None) loc_annots
+          in
+          let id_def_regions = Hashtbl.of_list 1023 id_def_regions_list in
+          Debug.format "cmt loaded: id_def_regions created from %s@." path;
+          let tree = lazy begin
+            List.fold_left Tree.add Tree.empty rannots
+          end in
+          let flat = Spot.Abstraction.flatten str in
+          Debug.format "cmt loaded: flat created from %s@." path;
+          Debug.format "cmt analysis done from %s@." path;
           { cmt; path;
             top = str;
-            flat = Spot.Abstraction.flatten str;
-            id_def_regions = 
-              Hashtbl.of_list 1023 begin
-                List.filter_map (fun (loc, annot) -> match annot with
-                | Annot.Str sitem ->
-                    begin match Abstraction.ident_of_structure_item sitem with
-                    | None -> None
-                    | Some (_kind, id) -> 
-                        Some (id, Region.of_parsing loc)
-                    end
-                | _ -> None) loc_annots
-              end
+            flat;
+            id_def_regions;
+            rannots;
+            tree;
           }
       | None -> failwith (sprintf "load_directly failed: %s" path)
 
   flat           : Abstraction.structure;
   top            : Abstraction.structure;
   id_def_regions : (Ident.t, Region.t) Utils.Hashtbl.t;
+  rannots        : Annot.t Regioned.t list;
+  tree           : Tree.t lazy_t
 }
 
 val source_path_of_cmt : cmt_infos -> string
-dummy.cmi :
-test001.cmo :
-test001.cmx :
-dir/dummy.cmo :
-dir/dummy.cmx :
+bigmodtest.cmi: target.cmo
+class.cmi:
+class2.cmi:
+open_in_mli.cmi: target.cmo
+siginclude.cmi:
+siginclude2.cmi:
+signature2.cmi:
+test15.cmi:
+applied_sig.cmo:
+applied_sig.cmx:
+bug_private_row.cmo:
+bug_private_row.cmx:
+capital_idents.cmo:
+capital_idents.cmx:
+capital_idents_include.cmo: capital_idents.cmo
+capital_idents_include.cmx: capital_idents.cmx
+class.cmo: class.cmi
+class.cmx: class.cmi
+exception.cmo: target.cmo
+exception.cmx: target.cmx
+external.cmo: target.cmo
+external.cmx: target.cmx
+external_include.cmo:
+external_include.cmx:
+fstclassmodule.cmo:
+fstclassmodule.cmx:
+functor.cmo:
+functor.cmx:
+functor_parameter.cmo:
+functor_parameter.cmx:
+immediate_include.cmo:
+immediate_include.cmx:
+include.cmo:
+include.cmx:
+include_functor_app.cmo:
+include_functor_app.cmx:
+include_override.cmo:
+include_override.cmx:
+included_and_flat.cmo:
+included_and_flat.cmx:
+inherit.cmo:
+inherit.cmx:
+inherit2.cmo:
+inherit2.cmx:
+interface.cmo:
+interface.cmx:
+intermodule.cmo:
+intermodule.cmx:
+localvar.cmo:
+localvar.cmx:
+module.cmo:
+module.cmx:
+module_alias.cmo:
+module_alias.cmx:
+module_alias_ext.cmo: module_alias.cmo
+module_alias_ext.cmx: module_alias.cmx
+module_and_modtype.cmo:
+module_and_modtype.cmx:
+module_and_modtype2.cmo: module_and_modtype.cmo
+module_and_modtype2.cmx: module_and_modtype.cmx
+module_type.cmo:
+module_type.cmx:
+module_use.cmo:
+module_use.cmx:
+multiple_definition.cmo:
+multiple_definition.cmx:
+object.cmo:
+object.cmx:
+ocaml312.cmo:
+ocaml312.cmx:
+open.cmo: target.cmo
+open.cmx: target.cmx
+open_pack.cmo: packed.cmo
+open_pack.cmx: packed.cmx
+override_x.cmo:
+override_x.cmx:
+packed.cmo:
+packed.cmx:
+packed_alias.cmo:
+packed_alias.cmx:
+pathname.cmo:
+pathname.cmx:
+perv.cmo:
+perv.cmx:
+primitive.cmo:
+primitive.cmx:
+recmodule.cmo:
+recmodule.cmx:
+record.cmo:
+record.cmx:
+self.cmo:
+self.cmx:
+set_field.cmo:
+set_field.cmx:
+signature.cmo:
+signature.cmx:
+subpath.cmo:
+subpath.cmx:
+target.cmo:
+target.cmx:
+test.cmo:
+test.cmx:
+test1.cmo:
+test1.cmx:
+test10.cmo:
+test10.cmx:
+test11.cmo: test10.cmo
+test11.cmx: test10.cmx
+test12.cmo: test10.cmo test.cmo
+test12.cmx: test10.cmx test.cmx
+test13.cmo:
+test13.cmx:
+test14.cmo:
+test14.cmx:
+test16.cmo: test15.cmi
+test16.cmx: test15.cmi
+test17.cmo:
+test17.cmx:
+test18.cmo:
+test18.cmx:
+test19.cmo:
+test19.cmx:
+test24.cmo:
+test24.cmx:
+test3.cmo:
+test3.cmx:
+test5.cmo: dir1/test4.cmo
+test5.cmx: dir1/test4.cmx
+test7.cmo:
+test7.cmx:
+test8.cmo: test7.cmo
+test8.cmx: test7.cmx
+test9.cmo: test7.cmo
+test9.cmx: test7.cmx
+twotypes.cmo:
+twotypes.cmx:
+type_def.cmo:
+type_def.cmx:
+types_in_type_def.cmo: type_def.cmo
+types_in_type_def.cmx: type_def.cmx
+use_record.cmo: record.cmo
+use_record.cmx: record.cmx
+utf8.cmo:
+utf8.cmx:
+variant.cmo:
+variant.cmx:
+variant_external.cmo: variant.cmo
+variant_external.cmx: variant.cmx
+with_type.cmo:
+with_type.cmx:
+with_type2.cmo:
+with_type2.cmx:
+dir1/test4.cmo: test.cmo
+dir1/test4.cmx: test.cmx
+dir2/test6.cmo: test5.cmo
+dir2/test6.cmx: test5.cmx
-OCAMLC   = ocamlc -bin-annot -annot
-OCAMLOPT = ocamlopt -bin-annot -annot
+# include ../../config/Makefile
+
+# Various commands and dir
+##########################
+OCAMLC   = ocamlc -annot -bin-annot
+OCAMLOPT = ocamlopt -annot -bin-annot
 OCAMLDEP = ocamldep
 OCAMLLEX = ocamllex
 OCAMLYACC= ocamlyacc
+OCAMLLIB = $(LIBDIR)
+OCAMLBIN = $(BINDIR)
+
+# Compilation
+#############
+OCAMLSRCDIR=..
+INCLUDES_DEP=-I $(OCAMLSRCDIR)/parsing \
+	-I $(OCAMLSRCDIR)/utils \
+	-I $(OCAMLSRCDIR)/typing \
+	-I $(OCAMLSRCDIR)/driver \
+	-I $(OCAMLSRCDIR)/bytecomp \
+	-I $(OCAMLSRCDIR)/tools \
+	-I $(OCAMLSRCDIR)/toplevel/ \
+	-I dir1 -I dir2
+
+OTHERS=../../otherlibs
 
 # Requires unix!
 COMPFLAGS= $(INCLUDES_DEP) -I $(OTHERS)/unix
 beforedepend::
 
 depend: beforedepend
-	$(OCAMLDEP) $(INCLUDES) -I dir *.mli *.ml */*.mli */*.ml > .depend
-
-#	$(OCAMLDEP) $(INCLUDES) -I dir1 -I dir2 *.mli *.ml */*.mli */*.ml > .depend
+	$(CAMLRUN) ../../tools/ocamldep $(INCLUDES) -I dir1 -I dir2 *.mli *.ml */*.mli */*.ml > .depend
 
 Makefile.targets: *.ml *.mli */*.ml
 	echo TARGETS= \\ > $@

tests/Makefile.targets

 TARGETS= \
-dummy.cmi \
-test001.cmo \
-test002.cmo \
-test003_include.cmo \
+applied_sig.cmo \
+bigmodtest.cmi \
+bug_private_row.cmo \
+capital_idents.cmo \
+capital_idents_include.cmo \
+class.cmo \
+class.cmi \
+class2.cmi \
+exception.cmo \
+external.cmo \
+external_include.cmo \
+fstclassmodule.cmo \
+fstclassmodule2.cmo \
+functor.cmo \
+functor_parameter.cmo \
+immediate_include.cmo \
+include.cmo \
+include_functor_app.cmo \
+include_override.cmo \
+included_and_flat.cmo \
+inherit.cmo \
+inherit2.cmo \
+interface.cmo \
+intermodule.cmo \
+localvar.cmo \
+module.cmo \
+module_alias.cmo \
+module_alias_ext.cmo \
+module_and_modtype.cmo \
+module_and_modtype2.cmo \
+module_type.cmo \
+module_use.cmo \
+multiple_definition.cmo \
+object.cmo \
+ocaml312.cmo \
+open.cmo \
+open_in_mli.cmi \
+open_pack.cmo \
+override_x.cmo \
+packed.cmo \
+packed_alias.cmo \
+pathname.cmo \
+perv.cmo \
+primitive.cmo \
+recmodule.cmo \
+record.cmo \
+self.cmo \
+set_field.cmo \
+siginclude.cmi \
+siginclude2.cmi \
+signature.cmo \
+signature2.cmi \
+subpath.cmo \
+target.cmo \
+test.cmo \
+test1.cmo \
+test10.cmo \
+test11.cmo \
+test12.cmo \
+test13.cmo \
+test14.cmo \
+test15.cmi \
+test16.cmo \
+test17.cmo \
+test18.cmo \
+test19.cmo \
+test24.cmo \
+test3.cmo \
+test5.cmo \
+test7.cmo \
+test8.cmo \
+test9.cmo \
+twotypes.cmo \
+type_def.cmo \
+types_in_type_def.cmo \
+use_record.cmo \
+utf8.cmo \
+variant.cmo \
+variant_external.cmo \
+with_type.cmo \
+with_type2.cmo \

tests/applied_sig.ml

+module M(A : sig type t end) = struct
+  let _ = prerr_endline "M(A)"
+  (* M(A).S => *)
+  module type S = sig
+    type t = A.t list
+  end
+  (* <= M(A).S *)
+end
+
+module A = struct type t = int end
+
+(*
+module MA = M(A)
+
+module N0 : MA.S = struct
+  type t = int list
+end
+*)
+
+module N1 : M(A).S (* ? M(A).S *) = struct
+  type t = int list
+end
+
+(*
+module N2 : M(struct type t = int end).S = struct
+  type t = int list
+end
+*)
+

tests/auto-test.pl

+#!/usr/bin/perl
+
+sub load_file {
+    my $file = $_[0];
+    open(INF, $file);
+    my $content = "";
+    while(<INF>){
+	$content = "$content$_";
+    }
+    close INF;
+    return $content;
+}
+
+sub check_file_head {
+    my $file = $_[0];
+    open(INH, $file);
+    my $head = <INH>;
+    close INH;
+    if( $head =~ /\(\*\s*([^\*]+)\s*\*\)/ ){
+        my $result = $1;
+        $result =~ s/^\s+//;
+        $result =~ s/\s+$//;
+        return $result;
+    }
+    return "none";
+}
+
+sub check_result {
+    my $file = $_[0];
+    my $start = $_[1];
+    my $end = $_[2];
+    my $content = load_file($file);
+
+    my $match = substr ($content, $start, $end - $start);
+    # print STDERR "MATCH=/$match/\n";
+
+    # print STDERR "PREFIX: $prefix/\n";
+    my $prefix = substr($content, 0, $start);
+
+    # fix the prefix for type >>>(* xxx => *) ... <<<
+    if( $match =~ /^\s*\(\*[^\*]+=>\s*\*\)/ ){
+	$prefix = "$prefix$&";
+    }
+
+    my $test_prefix = "";
+    if( $prefix =~ /\(\*\s*([^\*]+)=>\s*\*\)\s*$/ ){
+	$test_prefix = $1;
+	$test_prefix =~ s/^\s*//;
+	$test_prefix =~ s/\s*$//;
+	# print "PREFIX $test_prefix found\n";
+    }
+
+    my $postfix = substr($content, $end, length($content) - $end - 1);
+    my $test_postfix = "";
+    if( $postfix =~ /^\s*\(\* <=([^\*]+)\*\)/ ){
+	$test_postfix = $1;
+	$test_postfix =~ s/^\s*//;
+	$test_postfix =~ s/\s*$//;
+	# print "POSTFIX $test_postfix found\n";
+    }
+
+    if( $test_prefix eq $test_postfix ){ return $test_prefix; }
+    else { 
+	$message = "pre/post=/$test_prefix/$test_postfix/\n";
+	return ""; 
+    }
+}
+
+my $all_tests = 0;
+my $all_succeeds = 0;
+
+sub test {
+    my $file = $_[0];
+    my $content = load_file($file);
+    print STDER "$file loaded\n";
+    my $pos = 0;
+    while( $content =~ /\s*\(\*\s*\?\s*([^\*]+)\*\)/ ){
+	$pos += length($`);
+	my $test_name = $1;
+	my $test_pos = $pos - 1;
+	$content = $'; #'
+	$pos = $pos + length($&);
+
+	$test_name =~ s/^\s*//;
+	$test_name =~ s/\s*$//;
+
+	if( $test_name eq "" ) { next; }
+
+	my $message = "* $test_name: ocamlspot $file:$test_pos\n";
+
+	my $tested = 0;
+	my $succeed = 0;
+	if( -x "ocamlspot" ){
+	    $command = "./ocamlspot $file:b$test_pos";
+	} elsif( -x "../ocamlspot" )  {
+	    $command = "../ocamlspot $file:b$test_pos";
+	} else {
+	    print "no ocamlspot binary around\n";
+	    exit 1;
+	}
+
+	print STDERR "$command\n";
+	open(IN, "$command |");
+
+	$all_tests++;
+
+	while(<IN>){
+            my $result;
+            if( /^Spot: <(.*):all>/ ){ # whole file
+                $tested = 1;
+                $message = "$message$&\n";
+                $result = check_file_head($1);
+            }
+	    if( /^Spot: <(.*):l[0-9]+c[0-9]+b([0-9]+):l[0-9]+c[0-9]+b([0-9]+)>$/ ){
+		$tested = 1;
+		$message = "$message$&\n";
+		$result = check_result($1, $2, $3);
+            }
+            if( $tested ){
+                if( $test_name eq $result ){
+                    print STDERR "$file:$test_pos:$test_name:\tOK!\n";
+                    $succeed = 1;
+		    $all_succeeds ++;
+                } else {
+                    print STDERR "$file:$test_pos:$test_name:\tFAILED!\n$message\{ test_name=\"$test_name\"; result=\"$result\" \}\n";
+                }
+                last;
+            }
+	}
+	while(<IN>){} # avoid Broken pipe
+	close IN;
+	if( ! $tested ){
+	    if( $test_name =~ /impos/ ){ # This is not a bug. Known impossible.
+		print STDERR "$file:$test_pos:$test_name:\tnot found, but a known issue\n";
+		$all_succeeds ++;
+	    } else {
+		print STDERR "$file:$test_pos:$test_name:\tNOT FOUND!\n";
+	    }
+	}
+    }
+}
+
+for $f (@ARGV) {
+    test($f);
+}
+
+$ratio = $all_succeeds/$all_tests;
+printf "successes/tests = $all_succeeds/$all_tests = %.02f\n", $ratio;
+if( $ratio == 1.0  ){
+    print "Looks ok\n"; 
+    exit 0;
+} else {
+    print "Some tests failed!\n"; 
+    exit 1;
+}
+
+  

tests/bigmodtest.mli

+(*
+        | Psig_value(name, sdesc) ->
+        | Psig_type sdecls ->
+        | Psig_exception(name, sarg) ->
+        | Psig_module(name, smty) ->
+        | Psig_recmodule sdecls ->
+        | Psig_modtype(name, sinfo) ->
+        | Psig_open lid ->
+        | Psig_include smty ->
+        | Psig_class cl ->
+        | Psig_class_type cl ->
+*)
+
+(* M0 => *)
+module M0 : sig
+  val v : int
+  type   (* t => *) t (* <= t *) 
+  exception E
+  module M : sig end
+  module rec MR : sig end
+
+  (* MT => *) module type MT = sig 
+    type (* s => *) s (* <= s *) 
+  end (* <= MT *)
+
+  open Target (* ? Target *)
+  include MT (* ? MT *)
+  class (* c => *) c : object end (* <= c *)
+  class type (* ct => *) ct = object end (* <= ct *)
+end
+(* <= M0 *)
+
+module Test : sig
+  open M0 (* ? M0 *)
+  type t = M0.t (* ? t *)
+  module M : MT (* ? MT *)
+  class c : M0.c (* ? c *)
+  class type ct = M0.ct (* ? ct *)
+  type s = M0.s (* ? s *) 
+end

tests/bug_private_row.ml

+type t = private [< `foo | `bar > `bar ]

tests/capital_idents.ml

+let z = 1
+
+type (* constr E => *) t = E (* <= constr E *)
+
+(* module E => *) module E = struct let (* E.x => *) x (* <= E.x *) = 1 end (* <= module E *) 
+
+(* modtype E => *) module type E = sig val x : int end (* <= modtype E *) 
+
+let _ = E (* ? constr E *)
+
+(* exception E => *) exception E (* <= exception E *)
+
+let _ = raise E (* ? exception E *)
+
+let _ = E.x (* ? E.x *)
+
+(* module M => *)
+module M : E (* ? modtype E *) = struct
+  let x = 1
+end
+(* <= module M *)

tests/capital_idents_include.ml

+include Capital_idents
+
+let _ = (E (* ? exception E *) : exn)
+
+module E2 = E (* ? module E *)
+
+module N : E (* ? modtype E *) = M (* ? module M *)
+
+type u = t (* ? constr E *)
+class (* class c => *) c =  (* CR: pos can be improved *)
+  let (* x => *) x (* <= x *) = 1 in
+  let (* y => *) y (* <= y *) = x (* ? x *) in
+  object
+    val x = x (* ? x *)
+    val y = y (* ? y *)
+    val (* vx => *) vx = 1 (* <= vx *) (* CR: pos can be improved *)
+    method m = vx (* ? vx *)
+end (* <= class c *)
+
+let v = new c (* ? class c *)
+;;
+
+class (* c => *) 
+  c : object val vx : int val x : int val y : int method m : int end
+(* <= c *)
+val v : c (* ? c *)
+module M0 : sig
+  class (* M0.c => *) c : object end (* <= M0.c *)
+end
+(* <= M0 *)
+
+module Test : sig
+  val v : M0.c (* ? M0.c *)
+  class type (* ct => *) ct = M0.c (* <= ct *)
+  class type ct' = M0.c (* ? M0.c *) 
+  val z : ct (* ? ct *)
+end

tests/dir/dummy.ml

Empty file removed.

tests/dir1/test4.ml

+let _ = Test.foo (* ? foo *)
+let _ = Test.O.bar2 (* ? F.bar2 *)
+
+include Test
+
+let _ = foo (* ? foo *)
+
+let (* in_test4 => *) in_test4 (* <= in_test4 *) = 1

tests/dir2/test6.ml

+include Test5
+let _ = foo (* ? foo *) (* to foo of test.ml *)
+let _ = Test5.in_test4 (* ? in_test4 *)
+

tests/dummy.mli

Empty file removed.

tests/exception.ml

+(* E => *) exception E (* <= E *)
+let _ = raise E (* ? E *)
+
+let _ = try raise E (* ? E *) with
+  | E (* ? E *) -> assert false
+  | Target.E (* ? Target.E *) -> assert false
+
+exception X = E (* ? E *) (* bug 090818 *)
+
+module M = struct
+  (* EE => *) exception EE (* <= EE *)
+end
+
+let _ = raise M.EE (* ? EE *)
+let _ = raise (Failure "x") (* predefind *)

tests/external.ml

+external ext : int -> int = "ext"
+
+let _ = ext
+let _ = Target.external_value
+

tests/external_include.ml

+module M = struct
+  external ext : int -> int = "hogehoge"
+end
+
+module N = struct
+  external ext : int -> int = "hagehage"
+end
+
+include M
+
+let ext = ext
+
+include N
+
+let ext = ext

tests/fstclassmodule.ml

+(* S => *)
+module type S = sig
+  type t
+  val x : t list
+end
+(* <= S *)
+
+(* M => *)
+module M : S (* ? S *) with type t = int = struct
+  type t = int
+  let x = [1]
+end
+(* <= M *)
+
+let (* m => *) m (* <= m *) = (module M (* ? M *) : S (* ? S *) with type t = int)
+module M' = (val m (* ? m *) : S (* ? S *) with type t = int)

tests/fstclassmodule2.ml

+module type ASig = sig (* B.f => *) val f : int -> int (* <= B.f *) end
+module A = struct let f x = x + 1 end
+let x = (module A : ASig)
+let y = 
+  let module B = (val x : ASig) in
+  B.f (* ? B.f *) 1
+module F (A : sig val x : int end) = struct
+  let y = A.x
+end
+
+module M = struct let x = 1 end
+
+module N = F(M)
+
+let _ = N.y

tests/functor_parameter.ml

+module F(A : (* A => *) sig val x : int end (* <= A *)) = struct
+  let y = A.x (* ? A *)
+end

tests/immediate_include.ml

+include struct let (* x => *) x (* <= x *) = 1 end
+
+let _ = x (* ? x *)
+include List
+let _ = length
+

tests/include_functor_app.ml

+(* F => *)
+module F(A : sig end) = struct
+  let (* x => *) x (* <= x *) = 1
+end
+(* <= F *)
+
+module M = struct
+  include F (* ? F *) (struct end)
+  let _ = x (* ? x *)
+end
+
+let _ = M.x (* ? x *)
+

tests/include_override.ml

+module Z1 : sig
+  val zx : int
+end = struct
+  let (* Z1.zx => *) zx (* <= Z1.zx *) = 1
+  let zy = 2
+end
+
+module Z2 = struct
+  let zx = 2
+  let (* Z2.zy => *) zy (* <= Z2.zy *) = 3
+  include Z1
+end
+
+let _ = Z2.zx (* ? Z1.zx *) (* fixed bug : did not point to zx in Z1 *)
+let _ = Z2.zy (* ? Z2.zy *)

tests/included_and_flat.ml

+module M = struct
+  type t
+  let x = 1
+end
+
+include M
+
+module N = struct
+  include M
+end
+class (* c => *) c = object
+  val (* x => *) x = 1 (* <= x *)
+end (* <= c *)
+
+class nc = object
+  inherit let _x = 1 in c (* ? c *)
+  val y = 1
+  method m = x
+end
+
+class nnc = object
+  inherit (* nc => *) let _y = 1 in nc (* <= nc *) (* limitation *)
+  method n = y (* ? nc *)
+end

tests/inherit2.ml

+class c x = object
+  val x = x
+end
+
+class c2 = object
+  inherit let x = 1 in c x as super
+  method m = x
+end
+

tests/interface.ml

+module M : sig 
+  exception E
+  val x : int
+end = struct
+  exception E
+  let x = 1
+  let _ = x
+end
+
+module N = struct
+  let y = 1
+end
+
+let _ = M.x
+let _ = N.y
+
+module O : sig
+  module P : sig
+    val z : int
+  end 
+end = struct
+  module P = struct
+    let z = 1
+  end
+end
+
+let _ = O.P.z

tests/intermodule.ml

+module M = struct
+  let x = 1
+end
+
+include M
+
+include Printf
+
+let y = x
+
+let z = printf

tests/localvar.ml

+let x = 1
+let y = x
+module M = struct
+
+  let x = 1
+
+end

tests/module_alias.ml

+(* M0 => *)
+module M0 = struct
+end
+(* <= M0 *)
+
+module M1 = M0 (* ? M0 *) 
+
+module M2 = M1 (* ? M0 *) (* bug 08/12/10: does not trace all the aliases *)
+

tests/module_alias_ext.ml

+open Module_alias
+
+module M3 = M2 (* ? M0 *)

tests/module_and_modtype.ml

+module O = struct
+  module M = struct end
+  (* O.M => *) module type M = sig end (* <= O.M *) 
+end
+
+module N : O.M (* ? O.M *) = struct end
+

tests/module_and_modtype2.ml

+module F(O : Module_and_modtype.O.M (* ? O.M *) ) = struct
+end

tests/module_type.ml

+(* SX => *)
+module type SX = sig
+  type (* SX.t => *) t = int (* <= SX.t *)
+end
+(* <= SX *)
+
+module type S = sig
+  module X : SX (* ? SX *)
+
+  type t = X.t (* ? SX.t *)
+end
+  

tests/module_use.ml

+(* F => *) module F (A : sig end) = struct end (* <= F *) 
+
+(* N => *) module N = struct end (* <= N *)
+
+module M = F (* ? F *) (N (* ? N *))

tests/multiple_definition.ml

+module M = struct
+  let x = 1
+  let (* M.x => *) x (* <= M.x *) = 2
+end
+
+let _ = M.x (* ? M.x *)
+class (* c0 => *) c0 = object
+  val a = 1
+  method m = a
+end 
+(* <= c0 *)
+
+class (* c => *) c ((* p => *) p (* <= p *) : int) = 
+  let (* x => *) x (* <= x *) = 1 in
+  let p' = p (* ? p *) in
+  object (* self => *)(self)(* <= self *)
+    inherit (* a => *) c0 (* <= a *)
+
+    val (* y => *) mutable y = x (* <= y *)
+    val z = x (* ? x *)
+    val p'' = p (* ? p *)
+    method f () = x (* ? x *)
+    method g () = y (* ? y *)
+    method h () = self(* ? self *)#g ()
+    method i () = a (* ? a *) (* We cannot follow into c0... *)
+    method get_p = p (* ? p *)
+    method get_p' = p'
+    initializer
+      y <- 42
+  end
+(* <= c *)
+
+let _ = 
+  let (* o => *) o (* <= o *) : c (* ? c *) = new c (* ? c *) 42 in
+  o(*? o *)#f ()
+
+let o = 
+  let (* yy => *) yy (* <= yy *) = 2 in
+object 
+  val (* xx => *) xx = 1 (* <= xx *) 
+  method get_xx = xx (* ? xx *) 
+  method get_yy = yy (* ? yy *)
+end

tests/ocaml312.ml

+(* M => *)
+module M = struct
+  type (* M.t => *) t = { foo : int } (* <= M.t *)
+  let _ = fun (* foo1 => *) foo (* <= foo1 *) -> { foo (* ? foo1 *) (* ? M.t *) }
+  let _ = fun { (* foo2 => *) foo (* <= foo2 *) (* ? M.t *) } -> foo (* ? foo2 *)
+  let (* x => *) x (* <= x *) = 1
+end
+(* <= M *)
+
+let _ = fun (* foo3 => *) foo (* <= foo3 *) -> { M.foo (* ? foo3 *) (* ? M.t *) }
+let _ = fun { (* M.foo => *) M.foo (* <= M.foo *) (* ? M.t *) } -> foo (* ? M.foo *)
+ 
+let f (type t) (x : t) = 
+  let module N = struct
+    exception E of t
+  end in
+  raise (N.E x)
+;;
+
+let f : 'a. 'a -> 'a = fun x -> x
+
+(* first class packaged modules are tested in fstclassmodule.ml *)
+
+let _ = 
+  let open M (* ? M *) (* damn, no position for M *) in
+  x (* ? x *)
+;;
+
+let _ = 
+  M. (* ? M *) (* damn, no position for M *) (x (* ? x *))
+;;
+
+(* untested 
+- method! val! inherit!
+- <signature> with type t := <typeconstr>
+  <signature> with module M := <module-path>
+*)

tests/ocamlspot.sh

+#!/bin/sh
+../../boot/ocamlrun -I ../../stdlib/ -I ../../otherlibs/unix/ ../ocamlspot $*
+(* M => *) module M = struct
+  let (* x => *) x (* <= x *) = 1
+end (* <= M *)
+
+open M (* ? M *)
+open Target (* ? Target *)
+

tests/open_in_mli.mli

+open Target (* ? Target *)
+  
+  

tests/open_pack.ml

+open Packed
+  

tests/override_x.ml

+module M = struct
+  type (* type x => *) x = Foo (* <= type x *)
+  let (* x1 => *) x (* <= x1 *) = 1
+  let y = x (* ? x1 *)
+  let (* x2 => *) x (* <= x2 *) = 2
+  let z = x (* ? x2 *)
+  let _ = Foo (* ? type x *)
+end
+
+let _ = M.x (* ? x2 *)
+let _ = M.Foo (* ? type x *)
+(* Pack.Packed *)
+let (* Packed.x => *) x (* <= Packed.x *) = 1

tests/packed_alias.ml

+module P = Pack.Packed (* ? Pack.Packed *)
+let _ = Pack.Packed.x (* ? Packed.x *)

tests/pathname.ml

+module M = struct
+  module N = struct
+    module O = struct
+      module P = struct
+	let q = 1
+      end
+    end
+  end
+end
+
+module F( M : sig end ) = struct
+  module N = struct
+    let x = 1
+  end
+end
+
+let _ = M.N.O.P.q
+let _ = (*comment*)M.(*comment*)N.O(*comment*).P.q
+
+let _ = let module FM = F(M) in FM.N.x
+let _ = output_char

tests/primitive.ml

+type t = int

tests/recmodule.ml

+module rec M : sig val f : unit -> unit end = (* M => *) struct
+
+  include N (* ? N *)
+
+  let (* M.f => *) f (* <= M.f *) () = N.g (* ? N.g *) ()
+
+end (* <= M *) and N : sig val g : unit -> unit end = (* N => *) struct
+
+  include M (* ? M *) 
+
+  let (* N.g => *) g (* <= N.g *) () = M.f (* ? M.f *) ()
+
+end (* <= N *)
+type (* t => *) t = { foo : int ; bar : float } (* <= t *)
+    
+let x = { foo (* ? t *) = 1; bar = 4.2 }
+let _ = x.foo (* ? t *)
+class c = object (* self => *) (self)  (* <= self *)
+  val x = 1
+  method m = self (* ? self *) #m + 1
+end

tests/set_field.ml

+type (* record => *) record = { mutable x : int } (* <= record *)
+
+let (* r => *) r (* <= r *) = { x = 0; } (* ? record *)
+
+let _ = r(* ? r *).x <- (* ? record *) 1 
+
+ 

tests/siginclude.mli

+module type T = sig type (* t => *) t (* <= t *) end
+
+include T
+
+type s = t (* ? t *)

tests/siginclude2.mli

+module M : sig
+  module type MT = sig type (* t => *) t (* <= t *) end
+  include MT
+  type s0 = t (* ? t *)
+end
+
+module N : sig
+  type s = M.t (* ? t *)
+end

tests/signature.ml

+module type T = sig
+  module M : sig type (* M.t => *) t = int (* <= M.t *) end
+  val f : M.t (* ? M.t *)
+end
+
+module MT = struct
+  module MM = struct type t = int end
+  let f : MM.t = 1
+end
+  

tests/signature2.mli

+(* S => *)
+module type S = sig type (* S.t => *) t (* <= S.t *) end
+(* <= S *)
+
+module M : S (* ? S *)
+
+module N : sig
+  type t = C of M.t (* ? S.t *)
+end
+
+module O : sig type (* O.t => *) t (* <= O.t *) end
+
+module P : sig
+  type t = C of O.t (* ? O.t *)
+end
+  
+module F(M : sig end) = struct
+  type (* t => *) t (* <= t *)
+end
+
+(* N => *)
+module N = struct
+end
+(* <= N *)
+
+module O = N
+
+type fnt = F(N(* ? N *)).t (* ? t *)
+(* Target *)
+
+(* Target.E => *) exception E (* <= Target.E *)
+let int = 1
+
+external external_value : int -> int = "external_value_impl"
+(* very simple one *)
+let (* foo => *) foo (* <= foo *) = 1
+let _ = foo (* ? foo *)
+
+(* from internal module *)
+
+(* M => *)
+module M = struct
+  let (* M.bar => *) bar (* <= M.bar *) = foo
+end
+(* <= M *)
+
+(* to internal module *)
+let _ = M.bar (* ? M.bar *)
+
+(* F => *)
+module F (S : sig val bar : int end) = struct
+  include S
+  let (* F.bar2 => *) bar2 (* <= F.bar2 *) = 
+    S.bar (* CR jfuruse: functor abstracted module? *)
+  let _ = bar2 (* ? F.bar2 *)
+  let _ = bar (* CR jfuruse: functor abstracted module? *)
+end
+(* <= F *)
+
+module N = F (* ? F *)(M (* ? M *))
+
+let _ = N.bar2 (* ? F.bar2 *)
+let _ = N.bar (* ? M.bar *) 
+
+include M (* ? M *)
+let _ = bar (* ? M.bar *)
+
+module O = struct
+  include F(M)
+end
+
+let _ = O.bar (* ? M.bar *)
+
+module P = struct