aboutsummaryrefslogtreecommitdiff
path: root/lib/expression/type_of.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/expression/type_of.ml')
-rw-r--r--lib/expression/type_of.ml150
1 files changed, 150 insertions, 0 deletions
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