dummy dml for testingrnt-integration

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