Commits

Anonymous committed fa41b0c

Use + closure id

Comments (0)

Files changed (7)

Binary file modified.

ocamlspot/ocamlspot.ml

 
   end
 	
+  module Use = struct
+    include Spot.Use
+	
+    let to_string = function
+      | Value -> "Value"
+      | Type -> "Type"
+      | Exception -> "Exception" 
+      | Module -> "Module"
+      | Module_type -> "Module_type"
+      | Class -> "Class"
+      | Class_type -> "Class_type"
+  end
+
   module Annot = struct
     include Spot.Annot
 
       | Str str ->
 	  Format.fprintf ppf "Str: %a"
 	    Abstraction.format_structure_item str
-      | Value_use path ->
-	  Format.fprintf ppf "Value_use: %s" (Path.name path)
-      | Type_use path ->
-	  Format.fprintf ppf "Type_use: %s" (Path.name path)
+      | Use (use, path) ->
+	  Format.fprintf ppf "Use(%s, %s)" (Use.to_string use) (Path.name path)
       | Module _todo ->
 	  Format.fprintf ppf "Module: (...)" 
       | Non_expansive b ->
           Format.fprintf ppf "Non_expansive: %b" b
 
-    let dummy = Value_use (Path.Pident (Ident.create_persistent "dummy"))
+    let dummy = Use (Use.Value, Path.Pident (Ident.create_persistent "dummy"))
   end 
 
   module LAnnot = struct
         | Type_ident of PIdent.t
         | Structure of PIdent.t option * structure
         | Parameter of PIdent.t
