blob: 322fada3fab6590ee6b585735bdb23c0ac2401e1 (
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)
|
