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
|
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)
|
