blob: d4bbf567816e6d63c7267f1eed4cd72cff7f7f08 (
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
|
(* Boots a BEAM node on a directory of images and prints the programs
named on the command line, read from \karuta\program.
dune exec ./tools/run/main.exe -- <image directory> <program>... *)
open Rnt
module Beam = Subsystem.Karuta.Beam
let ( let* ) = Result.bind
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 ()
(* Where calendar.skr's persisted predicates live, made of plain
namespaces since this kernel has no branches. *)
let rec directories root prefix = function
| [] -> Ok ()
| segment :: rest ->
let* _ =
Kernel.Path.update root (Kernel.Path.of_list prefix) segment None
(Some (Kernel.Namespace.make ()))
in
directories root (prefix @ [segment]) rest
let show root name =
let* handle = Kernel.Path.lookup root Kernel.Path.("karuta" @/ "program" @/ name @/ this) in
let* relation =
Protocols.Handle.releasing handle (fun () ->
let* executable = Protocols.Executable.require handle in
Protocols.Executable.invoke executable [] ~within:root )
in
Protocols.Handle.releasing relation (fun () ->
let* _, tuples = Protocols.Relation.read relation in
Printf.printf "\\karuta\\program\\%s:\n" name;
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 names root =
let* () = mount_fol root in
let* () =
directories root ["system"]
["branch"; "master"; "multigroup"; "calendar"; "schema"; "public"; "relation"]
in
let* () = Beam.register root [directory] in
List.fold_left (fun acc name -> let* () = acc in show root name) (Ok ()) names
let () =
Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
let root = Kernel.Namespace.make () in
let names = Array.to_list (Array.sub Sys.argv 2 (Array.length Sys.argv - 2)) in
match Protocols.Handle.releasing root (fun () -> run Sys.argv.(1) names root) with
| Ok () -> ()
| Error c -> prerr_endline (Concepts.Condition.to_string_hum c); exit 1
|
