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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
(** Test solid pill lifecycle with all three Nock implementations in parallel **)
open Nock_lib
let time_it name f =
Printf.printf " [%s] Starting on domain %d...\n%!" name (Domain.self () :> int);
let start = Unix.gettimeofday () in
try
let result = f () in
let elapsed = Unix.gettimeofday () -. start in
Printf.printf " [%s] ✓ Complete in %.4fs\n%!" name elapsed;
Ok (name, elapsed, result)
with
| Stack_overflow ->
let elapsed = Unix.gettimeofday () -. start in
Printf.printf " [%s] ✗ Stack overflow after %.4fs\n%!" name elapsed;
Error (name, "Stack overflow")
| e ->
let elapsed = Unix.gettimeofday () -. start in
Printf.printf " [%s] ✗ Error: %s (after %.4fs)\n%!" name (Printexc.to_string e) elapsed;
Error (name, Printexc.to_string e)
let () =
Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n";
Printf.printf "║ Parallel Solid Pill Lifecycle Test ║\n";
Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n";
Printf.printf "[0] System info:\n";
Printf.printf " CPU cores available: %d\n" (Domain.recommended_domain_count ());
Printf.printf " Main domain ID: %d\n\n" (Domain.self () :> int);
Printf.printf "[1] Loading solid.pill...\n";
let ic = open_in_bin "solid.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 (%.1f MB)\n" len (float_of_int len /. 1024.0 /. 1024.0);
Printf.printf "[2] Cuing solid pill...\n";
let start = Unix.gettimeofday () in
let pill = Serial.cue bytes in
let elapsed = Unix.gettimeofday () -. start in
Printf.printf " ✓ Cued in %.2fs\n" elapsed;
Printf.printf "[3] Parsing pill structure...\n";
(* Parse: [tag type [bot mod use]] *)
match pill with
| Noun.Cell { h = _tag; t = rest; _ } ->
(match rest with
| Noun.Cell { h = _ptype; t = events_triple; _ } ->
(match events_triple with
| Noun.Cell { h = bot; t = rest2; _ } ->
(match rest2 with
| Noun.Cell { h = _mod; t = rest3; _ } ->
(match rest3 with
| Noun.Cell { h = use; t = _; _ } ->
(* Concatenate bot and use *)
let rec to_list acc n =
match n with
| Noun.Atom _ -> List.rev acc
| Noun.Cell { h; t; _ } -> to_list (h :: acc) t
in
let bot_list = to_list [] bot in
let use_list = to_list [] use in
let all_events = bot_list @ use_list in
Printf.printf " Bot events: %d\n" (List.length bot_list);
Printf.printf " Use events: %d\n" (List.length use_list);
Printf.printf " Total: %d events\n" (List.length all_events);
(* Convert to proper Nock list format *)
let rec from_list = function
| [] -> Noun.atom 0
| h :: t -> Noun.cell h (from_list t)
in
let event_list = from_list all_events in
Printf.printf "\n[4] 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[5] Running lifecycle with all three implementations:\n\n";
(* Spawn domains for parallel execution *)
let domain1 = Domain.spawn (fun () ->
time_it "nock.ml" (fun () ->
Nock.nock_on event_list formula)
) in
let domain2 = Domain.spawn (fun () ->
time_it "nock_iter.ml" (fun () ->
Nock_iter.nock_on event_list formula)
) in
let domain3 = Domain.spawn (fun () ->
time_it "nock_tail.ml" (fun () ->
Nock_tail.nock_on event_list formula)
) in
(* Wait for all to complete *)
Printf.printf "\n[6] Joining domains...\n%!";
let res1 = Domain.join domain1 in
let res2 = Domain.join domain2 in
let res3 = Domain.join domain3 in
Printf.printf "\n[7] Results:\n";
let successes = ref [] in
let failures = ref [] in
(match res1 with
| Ok (name, time, result) ->
let mug = Noun.mug result in
Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time;
successes := (name, mug, time) :: !successes
| Error (name, err) ->
Printf.printf " %s: %s ✗\n" name err;
failures := (name, err) :: !failures);
(match res2 with
| Ok (name, time, result) ->
let mug = Noun.mug result in
Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time;
successes := (name, mug, time) :: !successes
| Error (name, err) ->
Printf.printf " %s: %s ✗\n" name err;
failures := (name, err) :: !failures);
(match res3 with
| Ok (name, time, result) ->
let mug = Noun.mug result in
Printf.printf " %s: 0x%08lx (%.4fs) ✓\n" name mug time;
successes := (name, mug, time) :: !successes
| Error (name, err) ->
Printf.printf " %s: %s ✗\n" name err;
failures := (name, err) :: !failures);
Printf.printf "\n[8] Verification:\n";
Printf.printf " Successes: %d\n" (List.length !successes);
Printf.printf " Failures: %d\n" (List.length !failures);
if List.length !successes >= 2 then begin
let mugs = List.map (fun (_, mug, _) -> mug) !successes in
let all_same = List.for_all (fun m -> m = List.hd mugs) mugs in
if all_same then
Printf.printf " ✓ All successful implementations produce identical kernels!\n"
else
Printf.printf " ✗ Mug mismatch between successful implementations!\n"
end;
Printf.printf "\n╔═══════════════════════════════════════════════════════╗\n";
Printf.printf "║ Summary: ║\n";
if List.length !successes > 0 then begin
let fastest = List.fold_left
(fun (acc_name, acc_time) (name, _, time) ->
if time < acc_time then (name, time) else (acc_name, acc_time))
("", max_float)
!successes in
Printf.printf "║ Fastest (of successful): %-28s║\n" (fst fastest);
end;
Printf.printf "╚═══════════════════════════════════════════════════════╝\n\n"
| _ -> Printf.printf " ✗ Unexpected structure at use level\n")
| _ -> Printf.printf " ✗ Unexpected structure at mod level\n")
| _ -> Printf.printf " ✗ Unexpected structure at bot level\n")
| _ -> Printf.printf " ✗ Unexpected structure at events level\n")
| _ -> Printf.printf " ✗ Unexpected pill structure\n"
|
