ocaml bindings for chibi-scheme VM
Add core OCaml bindings library (chibi_ocaml)
+2651
+775
lib/chibi.ml
+775
lib/chibi.ml
···
1
+
(** Chibi-scheme OCaml bindings - High-level API *)
2
+
3
+
(** {1 Exceptions} *)
4
+
5
+
exception Chibi_error of string
6
+
exception Context_destroyed
7
+
exception Type_error of string
8
+
9
+
let () =
10
+
Printexc.register_printer (function
11
+
| Chibi_error msg -> Some ("Chibi_error: " ^ msg)
12
+
| Context_destroyed -> Some "Context_destroyed: chibi context has been destroyed"
13
+
| Type_error msg -> Some ("Type_error: " ^ msg)
14
+
| _ -> None)
15
+
16
+
(** {1 Sexp - Scheme values} *)
17
+
18
+
module Sexp = struct
19
+
type t = Chibi_ffi.sexp
20
+
21
+
(** Type tag for pattern matching *)
22
+
type tag =
23
+
| Null
24
+
| Boolean of bool
25
+
| Fixnum of int
26
+
| Flonum of float
27
+
| Char of int
28
+
| String of string
29
+
| Symbol of string
30
+
| Pair
31
+
| Vector
32
+
| Bytevector
33
+
| Procedure
34
+
| Port
35
+
| Void
36
+
| Eof
37
+
| Other
38
+
39
+
let classify (s : t) : tag =
40
+
if Chibi_ffi.is_null s then Null
41
+
else if Chibi_ffi.is_void s then Void
42
+
else if Chibi_ffi.is_eof s then Eof
43
+
else if Chibi_ffi.is_boolean s then Boolean (Chibi_ffi.unbox_boolean s)
44
+
else if Chibi_ffi.is_fixnum s then Fixnum (Chibi_ffi.unbox_fixnum s)
45
+
else if Chibi_ffi.is_flonum s then Flonum (Chibi_ffi.unbox_flonum s)
46
+
else if Chibi_ffi.is_char s then Char (Chibi_ffi.unbox_char s)
47
+
else if Chibi_ffi.is_string s then String (Chibi_ffi.unbox_string s)
48
+
else if Chibi_ffi.is_symbol s then Symbol (Chibi_ffi.unbox_symbol s)
49
+
else if Chibi_ffi.is_pair s then Pair
50
+
else if Chibi_ffi.is_vector s then Vector
51
+
else if Chibi_ffi.is_bytes s then Bytevector
52
+
else if Chibi_ffi.is_procedure s then Procedure
53
+
else if Chibi_ffi.is_port s then Port
54
+
else Other
55
+
56
+
(* Predicates *)
57
+
let is_null = Chibi_ffi.is_null
58
+
let is_pair = Chibi_ffi.is_pair
59
+
let is_symbol = Chibi_ffi.is_symbol
60
+
let is_string = Chibi_ffi.is_string
61
+
let is_fixnum = Chibi_ffi.is_fixnum
62
+
let is_flonum = Chibi_ffi.is_flonum
63
+
let is_number = Chibi_ffi.is_number
64
+
let is_boolean = Chibi_ffi.is_boolean
65
+
let is_char = Chibi_ffi.is_char
66
+
let is_vector = Chibi_ffi.is_vector
67
+
let is_bytevector = Chibi_ffi.is_bytes
68
+
let is_procedure = Chibi_ffi.is_procedure
69
+
let is_port = Chibi_ffi.is_port
70
+
let is_void = Chibi_ffi.is_void
71
+
let is_eof = Chibi_ffi.is_eof
72
+
let is_true = Chibi_ffi.sexp_truep
73
+
74
+
(* Pair accessors *)
75
+
let car = Chibi_ffi.car
76
+
let cdr = Chibi_ffi.cdr
77
+
78
+
let caar s = car (car s)
79
+
let cadr s = car (cdr s)
80
+
let cdar s = cdr (car s)
81
+
let cddr s = cdr (cdr s)
82
+
83
+
(* Extraction *)
84
+
let to_int s =
85
+
if Chibi_ffi.is_fixnum s then Chibi_ffi.unbox_fixnum s
86
+
else raise (Type_error "expected fixnum")
87
+
88
+
let to_float s =
89
+
if Chibi_ffi.is_flonum s then Chibi_ffi.unbox_flonum s
90
+
else if Chibi_ffi.is_fixnum s then Float.of_int (Chibi_ffi.unbox_fixnum s)
91
+
else raise (Type_error "expected number")
92
+
93
+
let to_string s =
94
+
if Chibi_ffi.is_string s then Chibi_ffi.unbox_string s
95
+
else raise (Type_error "expected string")
96
+
97
+
let to_symbol s =
98
+
if Chibi_ffi.is_symbol s then Chibi_ffi.unbox_symbol s
99
+
else raise (Type_error "expected symbol")
100
+
101
+
let to_bool s =
102
+
if Chibi_ffi.is_boolean s then Chibi_ffi.unbox_boolean s
103
+
else raise (Type_error "expected boolean")
104
+
105
+
let to_char s =
106
+
if Chibi_ffi.is_char s then Chibi_ffi.unbox_char s
107
+
else raise (Type_error "expected char")
108
+
109
+
let to_bytes s =
110
+
if Chibi_ffi.is_bytes s then Chibi_ffi.unbox_bytes s
111
+
else raise (Type_error "expected bytevector")
112
+
113
+
(** Convert a scheme list to an OCaml list *)
114
+
let to_list (s : t) : t list =
115
+
let rec loop acc s =
116
+
if Chibi_ffi.is_null s then List.rev acc
117
+
else if Chibi_ffi.is_pair s then
118
+
loop (Chibi_ffi.car s :: acc) (Chibi_ffi.cdr s)
119
+
else raise (Type_error "expected proper list")
120
+
in
121
+
loop [] s
122
+
123
+
(** Convert a scheme vector to an OCaml array *)
124
+
let to_array (s : t) : t array =
125
+
if not (Chibi_ffi.is_vector s) then
126
+
raise (Type_error "expected vector");
127
+
let len = Chibi_ffi.vector_length s in
128
+
Array.init len (fun i -> Chibi_ffi.vector_ref s i)
129
+
130
+
(** Pointer equality *)
131
+
let equal = Chibi_ffi.sexp_equal
132
+
133
+
(** List length *)
134
+
let list_length = Chibi_ffi.list_length
135
+
end
136
+
137
+
(** {1 Sandbox - Capability-based security} *)
138
+
139
+
module Sandbox = struct
140
+
(** Capabilities that can be granted to a sandboxed VM *)
141
+
type capability =
142
+
| File_read (** Allow reading files *)
143
+
| File_write (** Allow writing files *)
144
+
| Net_access (** Allow network access *)
145
+
| Process_exec (** Allow exec/system calls *)
146
+
| Env_access (** Allow environment variable access *)
147
+
| Module_import (** Allow importing modules *)
148
+
| Standard_io (** Allow stdin/stdout/stderr *)
149
+
150
+
type t = {
151
+
capabilities : capability list;
152
+
}
153
+
154
+
(** No capabilities at all - maximum sandbox *)
155
+
let none = { capabilities = [] }
156
+
157
+
(** All capabilities - no restrictions *)
158
+
let full = {
159
+
capabilities = [
160
+
File_read; File_write; Net_access; Process_exec;
161
+
Env_access; Module_import; Standard_io;
162
+
]
163
+
}
164
+
165
+
let allow caps = { capabilities = caps }
166
+
167
+
let has_capability sandbox cap =
168
+
List.mem cap sandbox.capabilities
169
+
end
170
+
171
+
(** {1 Context - Scheme VM instance} *)
172
+
173
+
module Context = struct
174
+
type t = {
175
+
raw : Chibi_ffi.context;
176
+
sandbox : Sandbox.t;
177
+
mutable destroyed : bool;
178
+
}
179
+
180
+
type config = {
181
+
heap_size : int;
182
+
max_heap_size : int;
183
+
sandbox : Sandbox.t;
184
+
module_paths : string list;
185
+
}
186
+
187
+
let default_config = {
188
+
heap_size = 0; (* 0 = use chibi default (2MB) *)
189
+
max_heap_size = 0; (* 0 = unlimited *)
190
+
sandbox = Sandbox.full; (* full access by default *)
191
+
module_paths = [];
192
+
}
193
+
194
+
let sandboxed_config ?(heap_size = 2 * 1024 * 1024)
195
+
?(max_heap_size = 16 * 1024 * 1024)
196
+
?(capabilities = []) () =
197
+
{
198
+
heap_size;
199
+
max_heap_size;
200
+
sandbox = Sandbox.allow capabilities;
201
+
module_paths = [];
202
+
}
203
+
204
+
let check_alive t =
205
+
if t.destroyed then raise Context_destroyed
206
+
207
+
(** Override a list of bindings with void in the current environment.
208
+
Silently ignores bindings that don't exist. *)
209
+
let nullify_bindings ctx names =
210
+
let void = Chibi_ffi.sexp_void ctx in
211
+
List.iter (fun name ->
212
+
try Chibi_ffi.env_define ctx name void with _ -> ()
213
+
) names
214
+
215
+
(** Install sandbox restrictions by overriding dangerous bindings with
216
+
void and redirecting I/O ports.
217
+
218
+
The sandbox enforces restrictions on the interaction environment after
219
+
the standard library has been loaded. Each capability that is NOT
220
+
granted causes the corresponding bindings to be replaced with void.
221
+
222
+
This covers bindings from (scheme base), (scheme file),
223
+
(chibi filesystem), (chibi process), (chibi net), (chibi system),
224
+
(chibi shell), (scheme process-context), (scheme eval), (scheme load),
225
+
and related modules. *)
226
+
let apply_sandbox (t : t) =
227
+
let sandbox = t.sandbox in
228
+
let ctx = t.raw in
229
+
230
+
(* Standard I/O: redirect ports to null string ports *)
231
+
if not (Sandbox.has_capability sandbox Sandbox.Standard_io) then begin
232
+
let null_in = Chibi_ffi.open_input_string ctx "" in
233
+
let null_out = Chibi_ffi.open_output_string ctx in
234
+
let null_err = Chibi_ffi.open_output_string ctx in
235
+
Chibi_ffi.set_current_input_port ctx null_in;
236
+
Chibi_ffi.set_current_output_port ctx null_out;
237
+
Chibi_ffi.set_current_error_port ctx null_err
238
+
end;
239
+
240
+
(* File read: all filesystem reading operations *)
241
+
if not (Sandbox.has_capability sandbox Sandbox.File_read) then
242
+
nullify_bindings ctx [
243
+
"open-input-file"; "open-binary-input-file";
244
+
"call-with-input-file"; "with-input-from-file";
245
+
"file-exists?"; "file->string"; "file->bytevector";
246
+
"open-input-file-descriptor";
247
+
"directory-files"; "directory-fold"; "directory-fold-tree";
248
+
"read-link"; "file-status"; "file-link-status";
249
+
"file-device"; "file-inode"; "file-mode"; "file-num-links";
250
+
"file-owner"; "file-group"; "file-represented-device";
251
+
"file-size"; "file-block-size"; "file-num-blocks";
252
+
"file-access-time"; "file-change-time";
253
+
"file-modification-time"; "file-modification-time/safe";
254
+
"file-regular?"; "file-directory?"; "file-character?";
255
+
"file-block?"; "file-fifo?"; "file-link?"; "file-socket?";
256
+
"file-is-readable?"; "file-is-writable?"; "file-is-executable?";
257
+
"get-file-descriptor-flags"; "get-file-descriptor-status";
258
+
"current-directory"; "is-a-tty?"; "file-position";
259
+
"include"; "include-ci"; "load";
260
+
];
261
+
262
+
(* File write: all filesystem writing/modification operations *)
263
+
if not (Sandbox.has_capability sandbox Sandbox.File_write) then
264
+
nullify_bindings ctx [
265
+
"open-output-file"; "open-binary-output-file";
266
+
"call-with-output-file"; "with-output-to-file";
267
+
"delete-file"; "rename-file"; "link-file"; "symbolic-link-file";
268
+
"create-directory"; "create-directory*";
269
+
"delete-directory"; "delete-file-hierarchy";
270
+
"open-output-file-descriptor"; "open-output-file/append";
271
+
"make-fifo"; "file-truncate"; "file-lock";
272
+
"chmod"; "chown";
273
+
"set-file-descriptor-flags!"; "set-file-descriptor-status!";
274
+
"set-file-position!"; "change-directory"; "with-directory";
275
+
"send-file"; "call-with-temp-file"; "call-with-temp-dir";
276
+
(* low-level fd operations that enable write *)
277
+
"duplicate-file-descriptor"; "duplicate-file-descriptor-to";
278
+
"renumber-file-descriptor"; "open-pipe";
279
+
];
280
+
281
+
(* Network: all socket, connection, and HTTP operations *)
282
+
if not (Sandbox.has_capability sandbox Sandbox.Net_access) then
283
+
nullify_bindings ctx [
284
+
"socket"; "connect"; "bind"; "accept"; "listen";
285
+
"open-socket-pair"; "with-net-io"; "open-net-io";
286
+
"make-listener-socket";
287
+
"send"; "receive!"; "receive";
288
+
"send/non-blocking"; "receive!/non-blocking"; "receive/non-blocking";
289
+
"get-address-info"; "make-address-info"; "make-sockaddr";
290
+
"get-socket-option"; "set-socket-option!"; "get-peer-name";
291
+
"run-net-server"; "make-listener-thunk";
292
+
"http-get"; "http-get/headers"; "http-get-to-file";
293
+
"http-head"; "http-post"; "http-put"; "http-delete";
294
+
"call-with-input-url"; "call-with-input-url/headers";
295
+
"with-input-from-url";
296
+
"run-http-server"; "http-file-servlet";
297
+
"http-cgi-bin-dir-servlet"; "http-scheme-script-dir-servlet";
298
+
];
299
+
300
+
(* Process execution: fork, exec, system, signals, shell *)
301
+
if not (Sandbox.has_capability sandbox Sandbox.Process_exec) then
302
+
nullify_bindings ctx [
303
+
"%fork"; "fork"; "execute"; "kill"; "waitpid";
304
+
"system"; "system?"; "exit"; "emergency-exit";
305
+
"sleep"; "alarm";
306
+
"process-command-line"; "process-running?";
307
+
"set-signal-action!"; "signal-mask-block!";
308
+
"signal-mask-unblock!"; "signal-mask-set!";
309
+
"call-with-process-io";
310
+
"process->bytevector"; "process->string";
311
+
"process->sexp"; "process->string-list";
312
+
"process->output+error"; "process->output+error+status";
313
+
(* shell module *)
314
+
"shell"; "shell&"; "shell-pipe"; "call-with-shell-io";
315
+
"shell->string"; "shell->string-list";
316
+
"shell->sexp"; "shell->sexp-list"; "shell->output&error";
317
+
"shell-do"; "shell-command";
318
+
(* privilege escalation *)
319
+
"set-current-user-id!"; "set-current-effective-user-id!";
320
+
"set-current-group-id!"; "set-current-effective-group-id!";
321
+
"set-root-directory!"; "create-session";
322
+
];
323
+
324
+
(* Environment access: env vars, host/user info *)
325
+
if not (Sandbox.has_capability sandbox Sandbox.Env_access) then
326
+
nullify_bindings ctx [
327
+
"get-environment-variable"; "get-environment-variables";
328
+
"command-line";
329
+
"get-host-name"; "user-information"; "group-information";
330
+
"user-name"; "user-password"; "user-id"; "user-group-id";
331
+
"user-gecos"; "user-home"; "user-shell";
332
+
"group-name"; "group-password"; "group-id";
333
+
"current-user-id"; "current-group-id";
334
+
"current-effective-user-id"; "current-effective-group-id";
335
+
"current-process-id"; "parent-process-id";
336
+
"current-session-id";
337
+
]
338
+
339
+
(** Create a new Scheme VM context. *)
340
+
let create ?(config = default_config) () =
341
+
let raw = Chibi_ffi.create_context config.heap_size config.max_heap_size in
342
+
let t = { raw; sandbox = config.sandbox; destroyed = false } in
343
+
(* Set up module path: vendored lib directory must be added BEFORE
344
+
loading the standard environment, since init-7.scm lives there. *)
345
+
(match Chibi_config.find_lib_dir () with
346
+
| Some dir -> Chibi_ffi.add_module_directory raw dir
347
+
| None -> ());
348
+
(* Add user-specified module paths *)
349
+
List.iter (fun dir -> Chibi_ffi.add_module_directory raw dir) config.module_paths;
350
+
(* Load standard environment if module import is allowed *)
351
+
if Sandbox.has_capability config.sandbox Sandbox.Module_import then begin
352
+
Chibi_ffi.load_standard_env raw;
353
+
if Sandbox.has_capability config.sandbox Sandbox.Standard_io then
354
+
Chibi_ffi.load_standard_ports raw
355
+
end;
356
+
(* Apply sandbox restrictions *)
357
+
apply_sandbox t;
358
+
(* Register finalizer *)
359
+
Gc.finalise (fun t ->
360
+
if not t.destroyed then begin
361
+
Chibi_ffi.destroy_context t.raw;
362
+
t.destroyed <- true
363
+
end
364
+
) t;
365
+
t
366
+
367
+
(** Destroy the context, freeing all chibi-scheme resources. *)
368
+
let destroy t =
369
+
if not t.destroyed then begin
370
+
Chibi_ffi.destroy_context t.raw;
371
+
t.destroyed <- true
372
+
end
373
+
374
+
(** Check if the context is still alive. *)
375
+
let is_alive t = not t.destroyed && Chibi_ffi.context_is_alive t.raw
376
+
377
+
(** Get heap statistics *)
378
+
let heap_size t =
379
+
check_alive t;
380
+
Chibi_ffi.heap_size t.raw
381
+
382
+
let heap_max_size t =
383
+
check_alive t;
384
+
Chibi_ffi.heap_max_size t.raw
385
+
386
+
(** Trigger garbage collection. Returns approximate bytes freed. *)
387
+
let gc t =
388
+
check_alive t;
389
+
Chibi_ffi.gc t.raw
390
+
391
+
(** Get the raw FFI context (for advanced usage) *)
392
+
let raw t =
393
+
check_alive t;
394
+
t.raw
395
+
end
396
+
397
+
(** {1 Value construction} *)
398
+
399
+
module Value = struct
400
+
let void ctx =
401
+
Context.check_alive ctx;
402
+
Chibi_ffi.sexp_void ctx.Context.raw
403
+
404
+
let null ctx =
405
+
Context.check_alive ctx;
406
+
Chibi_ffi.sexp_null ctx.Context.raw
407
+
408
+
let eof ctx =
409
+
Context.check_alive ctx;
410
+
Chibi_ffi.sexp_eof ctx.Context.raw
411
+
412
+
let of_bool ctx b =
413
+
Context.check_alive ctx;
414
+
if b then Chibi_ffi.sexp_true ctx.Context.raw
415
+
else Chibi_ffi.sexp_false ctx.Context.raw
416
+
417
+
let of_int ctx n =
418
+
Context.check_alive ctx;
419
+
Chibi_ffi.make_fixnum ctx.Context.raw n
420
+
421
+
let of_float ctx f =
422
+
Context.check_alive ctx;
423
+
Chibi_ffi.make_flonum ctx.Context.raw f
424
+
425
+
let of_string ctx s =
426
+
Context.check_alive ctx;
427
+
Chibi_ffi.make_string ctx.Context.raw s
428
+
429
+
let of_symbol ctx s =
430
+
Context.check_alive ctx;
431
+
Chibi_ffi.intern ctx.Context.raw s
432
+
433
+
let of_char ctx c =
434
+
Context.check_alive ctx;
435
+
Chibi_ffi.make_char ctx.Context.raw (Char.code c)
436
+
437
+
let of_char_code ctx c =
438
+
Context.check_alive ctx;
439
+
Chibi_ffi.make_char ctx.Context.raw c
440
+
441
+
let of_bytes ctx b =
442
+
Context.check_alive ctx;
443
+
Chibi_ffi.make_bytes ctx.Context.raw b
444
+
445
+
let cons ctx a b =
446
+
Context.check_alive ctx;
447
+
Chibi_ffi.cons ctx.Context.raw a b
448
+
449
+
(** Build a proper scheme list from an OCaml list *)
450
+
let of_list ctx items =
451
+
Context.check_alive ctx;
452
+
let raw = ctx.Context.raw in
453
+
List.fold_right (fun x acc -> Chibi_ffi.cons raw x acc)
454
+
items (Chibi_ffi.sexp_null raw)
455
+
456
+
(** Build a scheme vector from an OCaml array *)
457
+
let of_array ctx arr =
458
+
Context.check_alive ctx;
459
+
let raw = ctx.Context.raw in
460
+
let void = Chibi_ffi.sexp_void raw in
461
+
let vec = Chibi_ffi.make_vector raw (Array.length arr) void in
462
+
Array.iteri (fun i v -> Chibi_ffi.vector_set vec i v) arr;
463
+
vec
464
+
465
+
(** Build a scheme list of integers *)
466
+
let of_int_list ctx lst =
467
+
of_list ctx (List.map (fun n -> of_int ctx n) lst)
468
+
469
+
(** Build a scheme list of strings *)
470
+
let of_string_list ctx lst =
471
+
of_list ctx (List.map (fun s -> of_string ctx s) lst)
472
+
end
473
+
474
+
(** {1 Eval - Expression evaluation} *)
475
+
476
+
module Eval = struct
477
+
let string ctx code =
478
+
Context.check_alive ctx;
479
+
try Chibi_ffi.eval_string ctx.Context.raw code
480
+
with Failure msg -> raise (Chibi_error msg)
481
+
482
+
let sexp ctx s =
483
+
Context.check_alive ctx;
484
+
try Chibi_ffi.eval ctx.Context.raw s
485
+
with Failure msg -> raise (Chibi_error msg)
486
+
487
+
let apply ctx proc args =
488
+
Context.check_alive ctx;
489
+
try Chibi_ffi.apply ctx.Context.raw proc args
490
+
with Failure msg -> raise (Chibi_error msg)
491
+
492
+
let load ctx path =
493
+
Context.check_alive ctx;
494
+
try Chibi_ffi.load_file ctx.Context.raw path
495
+
with Failure msg -> raise (Chibi_error msg)
496
+
497
+
let load_direct ctx path =
498
+
Context.check_alive ctx;
499
+
try Chibi_ffi.load_file_direct ctx.Context.raw path
500
+
with Failure msg -> raise (Chibi_error msg)
501
+
502
+
let read ctx code =
503
+
Context.check_alive ctx;
504
+
try Chibi_ffi.read_from_string ctx.Context.raw code
505
+
with Failure msg -> raise (Chibi_error msg)
506
+
507
+
(** Evaluate and convert result to string *)
508
+
let to_string ctx code =
509
+
let result = string ctx code in
510
+
Chibi_ffi.sexp_to_string ctx.Context.raw result
511
+
512
+
(** Evaluate and convert to int *)
513
+
let to_int ctx code =
514
+
Sexp.to_int (string ctx code)
515
+
516
+
(** Evaluate and convert to float *)
517
+
let to_float ctx code =
518
+
Sexp.to_float (string ctx code)
519
+
520
+
(** Evaluate and convert to bool *)
521
+
let to_bool ctx code =
522
+
Sexp.to_bool (string ctx code)
523
+
524
+
(** Write a sexp to its string representation *)
525
+
let write ctx s =
526
+
Context.check_alive ctx;
527
+
Chibi_ffi.sexp_to_string ctx.Context.raw s
528
+
529
+
(** Display a sexp (strings without quotes) *)
530
+
let display ctx s =
531
+
Context.check_alive ctx;
532
+
Chibi_ffi.sexp_display_string ctx.Context.raw s
533
+
end
534
+
535
+
(** {1 Env - Environment bindings} *)
536
+
537
+
module Env = struct
538
+
(** Define a binding in the current environment *)
539
+
let define ctx name value =
540
+
Context.check_alive ctx;
541
+
try Chibi_ffi.env_define ctx.Context.raw name value
542
+
with Failure msg -> raise (Chibi_error msg)
543
+
544
+
(** Look up a binding *)
545
+
let lookup ctx name =
546
+
Context.check_alive ctx;
547
+
let v = Chibi_ffi.env_ref ctx.Context.raw name in
548
+
if Chibi_ffi.is_void v then None
549
+
else Some v
550
+
551
+
(** Look up a binding, raising if not found *)
552
+
let lookup_exn ctx name =
553
+
match lookup ctx name with
554
+
| Some v -> v
555
+
| None -> raise (Chibi_error ("unbound variable: " ^ name))
556
+
557
+
(** Register a foreign function callable from Scheme.
558
+
The OCaml function receives a list of Sexp.t arguments. *)
559
+
let define_function ctx name arity (f : Sexp.t list -> Sexp.t) =
560
+
Context.check_alive ctx;
561
+
try Chibi_ffi.define_foreign ctx.Context.raw name arity f
562
+
with Failure msg -> raise (Chibi_error msg)
563
+
564
+
(** Convenience: define a 0-arity function *)
565
+
let define_fn0 ctx name (f : unit -> Sexp.t) =
566
+
define_function ctx name 0 (fun _args -> f ())
567
+
568
+
(** Convenience: define a 1-arity function *)
569
+
let define_fn1 ctx name (f : Sexp.t -> Sexp.t) =
570
+
define_function ctx name 1 (function
571
+
| [a] -> f a
572
+
| _ -> raise (Chibi_error ("wrong arity for " ^ name)))
573
+
574
+
(** Convenience: define a 2-arity function *)
575
+
let define_fn2 ctx name (f : Sexp.t -> Sexp.t -> Sexp.t) =
576
+
define_function ctx name 2 (function
577
+
| [a; b] -> f a b
578
+
| _ -> raise (Chibi_error ("wrong arity for " ^ name)))
579
+
580
+
(** Convenience: define a 3-arity function *)
581
+
let define_fn3 ctx name (f : Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) =
582
+
define_function ctx name 3 (function
583
+
| [a; b; c] -> f a b c
584
+
| _ -> raise (Chibi_error ("wrong arity for " ^ name)))
585
+
586
+
(** Convenience: define a 4-arity function *)
587
+
let define_fn4 ctx name (f : Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) =
588
+
define_function ctx name 4 (function
589
+
| [a; b; c; d] -> f a b c d
590
+
| _ -> raise (Chibi_error ("wrong arity for " ^ name)))
591
+
592
+
(** Convenience: define a 5-arity function *)
593
+
let define_fn5 ctx name
594
+
(f : Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) =
595
+
define_function ctx name 5 (function
596
+
| [a; b; c; d; e] -> f a b c d e
597
+
| _ -> raise (Chibi_error ("wrong arity for " ^ name)))
598
+
599
+
(** Convenience: define a 6-arity function *)
600
+
let define_fn6 ctx name
601
+
(f : Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) =
602
+
define_function ctx name 6 (function
603
+
| [a; b; c; d; e; g] -> f a b c d e g
604
+
| _ -> raise (Chibi_error ("wrong arity for " ^ name)))
605
+
end
606
+
607
+
(** {1 Stream - Effect-based data streaming} *)
608
+
609
+
module Stream = struct
610
+
(** Effect type for yielding values into the stream *)
611
+
type _ Effect.t += Yield : Sexp.t -> unit Effect.t
612
+
613
+
(** A stream is a lazy sequence of sexp values *)
614
+
type t = Sexp.t Seq.t
615
+
616
+
(** Create a Seq.t from a function that uses Yield to produce values *)
617
+
let from_producer (f : unit -> unit) : t =
618
+
let open Effect.Deep in
619
+
fun () ->
620
+
match_with f ()
621
+
{ retc = (fun () -> Seq.Nil);
622
+
exnc = (fun e -> raise e);
623
+
effc = fun (type a) (eff : a Effect.t) ->
624
+
match eff with
625
+
| Yield v ->
626
+
Some (fun (k : (a, _) continuation) ->
627
+
Seq.Cons (v, fun () -> continue k ()))
628
+
| _ -> None }
629
+
630
+
(** Feed an OCaml Seq.t into a Scheme function, one element at a time.
631
+
The Scheme function is called for each element. Returns the
632
+
final accumulator value. *)
633
+
let feed ctx ~(proc : Sexp.t) ~(init : Sexp.t) (seq : Sexp.t Seq.t) : Sexp.t =
634
+
Context.check_alive ctx;
635
+
let raw = ctx.Context.raw in
636
+
let acc = ref init in
637
+
let s = ref seq in
638
+
let continue = ref true in
639
+
while !continue do
640
+
match (!s) () with
641
+
| Seq.Nil -> continue := false
642
+
| Seq.Cons (v, rest) ->
643
+
let args = Chibi_ffi.cons raw v
644
+
(Chibi_ffi.cons raw !acc (Chibi_ffi.sexp_null raw)) in
645
+
(try
646
+
acc := Chibi_ffi.apply raw proc args
647
+
with Failure msg -> raise (Chibi_error msg));
648
+
s := rest
649
+
done;
650
+
!acc
651
+
652
+
(** Process a Seq.t through a Scheme expression.
653
+
[expr] should be a string like "(lambda (x acc) (+ acc x))".
654
+
Returns the accumulated result. *)
655
+
let fold ctx ~expr ~init seq =
656
+
Context.check_alive ctx;
657
+
let proc = Eval.string ctx expr in
658
+
feed ctx ~proc ~init seq
659
+
660
+
(** Map a Scheme function over a Seq.t, producing a new Seq.t.
661
+
[proc] is a Scheme procedure sexp. *)
662
+
let map ctx ~(proc : Sexp.t) (seq : Sexp.t Seq.t) : Sexp.t Seq.t =
663
+
Context.check_alive ctx;
664
+
let raw = ctx.Context.raw in
665
+
Seq.map (fun v ->
666
+
let args = Chibi_ffi.cons raw v (Chibi_ffi.sexp_null raw) in
667
+
try Chibi_ffi.apply raw proc args
668
+
with Failure msg -> raise (Chibi_error msg)
669
+
) seq
670
+
671
+
(** Filter a Seq.t using a Scheme predicate. *)
672
+
let filter ctx ~(pred : Sexp.t) (seq : Sexp.t Seq.t) : Sexp.t Seq.t =
673
+
Context.check_alive ctx;
674
+
let raw = ctx.Context.raw in
675
+
Seq.filter (fun v ->
676
+
let args = Chibi_ffi.cons raw v (Chibi_ffi.sexp_null raw) in
677
+
let result =
678
+
try Chibi_ffi.apply raw pred args
679
+
with Failure msg -> raise (Chibi_error msg)
680
+
in
681
+
Chibi_ffi.sexp_truep result
682
+
) seq
683
+
684
+
(** Create a stream from an OCaml channel, reading lines as scheme strings *)
685
+
let of_channel ctx (ic : in_channel) : Sexp.t Seq.t =
686
+
let raw = ctx.Context.raw in
687
+
let rec next () =
688
+
match In_channel.input_line ic with
689
+
| None -> Seq.Nil
690
+
| Some line ->
691
+
Seq.Cons (Chibi_ffi.make_string raw line, next)
692
+
in
693
+
next
694
+
695
+
(** Create a stream of scheme integers from an int Seq *)
696
+
let of_int_seq ctx (seq : int Seq.t) : Sexp.t Seq.t =
697
+
let raw = ctx.Context.raw in
698
+
Seq.map (fun n -> Chibi_ffi.make_fixnum raw n) seq
699
+
700
+
(** Create a stream of scheme strings from a string Seq *)
701
+
let of_string_seq ctx (seq : string Seq.t) : Sexp.t Seq.t =
702
+
let raw = ctx.Context.raw in
703
+
Seq.map (fun s -> Chibi_ffi.make_string raw s) seq
704
+
705
+
(** Collect a Sexp.t Seq into a scheme list *)
706
+
let to_scheme_list ctx (seq : Sexp.t Seq.t) : Sexp.t =
707
+
Context.check_alive ctx;
708
+
let raw = ctx.Context.raw in
709
+
let items = List.of_seq seq in
710
+
List.fold_right (fun x acc -> Chibi_ffi.cons raw x acc)
711
+
items (Chibi_ffi.sexp_null raw)
712
+
713
+
(** Collect a stream, extracting ints *)
714
+
let to_int_list (seq : Sexp.t Seq.t) : int list =
715
+
List.of_seq (Seq.map Sexp.to_int seq)
716
+
717
+
(** Collect a stream, extracting strings *)
718
+
let to_string_list (seq : Sexp.t Seq.t) : string list =
719
+
List.of_seq (Seq.map Sexp.to_string seq)
720
+
end
721
+
722
+
(** {1 IO - Port redirection and output capture} *)
723
+
724
+
module Io = struct
725
+
(** Redirect current output and error ports to string ports,
726
+
evaluate [f], and return the captured output.
727
+
Original ports are saved and restored afterward. *)
728
+
let capture ctx f =
729
+
Context.check_alive ctx;
730
+
let raw = ctx.Context.raw in
731
+
(* Save original ports *)
732
+
let orig_out = Chibi_ffi.get_current_output_port raw in
733
+
let orig_err = Chibi_ffi.get_current_error_port raw in
734
+
(* Redirect to string ports *)
735
+
let out_port = Chibi_ffi.open_output_string raw in
736
+
let err_port = Chibi_ffi.open_output_string raw in
737
+
Chibi_ffi.set_current_output_port raw out_port;
738
+
Chibi_ffi.set_current_error_port raw err_port;
739
+
let result =
740
+
try Ok (f ())
741
+
with e -> Error e
742
+
in
743
+
let stdout_str = Chibi_ffi.get_output_string raw out_port in
744
+
let stderr_str = Chibi_ffi.get_output_string raw err_port in
745
+
(* Restore original ports *)
746
+
Chibi_ffi.set_current_output_port raw orig_out;
747
+
Chibi_ffi.set_current_error_port raw orig_err;
748
+
(result, stdout_str, stderr_str)
749
+
750
+
(** Set the current input port to read from a string. *)
751
+
let set_input_string ctx s =
752
+
Context.check_alive ctx;
753
+
let raw = ctx.Context.raw in
754
+
let port = Chibi_ffi.open_input_string raw s in
755
+
Chibi_ffi.set_current_input_port raw port
756
+
757
+
(** Set the current output port to a string port and return
758
+
a function to retrieve the accumulated string. *)
759
+
let redirect_output ctx =
760
+
Context.check_alive ctx;
761
+
let raw = ctx.Context.raw in
762
+
let port = Chibi_ffi.open_output_string raw in
763
+
Chibi_ffi.set_current_output_port raw port;
764
+
fun () -> Chibi_ffi.get_output_string raw port
765
+
end
766
+
767
+
(** {1 Convenience: with_context} *)
768
+
769
+
(** Create a context, run [f], and destroy it when done.
770
+
Ensures cleanup even if [f] raises. *)
771
+
let with_context ?(config = Context.default_config) f =
772
+
let ctx = Context.create ~config () in
773
+
Fun.protect
774
+
~finally:(fun () -> Context.destroy ctx)
775
+
(fun () -> f ctx)
+369
lib/chibi.mli
+369
lib/chibi.mli
···
1
+
(** {1 chibi-ocaml: OCaml bindings for chibi-scheme}
2
+
3
+
Embed one or more sandboxed R7RS Scheme virtual machines in your OCaml
4
+
programs. Each VM has an independent heap with configurable memory limits
5
+
and capability-based security.
6
+
7
+
{2 Quick example}
8
+
9
+
{[
10
+
open Chibi_ocaml.Chibi
11
+
12
+
let () =
13
+
with_context (fun ctx ->
14
+
(* Evaluate Scheme code *)
15
+
let result = Eval.to_int ctx "(+ 2 3)" in
16
+
Printf.printf "2 + 3 = %d\n" result;
17
+
18
+
(* Register OCaml functions *)
19
+
Env.define_fn1 ctx "double" (fun x ->
20
+
Value.of_int ctx (Sexp.to_int x * 2));
21
+
let r = Eval.to_int ctx "(double 21)" in
22
+
Printf.printf "double 21 = %d\n" r)
23
+
]}
24
+
25
+
{2 Thread safety}
26
+
27
+
Each {!Context.t} is an independent VM with its own heap. Different
28
+
contexts may be used from different OCaml domains without synchronization.
29
+
A single context must {b not} be accessed concurrently from multiple
30
+
threads or domains.
31
+
32
+
{2 Memory management}
33
+
34
+
Scheme values ({!Sexp.t}) are automatically prevented from collection by
35
+
chibi-scheme's GC while OCaml holds a reference. When the OCaml wrapper
36
+
is garbage-collected, the protection is released. You do not need to
37
+
manually manage Scheme value lifetimes.
38
+
39
+
Contexts should be explicitly destroyed with {!Context.destroy} or
40
+
managed with {!with_context}. If you forget, the OCaml GC finalizer
41
+
will clean up, but explicit cleanup is recommended.
42
+
43
+
{2 Modules} *)
44
+
45
+
(** {2 Exceptions} *)
46
+
47
+
exception Chibi_error of string
48
+
(** Raised when chibi-scheme evaluation or API operations fail. *)
49
+
50
+
exception Context_destroyed
51
+
(** Raised when attempting to use a context that has been destroyed. *)
52
+
53
+
exception Type_error of string
54
+
(** Raised when extracting a value of the wrong type from a sexp. *)
55
+
56
+
(** {2 Sexp - Scheme values} *)
57
+
58
+
module Sexp : sig
59
+
(** An opaque Scheme value (s-expression). *)
60
+
type t
61
+
62
+
(** Type tag for classifying values. *)
63
+
type tag =
64
+
| Null
65
+
| Boolean of bool
66
+
| Fixnum of int
67
+
| Flonum of float
68
+
| Char of int
69
+
| String of string
70
+
| Symbol of string
71
+
| Pair
72
+
| Vector
73
+
| Bytevector
74
+
| Procedure
75
+
| Port
76
+
| Void
77
+
| Eof
78
+
| Other
79
+
80
+
val classify : t -> tag
81
+
(** Classify a sexp into its type tag. Useful for pattern matching. *)
82
+
83
+
(** {3 Type predicates} *)
84
+
85
+
val is_null : t -> bool
86
+
val is_pair : t -> bool
87
+
val is_symbol : t -> bool
88
+
val is_string : t -> bool
89
+
val is_fixnum : t -> bool
90
+
val is_flonum : t -> bool
91
+
val is_number : t -> bool
92
+
val is_boolean : t -> bool
93
+
val is_char : t -> bool
94
+
val is_vector : t -> bool
95
+
val is_bytevector : t -> bool
96
+
val is_procedure : t -> bool
97
+
val is_port : t -> bool
98
+
val is_void : t -> bool
99
+
val is_eof : t -> bool
100
+
val is_true : t -> bool
101
+
102
+
(** {3 Pair accessors} *)
103
+
104
+
val car : t -> t
105
+
val cdr : t -> t
106
+
val caar : t -> t
107
+
val cadr : t -> t
108
+
val cdar : t -> t
109
+
val cddr : t -> t
110
+
111
+
(** {3 Value extraction}
112
+
These raise {!Type_error} if the value has the wrong type. *)
113
+
114
+
val to_int : t -> int
115
+
val to_float : t -> float
116
+
val to_string : t -> string
117
+
val to_symbol : t -> string
118
+
val to_bool : t -> bool
119
+
val to_char : t -> int
120
+
val to_bytes : t -> bytes
121
+
122
+
(** {3 Collection conversions} *)
123
+
124
+
val to_list : t -> t list
125
+
(** Convert a Scheme list to an OCaml list. *)
126
+
127
+
val to_array : t -> t array
128
+
(** Convert a Scheme vector to an OCaml array. *)
129
+
130
+
val list_length : t -> int
131
+
(** Length of a Scheme list. *)
132
+
133
+
(** {3 Equality} *)
134
+
135
+
val equal : t -> t -> bool
136
+
(** Pointer equality (eq?) between two sexp values. *)
137
+
end
138
+
139
+
(** {2 Sandbox - Capability-based security} *)
140
+
141
+
module Sandbox : sig
142
+
(** A capability that can be granted to a VM. *)
143
+
type capability =
144
+
| File_read (** Allow reading files *)
145
+
| File_write (** Allow writing files *)
146
+
| Net_access (** Allow network access *)
147
+
| Process_exec (** Allow exec/system calls *)
148
+
| Env_access (** Allow environment variable access *)
149
+
| Module_import (** Allow importing modules *)
150
+
| Standard_io (** Allow stdin/stdout/stderr *)
151
+
152
+
(** Sandbox configuration. *)
153
+
type t
154
+
155
+
val none : t
156
+
(** Maximum sandbox: no capabilities granted. *)
157
+
158
+
val full : t
159
+
(** No restrictions: all capabilities granted. *)
160
+
161
+
val allow : capability list -> t
162
+
(** Create a sandbox granting only the specified capabilities. *)
163
+
164
+
val has_capability : t -> capability -> bool
165
+
(** Check if a sandbox has a specific capability. *)
166
+
end
167
+
168
+
(** {2 Context - Scheme VM instance} *)
169
+
170
+
module Context : sig
171
+
(** A Scheme VM instance with its own independent heap. *)
172
+
type t
173
+
174
+
(** Configuration for creating a context. *)
175
+
type config = {
176
+
heap_size : int; (** Initial heap size in bytes (0 = default ~2MB) *)
177
+
max_heap_size : int; (** Maximum heap size in bytes (0 = unlimited) *)
178
+
sandbox : Sandbox.t; (** Sandbox configuration *)
179
+
module_paths : string list; (** Additional module search paths *)
180
+
}
181
+
182
+
val default_config : config
183
+
(** Default configuration: full access, default heap, no limits. *)
184
+
185
+
val sandboxed_config :
186
+
?heap_size:int -> ?max_heap_size:int ->
187
+
?capabilities:Sandbox.capability list ->
188
+
unit -> config
189
+
(** Create a sandboxed configuration. Default: 2MB initial / 16MB max,
190
+
no capabilities. *)
191
+
192
+
val create : ?config:config -> unit -> t
193
+
(** Create a new Scheme VM context. *)
194
+
195
+
val destroy : t -> unit
196
+
(** Destroy the context, freeing all resources. Safe to call multiple times. *)
197
+
198
+
val is_alive : t -> bool
199
+
(** Check if the context has not been destroyed. *)
200
+
201
+
val heap_size : t -> int
202
+
(** Current total heap size in bytes. *)
203
+
204
+
val heap_max_size : t -> int
205
+
(** Maximum allowed heap size (0 = unlimited). *)
206
+
207
+
val gc : t -> int
208
+
(** Trigger garbage collection. Returns approximate bytes freed. *)
209
+
210
+
val raw : t -> Chibi_ffi.context
211
+
(** Access the raw FFI context for advanced usage. *)
212
+
end
213
+
214
+
(** {2 Value - Constructing Scheme values} *)
215
+
216
+
module Value : sig
217
+
val void : Context.t -> Sexp.t
218
+
val null : Context.t -> Sexp.t
219
+
val eof : Context.t -> Sexp.t
220
+
val of_bool : Context.t -> bool -> Sexp.t
221
+
val of_int : Context.t -> int -> Sexp.t
222
+
val of_float : Context.t -> float -> Sexp.t
223
+
val of_string : Context.t -> string -> Sexp.t
224
+
val of_symbol : Context.t -> string -> Sexp.t
225
+
val of_char : Context.t -> char -> Sexp.t
226
+
val of_char_code : Context.t -> int -> Sexp.t
227
+
val of_bytes : Context.t -> bytes -> Sexp.t
228
+
val cons : Context.t -> Sexp.t -> Sexp.t -> Sexp.t
229
+
val of_list : Context.t -> Sexp.t list -> Sexp.t
230
+
val of_array : Context.t -> Sexp.t array -> Sexp.t
231
+
val of_int_list : Context.t -> int list -> Sexp.t
232
+
val of_string_list : Context.t -> string list -> Sexp.t
233
+
end
234
+
235
+
(** {2 Eval - Expression evaluation} *)
236
+
237
+
module Eval : sig
238
+
val string : Context.t -> string -> Sexp.t
239
+
(** Evaluate a Scheme expression from a string. *)
240
+
241
+
val sexp : Context.t -> Sexp.t -> Sexp.t
242
+
(** Evaluate a parsed Scheme s-expression. *)
243
+
244
+
val apply : Context.t -> Sexp.t -> Sexp.t -> Sexp.t
245
+
(** Apply a Scheme procedure to a list of arguments. *)
246
+
247
+
val load : Context.t -> string -> Sexp.t
248
+
(** Load and evaluate a Scheme file (searches module path). *)
249
+
250
+
val load_direct : Context.t -> string -> Sexp.t
251
+
(** Load and evaluate a Scheme file by absolute path (no module path search).
252
+
This properly handles files with top-level import forms. *)
253
+
254
+
val read : Context.t -> string -> Sexp.t
255
+
(** Parse a string into an s-expression (without evaluating). *)
256
+
257
+
val to_string : Context.t -> string -> string
258
+
(** Evaluate and convert the result to its write representation. *)
259
+
260
+
val to_int : Context.t -> string -> int
261
+
(** Evaluate and extract an integer. *)
262
+
263
+
val to_float : Context.t -> string -> float
264
+
(** Evaluate and extract a float. *)
265
+
266
+
val to_bool : Context.t -> string -> bool
267
+
(** Evaluate and extract a boolean. *)
268
+
269
+
val write : Context.t -> Sexp.t -> string
270
+
(** Convert a sexp to its write (machine-readable) string. *)
271
+
272
+
val display : Context.t -> Sexp.t -> string
273
+
(** Convert a sexp to its display (human-readable) string. *)
274
+
end
275
+
276
+
(** {2 Env - Environment bindings} *)
277
+
278
+
module Env : sig
279
+
val define : Context.t -> string -> Sexp.t -> unit
280
+
(** Define a binding in the current environment. *)
281
+
282
+
val lookup : Context.t -> string -> Sexp.t option
283
+
(** Look up a binding by name. Returns [None] if unbound. *)
284
+
285
+
val lookup_exn : Context.t -> string -> Sexp.t
286
+
(** Look up a binding, raising {!Chibi_error} if not found. *)
287
+
288
+
val define_function : Context.t -> string -> int -> (Sexp.t list -> Sexp.t) -> unit
289
+
(** Register a foreign function callable from Scheme.
290
+
[define_function ctx name arity f] registers [f] as a Scheme procedure
291
+
with [arity] parameters (0-6). *)
292
+
293
+
val define_fn0 : Context.t -> string -> (unit -> Sexp.t) -> unit
294
+
val define_fn1 : Context.t -> string -> (Sexp.t -> Sexp.t) -> unit
295
+
val define_fn2 : Context.t -> string -> (Sexp.t -> Sexp.t -> Sexp.t) -> unit
296
+
val define_fn3 : Context.t -> string -> (Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) -> unit
297
+
val define_fn4 : Context.t -> string -> (Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) -> unit
298
+
val define_fn5 : Context.t -> string -> (Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) -> unit
299
+
val define_fn6 : Context.t -> string -> (Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t -> Sexp.t) -> unit
300
+
end
301
+
302
+
(** {2 Stream - Effect-based streaming} *)
303
+
304
+
module Stream : sig
305
+
(** Effect for yielding values from a producer function. *)
306
+
type _ Effect.t += Yield : Sexp.t -> unit Effect.t
307
+
308
+
type t = Sexp.t Seq.t
309
+
310
+
val from_producer : (unit -> unit) -> t
311
+
(** Create a stream from a function that uses [perform (Yield v)] to
312
+
produce values. *)
313
+
314
+
val feed : Context.t -> proc:Sexp.t -> init:Sexp.t -> Sexp.t Seq.t -> Sexp.t
315
+
(** Feed a stream into a Scheme fold function.
316
+
[feed ctx ~proc ~init seq] calls [proc(element, accumulator)] for each
317
+
element, returning the final accumulator. *)
318
+
319
+
val fold : Context.t -> expr:string -> init:Sexp.t -> Sexp.t Seq.t -> Sexp.t
320
+
(** Like {!feed} but takes the procedure as a Scheme expression string.
321
+
Example: [fold ctx ~expr:"(lambda (x acc) (+ acc x))" ~init:(Value.of_int ctx 0) seq] *)
322
+
323
+
val map : Context.t -> proc:Sexp.t -> Sexp.t Seq.t -> Sexp.t Seq.t
324
+
(** Map a Scheme procedure over a stream. *)
325
+
326
+
val filter : Context.t -> pred:Sexp.t -> Sexp.t Seq.t -> Sexp.t Seq.t
327
+
(** Filter a stream using a Scheme predicate. *)
328
+
329
+
val of_channel : Context.t -> in_channel -> t
330
+
(** Read lines from a channel as Scheme strings. *)
331
+
332
+
val of_int_seq : Context.t -> int Seq.t -> t
333
+
(** Convert an int sequence to a Scheme fixnum stream. *)
334
+
335
+
val of_string_seq : Context.t -> string Seq.t -> t
336
+
(** Convert a string sequence to a Scheme string stream. *)
337
+
338
+
val to_scheme_list : Context.t -> Sexp.t Seq.t -> Sexp.t
339
+
(** Collect a stream into a Scheme list. *)
340
+
341
+
val to_int_list : Sexp.t Seq.t -> int list
342
+
(** Collect a stream, extracting integers. *)
343
+
344
+
val to_string_list : Sexp.t Seq.t -> string list
345
+
(** Collect a stream, extracting strings. *)
346
+
end
347
+
348
+
(** {2 IO - Port redirection and output capture} *)
349
+
350
+
module Io : sig
351
+
val capture : Context.t -> (unit -> 'a) -> ('a, exn) result * string * string
352
+
(** [capture ctx f] redirects stdout/stderr to string ports, runs [f ()],
353
+
and returns [(result, stdout_string, stderr_string)]. The original
354
+
ports are saved before and restored after [f] runs, so the context
355
+
remains usable for normal I/O afterward. *)
356
+
357
+
val set_input_string : Context.t -> string -> unit
358
+
(** Set the current input port to read from a string. *)
359
+
360
+
val redirect_output : Context.t -> (unit -> string)
361
+
(** Redirect stdout to a string port. Returns a thunk that retrieves
362
+
the accumulated output. *)
363
+
end
364
+
365
+
(** {2 Convenience} *)
366
+
367
+
val with_context : ?config:Context.config -> (Context.t -> 'a) -> 'a
368
+
(** [with_context f] creates a context, runs [f ctx], and ensures the
369
+
context is destroyed afterward (even if [f] raises). *)
+29
lib/chibi_config.ml
+29
lib/chibi_config.ml
···
1
+
(* chibi_config.ml -- Runtime configuration for finding chibi-scheme libraries *)
2
+
3
+
(** Find the vendored chibi-scheme lib directory.
4
+
Search order:
5
+
1. CHIBI_MODULE_PATH environment variable
6
+
2. Relative to the source tree (for development)
7
+
3. opam share directory (for installed packages) *)
8
+
let find_lib_dir () =
9
+
(* Check env var first *)
10
+
match Sys.getenv_opt "CHIBI_MODULE_PATH" with
11
+
| Some path when Sys.file_exists path -> Some path
12
+
| _ ->
13
+
(* Try paths relative to Sys.executable_name *)
14
+
let exe_dir = Filename.dirname Sys.executable_name in
15
+
let candidates = [
16
+
(* Development: running from _build or project root *)
17
+
Filename.concat exe_dir "../../../vendor/chibi-scheme/lib";
18
+
Filename.concat exe_dir "../../vendor/chibi-scheme/lib";
19
+
Filename.concat exe_dir "../vendor/chibi-scheme/lib";
20
+
Filename.concat exe_dir "vendor/chibi-scheme/lib";
21
+
(* opam installed: share/chibi-ocaml/lib *)
22
+
Filename.concat exe_dir "../share/chibi-ocaml/lib";
23
+
Filename.concat exe_dir "../lib/chibi-ocaml/chibi-scheme/lib";
24
+
(* Relative to CWD for tests *)
25
+
"vendor/chibi-scheme/lib";
26
+
] in
27
+
List.find_opt (fun p ->
28
+
Sys.file_exists (Filename.concat p "init-7.scm")
29
+
) candidates
+128
lib/chibi_ffi.ml
+128
lib/chibi_ffi.ml
···
1
+
(* chibi_ffi.ml -- Low-level OCaml externals for chibi-scheme C stubs *)
2
+
3
+
(* Opaque types wrapping C custom blocks *)
4
+
type context
5
+
type sexp
6
+
7
+
(* ---- Context lifecycle ---- *)
8
+
external create_context : int -> int -> context = "caml_chibi_create_context"
9
+
external destroy_context : context -> unit = "caml_chibi_destroy_context"
10
+
external context_is_alive : context -> bool = "caml_chibi_context_is_alive"
11
+
12
+
(* ---- Environment setup ---- *)
13
+
external load_standard_env : context -> unit = "caml_chibi_load_standard_env"
14
+
external load_standard_ports : context -> unit = "caml_chibi_load_standard_ports"
15
+
external add_module_directory : context -> string -> unit = "caml_chibi_add_module_directory"
16
+
17
+
(* ---- Evaluation ---- *)
18
+
external eval_string : context -> string -> sexp = "caml_chibi_eval_string"
19
+
external eval : context -> sexp -> sexp = "caml_chibi_eval"
20
+
external apply : context -> sexp -> sexp -> sexp = "caml_chibi_apply"
21
+
external load_file : context -> string -> sexp = "caml_chibi_load_file"
22
+
external load_file_direct : context -> string -> sexp = "caml_chibi_load_file_direct"
23
+
24
+
(* ---- Reading/Parsing ---- *)
25
+
external read_from_string : context -> string -> sexp = "caml_chibi_read_from_string"
26
+
27
+
(* ---- Constructing values ---- *)
28
+
external sexp_void : context -> sexp = "caml_chibi_sexp_void"
29
+
external sexp_true : context -> sexp = "caml_chibi_sexp_true"
30
+
external sexp_false : context -> sexp = "caml_chibi_sexp_false"
31
+
external sexp_null : context -> sexp = "caml_chibi_sexp_null"
32
+
external sexp_eof : context -> sexp = "caml_chibi_sexp_eof"
33
+
34
+
external make_fixnum : context -> int -> sexp = "caml_chibi_make_fixnum"
35
+
external make_flonum : context -> float -> sexp = "caml_chibi_make_flonum"
36
+
external make_integer : context -> int -> sexp = "caml_chibi_make_integer"
37
+
external make_string : context -> string -> sexp = "caml_chibi_make_string"
38
+
external intern : context -> string -> sexp = "caml_chibi_intern"
39
+
external make_char : context -> int -> sexp = "caml_chibi_make_char"
40
+
41
+
external cons : context -> sexp -> sexp -> sexp = "caml_chibi_cons"
42
+
external car : sexp -> sexp = "caml_chibi_car"
43
+
external cdr : sexp -> sexp = "caml_chibi_cdr"
44
+
45
+
external make_bytes : context -> bytes -> sexp = "caml_chibi_make_bytes"
46
+
external make_vector : context -> int -> sexp -> sexp = "caml_chibi_make_vector"
47
+
external vector_ref : sexp -> int -> sexp = "caml_chibi_vector_ref"
48
+
external vector_set : sexp -> int -> sexp -> unit = "caml_chibi_vector_set"
49
+
external vector_length : sexp -> int = "caml_chibi_vector_length"
50
+
51
+
(* ---- Type predicates ---- *)
52
+
external is_pair : sexp -> bool = "caml_chibi_is_pair"
53
+
external is_null : sexp -> bool = "caml_chibi_is_null"
54
+
external is_symbol : sexp -> bool = "caml_chibi_is_symbol"
55
+
external is_string : sexp -> bool = "caml_chibi_is_string"
56
+
external is_fixnum : sexp -> bool = "caml_chibi_is_fixnum"
57
+
external is_flonum : sexp -> bool = "caml_chibi_is_flonum"
58
+
external is_boolean : sexp -> bool = "caml_chibi_is_boolean"
59
+
external is_char : sexp -> bool = "caml_chibi_is_char"
60
+
external is_vector : sexp -> bool = "caml_chibi_is_vector"
61
+
external is_bytes : sexp -> bool = "caml_chibi_is_bytes"
62
+
external is_procedure : sexp -> bool = "caml_chibi_is_procedure"
63
+
external is_exception : sexp -> bool = "caml_chibi_is_exception"
64
+
external is_void : sexp -> bool = "caml_chibi_is_void"
65
+
external is_eof : sexp -> bool = "caml_chibi_is_eof"
66
+
external is_port : sexp -> bool = "caml_chibi_is_port"
67
+
external is_input_port : sexp -> bool = "caml_chibi_is_input_port"
68
+
external is_output_port : sexp -> bool = "caml_chibi_is_output_port"
69
+
external is_number : sexp -> bool = "caml_chibi_is_number"
70
+
external sexp_truep : sexp -> bool = "caml_chibi_sexp_truep"
71
+
72
+
(* ---- Value extraction ---- *)
73
+
external unbox_fixnum : sexp -> int = "caml_chibi_unbox_fixnum"
74
+
external unbox_flonum : sexp -> float = "caml_chibi_unbox_flonum"
75
+
external unbox_string : sexp -> string = "caml_chibi_unbox_string"
76
+
external unbox_symbol : sexp -> string = "caml_chibi_unbox_symbol"
77
+
external unbox_boolean : sexp -> bool = "caml_chibi_unbox_boolean"
78
+
external unbox_char : sexp -> int = "caml_chibi_unbox_char"
79
+
external unbox_bytes : sexp -> bytes = "caml_chibi_unbox_bytes"
80
+
81
+
(* ---- Display/Write ---- *)
82
+
external sexp_to_string : context -> sexp -> string = "caml_chibi_sexp_to_string"
83
+
external sexp_display_string : context -> sexp -> string = "caml_chibi_sexp_display_string"
84
+
85
+
(* ---- Environment bindings ---- *)
86
+
external env_define : context -> string -> sexp -> unit = "caml_chibi_env_define"
87
+
external env_ref : context -> string -> sexp = "caml_chibi_env_ref"
88
+
89
+
(* ---- Foreign functions ---- *)
90
+
external define_foreign : context -> string -> int -> (sexp list -> sexp) -> unit
91
+
= "caml_chibi_define_foreign"
92
+
93
+
(* ---- I/O Ports ---- *)
94
+
external open_input_string : context -> string -> sexp = "caml_chibi_open_input_string"
95
+
external open_output_string : context -> sexp = "caml_chibi_open_output_string"
96
+
external get_output_string : context -> sexp -> string = "caml_chibi_get_output_string"
97
+
98
+
(* ---- Port redirection ---- *)
99
+
external set_current_input_port : context -> sexp -> unit = "caml_chibi_set_current_input_port"
100
+
external set_current_output_port : context -> sexp -> unit = "caml_chibi_set_current_output_port"
101
+
external set_current_error_port : context -> sexp -> unit = "caml_chibi_set_current_error_port"
102
+
external get_current_input_port : context -> sexp = "caml_chibi_get_current_input_port"
103
+
external get_current_output_port : context -> sexp = "caml_chibi_get_current_output_port"
104
+
external get_current_error_port : context -> sexp = "caml_chibi_get_current_error_port"
105
+
106
+
(* ---- GC ---- *)
107
+
external gc : context -> int = "caml_chibi_gc"
108
+
109
+
(* ---- Exception info ---- *)
110
+
external exception_message : sexp -> string = "caml_chibi_exception_message"
111
+
112
+
(* ---- Environment management ---- *)
113
+
external make_null_env : context -> sexp = "caml_chibi_make_null_env"
114
+
external make_primitive_env : context -> sexp = "caml_chibi_make_primitive_env"
115
+
external context_env : context -> sexp = "caml_chibi_context_env"
116
+
external set_context_env : context -> sexp -> unit = "caml_chibi_set_context_env"
117
+
external eval_in_env : context -> string -> sexp -> sexp = "caml_chibi_eval_in_env"
118
+
external load_standard_env_into : context -> sexp -> unit = "caml_chibi_load_standard_env_into"
119
+
120
+
(* ---- Equality ---- *)
121
+
external sexp_equal : sexp -> sexp -> bool = "caml_chibi_sexp_equal"
122
+
123
+
(* ---- List utils ---- *)
124
+
external list_length : sexp -> int = "caml_chibi_list_length"
125
+
126
+
(* ---- Heap stats ---- *)
127
+
external heap_size : context -> int = "caml_chibi_heap_size"
128
+
external heap_max_size : context -> int = "caml_chibi_heap_max_size"
+1234
lib/chibi_stubs.c
+1234
lib/chibi_stubs.c
···
1
+
/*
2
+
* chibi_stubs.c -- OCaml C stubs for chibi-scheme bindings
3
+
*
4
+
* Memory management strategy:
5
+
* - Each chibi-scheme context (sexp) is wrapped in an OCaml custom block.
6
+
* - Each sexp value is wrapped in a custom block holding {ctx, sexp} pair.
7
+
* - When a context is destroyed, all associated sexp wrappers are invalidated.
8
+
* - We use sexp_preserve_object/sexp_release_object to prevent chibi GC from
9
+
* collecting values that OCaml still holds references to.
10
+
* - OCaml custom block finalizers call sexp_release_object.
11
+
*/
12
+
13
+
#include <string.h>
14
+
#include <stdio.h>
15
+
16
+
#include <caml/mlvalues.h>
17
+
#include <caml/memory.h>
18
+
#include <caml/alloc.h>
19
+
#include <caml/custom.h>
20
+
#include <caml/fail.h>
21
+
#include <caml/callback.h>
22
+
#include <caml/threads.h>
23
+
24
+
#include "chibi/eval.h"
25
+
26
+
/* ---------- Context wrapper ---------- */
27
+
28
+
/* A context wrapper holds:
29
+
* - The chibi-scheme context (sexp)
30
+
* - An "alive" flag (set to 0 on destroy)
31
+
*/
32
+
typedef struct {
33
+
sexp ctx;
34
+
int alive;
35
+
} chibi_context_t;
36
+
37
+
#define Context_val(v) (*((chibi_context_t **)Data_custom_val(v)))
38
+
39
+
static void chibi_context_finalize(value v) {
40
+
chibi_context_t *w = Context_val(v);
41
+
if (w != NULL) {
42
+
if (w->alive && w->ctx != NULL) {
43
+
sexp_destroy_context(w->ctx);
44
+
w->ctx = NULL;
45
+
w->alive = 0;
46
+
}
47
+
caml_stat_free(w);
48
+
Context_val(v) = NULL;
49
+
}
50
+
}
51
+
52
+
static struct custom_operations chibi_context_ops = {
53
+
"chibi-ocaml.context",
54
+
chibi_context_finalize,
55
+
custom_compare_default,
56
+
custom_hash_default,
57
+
custom_serialize_default,
58
+
custom_deserialize_default,
59
+
custom_compare_ext_default,
60
+
custom_fixed_length_default
61
+
};
62
+
63
+
/* ---------- Sexp wrapper ---------- */
64
+
65
+
/* A sexp wrapper holds:
66
+
* - Pointer to the context wrapper (to check aliveness & release)
67
+
* - The sexp value itself
68
+
* - Whether we called sexp_preserve_object (only for heap-allocated values)
69
+
*/
70
+
typedef struct {
71
+
chibi_context_t *ctx_wrapper;
72
+
sexp val;
73
+
int preserved;
74
+
} chibi_sexp_t;
75
+
76
+
#define Sexp_val(v) (*((chibi_sexp_t **)Data_custom_val(v)))
77
+
78
+
static void chibi_sexp_finalize(value v) {
79
+
chibi_sexp_t *w = Sexp_val(v);
80
+
if (w != NULL) {
81
+
if (w->preserved && w->ctx_wrapper != NULL &&
82
+
w->ctx_wrapper->alive && w->ctx_wrapper->ctx != NULL) {
83
+
sexp_release_object(w->ctx_wrapper->ctx, w->val);
84
+
}
85
+
caml_stat_free(w);
86
+
Sexp_val(v) = NULL;
87
+
}
88
+
}
89
+
90
+
static struct custom_operations chibi_sexp_ops = {
91
+
"chibi-ocaml.sexp",
92
+
chibi_sexp_finalize,
93
+
custom_compare_default,
94
+
custom_hash_default,
95
+
custom_serialize_default,
96
+
custom_deserialize_default,
97
+
custom_compare_ext_default,
98
+
custom_fixed_length_default
99
+
};
100
+
101
+
/* ---------- Helper: wrap a sexp into an OCaml value ---------- */
102
+
103
+
static value wrap_sexp(chibi_context_t *ctx_w, sexp s) {
104
+
CAMLparam0();
105
+
CAMLlocal1(v);
106
+
chibi_sexp_t *w = caml_stat_alloc(sizeof(chibi_sexp_t));
107
+
w->ctx_wrapper = ctx_w;
108
+
w->val = s;
109
+
/* Only preserve heap-allocated objects */
110
+
if (s != NULL && sexp_pointerp(s)) {
111
+
sexp_preserve_object(ctx_w->ctx, s);
112
+
w->preserved = 1;
113
+
} else {
114
+
w->preserved = 0;
115
+
}
116
+
v = caml_alloc_custom(&chibi_sexp_ops, sizeof(chibi_sexp_t *), 0, 1);
117
+
Sexp_val(v) = w;
118
+
CAMLreturn(v);
119
+
}
120
+
121
+
/* Helper: extract sexp, raising if context is dead */
122
+
static inline sexp get_sexp(value v) {
123
+
chibi_sexp_t *w = Sexp_val(v);
124
+
if (w == NULL || w->ctx_wrapper == NULL || !w->ctx_wrapper->alive)
125
+
caml_failwith("Chibi: sexp from destroyed context");
126
+
return w->val;
127
+
}
128
+
129
+
static inline sexp get_ctx(value v) {
130
+
chibi_context_t *w = Context_val(v);
131
+
if (w == NULL || !w->alive)
132
+
caml_failwith("Chibi: context has been destroyed");
133
+
return w->ctx;
134
+
}
135
+
136
+
static inline chibi_context_t *get_ctx_wrapper(value v) {
137
+
chibi_context_t *w = Context_val(v);
138
+
if (w == NULL || !w->alive)
139
+
caml_failwith("Chibi: context has been destroyed");
140
+
return w;
141
+
}
142
+
143
+
/* ---------- Error handling ---------- */
144
+
145
+
static void raise_chibi_error(sexp ctx, sexp err) {
146
+
sexp out, msg_str;
147
+
const char *msg;
148
+
149
+
if (!sexp_exceptionp(err)) {
150
+
caml_failwith("Chibi: unknown error");
151
+
return;
152
+
}
153
+
154
+
/* Try to get a string representation of the error */
155
+
out = sexp_open_output_string(ctx);
156
+
if (sexp_exceptionp(out)) {
157
+
msg = sexp_string_data(sexp_exception_message(err));
158
+
if (msg)
159
+
caml_failwith(msg);
160
+
else
161
+
caml_failwith("Chibi: error (could not format)");
162
+
return;
163
+
}
164
+
165
+
sexp_print_exception(ctx, err, out);
166
+
msg_str = sexp_get_output_string(ctx, out);
167
+
if (sexp_stringp(msg_str))
168
+
caml_failwith(sexp_string_data(msg_str));
169
+
else
170
+
caml_failwith("Chibi: error (could not format)");
171
+
}
172
+
173
+
/* ================================================================
174
+
* CONTEXT MANAGEMENT
175
+
* ================================================================ */
176
+
177
+
static int chibi_initialized = 0;
178
+
179
+
CAMLprim value caml_chibi_create_context(value v_heap_size, value v_max_heap_size) {
180
+
CAMLparam2(v_heap_size, v_max_heap_size);
181
+
CAMLlocal1(result);
182
+
183
+
if (!chibi_initialized) {
184
+
sexp_scheme_init();
185
+
chibi_initialized = 1;
186
+
}
187
+
188
+
sexp_uint_t heap_size = (sexp_uint_t)Long_val(v_heap_size);
189
+
sexp_uint_t max_heap_size = (sexp_uint_t)Long_val(v_max_heap_size);
190
+
191
+
sexp ctx = sexp_make_eval_context(NULL, NULL, NULL, heap_size, max_heap_size);
192
+
if (!ctx || sexp_exceptionp(ctx)) {
193
+
caml_failwith("Chibi: failed to create context");
194
+
}
195
+
196
+
chibi_context_t *w = caml_stat_alloc(sizeof(chibi_context_t));
197
+
w->ctx = ctx;
198
+
w->alive = 1;
199
+
200
+
result = caml_alloc_custom(&chibi_context_ops, sizeof(chibi_context_t *), 0, 1);
201
+
Context_val(result) = w;
202
+
CAMLreturn(result);
203
+
}
204
+
205
+
CAMLprim value caml_chibi_destroy_context(value v_ctx) {
206
+
CAMLparam1(v_ctx);
207
+
chibi_context_t *w = Context_val(v_ctx);
208
+
if (w != NULL && w->alive && w->ctx != NULL) {
209
+
sexp_destroy_context(w->ctx);
210
+
w->ctx = NULL;
211
+
w->alive = 0;
212
+
}
213
+
CAMLreturn(Val_unit);
214
+
}
215
+
216
+
CAMLprim value caml_chibi_context_is_alive(value v_ctx) {
217
+
CAMLparam1(v_ctx);
218
+
chibi_context_t *w = Context_val(v_ctx);
219
+
CAMLreturn(Val_bool(w != NULL && w->alive));
220
+
}
221
+
222
+
/* ================================================================
223
+
* ENVIRONMENT SETUP
224
+
* ================================================================ */
225
+
226
+
CAMLprim value caml_chibi_load_standard_env(value v_ctx) {
227
+
CAMLparam1(v_ctx);
228
+
sexp ctx = get_ctx(v_ctx);
229
+
sexp env = sexp_context_env(ctx);
230
+
sexp res = sexp_load_standard_env(ctx, env, SEXP_SEVEN);
231
+
if (sexp_exceptionp(res))
232
+
raise_chibi_error(ctx, res);
233
+
CAMLreturn(Val_unit);
234
+
}
235
+
236
+
CAMLprim value caml_chibi_load_standard_ports(value v_ctx) {
237
+
CAMLparam1(v_ctx);
238
+
sexp ctx = get_ctx(v_ctx);
239
+
sexp env = sexp_context_env(ctx);
240
+
/* Use no_close=1 so chibi doesn't close our stdio streams */
241
+
sexp res = sexp_load_standard_ports(ctx, env, stdin, stdout, stderr, 1);
242
+
if (sexp_exceptionp(res))
243
+
raise_chibi_error(ctx, res);
244
+
CAMLreturn(Val_unit);
245
+
}
246
+
247
+
CAMLprim value caml_chibi_add_module_directory(value v_ctx, value v_dir) {
248
+
CAMLparam2(v_ctx, v_dir);
249
+
sexp ctx = get_ctx(v_ctx);
250
+
sexp_gc_var1(dir);
251
+
sexp_gc_preserve1(ctx, dir);
252
+
dir = sexp_c_string(ctx, String_val(v_dir), -1);
253
+
sexp res = sexp_add_module_directory(ctx, dir, SEXP_TRUE);
254
+
sexp_gc_release1(ctx);
255
+
if (sexp_exceptionp(res))
256
+
raise_chibi_error(ctx, res);
257
+
CAMLreturn(Val_unit);
258
+
}
259
+
260
+
/* ================================================================
261
+
* EVALUATION
262
+
* ================================================================ */
263
+
264
+
CAMLprim value caml_chibi_eval_string(value v_ctx, value v_str) {
265
+
CAMLparam2(v_ctx, v_str);
266
+
CAMLlocal1(result);
267
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
268
+
sexp ctx = ctx_w->ctx;
269
+
const char *str = String_val(v_str);
270
+
sexp_sint_t len = caml_string_length(v_str);
271
+
272
+
sexp res = sexp_eval_string(ctx, str, len, NULL);
273
+
if (sexp_exceptionp(res))
274
+
raise_chibi_error(ctx, res);
275
+
276
+
result = wrap_sexp(ctx_w, res);
277
+
CAMLreturn(result);
278
+
}
279
+
280
+
CAMLprim value caml_chibi_eval(value v_ctx, value v_sexp) {
281
+
CAMLparam2(v_ctx, v_sexp);
282
+
CAMLlocal1(result);
283
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
284
+
sexp ctx = ctx_w->ctx;
285
+
sexp obj = get_sexp(v_sexp);
286
+
287
+
sexp res = sexp_eval(ctx, obj, NULL);
288
+
if (sexp_exceptionp(res))
289
+
raise_chibi_error(ctx, res);
290
+
291
+
result = wrap_sexp(ctx_w, res);
292
+
CAMLreturn(result);
293
+
}
294
+
295
+
CAMLprim value caml_chibi_apply(value v_ctx, value v_proc, value v_args) {
296
+
CAMLparam3(v_ctx, v_proc, v_args);
297
+
CAMLlocal1(result);
298
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
299
+
sexp ctx = ctx_w->ctx;
300
+
sexp proc = get_sexp(v_proc);
301
+
sexp args = get_sexp(v_args);
302
+
303
+
sexp res = sexp_apply(ctx, proc, args);
304
+
if (sexp_exceptionp(res))
305
+
raise_chibi_error(ctx, res);
306
+
307
+
result = wrap_sexp(ctx_w, res);
308
+
CAMLreturn(result);
309
+
}
310
+
311
+
CAMLprim value caml_chibi_load_file(value v_ctx, value v_path) {
312
+
CAMLparam2(v_ctx, v_path);
313
+
CAMLlocal1(result);
314
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
315
+
sexp ctx = ctx_w->ctx;
316
+
317
+
sexp res = sexp_load_module_file(ctx, String_val(v_path),
318
+
sexp_context_env(ctx));
319
+
if (sexp_exceptionp(res))
320
+
raise_chibi_error(ctx, res);
321
+
322
+
result = wrap_sexp(ctx_w, res);
323
+
CAMLreturn(result);
324
+
}
325
+
326
+
/* Load a file by absolute path using sexp_load (not module path search) */
327
+
CAMLprim value caml_chibi_load_file_direct(value v_ctx, value v_path) {
328
+
CAMLparam2(v_ctx, v_path);
329
+
CAMLlocal1(result);
330
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
331
+
sexp ctx = ctx_w->ctx;
332
+
333
+
sexp_gc_var1(path);
334
+
sexp_gc_preserve1(ctx, path);
335
+
path = sexp_c_string(ctx, String_val(v_path), caml_string_length(v_path));
336
+
sexp res = sexp_load(ctx, path, sexp_context_env(ctx));
337
+
sexp_gc_release1(ctx);
338
+
339
+
if (sexp_exceptionp(res))
340
+
raise_chibi_error(ctx, res);
341
+
342
+
result = wrap_sexp(ctx_w, res);
343
+
CAMLreturn(result);
344
+
}
345
+
346
+
/* ================================================================
347
+
* READING / PARSING
348
+
* ================================================================ */
349
+
350
+
CAMLprim value caml_chibi_read_from_string(value v_ctx, value v_str) {
351
+
CAMLparam2(v_ctx, v_str);
352
+
CAMLlocal1(result);
353
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
354
+
sexp ctx = ctx_w->ctx;
355
+
356
+
sexp res = sexp_read_from_string(ctx, String_val(v_str),
357
+
caml_string_length(v_str));
358
+
if (sexp_exceptionp(res))
359
+
raise_chibi_error(ctx, res);
360
+
361
+
result = wrap_sexp(ctx_w, res);
362
+
CAMLreturn(result);
363
+
}
364
+
365
+
/* ================================================================
366
+
* CONSTRUCTING SCHEME VALUES
367
+
* ================================================================ */
368
+
369
+
/* -- Immediate values -- */
370
+
CAMLprim value caml_chibi_sexp_void(value v_ctx) {
371
+
CAMLparam1(v_ctx);
372
+
CAMLlocal1(result);
373
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
374
+
result = wrap_sexp(ctx_w, SEXP_VOID);
375
+
CAMLreturn(result);
376
+
}
377
+
378
+
CAMLprim value caml_chibi_sexp_true(value v_ctx) {
379
+
CAMLparam1(v_ctx);
380
+
CAMLlocal1(result);
381
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
382
+
result = wrap_sexp(ctx_w, SEXP_TRUE);
383
+
CAMLreturn(result);
384
+
}
385
+
386
+
CAMLprim value caml_chibi_sexp_false(value v_ctx) {
387
+
CAMLparam1(v_ctx);
388
+
CAMLlocal1(result);
389
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
390
+
result = wrap_sexp(ctx_w, SEXP_FALSE);
391
+
CAMLreturn(result);
392
+
}
393
+
394
+
CAMLprim value caml_chibi_sexp_null(value v_ctx) {
395
+
CAMLparam1(v_ctx);
396
+
CAMLlocal1(result);
397
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
398
+
result = wrap_sexp(ctx_w, SEXP_NULL);
399
+
CAMLreturn(result);
400
+
}
401
+
402
+
CAMLprim value caml_chibi_sexp_eof(value v_ctx) {
403
+
CAMLparam1(v_ctx);
404
+
CAMLlocal1(result);
405
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
406
+
result = wrap_sexp(ctx_w, SEXP_EOF);
407
+
CAMLreturn(result);
408
+
}
409
+
410
+
/* -- Numbers -- */
411
+
CAMLprim value caml_chibi_make_fixnum(value v_ctx, value v_n) {
412
+
CAMLparam2(v_ctx, v_n);
413
+
CAMLlocal1(result);
414
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
415
+
result = wrap_sexp(ctx_w, sexp_make_fixnum(Long_val(v_n)));
416
+
CAMLreturn(result);
417
+
}
418
+
419
+
CAMLprim value caml_chibi_make_flonum(value v_ctx, value v_f) {
420
+
CAMLparam2(v_ctx, v_f);
421
+
CAMLlocal1(result);
422
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
423
+
sexp ctx = ctx_w->ctx;
424
+
sexp f = sexp_make_flonum(ctx, Double_val(v_f));
425
+
result = wrap_sexp(ctx_w, f);
426
+
CAMLreturn(result);
427
+
}
428
+
429
+
CAMLprim value caml_chibi_make_integer(value v_ctx, value v_n) {
430
+
CAMLparam2(v_ctx, v_n);
431
+
CAMLlocal1(result);
432
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
433
+
sexp ctx = ctx_w->ctx;
434
+
sexp n = sexp_make_integer(ctx, Long_val(v_n));
435
+
result = wrap_sexp(ctx_w, n);
436
+
CAMLreturn(result);
437
+
}
438
+
439
+
/* -- Strings -- */
440
+
CAMLprim value caml_chibi_make_string(value v_ctx, value v_str) {
441
+
CAMLparam2(v_ctx, v_str);
442
+
CAMLlocal1(result);
443
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
444
+
sexp ctx = ctx_w->ctx;
445
+
sexp s = sexp_c_string(ctx, String_val(v_str), caml_string_length(v_str));
446
+
result = wrap_sexp(ctx_w, s);
447
+
CAMLreturn(result);
448
+
}
449
+
450
+
/* -- Symbols -- */
451
+
CAMLprim value caml_chibi_intern(value v_ctx, value v_str) {
452
+
CAMLparam2(v_ctx, v_str);
453
+
CAMLlocal1(result);
454
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
455
+
sexp ctx = ctx_w->ctx;
456
+
sexp s = sexp_intern(ctx, String_val(v_str), caml_string_length(v_str));
457
+
result = wrap_sexp(ctx_w, s);
458
+
CAMLreturn(result);
459
+
}
460
+
461
+
/* -- Pairs / Lists -- */
462
+
CAMLprim value caml_chibi_cons(value v_ctx, value v_car, value v_cdr) {
463
+
CAMLparam3(v_ctx, v_car, v_cdr);
464
+
CAMLlocal1(result);
465
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
466
+
sexp ctx = ctx_w->ctx;
467
+
468
+
sexp_gc_var1(pair);
469
+
sexp_gc_preserve1(ctx, pair);
470
+
pair = sexp_cons(ctx, get_sexp(v_car), get_sexp(v_cdr));
471
+
sexp_gc_release1(ctx);
472
+
473
+
result = wrap_sexp(ctx_w, pair);
474
+
CAMLreturn(result);
475
+
}
476
+
477
+
CAMLprim value caml_chibi_car(value v_sexp) {
478
+
CAMLparam1(v_sexp);
479
+
CAMLlocal1(result);
480
+
sexp s = get_sexp(v_sexp);
481
+
if (!sexp_pairp(s))
482
+
caml_failwith("Chibi: car of non-pair");
483
+
chibi_sexp_t *w = Sexp_val(v_sexp);
484
+
result = wrap_sexp(w->ctx_wrapper, sexp_car(s));
485
+
CAMLreturn(result);
486
+
}
487
+
488
+
CAMLprim value caml_chibi_cdr(value v_sexp) {
489
+
CAMLparam1(v_sexp);
490
+
CAMLlocal1(result);
491
+
sexp s = get_sexp(v_sexp);
492
+
if (!sexp_pairp(s))
493
+
caml_failwith("Chibi: cdr of non-pair");
494
+
chibi_sexp_t *w = Sexp_val(v_sexp);
495
+
result = wrap_sexp(w->ctx_wrapper, sexp_cdr(s));
496
+
CAMLreturn(result);
497
+
}
498
+
499
+
/* -- Bytevectors -- */
500
+
CAMLprim value caml_chibi_make_bytes(value v_ctx, value v_bytes) {
501
+
CAMLparam2(v_ctx, v_bytes);
502
+
CAMLlocal1(result);
503
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
504
+
sexp ctx = ctx_w->ctx;
505
+
506
+
sexp_sint_t len = caml_string_length(v_bytes);
507
+
sexp_gc_var1(bv);
508
+
sexp_gc_preserve1(ctx, bv);
509
+
bv = sexp_make_bytes(ctx, sexp_make_fixnum(len), SEXP_VOID);
510
+
if (sexp_exceptionp(bv)) {
511
+
sexp_gc_release1(ctx);
512
+
raise_chibi_error(ctx, bv);
513
+
}
514
+
memcpy(sexp_bytes_data(bv), Bytes_val(v_bytes), len);
515
+
sexp_gc_release1(ctx);
516
+
517
+
result = wrap_sexp(ctx_w, bv);
518
+
CAMLreturn(result);
519
+
}
520
+
521
+
/* -- Vectors -- */
522
+
CAMLprim value caml_chibi_make_vector(value v_ctx, value v_len, value v_fill) {
523
+
CAMLparam3(v_ctx, v_len, v_fill);
524
+
CAMLlocal1(result);
525
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
526
+
sexp ctx = ctx_w->ctx;
527
+
sexp fill = get_sexp(v_fill);
528
+
529
+
sexp vec = sexp_make_vector(ctx, sexp_make_fixnum(Long_val(v_len)), fill);
530
+
if (sexp_exceptionp(vec))
531
+
raise_chibi_error(ctx, vec);
532
+
533
+
result = wrap_sexp(ctx_w, vec);
534
+
CAMLreturn(result);
535
+
}
536
+
537
+
CAMLprim value caml_chibi_vector_ref(value v_sexp, value v_idx) {
538
+
CAMLparam2(v_sexp, v_idx);
539
+
CAMLlocal1(result);
540
+
sexp s = get_sexp(v_sexp);
541
+
if (!sexp_vectorp(s))
542
+
caml_failwith("Chibi: vector-ref of non-vector");
543
+
sexp_sint_t idx = Long_val(v_idx);
544
+
if (idx < 0 || idx >= sexp_vector_length(s))
545
+
caml_invalid_argument("Chibi: vector-ref index out of bounds");
546
+
chibi_sexp_t *w = Sexp_val(v_sexp);
547
+
result = wrap_sexp(w->ctx_wrapper, sexp_vector_data(s)[idx]);
548
+
CAMLreturn(result);
549
+
}
550
+
551
+
CAMLprim value caml_chibi_vector_set(value v_sexp, value v_idx, value v_val) {
552
+
CAMLparam3(v_sexp, v_idx, v_val);
553
+
sexp s = get_sexp(v_sexp);
554
+
if (!sexp_vectorp(s))
555
+
caml_failwith("Chibi: vector-set! of non-vector");
556
+
sexp_sint_t idx = Long_val(v_idx);
557
+
if (idx < 0 || idx >= sexp_vector_length(s))
558
+
caml_invalid_argument("Chibi: vector-set! index out of bounds");
559
+
sexp_vector_data(s)[idx] = get_sexp(v_val);
560
+
CAMLreturn(Val_unit);
561
+
}
562
+
563
+
CAMLprim value caml_chibi_vector_length(value v_sexp) {
564
+
CAMLparam1(v_sexp);
565
+
sexp s = get_sexp(v_sexp);
566
+
if (!sexp_vectorp(s))
567
+
caml_failwith("Chibi: vector-length of non-vector");
568
+
CAMLreturn(Val_long(sexp_vector_length(s)));
569
+
}
570
+
571
+
/* ================================================================
572
+
* TYPE PREDICATES
573
+
* ================================================================ */
574
+
575
+
CAMLprim value caml_chibi_is_pair(value v) {
576
+
return Val_bool(sexp_pairp(get_sexp(v)));
577
+
}
578
+
CAMLprim value caml_chibi_is_null(value v) {
579
+
return Val_bool(sexp_nullp(get_sexp(v)));
580
+
}
581
+
CAMLprim value caml_chibi_is_symbol(value v) {
582
+
return Val_bool(sexp_symbolp(get_sexp(v)));
583
+
}
584
+
CAMLprim value caml_chibi_is_string(value v) {
585
+
return Val_bool(sexp_stringp(get_sexp(v)));
586
+
}
587
+
CAMLprim value caml_chibi_is_fixnum(value v) {
588
+
return Val_bool(sexp_fixnump(get_sexp(v)));
589
+
}
590
+
CAMLprim value caml_chibi_is_flonum(value v) {
591
+
return Val_bool(sexp_flonump(get_sexp(v)));
592
+
}
593
+
CAMLprim value caml_chibi_is_boolean(value v) {
594
+
return Val_bool(sexp_booleanp(get_sexp(v)));
595
+
}
596
+
CAMLprim value caml_chibi_is_char(value v) {
597
+
return Val_bool(sexp_charp(get_sexp(v)));
598
+
}
599
+
CAMLprim value caml_chibi_is_vector(value v) {
600
+
return Val_bool(sexp_vectorp(get_sexp(v)));
601
+
}
602
+
CAMLprim value caml_chibi_is_bytes(value v) {
603
+
return Val_bool(sexp_bytesp(get_sexp(v)));
604
+
}
605
+
CAMLprim value caml_chibi_is_procedure(value v) {
606
+
return Val_bool(sexp_applicablep(get_sexp(v)));
607
+
}
608
+
CAMLprim value caml_chibi_is_exception(value v) {
609
+
return Val_bool(sexp_exceptionp(get_sexp(v)));
610
+
}
611
+
CAMLprim value caml_chibi_is_void(value v) {
612
+
return Val_bool(get_sexp(v) == SEXP_VOID);
613
+
}
614
+
CAMLprim value caml_chibi_is_eof(value v) {
615
+
return Val_bool(get_sexp(v) == SEXP_EOF);
616
+
}
617
+
CAMLprim value caml_chibi_is_port(value v) {
618
+
return Val_bool(sexp_portp(get_sexp(v)));
619
+
}
620
+
CAMLprim value caml_chibi_is_input_port(value v) {
621
+
return Val_bool(sexp_iportp(get_sexp(v)));
622
+
}
623
+
CAMLprim value caml_chibi_is_output_port(value v) {
624
+
return Val_bool(sexp_oportp(get_sexp(v)));
625
+
}
626
+
CAMLprim value caml_chibi_is_number(value v) {
627
+
return Val_bool(sexp_numberp(get_sexp(v)));
628
+
}
629
+
CAMLprim value caml_chibi_sexp_truep(value v) {
630
+
return Val_bool(sexp_truep(get_sexp(v)));
631
+
}
632
+
633
+
/* ================================================================
634
+
* VALUE EXTRACTION
635
+
* ================================================================ */
636
+
637
+
CAMLprim value caml_chibi_unbox_fixnum(value v) {
638
+
CAMLparam1(v);
639
+
sexp s = get_sexp(v);
640
+
if (!sexp_fixnump(s))
641
+
caml_failwith("Chibi: unbox_fixnum of non-fixnum");
642
+
CAMLreturn(Val_long(sexp_unbox_fixnum(s)));
643
+
}
644
+
645
+
CAMLprim value caml_chibi_unbox_flonum(value v) {
646
+
CAMLparam1(v);
647
+
sexp s = get_sexp(v);
648
+
if (!sexp_flonump(s))
649
+
caml_failwith("Chibi: unbox_flonum of non-flonum");
650
+
CAMLreturn(caml_copy_double(sexp_flonum_value(s)));
651
+
}
652
+
653
+
CAMLprim value caml_chibi_unbox_string(value v) {
654
+
CAMLparam1(v);
655
+
CAMLlocal1(result);
656
+
sexp s = get_sexp(v);
657
+
if (!sexp_stringp(s))
658
+
caml_failwith("Chibi: unbox_string of non-string");
659
+
result = caml_alloc_initialized_string(sexp_string_size(s),
660
+
sexp_string_data(s));
661
+
CAMLreturn(result);
662
+
}
663
+
664
+
CAMLprim value caml_chibi_unbox_symbol(value v) {
665
+
CAMLparam1(v);
666
+
CAMLlocal1(result);
667
+
chibi_sexp_t *w = Sexp_val(v);
668
+
if (w == NULL || w->ctx_wrapper == NULL || !w->ctx_wrapper->alive)
669
+
caml_failwith("Chibi: sexp from destroyed context");
670
+
sexp s = w->val;
671
+
if (!sexp_symbolp(s))
672
+
caml_failwith("Chibi: unbox_symbol of non-symbol");
673
+
sexp ctx = w->ctx_wrapper->ctx;
674
+
sexp str = sexp_symbol_to_string(ctx, s);
675
+
if (sexp_stringp(str)) {
676
+
result = caml_alloc_initialized_string(sexp_string_size(str),
677
+
sexp_string_data(str));
678
+
} else {
679
+
caml_failwith("Chibi: could not convert symbol to string");
680
+
}
681
+
CAMLreturn(result);
682
+
}
683
+
684
+
CAMLprim value caml_chibi_unbox_boolean(value v) {
685
+
CAMLparam1(v);
686
+
sexp s = get_sexp(v);
687
+
CAMLreturn(Val_bool(sexp_truep(s)));
688
+
}
689
+
690
+
CAMLprim value caml_chibi_unbox_char(value v) {
691
+
CAMLparam1(v);
692
+
sexp s = get_sexp(v);
693
+
if (!sexp_charp(s))
694
+
caml_failwith("Chibi: unbox_char of non-char");
695
+
CAMLreturn(Val_int(sexp_unbox_character(s)));
696
+
}
697
+
698
+
CAMLprim value caml_chibi_unbox_bytes(value v) {
699
+
CAMLparam1(v);
700
+
CAMLlocal1(result);
701
+
sexp s = get_sexp(v);
702
+
if (!sexp_bytesp(s))
703
+
caml_failwith("Chibi: unbox_bytes of non-bytevector");
704
+
sexp_sint_t len = sexp_bytes_length(s);
705
+
result = caml_alloc_string(len);
706
+
memcpy(Bytes_val(result), sexp_bytes_data(s), len);
707
+
CAMLreturn(result);
708
+
}
709
+
710
+
/* ================================================================
711
+
* WRITE / DISPLAY / TO_STRING
712
+
* ================================================================ */
713
+
714
+
CAMLprim value caml_chibi_sexp_to_string(value v_ctx, value v_sexp) {
715
+
CAMLparam2(v_ctx, v_sexp);
716
+
CAMLlocal1(result);
717
+
sexp ctx = get_ctx(v_ctx);
718
+
sexp obj = get_sexp(v_sexp);
719
+
720
+
sexp_gc_var2(out, str);
721
+
sexp_gc_preserve2(ctx, out, str);
722
+
723
+
out = sexp_open_output_string(ctx);
724
+
if (sexp_exceptionp(out)) {
725
+
sexp_gc_release2(ctx);
726
+
raise_chibi_error(ctx, out);
727
+
}
728
+
sexp_write(ctx, obj, out);
729
+
str = sexp_get_output_string(ctx, out);
730
+
sexp_gc_release2(ctx);
731
+
732
+
if (sexp_stringp(str))
733
+
result = caml_alloc_initialized_string(sexp_string_size(str),
734
+
sexp_string_data(str));
735
+
else
736
+
result = caml_copy_string("#<unknown>");
737
+
738
+
CAMLreturn(result);
739
+
}
740
+
741
+
CAMLprim value caml_chibi_sexp_display_string(value v_ctx, value v_sexp) {
742
+
CAMLparam2(v_ctx, v_sexp);
743
+
CAMLlocal1(result);
744
+
sexp ctx = get_ctx(v_ctx);
745
+
sexp obj = get_sexp(v_sexp);
746
+
747
+
sexp_gc_var2(out, str);
748
+
sexp_gc_preserve2(ctx, out, str);
749
+
750
+
out = sexp_open_output_string(ctx);
751
+
if (sexp_exceptionp(out)) {
752
+
sexp_gc_release2(ctx);
753
+
raise_chibi_error(ctx, out);
754
+
}
755
+
/* display writes strings without quotes */
756
+
if (sexp_stringp(obj)) {
757
+
sexp_write_string(ctx, sexp_string_data(obj), out);
758
+
} else {
759
+
sexp_write(ctx, obj, out);
760
+
}
761
+
str = sexp_get_output_string(ctx, out);
762
+
sexp_gc_release2(ctx);
763
+
764
+
if (sexp_stringp(str))
765
+
result = caml_alloc_initialized_string(sexp_string_size(str),
766
+
sexp_string_data(str));
767
+
else
768
+
result = caml_copy_string("");
769
+
770
+
CAMLreturn(result);
771
+
}
772
+
773
+
/* ================================================================
774
+
* ENVIRONMENT BINDINGS
775
+
* ================================================================ */
776
+
777
+
CAMLprim value caml_chibi_env_define(value v_ctx, value v_name, value v_val) {
778
+
CAMLparam3(v_ctx, v_name, v_val);
779
+
sexp ctx = get_ctx(v_ctx);
780
+
sexp env = sexp_context_env(ctx);
781
+
sexp val = get_sexp(v_val);
782
+
783
+
sexp_gc_var1(sym);
784
+
sexp_gc_preserve1(ctx, sym);
785
+
sym = sexp_intern(ctx, String_val(v_name), caml_string_length(v_name));
786
+
sexp res = sexp_env_define(ctx, env, sym, val);
787
+
sexp_gc_release1(ctx);
788
+
789
+
if (sexp_exceptionp(res))
790
+
raise_chibi_error(ctx, res);
791
+
792
+
CAMLreturn(Val_unit);
793
+
}
794
+
795
+
CAMLprim value caml_chibi_env_ref(value v_ctx, value v_name) {
796
+
CAMLparam2(v_ctx, v_name);
797
+
CAMLlocal1(result);
798
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
799
+
sexp ctx = ctx_w->ctx;
800
+
sexp env = sexp_context_env(ctx);
801
+
802
+
sexp_gc_var1(sym);
803
+
sexp_gc_preserve1(ctx, sym);
804
+
sym = sexp_intern(ctx, String_val(v_name), caml_string_length(v_name));
805
+
sexp val = sexp_env_ref(ctx, env, sym, SEXP_VOID);
806
+
sexp_gc_release1(ctx);
807
+
808
+
result = wrap_sexp(ctx_w, val);
809
+
CAMLreturn(result);
810
+
}
811
+
812
+
/* ================================================================
813
+
* FOREIGN FUNCTION REGISTRATION
814
+
* ================================================================ */
815
+
816
+
/* We store the OCaml closure in a C pointer wrapped as a sexp,
817
+
* and dispatch through a common C trampoline. */
818
+
819
+
/* Max arity for foreign functions */
820
+
#define MAX_FOREIGN_ARITY 6
821
+
822
+
/* Trampoline: calls an OCaml closure stored as the opcode data */
823
+
static sexp foreign_trampoline(sexp ctx, sexp self, sexp_sint_t n, ...) {
824
+
va_list ap;
825
+
sexp argv[MAX_FOREIGN_ARITY];
826
+
sexp_sint_t i;
827
+
828
+
/* Get the OCaml closure from opcode data.
829
+
* We stored a caml_stat_alloc'd value* as a cpointer in the opcode data. */
830
+
sexp data = sexp_opcode_data(self);
831
+
value *closure_root = (value *)sexp_cpointer_value(data);
832
+
if (closure_root == NULL)
833
+
return sexp_user_exception(ctx, self, "foreign function: null closure", SEXP_NULL);
834
+
835
+
/* Gather the scheme arguments */
836
+
va_start(ap, n);
837
+
for (i = 0; i < n && i < MAX_FOREIGN_ARITY; i++)
838
+
argv[i] = va_arg(ap, sexp);
839
+
va_end(ap);
840
+
841
+
/* We need to find the context wrapper. We'll store it in the
842
+
* second cpointer in the opcode data. Actually, let's use a simpler
843
+
* approach: use the first element of the allocated pair. */
844
+
value *ctx_root = (value *)(((char *)closure_root) + sizeof(value));
845
+
846
+
/* Build an OCaml array of sexp wrappers from the C arguments.
847
+
* For efficiency, we pass arguments as a list of raw sexp pointers
848
+
* and reconstruct in OCaml. But that's complex.
849
+
*
850
+
* Simpler approach: call the closure with the raw arguments encoded.
851
+
* We pass n and the arguments through a callback mechanism.
852
+
*/
853
+
854
+
/* Actually, the cleanest approach: the OCaml closure receives
855
+
* the context and a list of arguments. We build the list in C. */
856
+
chibi_context_t *ctx_w = *((chibi_context_t **)ctx_root);
857
+
858
+
/* Build OCaml values */
859
+
CAMLparam0();
860
+
CAMLlocal3(ml_args, ml_result, ml_pair);
861
+
862
+
/* Build the argument list in reverse, then pass it */
863
+
ml_args = Val_emptylist; /* [] */
864
+
for (i = n - 1; i >= 0; i--) {
865
+
ml_pair = wrap_sexp(ctx_w, argv[i]);
866
+
value new_cons = caml_alloc(2, 0);
867
+
Store_field(new_cons, 0, ml_pair);
868
+
Store_field(new_cons, 1, ml_args);
869
+
ml_args = new_cons;
870
+
}
871
+
872
+
/* Call the OCaml closure: fn(args) -> sexp */
873
+
ml_result = caml_callback(*closure_root, ml_args);
874
+
875
+
/* Extract the sexp result */
876
+
sexp result = get_sexp(ml_result);
877
+
CAMLreturnT(sexp, result);
878
+
}
879
+
880
+
/* Specific arity trampolines since chibi needs fixed signatures */
881
+
static sexp trampoline_0(sexp ctx, sexp self, sexp_sint_t n) {
882
+
return foreign_trampoline(ctx, self, 0);
883
+
}
884
+
static sexp trampoline_1(sexp ctx, sexp self, sexp_sint_t n, sexp a) {
885
+
return foreign_trampoline(ctx, self, 1, a);
886
+
}
887
+
static sexp trampoline_2(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b) {
888
+
return foreign_trampoline(ctx, self, 2, a, b);
889
+
}
890
+
static sexp trampoline_3(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp c) {
891
+
return foreign_trampoline(ctx, self, 3, a, b, c);
892
+
}
893
+
static sexp trampoline_4(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp c, sexp d) {
894
+
return foreign_trampoline(ctx, self, 4, a, b, c, d);
895
+
}
896
+
static sexp trampoline_5(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp c, sexp d, sexp e) {
897
+
return foreign_trampoline(ctx, self, 5, a, b, c, d, e);
898
+
}
899
+
static sexp trampoline_6(sexp ctx, sexp self, sexp_sint_t n, sexp a, sexp b, sexp c, sexp d, sexp e, sexp f) {
900
+
return foreign_trampoline(ctx, self, 6, a, b, c, d, e, f);
901
+
}
902
+
903
+
static sexp_proc1 trampolines[] = {
904
+
(sexp_proc1)trampoline_0,
905
+
(sexp_proc1)trampoline_1,
906
+
(sexp_proc1)trampoline_2,
907
+
(sexp_proc1)trampoline_3,
908
+
(sexp_proc1)trampoline_4,
909
+
(sexp_proc1)trampoline_5,
910
+
(sexp_proc1)trampoline_6,
911
+
};
912
+
913
+
CAMLprim value caml_chibi_define_foreign(value v_ctx, value v_name,
914
+
value v_arity, value v_closure) {
915
+
CAMLparam4(v_ctx, v_name, v_arity, v_closure);
916
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
917
+
sexp ctx = ctx_w->ctx;
918
+
int arity = Int_val(v_arity);
919
+
920
+
if (arity < 0 || arity > MAX_FOREIGN_ARITY)
921
+
caml_invalid_argument("Chibi: foreign function arity must be 0-6");
922
+
923
+
/* Allocate GC roots for the closure and context wrapper pointer */
924
+
/* We allocate a block to hold both: [closure_root, ctx_wrapper_ptr] */
925
+
value *roots = caml_stat_alloc(2 * sizeof(value));
926
+
roots[0] = v_closure;
927
+
roots[1] = (value)ctx_w;
928
+
caml_register_generational_global_root(&roots[0]);
929
+
930
+
/* Wrap the root pointer as a chibi cpointer */
931
+
sexp_gc_var1(data);
932
+
sexp_gc_preserve1(ctx, data);
933
+
data = sexp_make_cpointer(ctx, SEXP_CPOINTER, roots, SEXP_FALSE, 0);
934
+
935
+
sexp res = sexp_define_foreign_aux(
936
+
ctx, sexp_context_env(ctx),
937
+
String_val(v_name), arity, 0,
938
+
"ocaml-foreign", trampolines[arity], data);
939
+
940
+
sexp_gc_release1(ctx);
941
+
942
+
if (sexp_exceptionp(res))
943
+
raise_chibi_error(ctx, res);
944
+
945
+
CAMLreturn(Val_unit);
946
+
}
947
+
948
+
/* ================================================================
949
+
* I/O PORTS
950
+
* ================================================================ */
951
+
952
+
CAMLprim value caml_chibi_open_input_string(value v_ctx, value v_str) {
953
+
CAMLparam2(v_ctx, v_str);
954
+
CAMLlocal1(result);
955
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
956
+
sexp ctx = ctx_w->ctx;
957
+
958
+
sexp_gc_var2(str, port);
959
+
sexp_gc_preserve2(ctx, str, port);
960
+
str = sexp_c_string(ctx, String_val(v_str), caml_string_length(v_str));
961
+
port = sexp_open_input_string(ctx, str);
962
+
sexp_gc_release2(ctx);
963
+
964
+
if (sexp_exceptionp(port))
965
+
raise_chibi_error(ctx, port);
966
+
967
+
result = wrap_sexp(ctx_w, port);
968
+
CAMLreturn(result);
969
+
}
970
+
971
+
CAMLprim value caml_chibi_open_output_string(value v_ctx) {
972
+
CAMLparam1(v_ctx);
973
+
CAMLlocal1(result);
974
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
975
+
sexp ctx = ctx_w->ctx;
976
+
977
+
sexp port = sexp_open_output_string(ctx);
978
+
if (sexp_exceptionp(port))
979
+
raise_chibi_error(ctx, port);
980
+
981
+
result = wrap_sexp(ctx_w, port);
982
+
CAMLreturn(result);
983
+
}
984
+
985
+
CAMLprim value caml_chibi_get_output_string(value v_ctx, value v_port) {
986
+
CAMLparam2(v_ctx, v_port);
987
+
CAMLlocal1(result);
988
+
sexp ctx = get_ctx(v_ctx);
989
+
sexp port = get_sexp(v_port);
990
+
991
+
sexp str = sexp_get_output_string(ctx, port);
992
+
if (sexp_exceptionp(str))
993
+
raise_chibi_error(ctx, str);
994
+
995
+
if (sexp_stringp(str))
996
+
result = caml_alloc_initialized_string(sexp_string_size(str),
997
+
sexp_string_data(str));
998
+
else
999
+
result = caml_copy_string("");
1000
+
1001
+
CAMLreturn(result);
1002
+
}
1003
+
1004
+
/* ================================================================
1005
+
* GC CONTROL
1006
+
* ================================================================ */
1007
+
1008
+
CAMLprim value caml_chibi_gc(value v_ctx) {
1009
+
CAMLparam1(v_ctx);
1010
+
sexp ctx = get_ctx(v_ctx);
1011
+
size_t freed = 0;
1012
+
sexp_gc(ctx, &freed);
1013
+
CAMLreturn(Val_long(freed));
1014
+
}
1015
+
1016
+
/* ================================================================
1017
+
* EXCEPTION INFO
1018
+
* ================================================================ */
1019
+
1020
+
CAMLprim value caml_chibi_exception_message(value v_sexp) {
1021
+
CAMLparam1(v_sexp);
1022
+
CAMLlocal1(result);
1023
+
sexp s = get_sexp(v_sexp);
1024
+
if (!sexp_exceptionp(s))
1025
+
caml_failwith("Chibi: not an exception");
1026
+
sexp msg = sexp_exception_message(s);
1027
+
if (sexp_stringp(msg))
1028
+
result = caml_alloc_initialized_string(sexp_string_size(msg),
1029
+
sexp_string_data(msg));
1030
+
else
1031
+
result = caml_copy_string("(no message)");
1032
+
CAMLreturn(result);
1033
+
}
1034
+
1035
+
/* ================================================================
1036
+
* NULL ENV (for sandboxing - env with NO bindings)
1037
+
* ================================================================ */
1038
+
1039
+
CAMLprim value caml_chibi_make_null_env(value v_ctx) {
1040
+
CAMLparam1(v_ctx);
1041
+
CAMLlocal1(result);
1042
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1043
+
sexp ctx = ctx_w->ctx;
1044
+
sexp env = sexp_make_null_env(ctx, SEXP_SEVEN);
1045
+
if (sexp_exceptionp(env))
1046
+
raise_chibi_error(ctx, env);
1047
+
result = wrap_sexp(ctx_w, env);
1048
+
CAMLreturn(result);
1049
+
}
1050
+
1051
+
CAMLprim value caml_chibi_make_primitive_env(value v_ctx) {
1052
+
CAMLparam1(v_ctx);
1053
+
CAMLlocal1(result);
1054
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1055
+
sexp ctx = ctx_w->ctx;
1056
+
sexp env = sexp_make_primitive_env(ctx, SEXP_SEVEN);
1057
+
if (sexp_exceptionp(env))
1058
+
raise_chibi_error(ctx, env);
1059
+
result = wrap_sexp(ctx_w, env);
1060
+
CAMLreturn(result);
1061
+
}
1062
+
1063
+
CAMLprim value caml_chibi_context_env(value v_ctx) {
1064
+
CAMLparam1(v_ctx);
1065
+
CAMLlocal1(result);
1066
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1067
+
sexp ctx = ctx_w->ctx;
1068
+
sexp env = sexp_context_env(ctx);
1069
+
result = wrap_sexp(ctx_w, env);
1070
+
CAMLreturn(result);
1071
+
}
1072
+
1073
+
CAMLprim value caml_chibi_set_context_env(value v_ctx, value v_env) {
1074
+
CAMLparam2(v_ctx, v_env);
1075
+
sexp ctx = get_ctx(v_ctx);
1076
+
sexp env = get_sexp(v_env);
1077
+
sexp_context_env(ctx) = env;
1078
+
CAMLreturn(Val_unit);
1079
+
}
1080
+
1081
+
CAMLprim value caml_chibi_eval_in_env(value v_ctx, value v_str, value v_env) {
1082
+
CAMLparam3(v_ctx, v_str, v_env);
1083
+
CAMLlocal1(result);
1084
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1085
+
sexp ctx = ctx_w->ctx;
1086
+
sexp env = get_sexp(v_env);
1087
+
const char *str = String_val(v_str);
1088
+
sexp_sint_t len = caml_string_length(v_str);
1089
+
1090
+
sexp res = sexp_eval_string(ctx, str, len, env);
1091
+
if (sexp_exceptionp(res))
1092
+
raise_chibi_error(ctx, res);
1093
+
1094
+
result = wrap_sexp(ctx_w, res);
1095
+
CAMLreturn(result);
1096
+
}
1097
+
1098
+
/* ================================================================
1099
+
* LOAD STANDARD ENV WITH CUSTOM ENVIRONMENT
1100
+
* ================================================================ */
1101
+
1102
+
CAMLprim value caml_chibi_load_standard_env_into(value v_ctx, value v_env) {
1103
+
CAMLparam2(v_ctx, v_env);
1104
+
sexp ctx = get_ctx(v_ctx);
1105
+
sexp env = get_sexp(v_env);
1106
+
sexp res = sexp_load_standard_env(ctx, env, SEXP_SEVEN);
1107
+
if (sexp_exceptionp(res))
1108
+
raise_chibi_error(ctx, res);
1109
+
CAMLreturn(Val_unit);
1110
+
}
1111
+
1112
+
/* ================================================================
1113
+
* SEXP EQUALITY AND COMPARISON
1114
+
* ================================================================ */
1115
+
1116
+
CAMLprim value caml_chibi_sexp_equal(value v_a, value v_b) {
1117
+
sexp a = get_sexp(v_a);
1118
+
sexp b = get_sexp(v_b);
1119
+
return Val_bool(a == b);
1120
+
}
1121
+
1122
+
/* ================================================================
1123
+
* CHARACTER SUPPORT
1124
+
* ================================================================ */
1125
+
1126
+
CAMLprim value caml_chibi_make_char(value v_ctx, value v_c) {
1127
+
CAMLparam2(v_ctx, v_c);
1128
+
CAMLlocal1(result);
1129
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1130
+
result = wrap_sexp(ctx_w, sexp_make_character(Int_val(v_c)));
1131
+
CAMLreturn(result);
1132
+
}
1133
+
1134
+
/* ================================================================
1135
+
* LIST UTILITIES
1136
+
* ================================================================ */
1137
+
1138
+
CAMLprim value caml_chibi_list_length(value v_sexp) {
1139
+
CAMLparam1(v_sexp);
1140
+
sexp s = get_sexp(v_sexp);
1141
+
sexp_sint_t len = 0;
1142
+
while (sexp_pairp(s)) {
1143
+
len++;
1144
+
s = sexp_cdr(s);
1145
+
}
1146
+
CAMLreturn(Val_long(len));
1147
+
}
1148
+
1149
+
/* ================================================================
1150
+
* PORT REDIRECTION (for sandboxed I/O)
1151
+
* ================================================================ */
1152
+
1153
+
CAMLprim value caml_chibi_set_current_input_port(value v_ctx, value v_port) {
1154
+
CAMLparam2(v_ctx, v_port);
1155
+
sexp ctx = get_ctx(v_ctx);
1156
+
sexp port = get_sexp(v_port);
1157
+
sexp env = sexp_context_env(ctx);
1158
+
sexp_set_parameter(ctx, env,
1159
+
sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL), port);
1160
+
CAMLreturn(Val_unit);
1161
+
}
1162
+
1163
+
CAMLprim value caml_chibi_set_current_output_port(value v_ctx, value v_port) {
1164
+
CAMLparam2(v_ctx, v_port);
1165
+
sexp ctx = get_ctx(v_ctx);
1166
+
sexp port = get_sexp(v_port);
1167
+
sexp env = sexp_context_env(ctx);
1168
+
sexp_set_parameter(ctx, env,
1169
+
sexp_global(ctx, SEXP_G_CUR_OUT_SYMBOL), port);
1170
+
CAMLreturn(Val_unit);
1171
+
}
1172
+
1173
+
CAMLprim value caml_chibi_set_current_error_port(value v_ctx, value v_port) {
1174
+
CAMLparam2(v_ctx, v_port);
1175
+
sexp ctx = get_ctx(v_ctx);
1176
+
sexp port = get_sexp(v_port);
1177
+
sexp env = sexp_context_env(ctx);
1178
+
sexp_set_parameter(ctx, env,
1179
+
sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL), port);
1180
+
CAMLreturn(Val_unit);
1181
+
}
1182
+
1183
+
/* ================================================================
1184
+
* GET CURRENT PORTS
1185
+
* ================================================================ */
1186
+
1187
+
CAMLprim value caml_chibi_get_current_input_port(value v_ctx) {
1188
+
CAMLparam1(v_ctx);
1189
+
CAMLlocal1(result);
1190
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1191
+
sexp ctx = ctx_w->ctx;
1192
+
result = wrap_sexp(ctx_w, sexp_current_input_port(ctx));
1193
+
CAMLreturn(result);
1194
+
}
1195
+
1196
+
CAMLprim value caml_chibi_get_current_output_port(value v_ctx) {
1197
+
CAMLparam1(v_ctx);
1198
+
CAMLlocal1(result);
1199
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1200
+
sexp ctx = ctx_w->ctx;
1201
+
result = wrap_sexp(ctx_w, sexp_current_output_port(ctx));
1202
+
CAMLreturn(result);
1203
+
}
1204
+
1205
+
CAMLprim value caml_chibi_get_current_error_port(value v_ctx) {
1206
+
CAMLparam1(v_ctx);
1207
+
CAMLlocal1(result);
1208
+
chibi_context_t *ctx_w = get_ctx_wrapper(v_ctx);
1209
+
sexp ctx = ctx_w->ctx;
1210
+
result = wrap_sexp(ctx_w, sexp_current_error_port(ctx));
1211
+
CAMLreturn(result);
1212
+
}
1213
+
1214
+
/* ================================================================
1215
+
* HEAP STATS
1216
+
* ================================================================ */
1217
+
1218
+
CAMLprim value caml_chibi_heap_size(value v_ctx) {
1219
+
CAMLparam1(v_ctx);
1220
+
sexp ctx = get_ctx(v_ctx);
1221
+
sexp_heap h = sexp_context_heap(ctx);
1222
+
size_t total = 0;
1223
+
while (h) {
1224
+
total += h->size;
1225
+
h = h->next;
1226
+
}
1227
+
CAMLreturn(Val_long(total));
1228
+
}
1229
+
1230
+
CAMLprim value caml_chibi_heap_max_size(value v_ctx) {
1231
+
CAMLparam1(v_ctx);
1232
+
sexp ctx = get_ctx(v_ctx);
1233
+
CAMLreturn(Val_long(sexp_context_max_size(ctx)));
1234
+
}
+116
lib/dune
+116
lib/dune
···
1
+
(library
2
+
(name chibi_ocaml)
3
+
(public_name chibi-ocaml)
4
+
(foreign_stubs
5
+
(language c)
6
+
(names chibi_stubs)
7
+
(flags
8
+
:standard
9
+
-I%{project_root}/vendor/chibi-scheme/include
10
+
-DSEXP_USE_DL=1
11
+
-DSEXP_USE_STATIC_LIBS=0
12
+
-DSEXP_USE_GREEN_THREADS=1
13
+
-DSEXP_USE_MODULES=1
14
+
-DSEXP_USE_BOEHM=0
15
+
-O2 -g -fPIC))
16
+
(foreign_archives chibi_vendor)
17
+
(c_library_flags -lm -ldl)
18
+
(ocamlopt_flags (:standard -O2)))
19
+
20
+
; Common C flags for chibi-scheme compilation
21
+
; We use a variable to avoid repetition but dune doesn't support that easily,
22
+
; so we spell them out in each command.
23
+
24
+
(rule
25
+
(targets libchibi_vendor.a dllchibi_vendor.so)
26
+
(deps
27
+
(source_tree %{project_root}/vendor/chibi-scheme))
28
+
(action
29
+
(progn
30
+
(run %{cc} -c -fPIC -O2 -g
31
+
-I%{project_root}/vendor/chibi-scheme/include
32
+
-I%{project_root}/vendor/chibi-scheme
33
+
-DSEXP_USE_DL=1
34
+
-DSEXP_USE_STATIC_LIBS=0
35
+
-DSEXP_USE_GREEN_THREADS=1
36
+
-DSEXP_USE_MODULES=1
37
+
-DSEXP_USE_BOEHM=0
38
+
-o chibi_gc.o
39
+
%{project_root}/vendor/chibi-scheme/gc.c)
40
+
(run %{cc} -c -fPIC -O2 -g
41
+
-I%{project_root}/vendor/chibi-scheme/include
42
+
-I%{project_root}/vendor/chibi-scheme
43
+
-DSEXP_USE_DL=1
44
+
-DSEXP_USE_STATIC_LIBS=0
45
+
-DSEXP_USE_GREEN_THREADS=1
46
+
-DSEXP_USE_MODULES=1
47
+
-DSEXP_USE_BOEHM=0
48
+
-o chibi_sexp.o
49
+
%{project_root}/vendor/chibi-scheme/sexp.c)
50
+
(run %{cc} -c -fPIC -O2 -g
51
+
-I%{project_root}/vendor/chibi-scheme/include
52
+
-I%{project_root}/vendor/chibi-scheme
53
+
-DSEXP_USE_DL=1
54
+
-DSEXP_USE_STATIC_LIBS=0
55
+
-DSEXP_USE_GREEN_THREADS=1
56
+
-DSEXP_USE_MODULES=1
57
+
-DSEXP_USE_BOEHM=0
58
+
-o chibi_bignum.o
59
+
%{project_root}/vendor/chibi-scheme/bignum.c)
60
+
(run %{cc} -c -fPIC -O2 -g
61
+
-I%{project_root}/vendor/chibi-scheme/include
62
+
-I%{project_root}/vendor/chibi-scheme
63
+
-DSEXP_USE_DL=1
64
+
-DSEXP_USE_STATIC_LIBS=0
65
+
-DSEXP_USE_GREEN_THREADS=1
66
+
-DSEXP_USE_MODULES=1
67
+
-DSEXP_USE_BOEHM=0
68
+
-o chibi_gc_heap.o
69
+
%{project_root}/vendor/chibi-scheme/gc_heap.c)
70
+
(run %{cc} -c -fPIC -O2 -g
71
+
-I%{project_root}/vendor/chibi-scheme/include
72
+
-I%{project_root}/vendor/chibi-scheme
73
+
-DSEXP_USE_DL=1
74
+
-DSEXP_USE_STATIC_LIBS=0
75
+
-DSEXP_USE_GREEN_THREADS=1
76
+
-DSEXP_USE_MODULES=1
77
+
-DSEXP_USE_BOEHM=0
78
+
-o chibi_opcodes.o
79
+
%{project_root}/vendor/chibi-scheme/opcodes.c)
80
+
(run %{cc} -c -fPIC -O2 -g
81
+
-I%{project_root}/vendor/chibi-scheme/include
82
+
-I%{project_root}/vendor/chibi-scheme
83
+
-DSEXP_USE_DL=1
84
+
-DSEXP_USE_STATIC_LIBS=0
85
+
-DSEXP_USE_GREEN_THREADS=1
86
+
-DSEXP_USE_MODULES=1
87
+
-DSEXP_USE_BOEHM=0
88
+
-o chibi_vm.o
89
+
%{project_root}/vendor/chibi-scheme/vm.c)
90
+
(run %{cc} -c -fPIC -O2 -g
91
+
-I%{project_root}/vendor/chibi-scheme/include
92
+
-I%{project_root}/vendor/chibi-scheme
93
+
-DSEXP_USE_DL=1
94
+
-DSEXP_USE_STATIC_LIBS=0
95
+
-DSEXP_USE_GREEN_THREADS=1
96
+
-DSEXP_USE_MODULES=1
97
+
-DSEXP_USE_BOEHM=0
98
+
-o chibi_eval.o
99
+
%{project_root}/vendor/chibi-scheme/eval.c)
100
+
(run %{cc} -c -fPIC -O2 -g
101
+
-I%{project_root}/vendor/chibi-scheme/include
102
+
-I%{project_root}/vendor/chibi-scheme
103
+
-DSEXP_USE_DL=1
104
+
-DSEXP_USE_STATIC_LIBS=0
105
+
-DSEXP_USE_GREEN_THREADS=1
106
+
-DSEXP_USE_MODULES=1
107
+
-DSEXP_USE_BOEHM=0
108
+
-o chibi_simplify.o
109
+
%{project_root}/vendor/chibi-scheme/simplify.c)
110
+
(run ar rcs libchibi_vendor.a
111
+
chibi_gc.o chibi_sexp.o chibi_bignum.o chibi_gc_heap.o
112
+
chibi_opcodes.o chibi_vm.o chibi_eval.o chibi_simplify.o)
113
+
(run %{cc} -shared -o dllchibi_vendor.so
114
+
chibi_gc.o chibi_sexp.o chibi_bignum.o chibi_gc_heap.o
115
+
chibi_opcodes.o chibi_vm.o chibi_eval.o chibi_simplify.o
116
+
-lm -ldl))))