diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/dml/ast.ml | 8 | ||||
| -rw-r--r-- | lib/dml/executor.ml | 24 | ||||
| -rw-r--r-- | lib/dml/parser.ml | 10 | ||||
| -rw-r--r-- | lib/dml/sublanguage.ml | 7 |
4 files changed, 49 insertions, 0 deletions
diff --git a/lib/dml/ast.ml b/lib/dml/ast.ml new file mode 100644 index 0000000..a38873e --- /dev/null +++ b/lib/dml/ast.ml @@ -0,0 +1,8 @@ +open Sexplib.Std + +type value = Str of string | Int of int [@@deriving sexp] + +type statement = + | Define of {target: string; heading: (string * string) list; tuples: (string * value) list list} + | Drop of {target: string} +[@@deriving sexp] diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml new file mode 100644 index 0000000..fdc3c9f --- /dev/null +++ b/lib/dml/executor.ml @@ -0,0 +1,24 @@ +open Utilities.Result + +let value_of = function Ast.Str s -> Value.String s | Ast.Int n -> Value.Integer n +let map_of bindings = List.to_seq bindings |> Utilities.StringMap.of_seq + +let execute (ctx : Sublanguage_context.t) statement = + let* {RNT.branch; _} = ctx.session#state in + let relation = Drl.Executor.relation_path ("\\branch\\" ^ branch) in + let* message = + match statement with + | Ast.Define {target; heading; tuples} -> + let* path = relation target in + let tuples = + List.map (fun row -> List.map (fun (a, v) -> a, value_of v) row |> map_of) tuples + in + let* () = RNT.create ctx.kernel path (RNT.Relation {heading= map_of heading; tuples}) in + Ok ("Defined " ^ target) + | Ast.Drop {target} -> + let* path = relation target in + let* () = RNT.remove ctx.kernel path in + Ok ("Dropped " ^ target) + in + let* () = ctx.session#set_branch_to branch in + Ok (Sublanguage_types.Transition message) diff --git a/lib/dml/parser.ml b/lib/dml/parser.ml new file mode 100644 index 0000000..e381365 --- /dev/null +++ b/lib/dml/parser.ml @@ -0,0 +1,10 @@ +module Error = struct + open Condition + + let parse_error msg = condition "parse-error" msg empty +end + +let of_sexp sexp = + match Ast.statement_of_sexp sexp with + | statement -> Ok statement + | exception exn -> Error (Error.parse_error (Printexc.to_string exn)) diff --git a/lib/dml/sublanguage.ml b/lib/dml/sublanguage.ml new file mode 100644 index 0000000..252e6ef --- /dev/null +++ b/lib/dml/sublanguage.ml @@ -0,0 +1,7 @@ +type configuration = unit +type ast = Ast.statement + +let name = "dml" +let parse _ = Ok () +let parse_sexp = Parser.of_sexp +let execute = Executor.execute |
