package p4spectec

  1. Overview
  2. Docs
package p4spectec
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file profile.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
open Domain.Lib
module Value = Runtime.Value
open Util

module Stat = struct
  type stat = {
    mutable count : int;
    mutable time_inclusive : float;
    mutable time_exclusive : float;
  }

  type t = (string, stat) Hashtbl.t

  let create () : t = Hashtbl.create 64
  let clear (t : t) : unit = Hashtbl.clear t

  let get (t : t) (id : string) : stat =
    match Hashtbl.find_opt t id with
    | Some stat -> stat
    | None ->
        let stat = { count = 0; time_inclusive = 0.0; time_exclusive = 0.0 } in
        Hashtbl.add t id stat;
        stat

  let collect (t : t) : (string * stat) list =
    Hashtbl.fold (fun id stat stats -> (id, stat) :: stats) t []
    |> List.sort (fun (_, stat_a) (_, stat_b) ->
           Float.compare stat_b.time_inclusive stat_a.time_inclusive)
end

type info = { id : Id.t; time_start : float; mutable time_children : float }
type frame = Rel of info | Func of info

let make () =
  (* Stack of frames *)
  let time_start = ref 0.0 in
  let stack : frame Stack.t = Stack.create () in
  (* Statistics *)
  let stats_rel = Stat.create () in
  let stats_func = Stat.create () in
  (* Profiling handler *)
  let module H : Handler.HANDLER = struct
    include Handler.Default

    let init_spec (_spec : Handler.spec) : unit =
      time_start := Time.now ();
      Stack.clear stack;
      Stat.clear stats_rel;
      Stat.clear stats_func

    let log (stats : (string * Stat.stat) list) : unit =
      Format.printf "  %-40s %8s %12s %12s %12s\n" "Name" "Calls" "Inclusive"
        "Exclusive" "Avg";
      Format.printf "  %s\n" (String.make 90 '-');
      List.iter
        (fun (id, stat) ->
          let avg =
            if stat.Stat.count > 0 then
              stat.Stat.time_inclusive /. float_of_int stat.Stat.count
            else 0.0
          in
          Format.printf "  %-40s %8d %11.4fs %11.4fs %11.6fs\n" id stat.count
            stat.time_inclusive stat.time_exclusive avg)
        stats;
      Format.printf "\n"

    let finish () : unit =
      let time_elapsed = Time.now () -. !time_start in
      let stats_rel = Stat.collect stats_rel in
      let stats_func = Stat.collect stats_func in
      Format.printf "\n=== Profiling Results ===\n\n";
      Format.printf "Total time elapsed: %11.4fs\n\n" time_elapsed;
      if stats_rel <> [] then (
        Format.printf "Relations (sorted by inclusive time):\n";
        log stats_rel);
      if stats_func <> [] then (
        Format.printf "Functions (sorted by inclusive time):\n";
        log stats_func)

    let is_recursive (frame : frame) : bool =
      let is_recursive = ref false in
      Stack.iter
        (fun frame_parent ->
          match (frame, frame_parent) with
          | Rel info, Rel info_parent ->
              if Id.eq info.id info_parent.id then is_recursive := true
          | Func info, Func info_parent ->
              if Id.eq info.id info_parent.id then is_recursive := true
          | _ -> ())
        stack;
      !is_recursive

    let on_exit (id : Id.t) : unit =
      if not (Stack.is_empty stack) then (
        let frame = Stack.pop stack in
        let info = match frame with Rel info | Func info -> info in
        let time_elapsed = Time.now () -. info.time_start in
        let time_exclusive = time_elapsed -. info.time_children in
        let stat = Stat.get stats_rel id.it in
        stat.count <- stat.count + 1;
        if not (is_recursive frame) then
          stat.time_inclusive <- stat.time_inclusive +. time_elapsed;
        stat.time_exclusive <- stat.time_exclusive +. time_exclusive;
        if not (Stack.is_empty stack) then
          let frame_parent = Stack.top stack in
          let info_parent =
            match frame_parent with Rel info | Func info -> info
          in
          info_parent.time_children <- info_parent.time_children +. time_elapsed)

    let on_rel_enter (rid : RId.t) (_values_input : Value.t list) : unit =
      let frame =
        Rel { id = rid; time_start = Time.now (); time_children = 0.0 }
      in
      Stack.push frame stack

    let on_rel_exit (rid : RId.t) : unit = on_exit rid

    let on_func_enter (fid : FId.t) (_values_input : Value.t list) : unit =
      let frame =
        Func { id = fid; time_start = Time.now (); time_children = 0.0 }
      in
      Stack.push frame stack

    let on_func_exit (fid : FId.t) : unit = on_exit fid
  end in
  (* Return the handler *)
  (module H : Handler.HANDLER)