1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
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 select_semijoin storage source filter =
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
Result.bind (wrap (Alg.equijoin storage common source filter)) (fun joined ->
wrap (Alg.project storage source_attrs joined))
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 ->
select_semijoin storage source filter
| 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 ->
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)
|
