blob: 4990236ce2aa67b6cede65fa017fc1c9f880e077 (
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
|
open StdLabels
let escape_dquote = Re.Str.regexp "'"
let escape content = Re.Str.global_replace escape_dquote "\\'" content
module E :
Sym.SYM_CHUNK
with type 'a obs = top:bool -> string
and type 'a path_repr = 'a -> string = struct
type 'a repr = top:bool -> string
type 'a obs = top:bool -> string
type 'a path_repr = 'a -> string
let observe x = x
let group : 'a repr list -> 'a repr =
fun args ~top ->
let args_repr = List.map ~f:(fun v -> v ~top) args in
let args = String.concat ~sep:", " args_repr in
"[" ^ args ^ "]"
let arguments : 'a repr list -> 'a repr =
fun args ~top ->
let args_repr = List.map ~f:(fun v -> v ~top) args in
let args = String.concat ~sep:", " args_repr in
"(" ^ args ^ ")"
let empty : unit -> 'a repr =
fun () ~top ->
match top with
| false -> "''"
| true -> ""
let literal : string -> 'a repr =
fun l ~top ->
if String.equal String.empty l then (empty ()) ~top
else
match int_of_string_opt l with
| Some _ -> l
| None -> "'" ^ escape l ^ "'"
let integer : string -> 'a repr =
fun l ~top -> if String.equal String.empty l then (empty ()) ~top else l
let expr : 'a repr -> 'a repr =
fun expr ~top ->
ignore top;
String.concat ~sep:"" [ "("; expr ~top:false; ")" ]
let path : 'b path_repr -> 'b -> 'a repr =
fun path_repr p ~top ->
ignore top;
path_repr p
let concat : 'a repr list -> 'a repr =
fun elems ~top ->
ignore top;
let top = false in
let strs = List.map elems ~f:(fun v -> v ~top) in
String.concat ~sep:" ^ " strs
let window : 'a repr T.window -> 'a repr list -> 'a repr list -> 'a repr =
fun name g1 sort ~top ->
ignore top;
let args1 = group ~top:false g1
and args2 = group ~top:false sort
and f_name = T.name_of_window name in
let args = [ args1; args2 ] in
let args =
match name with
| T.Counter -> args
| T.Min prefix_arg
| T.Max prefix_arg
| T.Previous prefix_arg
| T.Sum prefix_arg -> prefix_arg ~top:false :: args
in
f_name ^ "(" ^ String.concat ~sep:", " args ^ ")"
let nvl : 'a repr list -> 'a repr =
fun elems ~top ->
ignore top;
let args = arguments ~top:false elems in
"nvl" ^ args
let join : string -> 'a repr list -> 'a repr =
fun sep elems ~top ->
ignore top;
let header = literal sep in
let args = arguments ~top:false (header :: elems) in
"join" ^ args
let boperator : T.binary_operator -> 'a repr -> 'a repr -> 'a repr =
fun op arg1 arg2 ~top ->
ignore top;
let top = false in
let sep = T.name_of_operator op in
String.concat ~sep [ arg1 ~top; arg2 ~top ]
let gequality : T.binary_operator -> 'a repr -> 'a repr list -> 'a repr =
fun op arg1 arg2 ~top ->
ignore top;
let top = false in
let sep = T.name_of_operator op in
let args = group ~top:false arg2 in
String.concat ~sep [ arg1 ~top; args ]
let funct : string -> 'a repr list -> 'a repr =
fun f args ~top ->
ignore top;
let args = arguments ~top:false args in
f ^ args
let function' : T.funct -> 'a repr list -> 'a repr =
fun f args ~top ->
ignore top;
let args = arguments ~top:false args in
T.name_of_function f ^ args
end
module M = Sym.M (E)
let repr : ?top:bool -> ('a -> string) -> 'a T.t -> string =
fun ?(top = false) printer expr ->
let repr = M.eval ~path_repr:printer expr in
E.observe repr ~top
|
