camlspotter avatar camlspotter committed 74e2d29

tree dump version2

Comments (0)

Files changed (6)

       !!(unit.Unit.rannots)
   ;;
   
-  let tree unit = Tree.dump !!(unit.Unit.tree)
+  let tree unit = Tree.dump2 !!(unit.Unit.tree)
   ;;
 
   let top file = 
 	Printtyp.reset ();
 	Printtyp.mark_loops typ;
         (* CR jfuruse: not fancy having @. *)
-	fprintf ppf "Type: %a@ " (Printtyp.type_scheme ~with_pos:false) typ;
-	fprintf ppf "XType: %a@ " (Printtyp.type_scheme ~with_pos:true) typ;
-        fprintf ppf "At: %s" (string_of_at at)
+	fprintf ppf "Type: %a;@ " (Printtyp.type_scheme ~with_pos:false) typ;
+	fprintf ppf "XType: %a;@ " (Printtyp.type_scheme ~with_pos:true) typ;
+        fprintf ppf "At: %s;" (string_of_at at)
     | Mod_type mty ->
-	fprintf ppf "Type: %a@ " (Printtyp.modtype ~with_pos:false) mty;
-	fprintf ppf "XType: %a" (Printtyp.modtype ~with_pos:true) mty
+	fprintf ppf "Type: %a;@ " (Printtyp.modtype ~with_pos:false) mty;
+	fprintf ppf "XType: %a;" (Printtyp.modtype ~with_pos:true) mty
     | Str_item str ->
 	fprintf ppf "Str_item: %a"
 	  Abstraction.format_structure_item str
     end_ : Position.t
   }
 
-  let cache = Hashtbl.create 1023
-
   let fname = function
     | "_none_" -> None
     | s ->
 	eprintf "@[<2>@[%a@] =>@ @[%a@]@]@."
 	  format_parent parent
 	  RAnnot.format rrspot) t
+
+  let dump2 t =
+    let open Format in
+    let nodes = Hashtbl.create 1023 in
+    iter_elem (fun ~parent rrspot -> 
+      Hashtbl.multi_add nodes (Option.map ~f:(fun x -> x.region) parent) rrspot) t;
+    let rec loop ppf rrspot =
+      fprintf ppf "=> @[<v>%a%a@]" 
+        RAnnot.format rrspot
+        loop_region (Some rrspot.region);
+    and loop_region ppf regopt =
+      let subnodes = Hashtbl.find_default [] nodes regopt in
+      if subnodes = [] then ()
+      else begin
+        fprintf ppf "@,  @[<v>%a@]"
+          (list "@," loop) subnodes
+      end;
+    in
+    Format.eprintf "@[<v>Root%a@]@." loop_region None;
 end
 
 (* Minimum data for spotting, which are saved into spot files *)
     path           : string; (** source path. If packed, the .cmo itself *)
     top            : Abstraction.structure;
     loc_annots     : (Location.t, Annot.t list) Hashtbl.t
-  }
+ } 
 
   let dump file =
     eprintf "@[<v2>{ module= %S;@ path= %S;@ builddir= %S;@ loadpath= [ @[%a@] ];@ argv= [| @[%a@] |];@ ... }@]@."
     (** Region splitted Annot may be itered more than once. *)
 
   val dump : t -> unit
+  val dump2 : t -> unit
 end
 
 module File : sig

tests/Makefile.targets

 inherit3.cmo \
 interface.cmo \
 intermodule.cmo \
+issue19.cmo \
 let_open.cmo \
 lex.cmo \
 lex.cmo \
         let v = f k in
         Hashtbl.replace tbl k v;
         v
+
+  let find_default def tbl k = try find tbl k with Not_found -> def
+
+  let multi_add tbl k v =
+    let vs = v :: find_default [] tbl k in
+    replace tbl k vs
 end
 
 module Hashset = struct
   include module type of Hashtbl with type ('a,'b) t = ('a, 'b) Hashtbl.t
   val of_list : int -> ('a * 'b) list -> ('a, 'b) Hashtbl.t
   val memoize : ('a, 'b) Hashtbl.t -> ('a -> 'b) -> 'a -> 'b
+  val find_default : 'b -> ('a, 'b) Hashtbl.t -> 'a -> 'b
+  val multi_add : ('a, 'b list) Hashtbl.t -> 'a -> 'b -> unit
 end
 
 module Hashset : sig
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.