blob: ca0f4b7693cf539b2086f7818613c86f12740820 (
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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
[@@@ocaml.warning "-32"]
[@@@ocaml.warning "-69"] (* Disable "unused mutable field" warning *)
open Noun
open Nock
(** Runtime state storing the current Arvo kernel and event counter *)
type t = {
mutable roc: noun;
mutable eve: int64;
lock: Mutex.t;
mutable eventlog: Eventlog_lmdb.t option;
}
let atom_int n = atom (Z.of_int n)
let create ?(initial = atom_int 0) ?pier_path () =
let eventlog = match pier_path with
| None -> None
| Some path -> Some (Eventlog_lmdb.create path)
in
{
roc = initial;
eve = 0L;
lock = Mutex.create ();
eventlog;
}
let event_number state =
Mutex.lock state.lock;
let eve = state.eve in
Mutex.unlock state.lock;
eve
let arvo_core state =
Mutex.lock state.lock;
let core = state.roc in
Mutex.unlock state.lock;
core
let boot ?(events_played = 0L) state kernel =
Mutex.lock state.lock;
state.roc <- kernel;
state.eve <- events_played;
Mutex.unlock state.lock
let poke_formula_axis = Z.of_int 23
let kick_formula =
(* [9 2 [0 1]] -- standard gate call *)
let axis01 = cell (atom_int 0) (atom_int 1) in
cell (atom_int 9) (cell (atom_int 2) axis01)
let slam_on gate sample =
match gate with
| Cell (battery, payload) -> begin
match payload with
| Cell (_old_sample, context) ->
let new_payload = cell sample context in
let new_core = cell battery new_payload in
nock_on new_core kick_formula
| _ -> raise Exit
end
| Atom _ -> raise Exit
let poke state event =
Mutex.lock state.lock;
try
let kernel = state.roc in
let formula = slot poke_formula_axis kernel in
let gate = nock_on kernel formula in
let result = slam_on gate event in
begin match result with
| Cell (effects, new_core) ->
state.roc <- new_core;
state.eve <- Int64.succ state.eve;
(* Log event to disk if eventlog is enabled *)
begin match state.eventlog with
| Some log -> ignore (Eventlog_lmdb.append log event)
| None -> ()
end;
Mutex.unlock state.lock;
effects
| _ ->
Mutex.unlock state.lock;
raise Exit
end
with exn ->
Mutex.unlock state.lock;
raise exn
let peek_formula =
(* Simplified: return the subject *)
cell (atom_int 0) (atom_int 1)
let peek state path =
Mutex.lock state.lock;
let subject = cell path state.roc in
try
let res = nock_on subject peek_formula in
Mutex.unlock state.lock;
Some res
with _ ->
Mutex.unlock state.lock;
None
let snapshot state =
Mutex.lock state.lock;
let core = state.roc in
let eve = state.eve in
Mutex.unlock state.lock;
let jammed = Serial.jam core in
(jammed, eve)
let load_snapshot state jammed eve =
let core = Serial.cue jammed in
Mutex.lock state.lock;
state.roc <- core;
state.eve <- eve;
Mutex.unlock state.lock
let close_eventlog state =
Mutex.lock state.lock;
begin match state.eventlog with
| Some log -> Eventlog_lmdb.close log
| None -> ()
end;
Mutex.unlock state.lock
|
