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
|
(** Test ivory pill lifecycle with all three Nock implementations using Domainslib **)
open Nock_lib
module T = Domainslib.Task
let time_it name f =
Printf.printf " [%s] Starting...\n%!" name;
let start = Unix.gettimeofday () in
let result = f () in
let elapsed = Unix.gettimeofday () -. start in
Printf.printf " [%s] ✓ Complete in %.4fs\n%!" name elapsed;
(name, elapsed, result)
let main () =
Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n";
Printf.printf "║ Parallel Ivory Pill Test (Domainslib) ║\n";
Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n";
Printf.printf "[1] Loading ivory.pill...\n";
let ic = open_in_bin "ivory.pill" in
let len = in_channel_length ic in
let bytes = Bytes.create len in
really_input ic bytes 0 len;
close_in ic;
Printf.printf " Size: %d bytes\n" len;
Printf.printf "[2] Cuing ivory pill...\n";
let pill = Serial.cue bytes in
Printf.printf " ✓ Cued\n";
match pill with
| Noun.Cell { h = _tag; t = core; _ } ->
Printf.printf "[3] Building lifecycle formula...\n";
let formula = Noun.cell
(Noun.atom 2)
(Noun.cell
(Noun.cell (Noun.atom 0) (Noun.atom 3))
(Noun.cell (Noun.atom 0) (Noun.atom 2))) in
Printf.printf " Formula: [2 [0 3] [0 2]]\n";
Printf.printf "\n[4] Setting up Domainslib pool with 3 domains...\n";
let num_domains = 3 in
let pool = T.setup_pool ~num_domains:(num_domains - 1) () in
Printf.printf "\n[5] Running lifecycle with all three implementations:\n\n";
(* Run in T.run context for effect handlers *)
let (name1, time1, result1), (name2, time2, result2), (name3, time3, result3) =
T.run pool (fun () ->
(* Launch all three as async tasks *)
let task1 = T.async pool (fun () ->
time_it "nock.ml" (fun () -> Nock.nock_on core formula)) in
let task2 = T.async pool (fun () ->
time_it "nock_iter.ml" (fun () -> Nock_iter.nock_on core formula)) in
let task3 = T.async pool (fun () ->
time_it "nock_tail.ml" (fun () -> Nock_tail.nock_on core formula)) in
(* Await all results *)
Printf.printf "\n[6] Waiting for results...\n";
let r1 = T.await pool task1 in
let r2 = T.await pool task2 in
let r3 = T.await pool task3 in
(r1, r2, r3)
)
in
T.teardown_pool pool;
Printf.printf "\n[7] Computing mugs...\n%!";
Printf.printf " Computing mug for %s...%!" name1;
let mug1 = Noun.mug result1 in
Printf.printf " 0x%08lx\n%!" mug1;
Printf.printf " Computing mug for %s...%!" name2;
let mug2 = Noun.mug result2 in
Printf.printf " 0x%08lx\n%!" mug2;
Printf.printf " Computing mug for %s...%!" name3;
let mug3 = Noun.mug result3 in
Printf.printf " 0x%08lx\n%!" mug3;
Printf.printf "\n[8] Results:\n";
Printf.printf " %s: 0x%08lx (%.4fs)\n" name1 mug1 time1;
Printf.printf " %s: 0x%08lx (%.4fs)\n" name2 mug2 time2;
Printf.printf " %s: 0x%08lx (%.4fs)\n" name3 mug3 time3;
Printf.printf "\n[9] Verification:\n";
if mug1 = mug2 && mug2 = mug3 then
Printf.printf " ✓ All three mugs match - kernels are identical!\n"
else begin
Printf.printf " ✗ MISMATCH!\n";
if mug1 <> mug2 then
Printf.printf " nock.ml ≠ nock_iter.ml\n";
if mug2 <> mug3 then
Printf.printf " nock_iter.ml ≠ nock_tail.ml\n";
if mug1 <> mug3 then
Printf.printf " nock.ml ≠ nock_tail.ml\n"
end;
Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n";
Printf.printf "║ Summary: ║\n";
Printf.printf "║ Fastest: %-44s║\n"
(if time1 < time2 && time1 < time3 then name1
else if time2 < time3 then name2
else name3);
Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"
| _ ->
Printf.printf " ✗ Unexpected pill structure\n"
let _ = main ()
|