-        | Closure of env * Ident.t * Abstraction.module_expr
+        | Closure of PIdent.t * env * Ident.t * Abstraction.module_expr
         | Error of exn
 
     and env = {
 	    format_str str
       | Structure (None, str) ->
 	  format_str ppf str
-      | Closure (_, id, module_expr) ->
-	  Format.fprintf ppf "(@[<2>fun %s ->@ @[%a@]@])" 
+      | Closure (pid, _, id, module_expr) ->
+	  Format.fprintf ppf "(@[<2>(%a =)fun %s ->@ @[%a@]@])" 
+	    PIdent.format pid
 	    (Ident.name id)
 	    Abstraction.format_module_expr module_expr
       | Error exn -> Format.fprintf ppf "ERROR(%s)" (Printexc.to_string exn)
             Structure (Some { PIdent.path= env.path;
 			      ident = idopt }, str)
           end
-      | Mod_functor (id, mexp) -> eager (Closure (env, id, mexp))
+      | Mod_functor (id, mexp) -> 
+	  eager (Closure ({ PIdent.path = env.path;
+			    ident = idopt }, env, id, mexp))
       | Mod_constraint (mexp, _mty) -> 
           (* [_mty] may not be a simple signature but an ident which is
              hard to get its definition at this point. 
 	  | Structure _ -> assert false
           | Parameter _ -> Error (Failure "parameterized")
           | Error exn -> Error exn
-	  | Closure (env, id, mexp) -> 
+	  | Closure (_, env, id, mexp) -> 
               !!(module_expr { env with structure = ((id, v2) ^:: env.Env.structure) } None(*?*) mexp)
           end
 
 	    match annot with
 	    | Annot.Str sitem -> sitem :: st
 	    | Annot.Type _ 
-            | Annot.Value_use _ 
-	    | Annot.Type_use _ 
+            | Annot.Use _
 	    | Annot.Module _ 
 	    | Annot.Non_expansive _ -> st ) [] annots
         in
         | Value.Structure (Some id, _)  -> id, find_loc id
         | Value.Structure (None, _) -> Format.eprintf "it is an unnamed structure@."; assert false
         | Value.Parameter _ -> Format.eprintf "it is in a parameter@."; assert false
-        | Value.Closure _ -> Format.eprintf "it is a closure@."; assert false
+        | Value.Closure (id, _, _, _) -> id, find_loc id
         | Value.Error exn -> Format.eprintf "Error %s@." (Printexc.to_string exn); assert false
       in
 
 	List.iter (fun annot -> 
 	  Format.printf "%a;@." Spot.Annot.format annot) annots;
 	List.iter (function
-	  | Spot.Annot.Value_use path 
-	  | Spot.Annot.Type_use path 
-	  | Spot.Annot.Module (Spot.Abstraction.Mod_ident path) ->
+	  | Spot.Annot.Use (_, path) ->
 	      begin try 
-		  let pident, loc = Spot.File.find_path_in_flat file path in
-		  Format.printf "Spot: %s:%s@."
-                    pident.Spot.PIdent.path
-		    (Location.to_string loc)
+		let pident, loc = Spot.File.find_path_in_flat file path in
+		Format.printf "Spot: %s:%s@."
+                  pident.Spot.PIdent.path
+		  (Location.to_string loc)
 	      with
 	      | Not_found ->
 		  Format.printf "Spot: no spot@."  
     | Tsig_cltype (id, _, _) -> Str_cltype id
 end
 
+module Use = struct
+  type t = 
+    | Value | Type | Exception 
+    | Module | Module_type 
+    | Class | Class_type
+end
+
 module Annot = struct
   type t =
     | Type of Types.type_expr (* sub-expression's type *)
     | Str of Abstraction.structure_item 
-    | Value_use of Path.t
-    | Type_use of Path.t
+    | Use of Use.t * Path.t
     | Module of Abstraction.module_expr
     | Non_expansive of bool
 
   val signature_item : Types.signature_item -> structure_item
 end
 
+module Use : sig
+  type t = 
+    | Value | Type | Exception 
+    | Module | Module_type 
+    | Class | Class_type
+end
+
 module Annot : sig
   type t =
     | Type of Types.type_expr (* sub-expression's type *)
     | Str of Abstraction.structure_item 
-    | Value_use of Path.t
-    | Type_use of Path.t
+    | Use of Use.t * Path.t
     | Module of Abstraction.module_expr
     | Non_expansive of bool
 

typing/typecore.ml

         with Not_found ->
           raise(Error(sp.ppat_loc, Unbound_constructor lid)) in
       Spot.Annot.record sp.ppat_loc 
-	(Spot.Annot.Type_use (Spot.path_of_constr_type constr.cstr_res));
+	(Spot.Annot.Use (Spot.Use.Type,
+			 Spot.path_of_constr_type constr.cstr_res));
       let sargs =
         match sarg with
           None -> []
       in
       let desc =Tpat_record(type_label_a_list type_label_pat lid_sp_list) in
       Spot.Annot.record sp.ppat_loc 
-	(Spot.Annot.Type_use (Spot.path_of_constr_type ty));
+	(Spot.Annot.Use (Spot.Use.Type, Spot.path_of_constr_type ty));
       rp {
         pat_desc = desc;
         pat_loc = sp.ppat_loc;
           with _ -> ()
         end;
         let (path, desc) = Env.lookup_value lid env in
-	Spot.Annot.record sexp.pexp_loc (Spot.Annot.Value_use path);
+	Spot.Annot.record sexp.pexp_loc 
+	  (Spot.Annot.Use (Spot.Use.Value, path));
         re {
           exp_desc =
             begin match desc.val_kind with
         (label, {arg with exp_type = instance arg.exp_type}) in
       let lbl_exp_list = type_label_a_list type_label_exp lid_sexp_list in
       Spot.Annot.record sexp.pexp_loc 
-	(Spot.Annot.Type_use (Spot.path_of_constr_type ty));
+	(Spot.Annot.Use (Spot.Use.Type, Spot.path_of_constr_type ty));
       let rec check_duplicates seen_pos lid_sexp lbl_exp =
         match (lid_sexp, lbl_exp) with
           ((lid, _) :: rem1, (lbl, _) :: rem2) ->
         with Not_found ->
           raise(Error(sexp.pexp_loc, Unbound_label lid)) in
       Spot.Annot.record sexp.pexp_loc 
-	(Spot.Annot.Type_use (Spot.path_of_constr_type label.lbl_res));
+	(Spot.Annot.Use 
+	   (Spot.Use.Type, Spot.path_of_constr_type label.lbl_res));
       let (_, ty_arg, ty_res) = instance_label false label in
       unify_exp env arg ty_res;
       re {
   Spot.Annot.record loc 
     begin match constr.cstr_tag with
     | Cstr_exception p ->
-	Spot.Annot.Value_use p 
+	Spot.Annot.Use (Spot.Use.Exception, p)
     | _ -> 
-	Spot.Annot.Type_use (Spot.path_of_constr_type constr.cstr_res)
+	Spot.Annot.Use 
+	  (Spot.Use.Type, Spot.path_of_constr_type constr.cstr_res)
     end;
   let sargs =
     match sarg with

typing/typemod.ml

     Pmty_ident lid ->
       begin try
         let (path, info) = Env.lookup_modtype lid env in
-	Spot.Annot.record smty.pmty_loc (Spot.Annot.Type_use path);
+	Spot.Annot.record smty.pmty_loc 
+	  (Spot.Annot.Use (Spot.Use.Module_type, path));
         Tmty_ident path
       with Not_found ->
         raise(Error(smty.pmty_loc, Unbound_modtype lid))
   match smod.pmod_desc with
     Pmod_ident lid ->
       let (path, mty) = type_module_path env smod.pmod_loc lid in
+      Spot.Annot.record smod.pmod_loc 
+	(Spot.Annot.Use (Spot.Use.Module, path));
       rm { mod_desc = Tmod_ident path;
            mod_type = Mtype.strengthen env mty path;
            mod_env = env;

typing/typetexp.ml

           Env.lookup_type lid env
         with Not_found ->
           raise(Error(styp.ptyp_loc, Unbound_type_constructor lid)) in
-      Spot.Annot.record styp.ptyp_loc (Spot.Annot.Type_use path);
+      Spot.Annot.record styp.ptyp_loc (Spot.Annot.Use (Spot.Use.Type, path));
       if List.length stl <> decl.type_arity then
         raise(Error(styp.ptyp_loc, Type_arity_mismatch(lid, decl.type_arity,
                                                            List.length stl)));