diff options
Diffstat (limited to 'lib/drl')
| -rw-r--r-- | lib/drl/ast.ml | 25 | ||||
| -rw-r--r-- | lib/drl/executor.ml | 70 | ||||
| -rw-r--r-- | lib/drl/parser.ml | 9 |
3 files changed, 104 insertions, 0 deletions
diff --git a/lib/drl/ast.ml b/lib/drl/ast.ml new file mode 100644 index 0000000..f94965d --- /dev/null +++ b/lib/drl/ast.ml @@ -0,0 +1,25 @@ +open Sexplib.Std + +(** Literal values for Const nodes *) +type value = + | Int of int + | Float of float + | Str of string + | Bool of bool +[@@deriving sexp] + +type direction = Asc | Desc +[@@deriving sexp] + +type query = + | Base of string (** base relation by name *) + | Const of (string * value) list (** constant single-tuple relation *) + | Select of query * query (** σ semijoin: (filter, source) *) + | Join of string list * query * query (** ⋈ natural equijoin on named attrs *) + | Cartesian of query * query (** × Cartesian product *) + | Project of string list * query (** π restrict columns *) + | Rename of (string * string) list * query (** ρ rename (old,new) pairs *) + | Union of query * query (** ∪ — compatible schemas assumed *) + | Diff of query * query (** − *) + | Take of int * query (** τ *) +[@@deriving sexp] diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml new file mode 100644 index 0000000..7588b33 --- /dev/null +++ b/lib/drl/executor.ml @@ -0,0 +1,70 @@ +module Make(Storage : Management.Physical.S) = struct + module Alg = Algebra.Make(Storage) + module Ops = Manipulation.Make(Storage) + + type error = + | RelationNotFound of string + | AlgebraError of Algebra.error + + let wrap = Result.map_error (fun e -> AlgebraError e) + + (* Convert Ast.value → AbstractValue.t (Obj.t) via Obj.repr *) + let ast_value_to_abstract : Ast.value -> Conventions.AbstractValue.t = function + | Ast.Int n -> Obj.repr n + | Ast.Float f -> Obj.repr f + | Ast.Str s -> Obj.repr s + | Ast.Bool b -> Obj.repr b + + 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) diff --git a/lib/drl/parser.ml b/lib/drl/parser.ml new file mode 100644 index 0000000..71d694b --- /dev/null +++ b/lib/drl/parser.ml @@ -0,0 +1,9 @@ +type error = ParseError of string + +let of_string s = + match Sexplib.Sexp.of_string s |> Ast.query_of_sexp with + | q -> Ok q + | exception exn -> Error (ParseError (Printexc.to_string exn)) + +let to_string q = + Ast.sexp_of_query q |> Sexplib.Sexp.to_string_hum |