diff options
Diffstat (limited to 'lib/drl')
| -rw-r--r-- | lib/drl/executor.ml | 35 | ||||
| -rw-r--r-- | lib/drl/sublanguage.ml | 8 |
2 files changed, 14 insertions, 29 deletions
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml index 20b94b9..666ca37 100644 --- a/lib/drl/executor.ml +++ b/lib/drl/executor.ml @@ -1,19 +1,12 @@ 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" ("message" |=| (of_string error)) + let relation_not_found name = condition "relation-not-found" ("name" |=| (of_string name)) + let unsupported_operator msg = condition "unsupported-operator" ("message" |=| (of_string msg)) + let unqualified_name name = condition "unqualified-name" ("name" |=| (of_string name)) + end let ( let* ) = Result.bind @@ -22,11 +15,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) + | Error s -> Error (Error.unqualified_name s) | Ok fqn -> Ok (Nt.Scan { path = resolve fqn; args = [] })) | Ast.Join (on_attrs, q1, q2) -> let* p1 = compile resolve q1 in @@ -36,21 +29,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/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 |