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 | def q(x): return ['quote', x]
def qq(x): return ['quasiquote', x]
def uq(x): return ['unquote', x]
def uqs(x): return ['unquote-splicing', x]
p = ['begin',
['define', 'nil', q('nil')],
['define', '#t', q('#t')],
['define', '#f', q('#f')],
['define', 'list', ['lambda', 'x', 'x']],
['define', 'defun', ['mu', ['name', 'params', ..., 'body'],
['list', q('define'),
'name',
['cons', q('lambda'), ['cons', 'params', 'body']]]]],
['define', 'defmac', ['mu', ['name', 'params', ..., 'body'],
['list', q('define'),
'name',
['cons', q('mu'), ['cons', 'params', 'body']]]]],
['defun', 'caar', ['x'], ['car', ['car', 'x']]],
['defun', 'cadr', ['x'], ['car', ['cdr', 'x']]],
['defun', 'cdar', ['x'], ['cdr', ['car', 'x']]],
['defun', 'cddr', ['x'], ['cdr', ['cdr', 'x']]],
['defun', 'cadar', ['x'], ['car', ['cdr', ['car', 'x']]]],
['defun', 'null?', ['x'], ['eq?', 'x', 'nil']],
['defun', 'length', ['x'],
['defun', 'length*', ['x', 'a'],
['if', ['pair?', 'x'],
['length*', ['cdr', 'x'], ['+', 'a', 1]],
'a']],
['length*', 'x', 0]],
['defun', 'reverse', ['x'],
['defun', 'reverse*', ['a', 'b'],
['if', ['pair?', 'a'],
['reverse*', ['cdr', 'a'], ['cons', ['car', 'a'], 'b']],
'b']],
['reverse*', 'x', 'nil']],
['defun', 'append', ['a', 'b'],
['defun', 'append*', ['a', 'b'],
['if', ['pair?', 'a'],
['append*', ['cdr', 'a'], ['cons', ['car', 'a'], 'b']],
'b']],
['append*', ['reverse', 'a'], 'b']],
['defun', 'map', ['f', 'x'],
['defun', 'map*', ['f', 'x', 'z'],
['if', ['pair?', 'x'],
['map*', 'f', ['cdr', 'x'], ['cons', ['f', ['car', 'x']], 'z']],
'z']],
['map*', 'f', ['reverse', 'x'], 'nil']],
['defmac', 'quasiquote', ['x'],
['defun', 'qq', ['x'],
['if', ['pair?', 'x'],
['if', ['eq?', ['car', 'x'], q('unquote')],
['cadr', 'x'],
['if', ['pair?', ['car', 'x']],
['if', ['eq?', ['caar', 'x'], q('unquote-splicing')],
['list', q('append'), ['cadar', 'x'], ['qq', ['cdr', 'x']]],
['list', q('cons'), ['qq', ['car', 'x']], ['qq', ['cdr', 'x']]]],
['list', q('cons'), ['qq', ['car', 'x']], ['qq', ['cdr', 'x']]]]],
['list', q('quote'), 'x']]],
['qq', 'x']],
['defmac', 'let', ['bindings', ..., 'body'],
qq([['lambda', uq(['map', 'car', 'bindings']), uqs('body')],
uqs(['map', 'cadr', 'bindings'])])],
['defmac', 'cond', 'clauses',
['defun', 'cond*', ['clauses'],
['if', ['eq?', ['caar', 'clauses'], q('else')],
qq(['begin', uqs(['cdar', 'clauses'])]),
qq(['if', uq(['caar', 'clauses']),
['begin', uqs(['cdar', 'clauses'])],
uq(['cond*', ['cdr', 'clauses']])])]],
['cond*', 'clauses']],
['define', 'gensym',
['let', [['n', 0]],
['lambda', [], ['set!', 'n', ['+', 'n', 1]],
['+', q('g'), ['sym', 'n']]]]],
['defun', 'not', ['x'], ['if', 'x', '#f', '#t']],
['defmac', 'and', ['x', 'y'],
['let', [['g', ['gensym']]],
qq(['let', [[uq('g'), uq('x')]],
['if', uq('g'), uq('y'), uq('g')]])]],
['defmac', 'or', ['x', 'y'],
['let', [['g', ['gensym']]],
qq(['let', [[uq('g'), uq('x')]],
['if', uq('g'), uq('g'), uq('y')]])]],
['defun', 'list?', ['x'], ['or', ['null?', 'x'], ['pair?', 'x']]],
['define', '=', 'eq?'],
['defun', 'equal?', ['a', 'b'],
['if', ['and', ['pair?', 'a'], ['pair?', 'b']],
['and', ['equal?', ['car', 'a'], ['car', 'b']],
['equal?', ['cdr', 'a'], ['cdr', 'b']]],
['if', ['or', ['pair?', 'a'], ['pair?', 'b']],
'#f',
['eq?', 'a', 'b']]]],
['defun', 'assp', ['p', 'a'],
['cond', [['not', ['pair?', 'a']], '#f'],
[['p', ['caar', 'a']], ['car', 'a']],
['else', ['assp', 'p', ['cdr', 'a']]]]],
['defun', 'ormap', ['p', 'l'],
['cond', [['null?', 'l'], '#f'],
[['p', ['car', 'l']], '#t'],
['else', ['ormap', 'p', ['cdr', 'l']]]]],
['defun', 'var', ['x'], ['cons', q('\\var'), 'x']],
['defun', 'var?', ['x'], ['and', ['pair?', 'x'], ['eq?', q('\\var'), ['car', 'x']]]],
['defun', 'var=?', ['x', 'y'], ['eq?', ['cdr', 'x'], ['cdr', 'y']]],
['defun', 'walk', ['u', 's'],
['let', [['pr', ['and', ['var?', 'u'], ['assp', ['lambda', ['v'], ['var=?', 'u', 'v']], 's']]]],
['if', 'pr', ['walk', ['cdr', 'pr'], 's'], 'u']]],
['defun', 'ext-s', ['x', 'v', 's'], ['cons', ['cons', 'x', 'v'], 's']],
['defun', '==', ['u', 'v'],
['lambda', ['s/c'],
['let', [['s', ['unify', 'u', 'v', ['car', 's/c']]]],
['if', ['and', 's', ['not', ['invalid?', 's', ['cadr', 's/c']]]],
['unit', ['cons', 's', ['cons', ['cadr', 's/c'], ['cddr', 's/c']]]],
'mzero']]]],
['defun', '=/=', ['u', 'v'],
['lambda', ['s/c'],
['let', [['i', ['cons', ['cons', 'u', 'v'], ['cadr', 's/c']]]],
['unit', ['cons', ['car', 's/c'], ['cons', 'i', ['cddr', 's/c']]]]]]],
['defun', 'invalid?', ['s', 'i'],
['ormap', ['lambda', ['x'], ['equal?', 's', ['unify', ['car', 'x'], ['cdr', 'x'], 's']]], 'i']],
['defun', 'unit', ['s/c'], ['cons', 's/c', 'mzero']],
['define', 'mzero', 'nil'],
['defun', 'unify', ['u', 'v', 's'],
['let', [['u', ['walk', 'u', 's']], ['v', ['walk', 'v', 's']]],
['cond', [['and', ['and', ['var?', 'u'], ['var?', 'v']], ['var=?', 'u', 'v']], 's'],
[['var?', 'u'], ['ext-s', 'u', 'v', 's']],
[['var?', 'v'], ['ext-s', 'v', 'u', 's']],
[['and', ['pair?', 'u'], ['pair?', 'v']],
['let', [['s', ['unify', ['car', 'u'], ['car', 'v'], 's']]],
['and', 's', ['unify', ['cdr', 'u'], ['cdr', 'v'], 's']]]],
['else', ['and', ['eq?', 'u', 'v'], 's']]]]],
['defun', 'call/fresh', ['f'],
['lambda', ['s/c'],
['let', [['c', ['cddr', 's/c']]],
[['f', ['var', 'c']], ['cons', ['car', 's/c'], ['cons', ['cadr', 's/c'], ['+', 'c', 1]]]]]]],
['defun', 'disj', ['a', 'b'], ['lambda', ['s/c'], ['mplus', ['a', 's/c'], ['b', 's/c']]]],
['defun', 'conj', ['a', 'b'], ['lambda', ['s/c'], ['bind', ['a', 's/c'], 'b']]],
['defun', 'mplus', ['a', 'b'],
['cond', [['null?', 'a'], 'b'],
[['pair?', 'a'], ['cons', ['car', 'a'], ['mplus', 'b', ['cdr', 'a']]]],
['else', ['lambda', 'nil', ['mplus', 'b', ['a']]]]]],
['defun', 'bind', ['s', 'g'],
['cond', [['null?', 's'], 'mzero'],
[['pair?', 's'], ['mplus', ['g', ['car', 's']], ['bind', ['cdr', 's'], 'g']]],
['else', ['lambda', 'nil', ['bind', ['s'], 'g']]]]],
['defmac', 'Zzz', ['g'], qq(['lambda', ['s/c'], ['lambda', [], [uq('g'), 's/c']]])],
['defmac', 'conj+', 'g',
['defun', 'conj+*', ['g'],
['if', ['null?', ['cdr', 'g']],
qq(['Zzz', uq(['car', 'g'])]),
qq(['conj', ['Zzz', uq(['car', 'g'])], uq(['conj+*', ['cdr', 'g']])])]],
['conj+*', 'g']],
['defmac', 'disj+', 'g',
['defun', 'disj+*', ['g'],
['if', ['null?', ['cdr', 'g']],
qq(['Zzz', uq(['car', 'g'])]),
qq(['disj', ['Zzz', uq(['car', 'g'])], uq(['disj+*', ['cdr', 'g']])])]],
['disj+*', 'g']],
['defmac', 'conde', 'g',
['cons', q('disj+'), ['map', ['lambda', ['t'], ['cons', q('conj+'), 't']], 'g']]],
['defmac', 'fresh', ['x', ..., 'g'],
['defun', 'fresh*', ['x', 'g'],
['if', ['null?', 'x'],
['cons', q('conj+'), 'g'],
qq(['call/fresh', ['lambda', [uq(['car', 'x'])], uq(['fresh*', ['cdr', 'x'], 'g'])]])]],
['fresh*', 'x', 'g']],
['defun', 'pull', ['s'], ['if', ['list?', 's'], 's', ['pull', ['s']]]],
['defun', 'take-all', ['s'],
['let', [['s', ['pull', 's']]],
['if', ['null?', 's'], 'nil', ['cons', ['car', 's'], ['take-all', ['cdr', 's']]]]]],
['defun', 'take', ['n', 's'],
['if', ['=', 'n', 0],
'nil',
['let', [['s', ['pull', 's']]],
['cond', [['null?', 's'], 'nil'],
['else', ['cons', ['car', 's'], ['take', ['+', 'n', -1], ['cdr', 's']]]]]]]],
['defun', 'mK-reify', ['s/c*'],
['map', 'reify-state/first-var', 's/c*']],
['defun', 'reify-state/first-var', ['s/c'],
['let', [['v', ['walk*', ['var', 0], ['car', 's/c']]]],
['walk*', 'v', ['reify-s', 'v', 'nil']]]],
['defun', 'reify-s', ['v', 's'],
['let', [['v', ['walk', 'v', 's']]],
['cond',
[['var?', 'v'], ['let', [['n', ['reify-name', ['length', 's']]]],
['cons', ['cons', 'v', 'n'], 's']]],
[['pair?', 'v'], ['reify-s', ['cdr', 'v'], ['reify-s', ['car', 'v'], 's']]],
['else', 's']]]],
['defun', 'reify-name', ['n'],
['+', '_.', ['sym', 'n']]],
['defun', 'walk*', ['v', 's'],
['let', [['v', ['walk', 'v', 's']]],
['cond',
[['var?', 'v'], 'v'],
[['pair?', 'v'], ['cons', ['walk*', ['car', 'v'], 's'],
['walk*', ['cdr', 'v'], 's']]],
['else', 'v']]]],
['define', 'empty-state', ['cons', 'nil', ['cons', 'nil', 0]]],
['defun', 'call/empty-state', ['g'], ['g', 'empty-state']],
['defmac', 'run', ['n', 'x', ..., 'g'],
['if', ['eq?', 'n', '#f'],
qq(['mK-reify', ['take-all', ['call/empty-state',
['fresh', uq('x'), uqs('g')]]]]),
qq(['mK-reify', ['take', uq('n'), ['call/empty-state',
['fresh', uq('x'), uqs('g')]]]])]],
['defun', 'conso', ['a', 'd', 'p'], ['==', ['cons', 'a', 'd'], 'p']],
['defun', 'caro', ['p', 'a'], ['fresh', ['d'], ['conso', 'a', 'd', 'p']]],
['defun', 'cdro', ['p', 'd'], ['fresh', ['a'], ['conso', 'a', 'd', 'p']]],
['defun', 'nullo', ['x'], ['==', 'x', 'nil']],
['defun', 'in', ['e', 'xs'],
['conde', [['caro', 'xs', 'e']],
[['fresh', ['d'],
['cdro', 'xs', 'd'],
['in', 'e', 'd']]]]],
['defun', 'notin', ['e', 'xs'],
['conde', [['nullo', 'xs']],
[['fresh', ['a', 'd'],
['=/=', 'a', 'e'],
['conso', 'a', 'd', 'xs'],
['notin', 'e', 'd']]]]],
['defun', 'entryo', ['xs', 'ys'],
['conde', [['nullo', 'xs'], ['nullo', 'ys']],
[['fresh', ['xa', 'xd', 'ya', 'yd'],
['conso', 'xa', 'xd', 'xs'],
['conso', 'ya', 'yd', 'ys'],
['in', 'ya', 'xa'],
['notin', 'ya', 'yd'],
['entryo', 'xd', 'yd']]]]],
['defun', 'entry', ['xs'],
['car', ['run', 1, ['x'],
['entryo', 'xs', 'x']]]]
]
|
post a comment