-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathmatcher_core.kim
More file actions
367 lines (324 loc) · 10.9 KB
/
Copy pathmatcher_core.kim
File metadata and controls
367 lines (324 loc) · 10.9 KB
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
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
(type_pack FILE)
(type_pack (ptr anylist) embed_anylist)
(decl
((func (ptr char) (ptr char) (ptr FILE)) fopen)
((func (ptr FILE) int) fclose)
((ptr FILE) stdout)
((ptr FILE) stderr)
((func (ptr char) (ptr char) int) strcmp)
((func int (ptr FILE) int) putc))
(decl ((func any) read_all_terms_as_any))
(decl ((func (ptr char) any) read_all_terms_as_any_from_file))
(decl
((ptr anylist) nil)
((func (ptr anylist) (ptr any)) car_addr)
((func (ptr anylist) any) car)
((func (ptr anylist) (ptr anylist)) cdr)
((func any (ptr anylist) (ptr anylist)) cons)
((func (ptr anylist) (ptr anylist) (ptr anylist)) append))
(var
((ptr FILE) stdind (fopen "hidden_cheme_indices" "w"))
((func bool bool) mnot (lambda ((bool b)) (if b false true)))
((func any int) a2i (lambda ((any a)) (any_to int a)))
((func any (ptr FILE)) a2f (lambda ((any a)) (any_to (ptr FILE) a)))
((func int (ptr FILE) unit) putint
(lambda ((int z)
((ptr FILE) f))
(if (== z 0)
(begin (putc 48 f) unitv)
(begin
(var ((func int (ptr FILE) unit) worker
(lambda ((int x)
((ptr FILE) f))
(if (== x 0)
unitv
(begin
(var (int z (mod x 10)))
(worker (div x 10) f)
(putc (+ 48 z) f) unitv)))))
(worker z f)))))
((func (func char unit) (ptr char) unit) str_foreach
(lambda (((func char unit) f)
((ptr char) s))
(while (mnot (char_eq (ind s) '\0'))
(begin
(f (ind s))
(<- (ref s) (ptr_add s 1))))))
((func (func any char unit) any (ptr char) unit) str_foreachp
(lambda (((func any char unit) f)
(any param)
((ptr char) s))
(while (mnot (char_eq (ind s) '\0'))
(begin
(f param (ind s))
(<- (ref s) (ptr_add s 1))))))
((func (ptr char) (ptr FILE) unit) putstr
(lambda (((ptr char) s)
((ptr FILE) f))
(str_foreachp (lambda ((any f) (char c))
(putc (char2int c) (a2f f)) unitv) (to_any f) s)))
((func char (ptr FILE) unit) put_escaped_char
(lambda ((char c)
((ptr FILE) f))
(if (char_eq c '\n') (putstr "\\n" f)
(if (char_eq c '\0') (putstr "\\0" f)
(if (char_eq c '\"') (putstr "\\\"" f)
(if (char_eq c '\\') (putstr "\\\\" f)
(begin (putc (char2int c) f) unitv)))))))
((func (ptr char) (ptr FILE) unit) put_escaped_str
(lambda (((ptr char) s)
((ptr FILE) f))
(str_foreachp (lambda ((any f) (char c))
(put_escaped_char c (a2f f))) (to_any f) s)))
((func any (ptr anylist)) a2l (lambda ((any a)) (any_to (ptr anylist) a)))
((func (func any any) (ptr anylist) (ptr anylist)) map
(lambda ( ((func any any) f)
((ptr anylist) l) )
(if (is_null l) nil (cons (f (car l)) (map f (cdr l))))))
((func (func any any any) any (ptr anylist) (ptr anylist)) mapp
(lambda ( ((func any any any) f)
(any param)
((ptr anylist) l) )
(if (is_null l) nil (cons (f param (car l)) (mapp f param (cdr l))))))
((func any (ptr char)) any2symstr
(lambda ((any a))
(if (any_is sym a) (sym_str (any_to sym a)) "")))
((func any (ptr char)) any2str
(lambda ((any a)) (any_to (ptr char) a)))
((func any (ptr char)) first_word
(lambda ((any a))
(if (any_is (ptr anylist) a) (any2symstr (car (a2l a))) "")))
((func any bool) is_cspecial
(lambda ((any a))
(char_eq (ind (first_word a)) ':')))
((func any (ptr char) bool) is_sym
(lambda ((any a) ((ptr char) w) )
(and (any_is sym a)
(str_eq (any2symstr a) w))))
((func any bool) is_wild
(lambda ((any a)) (is_sym a "?")))
((func any bool) is_wild_atom
(lambda ((any a)) (is_sym a ".")))
((func any bool) is_cspecial_empty
(lambda ((any a))
(and (is_cspecial a) (str_eq (first_word a) ":"))))
((func any (ptr char)) get_cspecial
(lambda ((any a))
(ptr_add (first_word a) 1)))
((func any any bool) any_compare
(lambda ((any a) (any b))
(var ((func (ptr anylist) (ptr anylist) bool) compare_lists
(lambda (((ptr anylist) a) ((ptr anylist) b))
(if (and (is_null a) (is_null b)) true
(if (is_null a) false
(if (is_null b) false
(and
(any_compare (car a) (car b))
(compare_lists (cdr a) (cdr b)))))))))
(and
(type_desc_eq (any_type (ref a)) (any_type (ref b)))
(if (any_is (ptr char) a)
(str_eq (any_to (ptr char) a) (any_to (ptr char) b))
(if (any_is sym a)
(sym_eq (any_to sym a) (any_to sym b))
(if (any_is anylist a)
(compare_lists (a2l a) (a2l b))
(any_eq (ref a) (ref b) )))))))
((func (func any bool) (ptr anylist) (ptr anylist)) filter
(lambda ( ((func any bool) f)
((ptr anylist) l) )
(if (f (car l))
(cons (car l) (filter f (cdr l)))
(filter f (cdr l))))))
(type_pack (ptr anylist) basic_index)
(var
((func basic_index) new_basic_index
(lambda ()
(pack basic_index (cons (to_any 0) nil))))
((func basic_index) new_root_basic_index
(lambda ()
(pack basic_index nil)))
((func basic_index basic_index) basic_index_next
(lambda ((basic_index b))
(pack basic_index (cons
(to_any
(+ 1 (a2i (car (unpack b)))))
(cdr (unpack b))))))
((func basic_index basic_index) basic_index_in
(lambda ((basic_index b))
(pack basic_index (cons (to_any 0) (unpack b)))))
((func basic_index (ptr FILE) unit) display_basic_index
(lambda ((basic_index b)
((ptr FILE) f))
(decl ((func any (ptr FILE) any) display))
(display (to_any (unpack b)) f)
unitv)))
(var
((func any basic_index) a2b (lambda ((any a)) (any_to basic_index a))))
(type_pack (ptr (tup any basic_index)) iterm)
(var
((func iterm any) itt
(lambda ((iterm it)) (at (ind (unpack it)) 0)))
((func iterm basic_index) iti
(lambda ((iterm it)) (at (ind (unpack it)) 1)))
((func any basic_index iterm) itv
(lambda ((any a) (basic_index b))
(if (any_is embed_anylist a)
(begin
(putstr "should not pack embed_anylist inside iterm\n" stderr)
(abort)))
(var ((ptr (tup any basic_index)) p (new (tup any basic_index))))
(<- p (tupv a b))
(pack iterm p))))
(var ((func (ptr anylist) (ptr anylist)) terms_to_iterms
(lambda (((ptr anylist) l))
(var ((func (ptr anylist) basic_index (ptr anylist)) raw
(lambda (((ptr anylist) l)
(basic_index b))
(if (is_null l) nil
(begin
(var (any top (car l)))
(var (any newtop
(if (any_is (ptr anylist) top)
(to_any (raw (a2l top) (basic_index_in b)))
top)))
(cons (to_any (itv newtop b))
(raw (cdr l) (basic_index_next b))))))))
(raw l (new_basic_index))))
((func any iterm) a2it
(lambda ((any a)) (any_to iterm a)))
(any read_all_iterms_as_any_indices)
((func any) read_all_iterms_as_any
(lambda ()
(<- (ref read_all_iterms_as_any_indices)
(read_all_terms_as_any_from_file "hidden_cheme_prev_indices"))
(if (any_is unit read_all_iterms_as_any_indices)
(to_any
(itv
(to_any (terms_to_iterms (a2l (read_all_terms_as_any))))
(new_root_basic_index)))
(begin
(var ((func any any) zipper
(lambda ((any a))
(var
(any ret
(to_any
(itv a (pack
basic_index
(a2l
(car
(a2l
read_all_iterms_as_any_indices))))))))
(<- (ref read_all_iterms_as_any_indices)
(to_any (cdr (a2l read_all_iterms_as_any_indices))))
ret)))
(decl ((func (func any any) any any) deepmap))
(deepmap zipper (read_all_terms_as_any))))))
((func (ptr char) any) read_all_iterms_as_any_from_file
(lambda (((ptr char) name))
(to_any
(itv (to_any (terms_to_iterms (a2l (read_all_terms_as_any_from_file name))))
(new_root_basic_index))))))
(var
((func any (ptr FILE) any) display
(lambda ((any a)
((ptr FILE) f))
(if (any_is iterm a)
(begin
(display (itt (a2it a)) f)
unitv)
(if (any_is basic_index a)
(begin
(display_basic_index (a2b a) f)
unitv)
(if (any_is char a)
(begin
(putstr "'" f) (put_escaped_char (any_to char a) f) (putstr "'" f)
unitv)
(if (any_is (ptr char) a)
(begin
(putstr "\"" f)
(put_escaped_str (any_to (ptr char) a) f)
(putstr "\"" f)
unitv)
(if (any_is int a)
(begin (putint (any_to int a) f) unitv)
(if (any_is sym a)
(putstr (sym_str (any_to sym a)) f)
(if (any_is bool a)
(putstr (if (any_to bool a) "true" "false") f)
(if (any_is (ptr anylist) a)
(begin
(putc 40 f)
(mapp (lambda ((any f) (any a))
(display a (a2f f))
(putstr " " (a2f f)) a)
(to_any f)
(any_to (ptr anylist) a))
(putc 41 f)
unitv)
(begin (putstr "<UNDISPLAYABLE> of type " f)
(putstr (type_desc_name (any_type (ref a))) f)
unitv)))))))))
a)))
(var ((func any any bool) match
(lambda ((any expr) (any data2))
(var (any data (if (any_is iterm data2) (itt (a2it data2)) data2)))
(if (or (is_wild expr) (and (is_wild_atom expr)
(mnot (any_is (ptr anylist) data))))
true
(if (or (mnot (any_is (ptr anylist) expr))
(mnot (any_is (ptr anylist) data)))
(any_compare expr data)
(begin
(var ((ptr anylist) el (a2l expr))
((ptr anylist) dl (a2l data))
(any el1 (if (is_null el) (to_any nil) (car el))))
(if (is_null el)
(is_null dl)
(if (and (is_cspecial el1) (str_eq (get_cspecial el1) "b*"))
(or (match (to_any (cdr el)) (to_any dl))
(begin (var (any param (car (cdr (a2l el1)))))
(and (mnot (is_null dl))
(match param (car dl))
(match expr (to_any (cdr dl))))))
(if (is_null dl)
false
(and (match (car el) (car dl))
(match (to_any (cdr el)) (to_any (cdr dl))))))))))))
((func any any) cond2if
(lambda ((any it))
(var ((func (ptr anylist) basic_index any) raw
(lambda (((ptr anylist) l)
(basic_index b))
(var (any xi (car (a2l (itt (a2it (car l))))))
(any yi (car (cdr (a2l (itt (a2it (car l)))))))
(any xit (itt (a2it xi)))
(any yit (itt (a2it yi))))
(if (is_sym xit "else")
yi
(to_any (itv
(to_any (cons (to_any (itv (quote if)
(new_root_basic_index)))
(cons xi
(cons yi (cons (raw (cdr l) b)
nil)))))
b))))))
(raw (cdr (a2l (itt (a2it it))))
(iti (a2it it)))))
((func (func any any) any any) deepmap
(lambda (((func any any) f) (any a))
(var ((func (func any any) (ptr anylist) any) do_list_elems
(lambda (((func any any) f)
((ptr anylist) l))
(to_any (mapp (lambda ((any f) (any a))
(deepmap (any_to (func any any) f) a))
(to_any f)
l)))))
(f
(if (any_is (ptr anylist) a)
(do_list_elems f (any_to (ptr anylist) a))
(if (and (any_is iterm a) (any_is (ptr anylist) (itt (a2it a))))
(to_any
(itv (do_list_elems f (a2l (itt (a2it a)))) (iti (a2it a))))
a))))))