From 6b377719c10d5ab3343fd5221f99a4a21008e25a Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Thu, 14 Mar 2024 08:26:58 +0100
Subject: Initial commit

---
 lib/expression/sym.ml | 71 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 71 insertions(+)
 create mode 100644 lib/expression/sym.ml

(limited to 'lib/expression/sym.ml')

diff --git a/lib/expression/sym.ml b/lib/expression/sym.ml
new file mode 100644
index 0000000..0360e8e
--- /dev/null
+++ b/lib/expression/sym.ml
@@ -0,0 +1,71 @@
+(** The signature for an expression analyzer.
+
+    Every element is mapped to a function, using the tagless final pattern.
+
+ *)
+module type SYM_EXPR = sig
+  type 'a repr
+  type 'a obs
+  type 'a path_repr
+
+  val empty : unit -> 'a repr
+  val expr : 'a repr -> 'a repr
+  val literal : string -> 'a repr
+  val integer : string -> 'a repr
+  val path : 'a path_repr -> 'a -> 'a repr
+  val concat : 'a repr list -> 'a repr
+  val window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr
+  val nvl : 'a repr list -> 'a repr
+  val join : string -> 'a repr list -> 'a repr
+  val boperator : T.binary_operator -> 'a repr -> 'a repr -> 'a repr
+  val gequality : T.binary_operator -> 'a repr -> 'a repr list -> 'a repr
+  val funct : string -> 'a repr list -> 'a repr
+  val function' : T.funct -> 'a repr list -> 'a repr
+  val observe : 'a repr -> 'a obs
+end
+
+module type SYM_CHUNK = sig
+  include SYM_EXPR
+
+  val group : 'a repr list -> 'a repr
+  val arguments : 'a repr list -> 'a repr
+end
+
+open StdLabels
+
+module M (Expr : SYM_EXPR) = struct
+  let rec eval : path_repr:'a Expr.path_repr -> 'a T.t -> 'c Expr.repr =
+   fun ~path_repr t ->
+    match t with
+    | T.Expr expr -> Expr.expr (eval ~path_repr expr)
+    | T.Empty -> Expr.empty ()
+    | T.Literal s -> Expr.literal s
+    | T.Integer i -> Expr.integer i
+    | T.Concat elems -> Expr.concat (List.map elems ~f:(eval ~path_repr))
+    | T.Function (name, args) ->
+        Expr.funct name (List.map args ~f:(eval ~path_repr))
+    | T.Function' (name, args) ->
+        Expr.function' name (List.map args ~f:(eval ~path_repr))
+    | T.Nvl elems -> Expr.nvl (List.map elems ~f:(eval ~path_repr))
+    | T.Join (sep, args) -> Expr.join sep (List.map args ~f:(eval ~path_repr))
+    | T.Window (name, group, sort) ->
+        Expr.window
+          (eval_window ~path_repr name)
+          (List.map group ~f:(eval ~path_repr))
+          (List.map sort ~f:(eval ~path_repr))
+    | T.BOperator (op, arg1, arg2) ->
+        Expr.boperator op (eval ~path_repr arg1) (eval ~path_repr arg2)
+    | T.GEquality (op, arg1, arg2) ->
+        Expr.gequality op (eval ~path_repr arg1)
+          (List.map arg2 ~f:(eval ~path_repr))
+    | T.Path p -> Expr.path path_repr p
+
+  and eval_window :
+      path_repr:'a Expr.path_repr -> 'a T.t T.window -> 'a Expr.repr T.window =
+   fun ~path_repr -> function
+    | Min a -> Min (eval ~path_repr a)
+    | Max a -> Max (eval ~path_repr a)
+    | Counter -> Counter
+    | Previous a -> Previous (eval ~path_repr a)
+    | Sum a -> Sum (eval ~path_repr a)
+end
-- 
cgit v1.2.3