robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Builder_web.job_build_treemap: Implementing partitioning of Info tree

Browse source
This commit is contained in:
rand00 2021-12-15 23:09:23 +01:00 committed by Reynir Björnsson
parent 79c40473b4
commit b8c40861f3
1 changed files with 21 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
lib/builder_web.ml
View file

@ -212,13 +212,28 @@ let add_routes datadir =
m "Error reading ELF file %a" Fpath.pp path)) m "Error reading ELF file %a" Fpath.pp path))
>>= fun infos -> >>= fun infos ->
let svg_html = let svg_html =
infos let info, excluded =
|> Info.import let size, info =
|> Info.diff_size infos
|> Info.prefix_filename |> Info.import
|> Info.cut 2 |> Info.diff_size_tree
in
(*> Note: this heuristic fails if one has all subtrees of equal size*)
let node_big_enough subtree =
match Info.(subtree.T.value.size) with
| None -> true
| Some subtree_size ->
let pct = Int64.(to_float subtree_size /. to_float size) in
pct > 0.05
in
info
|> Info.prefix_filename
|> Info.cut 2
|> Info.partition_subtrees node_big_enough
in
info
|> Treemap.of_tree |> Treemap.of_tree
|> Treemap.to_html_with_scale ~binary_size |> Treemap.to_html_with_scale ~binary_size (*goto add 'excluded' via some new param*)
|> Fmt.to_to_string (Tyxml.Html.pp ()) |> Fmt.to_to_string (Tyxml.Html.pp ())
(* |> Treemap.svg (* |> Treemap.svg
* |> Fmt.to_to_string (Tyxml.Svg.pp ()) *) * |> Fmt.to_to_string (Tyxml.Svg.pp ()) *)