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

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

diff --git a/lib/expression/type_of.ml b/lib/expression/type_of.ml
new file mode 100644
index 0000000..ce1a17e
--- /dev/null
+++ b/lib/expression/type_of.ml
@@ -0,0 +1,150 @@
+(** 
+ This module evaluate the type of an expression.
+
+ The type is given with an analysis from all the component involved inside
+ the exrpssion. It is used inside the [query] module in order to check if one
+ type need conversion before being used.
+ *)
+
+open StdLabels
+
+module Lazy_Repr =
+  Compose.Expression
+    (Lazier.Make
+       (Repr.E))
+       (struct
+         let v _ = ""
+       end)
+
+type t = ImportDataTypes.Types.t
+
+(** Fold over the list of parameters and ensure all the elements are typed in
+the same way *)
+let group' : t list -> t =
+ fun elements ->
+  List.fold_left elements ~init:None
+    ~f:(fun (acc : ImportDataTypes.Types.t option) v ->
+      match acc with
+      | None -> Some v
+      | Some t when t = v -> acc
+      | _ -> Some Extern)
+  |> Option.value ~default:ImportDataTypes.Types.None
+
+include Lazy_Repr.Make (struct
+  type nonrec t = t
+  type 'a repr = t
+  type 'a obs = ImportDataTypes.Types.t
+  type 'a path_repr = 'a -> unit
+
+  let observe : 'a Repr.E.obs Lazy.t * 'a repr -> 'a obs = snd
+
+  let empty : 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun _ -> ImportDataTypes.Types.None
+
+  let expr : 'a Repr.E.obs Lazy.t * 'a repr -> 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun e _ -> snd e
+
+  let literal : string -> 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun _ _ -> ImportDataTypes.Types.String
+
+  let integer : string -> 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun _ _ -> ImportDataTypes.Types.Number
+
+  let path : 'b path_repr -> 'b -> 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun _ _ _ -> ImportDataTypes.Types.Extern
+
+  let concat :
+      ('a Repr.E.obs Lazy.t * 'a repr) list -> 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun _ _ -> ImportDataTypes.Types.String
+
+  let window :
+      ('a Repr.E.obs Lazy.t * 'a repr) T.window ->
+      ('a Repr.E.obs Lazy.t * 'a repr) list ->
+      ('a Repr.E.obs Lazy.t * 'a repr) list ->
+      'a Repr.E.obs Lazy.t ->
+      'a repr =
+   fun name expressions order _ ->
+    ignore order;
+    ignore expressions;
+    match name with
+    | T.Counter | T.Max _ | T.Min _ | T.Sum _ -> Number
+    | T.Previous expr -> snd expr
+
+  let nvl :
+      ('a Repr.E.obs Lazy.t * 'a repr) list -> 'a Repr.E.obs Lazy.t -> 'a repr =
+   fun v _ -> group' (List.map ~f:snd v)
+
+  let join :
+      string ->
+      ('a Repr.E.obs Lazy.t * 'a repr) list ->
+      'a Repr.E.obs Lazy.t ->
+      'a repr =
+   fun _ _ _ -> ImportDataTypes.Types.String
+
+  let boperator :
+      T.binary_operator ->
+      'a Repr.E.obs Lazy.t * 'a repr ->
+      'a Repr.E.obs Lazy.t * 'a repr ->
+      'a Repr.E.obs Lazy.t ->
+      'a repr =
+   fun name _ _ _ ->
+    match name with
+    | T.Equal | T.Different | T.LT | T.GT -> Bool
+    | T.Add | T.Minus -> Number
+    | T.Division -> Float
+    | T.And | T.Or -> Bool
+
+  let gequality :
+      T.binary_operator ->
+      'a Repr.E.obs Lazy.t * 'a repr ->
+      ('a Repr.E.obs Lazy.t * 'a repr) list ->
+      'a Repr.E.obs Lazy.t ->
+      'a repr =
+   fun name _ _ _ ->
+    match name with
+    | T.Equal | T.Different -> Bool
+    | _ -> None
+
+  let function' :
+      T.funct ->
+      ('a Repr.E.obs Lazy.t * 'a repr) list ->
+      'a Repr.E.obs Lazy.t ->
+      'a repr =
+   fun name expressions _ ->
+    ignore expressions;
+    match name with
+    | Upper | Trim -> String
+
+  let check : expected:t -> actual:t -> string -> 'a Repr.E.obs Lazy.t -> t =
+   fun ~expected ~actual subset expr ->
+    if actual = expected then actual
+    else
+      let expression = (Lazy.force expr) ~top:false in
+      raise (ImportErrors.TypeError { expression; subset; expected; actual })
+
+  let funct :
+      string ->
+      ('a Repr.E.obs Lazy.t * 'a repr) list ->
+      'a Repr.E.obs Lazy.t ->
+      'a repr =
+   fun name expressions repr ->
+    match name with
+    | "if" -> begin
+        match expressions with
+        | [] -> Extern
+        | (_, hd) :: arg1 :: _ when hd = Bool -> snd arg1
+        | (_, hd) :: _ ->
+            let expected = ImportDataTypes.Types.Bool and actual = hd in
+            check ~expected ~actual "the predicate" repr
+      end
+    | _ -> Extern
+end)
+
+let group :
+    ('a Lazier.Make(Repr.E).repr * t) list -> 'a Lazier.Make(Repr.E).repr * t =
+ fun v ->
+  let v' = group' (List.map v ~f:snd) in
+  let l = lazy (Repr.E.empty ()) in
+  (l, v')
+
+let arguments = group
-- 
cgit v1.2.3