blob: f1732ebb3086ade626ee6f0cd97762dc2d615774 (
plain) (
tree)
|
|
module Make (Storage : Management.Physical.S) = struct
module Alg = Algebra.Make (Storage)
module Ops = Manipulation.Make (Storage)
type error =
| ParseError of string
| RelationNotFound of string
| AlgebraError of Algebra.error
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
| ParseError s -> List [ Atom "parse-error"; Atom s ]
| RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
| AlgebraError (Algebra.StorageError s) ->
List [ Atom "storage-error"; Atom s ]
| AlgebraError (Algebra.GeneratorError s) ->
List [ Atom "generator-error"; Atom s ]
let wrap = Result.map_error (fun e -> AlgebraError e)
let ast_value_to_abstract = Ast.value_to_abstract
let rec execute (storage : Storage.t) (db : Management.Database.t)
(q : Ast.query) : (Relation.t, error) Result.t =
let ( >>= ) = Result.bind in
match q with
| Ast.Base name -> (
match Ops.get_relation db ~name with
| None -> Error (RelationNotFound name)
| Some rel -> Ok rel)
| Ast.Const pairs ->
Ok
(Alg.const_relation
(List.map (fun (k, v) -> (k, ast_value_to_abstract v)) pairs))
| Ast.Select (filter_q, source_q) ->
execute storage db filter_q >>= fun filter ->
execute storage db source_q >>= fun source ->
(* semijoin = project(source attrs, equijoin on common attrs) *)
let common =
List.filter_map
(fun (n, _) ->
if List.exists (fun (m, _) -> m = n) filter.Relation.schema then
Some n
else None)
source.Relation.schema
in
let source_attrs = List.map fst source.Relation.schema in
wrap (Alg.equijoin storage common source filter) >>= fun joined ->
wrap (Alg.project storage source_attrs joined)
| Ast.Join (attrs, q1, q2) ->
execute storage db q1 >>= fun r1 ->
execute storage db q2 >>= fun r2 ->
wrap (Alg.equijoin storage attrs r1 r2)
| Ast.Project (attrs, q) ->
execute storage db q >>= fun rel -> wrap (Alg.project storage attrs rel)
| Ast.Rename (renames, q) ->
execute storage db q >>= fun rel ->
wrap (Alg.rename storage renames rel)
| Ast.Cartesian (q1, q2) ->
execute storage db q1 >>= fun r1 ->
execute storage db q2 >>= fun r2 ->
(* Cartesian product = join on no attrs *)
wrap (Alg.equijoin storage [] r1 r2)
| Ast.Union (q1, q2) ->
execute storage db q1 >>= fun r1 ->
execute storage db q2 >>= fun r2 -> wrap (Alg.union storage r1 r2)
| Ast.Diff (q1, q2) ->
execute storage db q1 >>= fun r1 ->
execute storage db q2 >>= fun r2 -> wrap (Alg.diff storage r1 r2)
| Ast.Take (n, q) ->
execute storage db q >>= fun rel -> wrap (Alg.take storage n rel)
end
module Memory = Make (Management.Physical.Memory)
|
