blob: 662032c06af8160cded7267db78f861bbea220db (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
(* Boots a BEAM node on a directory of .beam images (Karuta's runtime
plus compiled modules), lets their rnt_init/0 register programs, and
reads them back through the kernel.
dune exec ./tools/driver/main.exe -- <image directory> *)
open Rnt
module Beam = Subsystem.Karuta.Beam
let ( let* ) = Result.bind
let program = Kernel.Path.("karuta" @/ "program" @/ this)
(* \system\evaluator\fol, so programs can name the "fol" evaluator. *)
let mount_fol root =
let evaluators = Kernel.Namespace.make () and system = Kernel.Namespace.make () in
let* _ =
Kernel.Path.update evaluators Kernel.Path.this "fol" None (Some (Evaluators.FOL.make ()))
in
let* _ = Kernel.Path.update system Kernel.Path.this "evaluator" None (Some evaluators) in
let* _ = Kernel.Path.update root Kernel.Path.this "system" None (Some system) in
Ok ()
(* {Module, Function, Beam, #{Attribute => <<"string">>}} as term_to_binary. *)
let image directory module_ function_ heading =
let beam =
In_channel.with_open_bin (Filename.concat directory (module_ ^ ".beam")) In_channel.input_all
in
let buffer = Buffer.create 64 in
let binary s =
Buffer.add_uint8 buffer 109;
Buffer.add_int32_be buffer (Int32.of_int (String.length s));
Buffer.add_string buffer s
in
List.iter (Buffer.add_uint8 buffer) [131; 104; 4];
List.iter binary [module_; function_; beam];
Buffer.add_uint8 buffer 116;
Buffer.add_int32_be buffer (Int32.of_int (List.length heading));
List.iter (fun name -> binary name; binary "string") heading;
Buffer.contents buffer
let print title relation =
Protocols.Handle.releasing relation (fun () ->
let* _, tuples = Protocols.Relation.read relation in
Printf.printf "%s\n" title;
List.iter
(fun {Concepts.Tuple.type_; attributes} ->
Printf.printf " %s {%s}\n" type_
( BatMap.String.bindings attributes
|> List.map (fun (k, v) -> k ^ " = " ^ Concepts.Value.to_string v)
|> String.concat ", " ) )
tuples;
Ok () )
let run directory root =
let* () = mount_fol root in
(* Boots erl on the images; the handshake runs every rnt_init/0. *)
let* () = Beam.register root [directory] in
let* listing = Kernel.Path.lookup root program in
let* names =
Protocols.Handle.releasing listing (fun () ->
Result.bind
(Protocols.Handle.require Protocols.Directory.from listing)
Protocols.Directory.list )
in
Printf.printf "\\karuta\\program holds: %s\n" (String.concat ", " (BatFingerTree.to_list names));
(* 1. The FOL program librarian defined from inside the node. *)
let* authors = Kernel.Path.lookup root Kernel.Path.("karuta" @/ "program" @/ "authors" @/ this) in
let* relation =
Protocols.Handle.releasing authors (fun () ->
let* executable = Protocols.Executable.require authors in
Protocols.Executable.invoke executable [] ~within:root )
in
let* () = print "FOL \\karuta\\program\\authors (project author over main):" relation in
(* 2. A beam program that itself issues a FOL plan back to RNT. *)
let* titles =
Kernel.Program.load root ~evaluator:"karuta:beam"
~source:(image directory "librarian" "titles" ["title"])
in
let* relation =
Protocols.Handle.releasing titles (fun () ->
let* executable = Protocols.Executable.require titles in
Protocols.Executable.invoke executable [] ~within:root )
in
print "librarian:titles (BEAM -> RNT fol -> BEAM main):" relation
let () =
Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
let root = Kernel.Namespace.make () in
let outcome = Protocols.Handle.releasing root (fun () -> run Sys.argv.(1) root) in
match outcome with
| Ok () -> ()
| Error c ->
prerr_endline (Concepts.Condition.to_string_hum c);
exit 1
|
