diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/drl/executor.ml | 40 |
1 files changed, 24 insertions, 16 deletions
diff --git a/lib/drl/executor.ml b/lib/drl/executor.ml index e472ec5..dcfe716 100644 --- a/lib/drl/executor.ml +++ b/lib/drl/executor.ml @@ -1,27 +1,35 @@ open Utilities.Result +module Error = struct + open Condition + + let unqualified_name name = + condition "unqualified-name" "A relation must be named as multigroup:relation" + ("name" |=| Value.String name) +end + let page_limit = 16 -(* [mg:rel] names a relation on the session's branch; a bare name, one the session created. *) -let path_of (ctx : Sublanguage_context.t) name = +let relation_path branch name = match String.index_opt name ':' with - | None -> ctx.session#namespace ^ "\\" ^ name - | Some i -> - String.concat "\\" - [ ""; - "branch"; - ctx.session#branch; - "multigroup"; - String.sub name 0 i; - "relation"; - String.sub name (i + 1) (String.length name - i - 1) ] + | Some i when i > 0 && i < String.length name - 1 -> + Ok + (String.concat "\\" + [ branch; + "multigroup"; + String.sub name 0 i; + "relation"; + String.sub name (i + 1) (String.length name - i - 1) ] ) + | _ -> Error (Error.unqualified_name name) -let rec compile ctx = function - | Ast.Base name -> RNT.Base (path_of ctx name) - | Ast.Project (attributes, query) -> RNT.Project (compile ctx query, attributes) +let rec compile branch = function + | Ast.Base name -> relation_path branch name |> Result.map (fun path -> RNT.Base path) + | Ast.Project (attributes, query) -> + compile branch query |> Result.map (fun plan -> RNT.Project (plan, attributes)) let execute (ctx : Sublanguage_context.t) query = - let* relation = RNT.execute ctx.kernel (compile ctx query) in + let* plan = compile (ctx.session#path ^ "\\branch") query in + let* relation = RNT.execute ctx.kernel plan in Fun.protect ~finally:(fun () -> RNT.release relation) (fun () -> |