erlang bindings to call relations

1 files changed, 24 insertions, 12 deletions

diff --git a/subsystem/karuta/rnt-node.lfe b/subsystem/karuta/rnt-node.lfe
index b7bffc8..94a4b76 100644
--- a/subsystem/karuta/rnt-node.lfe
+++ b/subsystem/karuta/rnt-node.lfe
@@ -3,9 +3,10 @@
 ;; a function taking one relation per input and giving back a relation:
 ;; a function from a limit to at most that many tuples and the rest of
 ;; the relation, or done when there are no more. Its tuples are as
-;; rnt:recv/1 gives and rnt:send/1 takes them.
+;; rnt:recv/1 gives and rnt:send/1 takes them, and it can read any
+;; relation RNT holds with lookup/1.
 (defmodule rnt-node
-  (export (start 0)))
+  (export (start 0) (lookup 1)))
 
 (defun start ()
   ;; The default handler prints to stdout, where it would break a frame.
@@ -24,16 +25,16 @@
 
 (defun write-frame (message) (port_command (get 'port) message))
 
-;; A function that cannot be applied leaves a relation that fails when read.
+;; The function is applied at the first fetch, while RNT waits on it and
+;; can answer what the function asks.
 (defun serve
   (((binary #\i (cursor (size 32)) (m (size 16)) (module binary (size m))
             (f (size 16)) (func binary (size f)) (readers binary)))
-   (put (tuple 'cursor cursor)
-        (try
-          (apply (binary_to_existing_atom module) (binary_to_existing_atom func)
-                 (lc ((<= (binary (reader (size 32))) readers)) (relation reader)))
-          (catch
-            ((tuple class reason stack) (lambda (_) (erlang:raise class reason stack)))))))
+   (let ((inputs (lc ((<= (binary (reader (size 32))) readers)) (relation reader))))
+     (put (tuple 'cursor cursor)
+          (lambda (limit)
+            (funcall (apply (binary_to_existing_atom module) (binary_to_existing_atom func) inputs)
+                     limit)))))
   (((binary #\f (cursor (size 32)) (limit (size 32))))
    (write-frame
      (try (fetch cursor limit)
@@ -56,19 +57,30 @@
            (let ((term (rnt:send tuple)))
              (list (binary ((byte_size term) (size 32))) term)))))
 
-;; An input, read through RNT. Reading it moves the reader on, so it can
-;; be read once.
+;; The relation at path, a list of segments, within what the program
+;; runs within.
+(defun lookup (path)
+  (write-frame
+    (cons #\l (lc ((<- segment path))
+                (let ((bytes (iolist_to_binary segment)))
+                  (list (binary ((byte_size bytes) (size 32))) bytes)))))
+  (let (((tuple 'reader reader) (answer)))
+    (relation reader)))
+
+;; A relation read through RNT. Reading it moves the reader on, so it
+;; can be read once.
 (defun relation (reader)
   (lambda (limit)
     (write-frame (binary #\n (reader (size 32)) (limit (size 32))))
     (let (((tuple tuples exhausted) (answer)))
       (tuple tuples (if exhausted 'done (relation reader))))))
 
-;; The answer to a next, serving the calls that come before it.
+;; The answer to a next or a lookup, serving the calls that come before it.
 (defun answer ()
   (case (read-frame)
     ((binary #\b exhausted (tuples binary))
      (tuple (lc ((<= (binary (n (size 32)) (term binary (size n))) tuples)) (rnt:recv term))
             (=:= exhausted 1)))
+    ((binary #\r (reader (size 32))) (tuple 'reader reader))
     ((binary #\e (message binary)) (error (tuple 'rnt message)))
     (call (serve call) (answer))))