blob: 6371e4f158e25da683c411e8eeed7a9b98a891b4 (
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
|
open StdLabels
let truncate buffer n = Buffer.truncate buffer (Buffer.length buffer - n)
module E :
Sym.SYM_CHUNK
with type 'a obs = buffer:Buffer.t -> unit
and type 'a path_repr = 'a -> Buffer.t -> unit = struct
type 'a repr = buffer:Buffer.t -> unit
type 'a obs = buffer:Buffer.t -> unit
type 'a path_repr = 'a -> Buffer.t -> unit
let group : 'a repr list -> 'a repr =
fun args ~buffer ->
Buffer.add_string buffer "[";
List.iter args ~f:(fun v ->
v ~buffer;
Buffer.add_string buffer ", ");
truncate buffer 2;
Buffer.add_string buffer "]"
let arguments : 'a repr list -> 'a repr =
fun expressions ~buffer ->
Buffer.add_string buffer "(";
List.iter expressions ~f:(fun v ->
v ~buffer;
Buffer.add_string buffer ", ");
truncate buffer 2;
Buffer.add_string buffer ")"
let observe x ~buffer = x ~buffer
let empty : unit -> 'a repr = fun _ ~buffer -> Buffer.add_string buffer "''"
let path printer p ~buffer = printer p buffer
let literal l ~buffer = Buffer.add_string buffer l
let integer l ~buffer = Buffer.add_string buffer l
let expr expr ~buffer =
Buffer.add_char buffer '(';
expr ~buffer;
Buffer.add_char buffer ')'
let nvl expression ~buffer =
Buffer.add_string buffer "nvl";
arguments ~buffer expression
let concat expression ~buffer = List.iter expression ~f:(fun v -> v ~buffer)
let join sep expression ~buffer =
List.iter expression ~f:(fun v ->
v ~buffer;
Buffer.add_string buffer sep);
truncate buffer (String.length sep)
let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
fun name expressions order ~buffer ->
ignore order;
let name = T.name_of_window name in
Buffer.add_string buffer name;
arguments ~buffer expressions
let boperator name e1 e2 ~buffer =
e1 ~buffer;
Buffer.add_string buffer (T.name_of_operator name);
e2 ~buffer
let gequality name e1 e2 ~buffer =
e1 ~buffer;
Buffer.add_string buffer (T.name_of_operator name);
group ~buffer e2
let funct name expressions ~buffer =
Buffer.add_string buffer name;
arguments ~buffer expressions
let function' name expressions ~buffer =
Buffer.add_string buffer (T.name_of_function name);
arguments ~buffer expressions
end
module M = Sym.M (E)
let headers_of_expression :
Buffer.t -> ('a -> Buffer.t -> unit) -> 'a T.t -> unit =
fun buffer printer expr ->
let repr = M.eval expr ~path_repr:printer in
E.observe repr ~buffer
|
