diff options
Diffstat (limited to 'lib/evaluators')
| -rw-r--r-- | lib/evaluators/FOL.ml | 83 |
1 files changed, 81 insertions, 2 deletions
diff --git a/lib/evaluators/FOL.ml b/lib/evaluators/FOL.ml index 016e3a0..e436eeb 100644 --- a/lib/evaluators/FOL.ml +++ b/lib/evaluators/FOL.ml @@ -23,11 +23,90 @@ module Error = struct let released_relation name = condition "released-relation" "A plan named a relation that was already released" ("object" |=| Concepts.Value.String name) + + let malformed_program () = + condition "malformed-fol-program" + "A stored FOL program did not conform to what was expected. Is your database corrupted?" empty + + let foreign_program evaluator = + condition "foreign-program" "A plan named a relation stored by another evaluator" + ("evaluator" |=| Concepts.Value.String evaluator) + + let cyclic_program code = + condition "cyclic-program" "A stored program reads itself" + ("program" |=| Concepts.Value.String (Concepts.Hash.to_hum_string code)) end -type plan = Base of Protocols.Handle.t | Project of plan * string BatFingerTree.t +let name = "fol" + +type 'r term = Base of 'r | Project of 'r term * string BatFingerTree.t +type plan = Protocols.Handle.t term type Protocols.Handle.protocol += Plan of plan +module Bencode = Concepts.Encoding.Bencode + +let rec bencode_of_term = + let strings values = Bencode.List (List.map (fun value -> Bencode.String value) values) in + function + | Base path -> Bencode.Tagged ('b', strings (Kernel.Path.to_list path)) + | Project (term, attributes) -> + Bencode.Tagged + ( 'p', + Bencode.Dict + ["term", bencode_of_term term; "attributes", strings (BatFingerTree.to_list attributes)] + ) + +let rec term_of_bencode = + let open Utilities.Result in + let strings values = + let* values = Bencode.as_list values in + List.map Bencode.as_string values |> Utilities.List.sequence + in + function + | Bencode.Tagged ('b', segments) -> + strings segments |> Result.map (fun segments -> Base (Kernel.Path.of_list segments)) + | Bencode.Tagged ('p', data) -> + let* term = Bencode.field "term" data |> fmap term_of_bencode in + let* attributes = Bencode.field "attributes" data |> fmap strings in + Ok (Project (term, BatFingerTree.of_list attributes)) + | _ -> Error (Error.malformed_program ()) + +let encode term = bencode_of_term term |> Bencode.to_blob +let decode code = Bencode.of_blob code |> Utilities.Result.fmap term_of_bencode + +let stored relation = + Protocols.Handle.into relation (function + | Kernel.EphemeralRelation.Stored {evaluator; code} -> Some (evaluator, code) + | _ -> None ) + |> Option.map (fun stored -> Protocols.Handle.invoke stored Fun.id) + +(* TODO: To strenghten our checks for self references, we need to + construct a graph and see raise a condition if there are self + references. We partially do that here with the program calling + self, but if the flow is alternated, say between program A and B, + where B calls A and A calls B, we also must check. *) +let instantiate resolve = + let open Utilities.Result in + let rec bind expanding = function + | Base reference -> ( + let* relation = resolve reference in + match stored relation with + | None -> Ok (Base relation) + | Some (evaluator, code) -> + Protocols.Handle.release relation; + let identity = Concepts.Hash.hash_of_blob code in + if not (String.equal evaluator name) then Error (Error.foreign_program evaluator) + else if List.exists (Concepts.Hash.hash_equals identity) expanding then + Error (Error.cyclic_program identity) + else + let* term = decode code in + bind (identity :: expanding) term ) + | Project (term, attributes) -> + let* plan = bind expanding term in + Ok (Project (plan, attributes)) + in + bind [] + class program plan = object inherit Kernel.Lifecycle.null @@ -96,7 +175,7 @@ let project description relation = let derive relation description enumerate = Kernel.EphemeralRelation.instantiate ~inputs:[relation] description - {Kernel.EphemeralRelation.schematics= `Temporary description} + {Kernel.EphemeralRelation.name= None; schematics= `Temporary description; program= None} (fun () -> enumerate relation) let rec execute plan = |
