summaryrefslogtreecommitdiff
path: root/ocaml/test/test_slam_directly.ml
blob: d7248f58ba9b63f1a01b88974f50a4cb645dc8c3 (plain)
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
(* Test slamming poke gates directly *)

open Nock_lib

let slam_on gate event =
  (* C Vere slam_on: [battery [new-sample context]] *)
  let battery = Noun.head gate in
  let context = Noun.tail (Noun.tail gate) in  (* slot 7 *)
  let new_core = Noun.cell battery (Noun.cell event context) in

  (* Kick arm 2: [9 2 0 1] *)
  let kick_formula = Noun.cell (Noun.atom 9)
    (Noun.cell (Noun.atom 2)
      (Noun.cell (Noun.atom 0) (Noun.atom 1))) in

  Nock.nock_on new_core kick_formula

let rec to_list acc noun =
  match noun with
  | Noun.Atom _ -> List.rev acc
  | Noun.Cell (item, rest) -> to_list (item :: acc) rest

let test_slam _env =
  Printf.printf "Testing direct slam on poke gates...\n\n";

  let in_channel = open_in_bin "solid.noun" in
  let pill = (Marshal.from_channel in_channel : Noun.noun) in
  close_in in_channel;

  match pill with
  | Noun.Cell (_tag, events) ->
      let event_list = to_list [] events in

      begin match List.nth_opt event_list 1 with
      | Some kernel ->
          (* Build test event: [now ovum] where ovum = [wire card] *)
          Printf.printf "Building test event...\n";
          let wire = Noun.atom 0 in
          let card = Noun.cell (Noun.atom 1953719668) (Noun.atom 42) in
          let ovum = Noun.cell wire card in
          let now = Noun.atom 0 in
          let event = Noun.cell now ovum in
          Printf.printf "  Event: [0 [0 [1953719668 42]]]\n\n";

          (* Try slot 23 *)
          Printf.printf "=== Testing Slot 23 ===\n";
          begin try
            let poke_gate = Noun.slot (Z.of_int 23) kernel in
            Printf.printf "Slamming slot 23 gate...\n";

            let start = Unix.gettimeofday () in
            let result = slam_on poke_gate event in
            let elapsed = Unix.gettimeofday () -. start in

            Printf.printf "āœ“ Slam succeeded in %.4fs!\n\n" elapsed;

            begin match result with
            | Noun.Cell (_effects, _new_kernel) ->
                Printf.printf "šŸŽ‰ SLOT 23 WORKS! Result is [effects new-kernel]\n\n"
            | Noun.Atom _ ->
                Printf.printf "Result is atom (unexpected)\n\n"
            end

          with
          | Noun.Exit ->
              Printf.printf "āœ— Slam failed (Nock Exit)\n\n"
          | e ->
              Printf.printf "āœ— Error: %s\n\n" (Printexc.to_string e)
          end;

          (* Try slot 42 *)
          Printf.printf "=== Testing Slot 42 ===\n";
          begin try
            let poke_gate = Noun.slot (Z.of_int 42) kernel in
            Printf.printf "Slamming slot 42 gate...\n";

            let start = Unix.gettimeofday () in
            let result = slam_on poke_gate event in
            let elapsed = Unix.gettimeofday () -. start in

            Printf.printf "āœ“ Slam succeeded in %.4fs!\n\n" elapsed;

            begin match result with
            | Noun.Cell (_effects, _new_kernel) ->
                Printf.printf "šŸŽ‰ SLOT 42 WORKS! Result is [effects new-kernel]\n\n"
            | Noun.Atom _ ->
                Printf.printf "Result is atom (unexpected)\n\n"
            end

          with
          | Noun.Exit ->
              Printf.printf "āœ— Slam failed (Nock Exit)\n\n"
          | e ->
              Printf.printf "āœ— Error: %s\n\n" (Printexc.to_string e)
          end

      | None ->
          Printf.printf "No event 1\n"
      end

  | Noun.Atom _ ->
      Printf.printf "Pill is atom\n"

let () =
  Printf.printf "\n═══════════════════════════════════════════\n";
  Printf.printf " Test Direct Slam on Poke Gates\n";
  Printf.printf "═══════════════════════════════════════════\n\n";
  Eio_main.run test_slam