2 files changed, 90 insertions, 0 deletions
diff --git a/lib/kernel/Source.ml b/lib/kernel/Source.ml
new file mode 100644
index 0000000..b3b7389
--- /dev/null
+++ b/lib/kernel/Source.ml
@@ -0,0 +1,58 @@
+let program ~language text =
+  Prototype.mixture
+    [ EphemeralRelation.Stored
+        {evaluator= language; code= Concepts.Blob.blob_of_bytes (Bytes.of_string text)} ]
+
+let text handle =
+  Protocols.Handle.into handle (function
+    | EphemeralRelation.Stored {evaluator; code} ->
+        Some (evaluator, Bytes.to_string (Concepts.Blob.bytes_of_blob code))
+    | _ -> None )
+  |> Option.map (fun i -> Protocols.Handle.invoke i Fun.id)
+
+module Error = struct
+  open Concepts.Condition
+
+  let not_a_program language =
+    condition "not-a-program" "An evaluator was given something that carries no source"
+      ("language" |=| Concepts.Value.String language)
+
+  let foreign language given =
+    condition "foreign-program" "An evaluator was given source in another language"
+      ("language" |=| Concepts.Value.String language & "given" |=| Concepts.Value.String given)
+
+  let no_evaluator language =
+    condition "no-evaluator" "No evaluator is registered for the language"
+      ("language" |=| Concepts.Value.String language)
+end
+
+let evaluator ~language run =
+  Protocols.Handle.make
+    object (self)
+      inherit Lifecycle.null
+      inherit Identity.of_id
+      method to_string = language ^ "-evaluator"
+      method protocols : Protocols.Handle.protocol list = [Protocols.Evaluator.make self]
+
+      method invoke program =
+        match text program with
+        | None -> Error (Error.not_a_program language)
+        | Some (given, _) when given <> language -> Error (Error.foreign language given)
+        | Some (_, source) -> run source
+    end
+
+let run root ~language source =
+  let open Utilities.Result in
+  let* evaluator =
+    Path.lookup root Path.("evaluator" @/ language @/ this)
+    |> Result.map_error (fun _ -> Error.no_evaluator language)
+  in
+  let* evaluator = Protocols.Evaluator.require evaluator in
+  Protocols.Evaluator.invoke evaluator (program ~language source)
+
+let register root ~language evaluator =
+  let open Utilities.Result in
+  let* evaluators = Path.lookup root Path.("evaluator" @/ this) in
+  let* registry = Protocols.Handle.require Protocols.Registry.from evaluators in
+  let* _ = Protocols.Registry.update registry language None (Some evaluator) in
+  Ok ()
diff --git a/lib/kernel/Source.mli b/lib/kernel/Source.mli
new file mode 100644
index 0000000..1a51da2
--- /dev/null
+++ b/lib/kernel/Source.mli
@@ -0,0 +1,32 @@
+(** programs as source. A program in any language travels the tree as a
+    handle carrying [EphemeralRelation.Stored], with its text as the code,
+    so whoever holds one can run it through the evaluator of its language
+    without linking that language. *)
+
+(** a program in [language]. *)
+val program : language:string -> string -> Protocols.Handle.t
+
+(** the language and text a handle carries, if it is a program. *)
+val text : Protocols.Handle.t -> (string * string) option
+
+(** an evaluator for [language]: it runs the text of a program in that
+    language, and refuses anything else. *)
+val evaluator :
+  language:string ->
+  (string -> (Protocols.Handle.t, Concepts.Condition.condition) result) ->
+  Protocols.Handle.t
+
+(** look up the evaluator of [language] under [root]'s \evaluator and run
+    [text] with it. *)
+val run :
+  Protocols.Handle.t ->
+  language:string ->
+  string ->
+  (Protocols.Handle.t, Concepts.Condition.condition) result
+
+(** register [evaluator] as \evaluator\[language] under [root]. *)
+val register :
+  Protocols.Handle.t ->
+  language:string ->
+  Protocols.Handle.t ->
+  (unit, Concepts.Condition.condition) result