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
|
open StdLabels
(** Build an expression module with the result from another expression. The
signature of the fuctions is a bit different, as they all receive the
result from the previous evaluated element in argument. *)
module Expression
(E : Sym.SYM_EXPR)
(R : sig
val v : 'a E.path_repr
end) =
struct
module type SIG = sig
type 'a repr
type 'a obs
type 'a path_repr
val empty : 'a E.obs -> 'a repr
val expr : 'a E.obs * 'a repr -> 'a E.obs -> 'a repr
val literal : string -> 'a E.obs -> 'a repr
val integer : string -> 'a E.obs -> 'a repr
val path : 'a path_repr -> 'a -> 'a E.obs -> 'a repr
val concat : ('a E.obs * 'a repr) list -> 'a E.obs -> 'a repr
val window :
('a E.obs * 'a repr) T.window ->
('a E.obs * 'a repr) list ->
('a E.obs * 'a repr) list ->
'a E.obs ->
'a repr
val nvl : ('a E.obs * 'a repr) list -> 'a E.obs -> 'a repr
val join : string -> ('a E.obs * 'a repr) list -> 'a E.obs -> 'a repr
val boperator :
T.binary_operator ->
'a E.obs * 'a repr ->
'a E.obs * 'a repr ->
'a E.obs ->
'a repr
val gequality :
T.binary_operator ->
'a E.obs * 'a repr ->
('a E.obs * 'a repr) list ->
'a E.obs ->
'a repr
val funct : string -> ('a E.obs * 'a repr) list -> 'a E.obs -> 'a repr
val function' : T.funct -> ('a E.obs * 'a repr) list -> 'a E.obs -> 'a repr
val observe : 'a E.obs * 'a repr -> 'a obs
end
module Make (M : SIG) = struct
type 'a repr = 'a E.repr * 'a M.repr
type 'a obs = 'a M.obs
type 'a path_repr = 'a M.path_repr
let map' : 'a repr list -> 'a E.repr list * ('a E.obs * 'a M.repr) list =
fun ll ->
let e = List.map ~f:fst ll in
(e, List.map ll ~f:(fun (e, m) -> (E.observe e, m)))
let observe : 'a repr -> 'a obs = fun (t, v) -> M.observe (E.observe t, v)
let empty : unit -> 'a repr =
fun () ->
let e = E.empty () in
(e, M.empty (E.observe e))
let expr : 'a repr -> 'a repr =
fun (e, m) ->
let e' = E.expr e in
(e', M.expr (E.observe e, m) (E.observe e'))
let literal : string -> 'a repr =
fun litt ->
let e = E.literal litt in
(e, M.literal litt (E.observe e))
let integer : string -> 'a repr =
fun i ->
let e' = E.integer i in
(e', M.integer i (E.observe e'))
let path : 'b path_repr -> 'b -> 'a repr =
fun path_repr path ->
let e = E.path R.v path in
let m = M.path path_repr path (E.observe e) in
(e, m)
let concat : 'a repr list -> 'a repr =
fun reprs ->
let e, m = map' reprs in
let e' = E.concat e in
(e', M.concat m (E.observe e'))
let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
fun window expressions order ->
let e_expressions, m_expressions = map' expressions
and e_order, m_order = map' order
and e_window = T.map_window window ~f:fst
and m_window = T.map_window window ~f:(fun (e, m) -> (E.observe e, m)) in
let e = E.window e_window e_expressions e_order in
(e, M.window m_window m_expressions m_order (E.observe e))
let nvl : 'a repr list -> 'a repr =
fun reprs ->
let e, m = List.split reprs in
let e' = E.nvl e in
let e = List.map ~f:E.observe e in
(e', M.nvl (List.combine e m) (E.observe e'))
let join : string -> 'a repr list -> 'a repr =
fun sep reprs ->
let e_reprs, m = map' reprs in
let e = E.join sep e_reprs in
(e, M.join sep m (E.observe e))
let boperator : T.binary_operator -> 'a repr -> 'a repr -> 'a repr =
fun op (e1, m1) (e2, m2) ->
let e1' = E.observe e1
and e2' = E.observe e2
and e = E.boperator op e1 e2 in
let m' = M.boperator op (e1', m1) (e2', m2) (E.observe e) in
(e, m')
let gequality : T.binary_operator -> 'a repr -> 'a repr list -> 'a repr =
fun op (e1, m1) exprs ->
let e_reprs, m_reprs = map' exprs in
let e' = E.gequality op e1 e_reprs in
let m' = M.gequality op (E.observe e1, m1) m_reprs (E.observe e') in
(e', m')
let funct : string -> 'a repr list -> 'a repr =
fun sep reprs ->
let e_reprs, m = map' reprs in
let e = E.funct sep e_reprs in
(e, M.funct sep m (E.observe e))
let function' : T.funct -> 'a repr list -> 'a repr =
fun f reprs ->
let e_reprs, m = map' reprs in
let e = E.function' f e_reprs in
(e, M.function' f m (E.observe e))
end
end
|
