a database layer insipred by caqti and ecto
gdiazlo.tngl.sh
1type alloc_stats = {
2 minor_words : float;
3 major_words : float;
4 minor_collections : int;
5 major_collections : int;
6 heap_words : int;
7 live_words : int;
8}
9
10let get_stats () =
11 Gc.full_major ();
12 let stat = Gc.stat () in
13 {
14 minor_words = stat.minor_words;
15 major_words = stat.major_words;
16 minor_collections = stat.minor_collections;
17 major_collections = stat.major_collections;
18 heap_words = stat.heap_words;
19 live_words = stat.live_words;
20 }
21
22let diff_stats before after =
23 {
24 minor_words = after.minor_words -. before.minor_words;
25 major_words = after.major_words -. before.major_words;
26 minor_collections = after.minor_collections - before.minor_collections;
27 major_collections = after.major_collections - before.major_collections;
28 heap_words = after.heap_words - before.heap_words;
29 live_words = after.live_words - before.live_words;
30 }
31
32let print_stats label stats =
33 Printf.printf "=== %s ===\n" label;
34 Printf.printf " Minor words: %.0f (%.2f KB)\n" stats.minor_words
35 (stats.minor_words *. 8.0 /. 1024.0);
36 Printf.printf " Major words: %.0f (%.2f KB)\n" stats.major_words
37 (stats.major_words *. 8.0 /. 1024.0);
38 Printf.printf " Minor GCs: %d\n" stats.minor_collections;
39 Printf.printf " Major GCs: %d\n" stats.major_collections;
40 Printf.printf " Heap words: %d (%.2f KB)\n" stats.heap_words
41 (float_of_int stats.heap_words *. 8.0 /. 1024.0);
42 Printf.printf " Live words: %d (%.2f KB)\n" stats.live_words
43 (float_of_int stats.live_words *. 8.0 /. 1024.0);
44 Printf.printf "\n"
45
46type bench_result = {
47 name : string;
48 iterations : int;
49 total_time_ms : float;
50 per_op_time_us : float;
51 allocs : alloc_stats;
52 allocs_per_op : float;
53}
54
55let print_bench_result r =
56 Printf.printf "%-30s | %6d iters | %8.2f ms | %8.2f µs/op | %10.0f words/op\n"
57 r.name r.iterations r.total_time_ms r.per_op_time_us r.allocs_per_op
58
59let bench name ~iterations f =
60 Gc.full_major ();
61 Gc.compact ();
62 let before = get_stats () in
63 let t0 = Unix.gettimeofday () in
64 for _ = 1 to iterations do
65 ignore (f ())
66 done;
67 let t1 = Unix.gettimeofday () in
68 let after = get_stats () in
69 let allocs = diff_stats before after in
70 let total_time_ms = (t1 -. t0) *. 1000.0 in
71 let per_op_time_us = total_time_ms *. 1000.0 /. float_of_int iterations in
72 let allocs_per_op = allocs.minor_words /. float_of_int iterations in
73 { name; iterations; total_time_ms; per_op_time_us; allocs; allocs_per_op }
74
75let leak_check name ~rounds ~ops_per_round f =
76 Printf.printf "\n=== Leak Check: %s ===\n" name;
77 Printf.printf "Running %d rounds of %d operations each...\n\n" rounds
78 ops_per_round;
79 let heap_sizes = Array.make rounds 0 in
80 let live_sizes = Array.make rounds 0 in
81 for round = 0 to rounds - 1 do
82 for _ = 1 to ops_per_round do
83 ignore (f ())
84 done;
85 Gc.full_major ();
86 Gc.compact ();
87 let stat = Gc.stat () in
88 heap_sizes.(round) <- stat.heap_words;
89 live_sizes.(round) <- stat.live_words;
90 if round mod 10 = 0 || round = rounds - 1 then
91 Printf.printf " Round %3d: heap=%d words, live=%d words\n" (round + 1)
92 stat.heap_words stat.live_words
93 done;
94 let first_heap = heap_sizes.(0) in
95 let last_heap = heap_sizes.(rounds - 1) in
96 let first_live = live_sizes.(0) in
97 let last_live = live_sizes.(rounds - 1) in
98 let heap_growth = last_heap - first_heap in
99 let live_growth = last_live - first_live in
100 Printf.printf "\nResults:\n";
101 Printf.printf " Heap growth: %d words (%.2f KB)\n" heap_growth
102 (float_of_int heap_growth *. 8.0 /. 1024.0);
103 Printf.printf " Live growth: %d words (%.2f KB)\n" live_growth
104 (float_of_int live_growth *. 8.0 /. 1024.0);
105 if live_growth > 1000 then
106 Printf.printf " ⚠️ POTENTIAL LEAK: Live memory grew by %d words\n"
107 live_growth
108 else Printf.printf " ✓ No significant memory leak detected\n";
109 (heap_growth, live_growth)
110
111let run_benchmarks name benchmarks =
112 Printf.printf "\n";
113 Printf.printf
114 "╔═══════════════════════════════════════════════════════════════════════════════╗\n";
115 Printf.printf "║ %-77s ║\n" (Printf.sprintf "BENCHMARK: %s" name);
116 Printf.printf
117 "╠═══════════════════════════════════════════════════════════════════════════════╣\n";
118 Printf.printf "║ %-30s | %6s | %8s | %11s | %14s ║\n" "Operation" "Iters"
119 "Total" "Per Op" "Allocs/Op";
120 Printf.printf
121 "╠═══════════════════════════════════════════════════════════════════════════════╣\n";
122 List.iter
123 (fun r ->
124 Printf.printf "║ %-30s | %6d | %6.1f ms | %8.2f µs | %11.0f w ║\n" r.name
125 r.iterations r.total_time_ms r.per_op_time_us r.allocs_per_op)
126 benchmarks;
127 Printf.printf
128 "╚═══════════════════════════════════════════════════════════════════════════════╝\n"