aboutsummaryrefslogtreecommitdiff
path: root/lib/expression/type_of.ml
blob: ce1a17eeb9ae04d06f73fab7e4487c6804190910 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
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