bound queries from sakurasakura-karuta-contract

3 files changed, 76 insertions, 8 deletions

diff --git a/tools/driver/main.ml b/tools/driver/main.ml
index 662032c..d22baf0 100644
--- a/tools/driver/main.ml
+++ b/tools/driver/main.ml
@@ -1,5 +1,5 @@
 (* Boots a BEAM node on a directory of .beam images (Karuta's runtime
-   plus compiled modules), lets their rnt_init/0 register programs, and
+   plus compiled modules), lets their rnt-init closures register programs, and
    reads them back through the kernel.
 
    dune exec ./tools/driver/main.exe -- <image directory> *)
@@ -20,8 +20,8 @@ let mount_fol root =
   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 =
+(* {Module, Beam, #{Attribute => <<"string">>}} as term_to_binary. *)
+let image directory module_ heading =
   let beam =
     In_channel.with_open_bin (Filename.concat directory (module_ ^ ".beam")) In_channel.input_all
   in
@@ -31,8 +31,8 @@ let image directory module_ function_ heading =
     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];
+  List.iter (Buffer.add_uint8 buffer) [131; 104; 3];
+  List.iter binary [module_; 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;
@@ -53,7 +53,7 @@ let print title relation =
 
 let run directory root =
   let* () = mount_fol root in
-  (* Boots erl on the images; the handshake runs every rnt_init/0. *)
+  (* Boots erl on the images; the handshake runs every rnt-init. *)
   let* () = Beam.register root [directory] in
   let* listing = Kernel.Path.lookup root program in
   let* names =
@@ -74,14 +74,14 @@ let run directory root =
   (* 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"])
+      ~source:(image directory "librarian" ["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
+  print "librarian's query (BEAM -> RNT fol -> BEAM main):" relation
 
 let () =
   Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
diff --git a/tools/run/dune b/tools/run/dune
new file mode 100644
index 0000000..429a4fc
--- /dev/null
+++ b/tools/run/dune
@@ -0,0 +1,3 @@
+(executable
+ (name main)
+ (libraries rnt subsystem batteries unix))
diff --git a/tools/run/main.ml b/tools/run/main.ml
new file mode 100644
index 0000000..d4bbf56
--- /dev/null
+++ b/tools/run/main.ml
@@ -0,0 +1,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