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/repr.ml | 127 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 127 insertions(+)
 create mode 100644 lib/expression/repr.ml

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

diff --git a/lib/expression/repr.ml b/lib/expression/repr.ml
new file mode 100644
index 0000000..4990236
--- /dev/null
+++ b/lib/expression/repr.ml
@@ -0,0 +1,127 @@
+open StdLabels
+
+let escape_dquote = Re.Str.regexp "'"
+let escape content = Re.Str.global_replace escape_dquote "\\'" content
+
+module E :
+  Sym.SYM_CHUNK
+    with type 'a obs = top:bool -> string
+     and type 'a path_repr = 'a -> string = struct
+  type 'a repr = top:bool -> string
+  type 'a obs = top:bool -> string
+  type 'a path_repr = 'a -> string
+
+  let observe x = x
+
+  let group : 'a repr list -> 'a repr =
+   fun args ~top ->
+    let args_repr = List.map ~f:(fun v -> v ~top) args in
+    let args = String.concat ~sep:", " args_repr in
+    "[" ^ args ^ "]"
+
+  let arguments : 'a repr list -> 'a repr =
+   fun args ~top ->
+    let args_repr = List.map ~f:(fun v -> v ~top) args in
+    let args = String.concat ~sep:", " args_repr in
+    "(" ^ args ^ ")"
+
+  let empty : unit -> 'a repr =
+   fun () ~top ->
+    match top with
+    | false -> "''"
+    | true -> ""
+
+  let literal : string -> 'a repr =
+   fun l ~top ->
+    if String.equal String.empty l then (empty ()) ~top
+    else
+      match int_of_string_opt l with
+      | Some _ -> l
+      | None -> "'" ^ escape l ^ "'"
+
+  let integer : string -> 'a repr =
+   fun l ~top -> if String.equal String.empty l then (empty ()) ~top else l
+
+  let expr : 'a repr -> 'a repr =
+   fun expr ~top ->
+    ignore top;
+    String.concat ~sep:"" [ "("; expr ~top:false; ")" ]
+
+  let path : 'b path_repr -> 'b -> 'a repr =
+   fun path_repr p ~top ->
+    ignore top;
+    path_repr p
+
+  let concat : 'a repr list -> 'a repr =
+   fun elems ~top ->
+    ignore top;
+    let top = false in
+    let strs = List.map elems ~f:(fun v -> v ~top) in
+    String.concat ~sep:" ^ " strs
+
+  let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
+   fun name g1 sort ~top ->
+    ignore top;
+
+    let args1 = group ~top:false g1
+    and args2 = group ~top:false sort
+    and f_name = T.name_of_window name in
+    let args = [ args1; args2 ] in
+    let args =
+      match name with
+      | T.Counter -> args
+      | T.Min prefix_arg
+      | T.Max prefix_arg
+      | T.Previous prefix_arg
+      | T.Sum prefix_arg -> prefix_arg ~top:false :: args
+    in
+
+    f_name ^ "(" ^ String.concat ~sep:", " args ^ ")"
+
+  let nvl : 'a repr list -> 'a repr =
+   fun elems ~top ->
+    ignore top;
+    let args = arguments ~top:false elems in
+    "nvl" ^ args
+
+  let join : string -> 'a repr list -> 'a repr =
+   fun sep elems ~top ->
+    ignore top;
+    let header = literal sep in
+    let args = arguments ~top:false (header :: elems) in
+    "join" ^ args
+
+  let boperator : T.binary_operator -> 'a repr -> 'a repr -> 'a repr =
+   fun op arg1 arg2 ~top ->
+    ignore top;
+    let top = false in
+    let sep = T.name_of_operator op in
+    String.concat ~sep [ arg1 ~top; arg2 ~top ]
+
+  let gequality : T.binary_operator -> 'a repr -> 'a repr list -> 'a repr =
+   fun op arg1 arg2 ~top ->
+    ignore top;
+    let top = false in
+    let sep = T.name_of_operator op in
+    let args = group ~top:false arg2 in
+    String.concat ~sep [ arg1 ~top; args ]
+
+  let funct : string -> 'a repr list -> 'a repr =
+   fun f args ~top ->
+    ignore top;
+    let args = arguments ~top:false args in
+    f ^ args
+
+  let function' : T.funct -> 'a repr list -> 'a repr =
+   fun f args ~top ->
+    ignore top;
+    let args = arguments ~top:false args in
+    T.name_of_function f ^ args
+end
+
+module M = Sym.M (E)
+
+let repr : ?top:bool -> ('a -> string) -> 'a T.t -> string =
+ fun ?(top = false) printer expr ->
+  let repr = M.eval ~path_repr:printer expr in
+  E.observe repr ~top
-- 
cgit v1.2.3