From f49af22461082b290787352989cdb35f89b8df7a Mon Sep 17 00:00:00 2001 From: Marcos Magueta Date: Fri, 30 Oct 2026 13:42:08 -0300 Subject: driver due to the lack of an init system for headless run --- tools/driver/dune | 3 ++ tools/driver/main.ml | 94 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 97 insertions(+) create mode 100644 tools/driver/dune create mode 100644 tools/driver/main.ml diff --git a/tools/driver/dune b/tools/driver/dune new file mode 100644 index 0000000..429a4fc --- /dev/null +++ b/tools/driver/dune @@ -0,0 +1,3 @@ +(executable + (name main) + (libraries rnt subsystem batteries unix)) diff --git a/tools/driver/main.ml b/tools/driver/main.ml new file mode 100644 index 0000000..662032c --- /dev/null +++ b/tools/driver/main.ml @@ -0,0 +1,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 -- *) + +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 -- cgit v1.2.3