diff options
Diffstat (limited to 'lib/backend/execution')
| -rw-r--r-- | lib/backend/execution/FOL.ml | 110 |
1 files changed, 0 insertions, 110 deletions
diff --git a/lib/backend/execution/FOL.ml b/lib/backend/execution/FOL.ml deleted file mode 100644 index 7da890d..0000000 --- a/lib/backend/execution/FOL.ml +++ /dev/null @@ -1,110 +0,0 @@ -(* @uses Tuple -- project, rename, merge over result streams *) -(* @needs Value *) -(* @needs Path *) -(* @needs Condition *) - -module Plan = struct - type path_arg = Var of string | Const of Concepts.Value.value - - type t = - | Scan of {path: Concepts.Path.t; args: path_arg BatFingerTree.t} - | Natural of {left: t; right: t} - | Take of {limit: int; from: t} - | Project of {attrs: BatSet.String.t; from: t} - | Materialize of t - | Rename of {attrs: string BatMap.String.t; from: t} - | Union of t BatFingerTree.t -end - -type stream = (Concepts.Tuple.t, Concepts.Condition.condition) result BatSeq.t - -let singleton (x : ('a, 'e) result) : ('a, 'e) result BatSeq.t = - fun () -> BatSeq.Cons (x, BatSeq.empty) - -module Error = struct - open Concepts.Condition - - let unbound_variable name = - condition "unbound-variable" - (Printf.sprintf "path variable %S is not bound in the enclosing tuple" name) - ("variable" |=| Concepts.Value.String name) -end - -let resolve (args : Plan.path_arg BatFingerTree.t) (bindings : Concepts.Tuple.t) : - (Concepts.Value.value BatFingerTree.t, Concepts.Condition.condition) result = - let open Utilities.Result in - BatFingerTree.fold_left - (fun acc arg -> - let* acc = acc in - let* value = - match arg with - | Plan.Const value -> Ok value - | Plan.Var name -> - Option.to_result ~none:(Error.unbound_variable name) - (Concepts.Tuple.access name bindings) - in - Ok (BatFingerTree.snoc acc value) ) - (Ok BatFingerTree.empty) args - -module Make (Handler : Managers.Handle.HANDLER) = struct - let scan handler ~path ~args : stream = - let opened = - let open Utilities.Result in - let* handle = Handler.open_ handler ~path in - Handler.open_cursor handle ~args - in - match opened with - | Error condition -> singleton (Error condition) - | Ok cursor -> - let rec pull () = - match Handler.next cursor with - | Error condition -> BatSeq.Cons (Error condition, BatSeq.empty) - | Ok None -> BatSeq.Nil - | Ok (Some tuple) -> BatSeq.Cons (Ok tuple, pull) - in - pull - - let rec compile handler : Plan.t -> Concepts.Tuple.t -> stream = function - | Scan {path; args} -> ( - fun bindings -> - match resolve args bindings with - | Ok args -> scan handler ~path ~args - | Error condition -> singleton (Error condition) ) - | Project {attrs; from} -> - let from = compile handler from in - fun bindings -> BatSeq.map (Result.map (Concepts.Tuple.project attrs)) (from bindings) - | Rename {attrs; from} -> - let from = compile handler from in - fun bindings -> BatSeq.map (Result.map (Concepts.Tuple.rename attrs)) (from bindings) - | Take {limit; from} -> - let from = compile handler from in - fun bindings -> BatSeq.take limit (from bindings) - | Union plans -> - let compiled = BatFingerTree.map (compile handler) plans in - fun bindings -> - BatFingerTree.fold_right - (fun rest c -> BatSeq.append (c bindings) rest) - BatSeq.empty compiled - | Natural {left; right} -> - let left = compile handler left and right = compile handler right in - let matches l r = - BatMap.String.for_all - (fun name value -> - match Concepts.Tuple.access name r with Some value' -> value = value' | None -> true ) - l - in - fun bindings -> - left bindings - |> BatSeq.concat_map (function - | Error _ as error -> singleton error - | Ok l -> - right l - |> BatSeq.filter (function Ok r -> matches l r | Error _ -> true) - |> BatSeq.map (Result.map (Concepts.Tuple.merge l)) ) - | Materialize from -> - let cached = lazy (BatSeq.memoize (compile handler from Concepts.Tuple.empty)) in - fun _ -> Lazy.force cached - - (* TODO: This should produce ephemeral relations with support of the sublanguage to manage it. *) - let run handler plan : stream = compile handler plan Concepts.Tuple.empty -end |