|
@@ -3,6 +3,7 @@ open Ast
|
|
|
open Type
|
|
|
open Common
|
|
|
open Typecore
|
|
|
+open DisplayTypes
|
|
|
|
|
|
open ImportHandling
|
|
|
|
|
@@ -12,22 +13,12 @@ type relation =
|
|
|
| Overridden
|
|
|
| Referenced
|
|
|
|
|
|
-type symbol =
|
|
|
- | SKClass of tclass
|
|
|
- | SKInterface of tclass
|
|
|
- | SKEnum of tenum
|
|
|
- | SKTypedef of tdef
|
|
|
- | SKAbstract of tabstract
|
|
|
- | SKField of tclass_field
|
|
|
- | SKEnumField of tenum_field
|
|
|
- | SKVariable of tvar
|
|
|
-
|
|
|
type statistics_filter =
|
|
|
| SFNone
|
|
|
| SFPos of pos
|
|
|
| SFFile of string
|
|
|
|
|
|
-let collect_statistics ctx pfilter =
|
|
|
+let collect_statistics ctx pfilter with_expressions =
|
|
|
let relations = Hashtbl.create 0 in
|
|
|
let symbols = Hashtbl.create 0 in
|
|
|
let handled_modules = Hashtbl.create 0 in
|
|
@@ -69,14 +60,34 @@ let collect_statistics ctx pfilter =
|
|
|
let cf' = PMap.find cf.cf_name c.cl_fields in
|
|
|
add_relation cf'.cf_name_pos (Overridden,cf.cf_pos)
|
|
|
with Not_found ->
|
|
|
- loop c
|
|
|
- end
|
|
|
+ ()
|
|
|
+ end;
|
|
|
+ loop c
|
|
|
| _ ->
|
|
|
()
|
|
|
in
|
|
|
loop c
|
|
|
) c.cl_overrides
|
|
|
in
|
|
|
+ let collect_implementations c =
|
|
|
+ List.iter (fun cf ->
|
|
|
+ let rec loop c =
|
|
|
+ begin try
|
|
|
+ let cf' = PMap.find cf.cf_name c.cl_fields in
|
|
|
+ add_relation cf.cf_name_pos (Implemented,cf'.cf_name_pos)
|
|
|
+ with Not_found ->
|
|
|
+ ()
|
|
|
+ end;
|
|
|
+ List.iter loop c.cl_descendants
|
|
|
+ in
|
|
|
+ List.iter loop c.cl_descendants
|
|
|
+ ) c.cl_ordered_fields;
|
|
|
+ let rec loop c' =
|
|
|
+ add_relation c.cl_name_pos ((if c'.cl_interface then Extended else Implemented),c'.cl_name_pos);
|
|
|
+ List.iter loop c'.cl_descendants
|
|
|
+ in
|
|
|
+ List.iter loop c.cl_descendants
|
|
|
+ in
|
|
|
let rec find_real_constructor c = match c.cl_constructor,c.cl_super with
|
|
|
(* The pos comparison might be a bit weak, not sure... *)
|
|
|
| Some cf,_ when not (Meta.has Meta.CompilerGenerated cf.cf_meta) && c.cl_pos <> cf.cf_pos -> cf
|
|
@@ -85,8 +96,39 @@ let collect_statistics ctx pfilter =
|
|
|
in
|
|
|
let var_decl v = declare (SKVariable v) v.v_pos in
|
|
|
let patch_string_pos p s = { p with pmin = p.pmax - String.length s } in
|
|
|
- let field_reference cf p =
|
|
|
- add_relation cf.cf_name_pos (Referenced,patch_string_pos p cf.cf_name)
|
|
|
+ let field_reference co cf p =
|
|
|
+ let p' = patch_string_pos p cf.cf_name in
|
|
|
+ add_relation cf.cf_name_pos (Referenced,p');
|
|
|
+ (* extend to related classes for instance fields *)
|
|
|
+ match co with
|
|
|
+ | Some c ->
|
|
|
+ let check c =
|
|
|
+ try
|
|
|
+ let cf = PMap.find cf.cf_name c.cl_fields in
|
|
|
+ add_relation cf.cf_name_pos (Referenced,p')
|
|
|
+ with Not_found ->
|
|
|
+ ()
|
|
|
+ in
|
|
|
+ (* to children *)
|
|
|
+ let rec loop c =
|
|
|
+ List.iter (fun c ->
|
|
|
+ check c;
|
|
|
+ loop c;
|
|
|
+ ) c.cl_descendants
|
|
|
+ in
|
|
|
+ loop c;
|
|
|
+ (* to parents *)
|
|
|
+ let rec loop c =
|
|
|
+ let f (c,_) =
|
|
|
+ check c;
|
|
|
+ loop c;
|
|
|
+ in
|
|
|
+ List.iter f c.cl_implements;
|
|
|
+ Option.may f c.cl_super
|
|
|
+ in
|
|
|
+ loop c;
|
|
|
+ | None ->
|
|
|
+ ()
|
|
|
in
|
|
|
let collect_references c e =
|
|
|
let rec loop e = match e.eexpr with
|
|
@@ -96,11 +138,13 @@ let collect_statistics ctx pfilter =
|
|
|
if e1.epos.pmin = e.epos.pmin && e1.epos.pmax <> e.epos.pmax then
|
|
|
loop e1;
|
|
|
begin match fa with
|
|
|
- | FStatic(_,cf) | FInstance(_,_,cf) | FClosure(_,cf) ->
|
|
|
- field_reference cf e.epos
|
|
|
+ | FStatic(_,cf) | FClosure(None,cf) ->
|
|
|
+ field_reference None cf e.epos
|
|
|
+ | FInstance(c,_,cf) | FClosure(Some(c,_),cf) ->
|
|
|
+ field_reference (Some c) cf e.epos
|
|
|
| FAnon cf ->
|
|
|
declare (SKField cf) cf.cf_name_pos;
|
|
|
- field_reference cf e.epos
|
|
|
+ field_reference None cf e.epos
|
|
|
| FEnum(_,ef) ->
|
|
|
add_relation ef.ef_name_pos (Referenced,patch_string_pos e.epos ef.ef_name)
|
|
|
| FDynamic _ ->
|
|
@@ -144,20 +188,45 @@ let collect_statistics ctx pfilter =
|
|
|
List.iter (fun (p,pn) -> add_relation pn (Referenced,p)) m.m_extra.m_display.m_type_hints
|
|
|
end
|
|
|
in
|
|
|
+ (* set up descendants *)
|
|
|
+ let f = function
|
|
|
+ | TClassDecl c ->
|
|
|
+ List.iter (fun (iface,_) -> add_descendant iface c) c.cl_implements;
|
|
|
+ begin match c.cl_super with
|
|
|
+ | Some (csup,_) -> add_descendant csup c
|
|
|
+ | None -> ()
|
|
|
+ end;
|
|
|
+ | _ ->
|
|
|
+ ()
|
|
|
+ in
|
|
|
+ let rec loop com =
|
|
|
+ List.iter f com.types;
|
|
|
+ Option.may loop (com.get_macros())
|
|
|
+ in
|
|
|
+ loop ctx.com;
|
|
|
+ (* find things *)
|
|
|
let f = function
|
|
|
| TClassDecl c ->
|
|
|
check_module c.cl_module;
|
|
|
declare (if c.cl_interface then (SKInterface c) else (SKClass c)) c.cl_name_pos;
|
|
|
- List.iter (fun (c',_) -> add_relation c'.cl_name_pos ((if c.cl_interface then Extended else Implemented),c.cl_name_pos)) c.cl_implements;
|
|
|
begin match c.cl_super with
|
|
|
| None -> ()
|
|
|
- | Some (c',_) -> add_relation c'.cl_name_pos (Extended,c.cl_name_pos);
|
|
|
+ | Some (c',_) ->
|
|
|
+ let rec loop c' =
|
|
|
+ add_relation c'.cl_name_pos (Extended,c.cl_name_pos);
|
|
|
+ Option.may (fun (c',_) -> loop c') c'.cl_super
|
|
|
+ in
|
|
|
+ loop c'
|
|
|
end;
|
|
|
collect_overrides c;
|
|
|
+ if c.cl_interface then
|
|
|
+ collect_implementations c;
|
|
|
let field cf =
|
|
|
if cf.cf_pos.pmin > c.cl_name_pos.pmin then declare (SKField cf) cf.cf_name_pos;
|
|
|
- let _ = follow cf.cf_type in
|
|
|
- match cf.cf_expr with None -> () | Some e -> collect_references c e
|
|
|
+ if with_expressions then begin
|
|
|
+ let _ = follow cf.cf_type in
|
|
|
+ match cf.cf_expr with None -> () | Some e -> collect_references c e
|
|
|
+ end
|
|
|
in
|
|
|
Option.may field c.cl_constructor;
|
|
|
List.iter field c.cl_ordered_fields;
|
|
@@ -178,11 +247,6 @@ let collect_statistics ctx pfilter =
|
|
|
Option.may loop (com.get_macros())
|
|
|
in
|
|
|
loop ctx.com;
|
|
|
- let l = List.fold_left (fun acc (_,cfi,_,cfo) -> match cfo with
|
|
|
- | Some cf -> if List.mem_assoc cf.cf_name_pos acc then acc else (cf.cf_name_pos,cfi.cf_name_pos) :: acc
|
|
|
- | None -> acc
|
|
|
- ) [] ctx.com.display_information.interface_field_implementations in
|
|
|
- List.iter (fun (p,p') -> add_relation p' (Implemented,p)) l;
|
|
|
(* let deal_with_imports paths =
|
|
|
let check_subtype m s p =
|
|
|
try
|
|
@@ -242,8 +306,10 @@ module Printer = struct
|
|
|
| SKTypedef _ -> "typedef"
|
|
|
| SKAbstract _ -> "abstract"
|
|
|
| SKField _ -> "class field"
|
|
|
+ | SKConstructor _ -> "constructor"
|
|
|
| SKEnumField _ -> "enum field"
|
|
|
| SKVariable _ -> "variable"
|
|
|
+ | SKOther -> "other"
|
|
|
|
|
|
let print_statistics (kinds,relations) =
|
|
|
let files = Hashtbl.create 0 in
|