blob: 84e76027347bf5afa94dc9f52cce8cb81ab42929 (
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
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
|
(* Effects - Output from Arvo event processing
*
* When Arvo processes an event (poke), it returns:
* - Updated kernel state
* - List of effects to perform
*
* Effects are messages to I/O drivers (vanes):
* - Behn: timers
* - Ames: network packets
* - Eyre: HTTP responses
* - Clay: filesystem operations
* - Dill: terminal output
* etc.
*)
(* Effect type - what to do after processing an event *)
type t =
(* Timer effect: set a timer *)
| SetTimer of {
id: int64; (* Timer ID *)
time: float; (* Unix timestamp when to fire *)
}
(* Timer effect: cancel a timer *)
| CancelTimer of {
id: int64; (* Timer ID to cancel *)
}
(* Log effect: print to console *)
| Log of string
(* Network effect: send UDP packet (Ames) *)
| SendPacket of {
dest: string; (* IP:port *)
data: bytes; (* Packet data *)
}
(* HTTP effect: send HTTP response (Eyre) *)
| HttpResponse of {
id: int; (* Request ID *)
status: int; (* HTTP status code *)
headers: (string * string) list;
body: bytes;
}
(* File effect: write file (Clay) *)
| WriteFile of {
path: string;
data: bytes;
}
(* Generic placeholder for other effects *)
| Other of {
vane: string; (* Which vane (behn, ames, eyre, etc) *)
data: Noun.noun; (* Effect data as noun *)
}
(* Effect result - what happened when we tried to execute an effect *)
type effect_result =
| Success
| Failed of string
(* Ovum - an input event to Arvo
*
* Format: [wire card]
* wire: path for response routing
* card: [driver-name data]
*)
type ovum = {
wire: Noun.noun; (* Response routing path *)
card: Noun.noun; (* [vane-tag event-data] *)
}
(* Create a simple ovum *)
let make_ovum ~wire ~card = { wire; card }
(* Create a timer ovum (from behn) *)
let timer_ovum ~id ~fire_time =
{
wire = Noun.Atom { z = Z.of_int64 id; mug = 0l };
card = Noun.cell
(Noun.atom 0) (* behn tag - simplified *)
(Noun.Atom { z = Z.of_float (fire_time *. 1000000.0); mug = 0l }); (* microseconds *)
}
(* Create a log ovum *)
let log_ovum ~msg:_ =
{
wire = Noun.atom 0;
card = Noun.cell
(Noun.atom 1) (* log tag *)
(Noun.atom 0); (* simplified - would be text *)
}
(* Create an Ames packet ovum *)
let ames_packet ~from:_ ~data:_ =
{
wire = Noun.atom 0; (* simplified routing *)
card = Noun.cell
(Noun.atom 2) (* ames tag *)
(Noun.atom 0); (* simplified - would be packet data *)
}
(* Note: from and data ignored for now, would be encoded in card *)
(* Parse effects from Arvo output
*
* In a real implementation, this would parse the noun structure
* that Arvo returns and convert it to our effect types.
*
* For now: simplified - just return empty list
*)
let parse_effects (_arvo_output : Noun.noun) : t list =
(* TODO: Parse real Arvo effect format *)
[]
(* Effect queue - for async effect processing *)
type queue = {
q: t Queue.t;
lock: Mutex.t;
cond: Condition.t;
}
(* Create effect queue *)
let create_queue () = {
q = Queue.create ();
lock = Mutex.create ();
cond = Condition.create ();
}
(* Add effect to queue *)
let enqueue queue eff =
Mutex.lock queue.lock;
Queue.add eff queue.q;
Condition.signal queue.cond;
Mutex.unlock queue.lock
(* Get next effect from queue (blocking) *)
let dequeue queue =
Mutex.lock queue.lock;
while Queue.is_empty queue.q do
Condition.wait queue.cond queue.lock
done;
let eff = Queue.take queue.q in
Mutex.unlock queue.lock;
eff
(* Try to get effect without blocking *)
let try_dequeue queue =
Mutex.lock queue.lock;
let result =
if Queue.is_empty queue.q then
None
else
Some (Queue.take queue.q)
in
Mutex.unlock queue.lock;
result
(* Get queue length *)
let queue_length queue =
Mutex.lock queue.lock;
let len = Queue.length queue.q in
Mutex.unlock queue.lock;
len
|
