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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
module EZ_SUBST = struct
type 'context t = 'context -> string -> string
exception UnclosedExpression of string
let escape = ref true
let check = function
| [] -> false
| p :: _ -> not p
let buffer ?(sep = '$') ?(sym = false) ?(fail = true) ?(escape = escape)
?skipper ?brace ?paren ?bracket ?var ~ctxt b s =
let len = String.length s in
let rec iter b skip stack i =
if i = len then
match stack with
| [] -> ()
| (_eoi, f, b1, skip1) :: stack ->
if fail then
raise (UnclosedExpression (Buffer.contents b))
else
replace b1 skip1 f b stack i
else
let c = s.[i] in
if c = sep then
iter1 b skip stack (i + 1)
else if c = '\\' && !escape then
iter3 b skip stack (i + 1)
else
match stack with
| [] ->
if check skip then Buffer.add_char b c;
iter b skip stack (i + 1)
| (eoi, f, b1, skip1) :: stack1 ->
if c = eoi then
if sym then
iter2 b skip stack eoi (i + 1)
else
replace b1 skip1 f b stack1 (i + 1)
else (
if check skip then Buffer.add_char b c;
iter b skip stack (i + 1)
)
and iter1 b skip stack i =
if i = len then (
if check skip then Buffer.add_char b sep;
iter b skip stack i
) else
let c = s.[i] in
match (c, brace, paren, bracket, var) with
| '{', Some f, _, _, _ ->
iter (Buffer.create 16) [ false ] (('}', f, b, skip) :: stack) (i + 1)
| '(', _, Some f, _, _ ->
iter (Buffer.create 16) [ false ] ((')', f, b, skip) :: stack) (i + 1)
| '[', _, _, Some f, _ ->
iter (Buffer.create 16) [ false ] ((']', f, b, skip) :: stack) (i + 1)
| ('a' .. 'z' | 'A' .. 'Z'), _, _, _, Some f ->
let b1 = Buffer.create 16 in
Buffer.add_char b1 c;
iter4 b1 [ false ] (('_', f, b, skip) :: stack) (i + 1)
| _ ->
if check skip then Buffer.add_char b sep;
iter b skip stack i
and iter2 b skip stack eoi i =
if i = len then
if fail then
raise (UnclosedExpression (Buffer.contents b))
else
match stack with
| [] -> assert false
| (_eoi, f, b1, skip1) :: stack -> replace b1 skip1 f b stack i
else
let c = s.[i] in
if c = sep then
match stack with
| [] -> assert false
| (_eoi, f, b1, skip1) :: stack -> replace b1 skip1 f b stack (i + 1)
else (
if check skip then Buffer.add_char b eoi;
iter b skip stack i
)
and iter3 b skip stack i =
if i = len then (
if check skip then Buffer.add_char b '\\';
iter b skip stack i
) else (
if check skip then Buffer.add_char b s.[i];
iter b skip stack (i + 1)
)
and iter4 b skip stack i =
if i = len then
match stack with
| [] -> assert false
| (_eoi, f, b1, skip1) :: stack -> replace b1 skip1 f b stack i
else
let c = s.[i] in
match c with
| 'A' .. 'Z'
| 'a' .. 'z'
| '_'
| '0' .. '9' ->
if check skip then Buffer.add_char b c;
iter4 b skip stack (i + 1)
| _ -> (
match stack with
| [] -> assert false
| (_eoi, f, b1, skip1) :: stack -> replace b1 skip1 f b stack i )
and replace b1 skip1 f b stack i =
let ident = Buffer.contents b in
( match skipper with
| None -> ()
| Some skipper -> skipper := skip1 );
let replacement = f ctxt ident in
let skip1 =
match skipper with
| None -> skip1
| Some skipper -> !skipper
in
if check skip1 then Buffer.add_string b1 replacement;
iter b1 skip1 stack i
in
iter b [ false ] [] 0
let string ?sep ?sym ?fail ?escape ?skipper ?brace ?paren ?bracket ?var ~ctxt
s =
let b = Buffer.create (String.length s) in
buffer ?sep ?sym ?escape ?skipper ?fail ?brace ?paren ?bracket ?var b ~ctxt
s;
Buffer.contents b
exception UnknownExpression of string
let string_from_list ?sep ?sym ?(fail = true) ?(brace = true) ?(paren = true)
?(bracket = true) ?(var = true) ?default list s =
let ctxt = default in
let subst default s =
match List.assoc s list with
| s -> s
| exception Not_found -> (
match default with
| Some s -> s
| None ->
if fail then
raise (UnknownExpression s)
else
s )
in
let subst flag =
if flag then
Some subst
else
None
in
let brace = subst brace in
let paren = subst paren in
let bracket = subst bracket in
let var = subst var in
string ?sep ?sym ~fail ?brace ?paren ?bracket ?var ~ctxt s
end