aboutsummaryrefslogtreecommitdiffstats
path: root/lib/drl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/drl')
-rw-r--r--lib/drl/executor.ml37
-rw-r--r--lib/drl/parser.ml9
-rw-r--r--lib/drl/sublanguage.ml8
3 files changed, 20 insertions, 34 deletions
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml
index 20b94b9..5f820c8 100644
--- a/lib/drl/executor.ml
+++ b/lib/drl/executor.ml
@@ -1,19 +1,11 @@
module Make (NT : Nt.S) = struct
- type error =
- | ParseError of string
- | RelationNotFound of string
- | NtError of Nt.error
- | UnsupportedOperator of string
- | UnqualifiedName of string
+ module Error = struct
+ open Condition
- 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 ]
- | NtError e -> List [ Atom "nt-error"; Atom (Nt.string_of_error e) ]
- | UnsupportedOperator s -> List [ Atom "unsupported-operator"; Atom s ]
- | UnqualifiedName s -> List [ Atom "unqualified-name"; Atom s ]
+ let parse_error error = condition "parse-error" error empty
+ let relation_not_found name = condition "relation-not-found" "Relation not found" ("name" |=| (of_string name))
+ let unsupported_operator msg = condition "unsupported-operator" msg empty
+ end
let ( let* ) = Result.bind
@@ -22,12 +14,11 @@ module Make (NT : Nt.S) = struct
[resolve] maps an FQN to its absolute RNT path. *)
let rec compile
(resolve : ?branch:string -> Qualified_name.t -> string)
- (q : Ast.query) : (Nt.plan_node, error) result =
+ (q : Ast.query) : (Nt.plan_node, Condition.t) result =
match q with
| Ast.Base name ->
- (match Qualified_name.try_parse name with
- | Error s -> Error (UnqualifiedName s)
- | Ok fqn -> Ok (Nt.Scan { path = resolve fqn; args = [] }))
+ let* fqn = Qualified_name.try_parse name in
+ Ok (Nt.Scan { path = resolve fqn; args = [] })
| Ast.Join (on_attrs, q1, q2) ->
let* p1 = compile resolve q1 in
let* p2 = compile resolve q2 in
@@ -36,21 +27,19 @@ module Make (NT : Nt.S) = struct
let* p = compile resolve q in
Ok (Nt.Take { limit = n; source = p })
| Ast.Const _ ->
- Error (UnsupportedOperator
+ Error (Error.unsupported_operator
"Const: literal relations not yet reachable by VM; use Base")
| _ ->
- Error (UnsupportedOperator
+ Error (Error.unsupported_operator
"Select/Project/Rename/Union/Diff/Cartesian require VM operators not yet implemented")
let page_limit = 16
let execute (ctx : Sublanguage_context.t) (q : Ast.query) :
- (Sublanguage_types.result, error) result =
+ (Sublanguage_types.result, Condition.t) result =
let* plan = compile ctx.resolve q in
let rel_name = "query_result" in
- let* stream =
- NT.execute_query plan ~rel_name
- |> Result.map_error (fun e -> NtError e)
+ let* stream = NT.execute_query plan ~rel_name
in
let rec drain acc count =
if count >= page_limit then (List.rev acc, true)
diff --git a/lib/drl/parser.ml b/lib/drl/parser.ml
index 76d4b4e..be1f1eb 100644
--- a/lib/drl/parser.ml
+++ b/lib/drl/parser.ml
@@ -1,13 +1,16 @@
-type error = ParseError of string
+module Error = struct
+ open Condition
+ let parse_error msg = condition "parse-error" msg empty
+end
let of_sexp sexp =
match Ast.query_of_sexp sexp with
| q -> Ok q
- | exception exn -> Error (ParseError (Printexc.to_string exn))
+ | exception exn -> Error (Error.parse_error (Printexc.to_string exn))
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))
+ | exception exn -> Error (Error.parse_error (Printexc.to_string exn))
let to_string q = Ast.sexp_of_query q |> Sexplib.Sexp.to_string_hum
diff --git a/lib/drl/sublanguage.ml b/lib/drl/sublanguage.ml
index ccc0222..64cd8c0 100644
--- a/lib/drl/sublanguage.ml
+++ b/lib/drl/sublanguage.ml
@@ -3,17 +3,11 @@ module Make (NT : Nt.S) = struct
type configuration = unit
type ast = Ast.query
- type error = Exec.error
let name = "drl"
let parse _ = Ok ()
- let parse_sexp sexp =
- match Parser.of_sexp sexp with
- | Ok r -> Ok r
- | Error (Parser.ParseError s) -> Error (Exec.ParseError s)
+ let parse_sexp sexp = Parser.of_sexp sexp
let execute ctx ast = Exec.execute ctx ast
-
- let sexp_of_error = Exec.sexp_of_error
end