-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathboot-common.lisp
363 lines (363 loc) · 80.1 KB
/
boot-common.lisp
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
; tré Common Lisp core, generated by 'makefiles/boot-common.lisp'.
(declaim #+sbcl(sb-ext:muffle-conditions compiler-note style-warning))
(DEFPACKAGE "TRE-CORE" (:EXPORT "NIL" "T" "SETQ" "COND" "PROGN" "BLOCK" "RETURN-FROM" "TAGBODY" "GO" "LABELS" "QUOTE" "FUNCTION" "LAMBDA" "SLOT-VALUE" "&REST" "&BODY" "&OPTIONAL" "&KEY" "BACKQUOTE" "QUASIQUOTE" "QUASIQUOTE-SPLICE" "SQUARE" "CURLY" "ACCENT-CIRCONFLEX" "ATOM" "APPLY" "CONS" "CAR" "CDR" "RPLACA" "RPLACD" "LIST" "LAST" "COPY-LIST" "NTHCDR" "NTH" "MAPCAR" "LENGTH" "MAKE-STRING" "MOD" "SQRT" "SIN" "COS" "ATAN" "EXP" "ROUND" "FLOOR" "AREF" "CHAR-CODE" "MAKE-PACKAGE" "PACKAGE-NAME" "FIND-PACKAGE" "PRINT" "BREAK" "POW" "CHARACTER>" "CHARACTER<" "CHARACTER==" "NUMBER>" "NUMBER<" "NUMBER/" "NUMBER*" "NUMBER-" "NUMBER+" "NUMBER==" "%/" "%*" ">=" "<=" ">" "<" "==" "/" "*" "-" "%CODE-CHAR" "INTEGER" "CHARACTER?" "NUMBER?" "ARRAY?" "STRING?" "FUNCTION?" "SYMBOL?" "CONS?" "NANOTIME" "UNIX-SH-RM" "UNIX-SH-MKDIR" "UNIX-SH-CP" "SH" "FIND-SYMBOL" "=-SYMBOL-FUNCTION" "SYMBOL-PACKAGE" "SYMBOL-FUNCTION" "SYMBOL-VALUE" "SYMBOL-NAME" "MAKE-SYMBOL" "LIST-STRING" "STRING==" "STRING" "STRING-CONCAT" "%SET-ELT" "ELT" "EQL" "EQ" "NOT" "<<" ">>" "BIT-XOR" "BIT-OR" "BIT-AND" "CODE-CHAR" "NANOTIME" "QUIT" "MACROEXPAND" "MACROEXPAND-1" "%%MACRO?" "%%MACROCALL" "MACRO?" "LOAD" "APPEND" "FILTER" "%START-CORE" "SYS-IMAGE-CREATE" "HASHKEYS" "COPY-HASH-TABLE" "HREMOVE" "=-HREF" "HREF" "HASH-TABLE?" "MAKE-HASH-TABLE" "FUNCTION-BYTECODE" "=-FUNCTION-SOURCE" "FUNCTION-SOURCE" "FUNCTION-NATIVE" "FILE-EXISTS?" "%READ-CHAR" "%FCLOSE" "%FOPEN" "%FORCE-OUTPUT" "%PRINC" "EVAL" "%ERROR" "ENV-LOAD" "=-AREF" "MAKE-ARRAY" "BUILTIN?" "%DEFUN-QUIET" "%DEFUN" "%DEFVAR" "%DEFMACRO" "?" "*UNIVERSE*" "*VARIABLES*" "*FUNCTIONS*" "*ENVIRONMENT-PATH*" "*ENVIRONMENT-FILENAMES*" "*MACROEXPAND*" "*QUASIQUOTE-EXPAND*" "*DOT-EXPAND*" "*PACKAGE*" "*KEYWORD-PACKAGE*" "*POINTER-SIZE*" "*LAUNCHFILE*" "*ASSERT?*" "*TARGETS*" "*ENDIANESS*" "*CPU-TYPE*" "*LIBC-PATH*" "*RAND-MAX*" "*EVAL*" "CONS?" "SYMBOL?" "FUNCTION?" "STRING?" "ARRAY?" "NUMBER?" "CHARACTER?" "INTEGER" "%CODE-CHAR" "-" "*" "/" "==" "<" ">" "<=" ">=" "%*" "%/" "NUMBER==" "NUMBER+" "NUMBER-" "NUMBER*" "NUMBER/" "NUMBER<" "NUMBER>" "CHARACTER==" "CHARACTER<" "CHARACTER>" "POW") (:IMPORT-FROM "CL" "FORMAT" "NIL" "T" "SETQ" "COND" "PROGN" "BLOCK" "RETURN-FROM" "TAGBODY" "GO" "LABELS" "QUOTE" "FUNCTION" "LAMBDA" "SLOT-VALUE" "&REST" "&BODY" "&OPTIONAL" "&KEY" "ATOM" "APPLY" "CONS" "CAR" "CDR" "RPLACA" "RPLACD" "LIST" "LAST" "COPY-LIST" "NTHCDR" "NTH" "MAPCAR" "LENGTH" "MAKE-STRING" "MOD" "SQRT" "SIN" "COS" "ATAN" "EXP" "ROUND" "FLOOR" "AREF" "CHAR-CODE" "MAKE-PACKAGE" "PACKAGE-NAME" "FIND-PACKAGE" "PRINT" "BREAK"))
(DEFPACKAGE "TRE" (:USE "TRE-CORE"))
(CL:IN-PACKAGE :TRE-CORE)
"Section CL-CORE"
(CL:DEFVAR *UNIVERSE*)
(CL:DEFVAR *VARIABLES*)
(CL:DEFVAR *LAUNCHFILE*)
(CL:DEFVAR *POINTER-SIZE*)
(CL:DEFVAR *ASSERT?*)
(CL:DEFVAR *ENDIANESS*)
(CL:DEFVAR *CPU-TYPE*)
(CL:DEFVAR *LIBC-PATH*)
(CL:DEFVAR *RAND-MAX*)
(CL:DEFVAR *PRINT-DEFINITIONS?*)
(CL:DEFVAR *DEFAULT-STREAM-TABSIZE*)
(CL:DEFVAR *QUASIQUOTE-EXPAND*)
(CL:DEFVAR *DOT-EXPAND*)
(CL:DEFVAR *BUILTIN-ATOMS* (CL:MAKE-HASH-TABLE :TEST (CL:FUNCTION CL:EQ)))
(CL:PROGN (CL:DEFUN BUILTIN? (X) (CL:LABELS ((~G774 (~G747) (CL:COND (~G747 ~G747) (T (CL:MEMBER X +CL-FUNCTION-IMPORTS+))))) (~G774 (CL:GETHASH X *BUILTIN-ATOMS*)))) (CL:SETF (CL:GETHASH 'BUILTIN? *BUILTIN-ATOMS*) (CL:FUNCTION BUILTIN?)))
(CL:PROGN (CL:DEFUN MAKE-ARRAY (CL:&OPTIONAL (DIMENSIONS 1)) (CL:MAKE-ARRAY DIMENSIONS)) (CL:SETF (CL:GETHASH 'MAKE-ARRAY *BUILTIN-ATOMS*) (CL:FUNCTION MAKE-ARRAY)))
(CL:PROGN (CL:DEFUN =-AREF (V X I) (CL:SETF (CL:AREF X I) V)) (CL:SETF (CL:GETHASH '=-AREF *BUILTIN-ATOMS*) (CL:FUNCTION =-AREF)))
(CL:DEFVAR *ENVIRONMENT-PATH*)
(CL:DEFVAR *ENVIRONMENT-FILENAMES*)
(CL:PROGN (CL:DEFUN ENV-LOAD (PATHNAME CL:&REST TARGETS) (PRINT-DEFINITION `(ENV-LOAD ,PATHNAME ,@TARGETS)) (CL:SETQ *ENVIRONMENT-FILENAMES* (CL:CONS (CL:CONS PATHNAME TARGETS) *ENVIRONMENT-FILENAMES*)) (CL:COND ((CL:LABELS ((~G775 (~G748) (CL:COND (~G748 ~G748) (T (MEMBER :CL TARGETS))))) (~G775 (NOT TARGETS))) (CL:PROGN (LOAD (+ *ENVIRONMENT-PATH* "/environment/" PATHNAME)))))) (CL:SETF (CL:GETHASH 'ENV-LOAD *BUILTIN-ATOMS*) (CL:FUNCTION ENV-LOAD)))
(CL:DEFVAR +ANONYMOUS-FUNCTION-SOURCES?+)
(CL:DEFUN MAKE-SCOPING-FUNCTION (X) (CL:LABELS ((~G776 (G) `(CL:LABELS ((,G ,@(MAKE-LAMBDAS (CADAR X)))) (,G ,@(MAKE-LAMBDAS (CL:CDR X)))))) (~G776 (GENSYM))))
(CL:DEFUN MAKE-ANONYMOUS-FUNCTION (X) (CL:LABELS ((~G777 (!) (CL:COND ((EQUAL ! '(NIL)) `(CL:LAMBDA NIL NIL)) (T `(CL:LAMBDA ,@!))))) (~G777 (MAKE-LAMBDAS (CL:CAR (CL:CDR X))))))
(CL:DEFUN LAMBDA-EXPR-WITHOUT-LAMBDA-KEYWORD? (X) (CL:COND ((CONS? X) (CL:COND ((EQ 'CL:FUNCTION (CL:CAR X)) (CL:COND ((NOT (CL:ATOM (CL:CAR (CL:CDR X)))) (NOT (EQ 'CL:LAMBDA (CL:CAR (CL:CAR (CL:CDR X))))))))))))
(CL:DEFUN MAKE-LAMBDAS (X) (CL:COND ((EQ 'CL:&BODY X) 'CL:&REST) ((CL:ATOM X) X) ((EQ 'CL:QUOTE (CL:CAR X)) X) ((LAMBDA-EXPR-WITHOUT-LAMBDA-KEYWORD? (CL:CAR X)) (MAKE-SCOPING-FUNCTION X)) ((LAMBDA-EXPR-WITHOUT-LAMBDA-KEYWORD? X) (MAKE-ANONYMOUS-FUNCTION X)) (T (CL:MAPCAR (CL:FUNCTION MAKE-LAMBDAS) X))))
(CL:PROGN (CL:DEFUN %ERROR (MSG) (CL:BREAK (NEUTRALIZE-FORMAT-STRING MSG))) (CL:SETF (CL:GETHASH '%ERROR *BUILTIN-ATOMS*) (CL:FUNCTION %ERROR)))
(CL:DEFUN TRE2CL (X) (MAKE-LAMBDAS (QUOTE-EXPAND (SPECIALEXPAND (QUOTE-EXPAND X)))))
(CL:DEFVAR *EVAL*)
(CL:PROGN (CL:DEFUN EVAL (X) (CL:EVAL (CL:PROGN (CL:SETQ *EVAL* (TRE2CL X))))) (CL:SETF (CL:GETHASH 'EVAL *BUILTIN-ATOMS*) (CL:FUNCTION EVAL)))
(CL:PROGN (CL:DEFUN %PRINC (X STREAM) (CL:LABELS ((~G778 (!) (CL:COND ((CHARACTER? X) (CL:WRITE-BYTE (CL:CHAR-CODE X) !)) ((STRING? X) (CL:LABELS ((~G779 (~G750) (CL:COND (~G750 (CL:PROGN (CL:LABELS ((~G780 (~G752) (CL:BLOCK NIL (CL:LABELS ((~G781 (~G751) (CL:TAGBODY ~G753 (CL:COND ((== ~G751 ~G752) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:LABELS ((~G782 (I) (%PRINC I !))) (~G782 (ELT ~G750 ~G751))) (CL:SETQ ~G751 (NUMBER+ 1 ~G751)) (CL:GO ~G753)))) (~G781 0))))) (~G780 (CL:LENGTH ~G750)))))))) (~G779 X))) (T (CL:PRINC X !))))) (~G778 (CL:LABELS ((~G783 (~G749) (CL:COND (~G749 ~G749) (T CL:*STANDARD-OUTPUT*)))) (~G783 STREAM))))) (CL:SETF (CL:GETHASH '%PRINC *BUILTIN-ATOMS*) (CL:FUNCTION %PRINC)))
(CL:PROGN (CL:DEFUN %FORCE-OUTPUT (STREAM) (CL:FORCE-OUTPUT STREAM)) (CL:SETF (CL:GETHASH '%FORCE-OUTPUT *BUILTIN-ATOMS*) (CL:FUNCTION %FORCE-OUTPUT)))
(CL:PROGN (CL:DEFUN %FOPEN (PATHNAME MODE) (CL:OPEN PATHNAME :DIRECTION (CL:COND ((CL:FIND #\w MODE :TEST (CL:FUNCTION CL:EQUAL)) :OUTPUT) (T :INPUT)) :IF-EXISTS :SUPERSEDE :ELEMENT-TYPE '(CL:UNSIGNED-BYTE 8))) (CL:SETF (CL:GETHASH '%FOPEN *BUILTIN-ATOMS*) (CL:FUNCTION %FOPEN)))
(CL:PROGN (CL:DEFUN %FCLOSE (STREAM) (CL:CLOSE STREAM)) (CL:SETF (CL:GETHASH '%FCLOSE *BUILTIN-ATOMS*) (CL:FUNCTION %FCLOSE)))
(CL:PROGN (CL:DEFUN %READ-CHAR (STR) (CL:LABELS ((~G784 (!) (CL:COND ((NOT (EQ ! 'EOF)) (CL:PROGN (CL:CODE-CHAR !)))))) (~G784 (CL:READ-BYTE (CL:LABELS ((~G785 (~G754) (CL:COND (~G754 ~G754) (T CL:*STANDARD-INPUT*)))) (~G785 STR)) NIL 'EOF)))) (CL:SETF (CL:GETHASH '%READ-CHAR *BUILTIN-ATOMS*) (CL:FUNCTION %READ-CHAR)))
(CL:PROGN (CL:DEFUN FILE-EXISTS? (PATHNAME) (CL:COND ((CL:PROBE-FILE PATHNAME) T))) (CL:SETF (CL:GETHASH 'FILE-EXISTS? *BUILTIN-ATOMS*) (CL:FUNCTION FILE-EXISTS?)))
(CL:DEFVAR *FUNCTIONS*)
(CL:PROGN (CL:DEFUN FUNCTION-NATIVE (X) X) (CL:SETF (CL:GETHASH 'FUNCTION-NATIVE *BUILTIN-ATOMS*) (CL:FUNCTION FUNCTION-NATIVE)))
(CL:PROGN (CL:DEFUN FUNCTION-SOURCE (X) (CL:CDR (CL:ASSOC X *FUNCTIONS* :TEST (CL:FUNCTION CL:EQ)))) (CL:SETF (CL:GETHASH 'FUNCTION-SOURCE *BUILTIN-ATOMS*) (CL:FUNCTION FUNCTION-SOURCE)))
(CL:PROGN (CL:DEFUN =-FUNCTION-SOURCE (V X) (ERROR "Can't set function source in the Common Lisp core.")) (CL:SETF (CL:GETHASH '=-FUNCTION-SOURCE *BUILTIN-ATOMS*) (CL:FUNCTION =-FUNCTION-SOURCE)))
(CL:PROGN (CL:DEFUN FUNCTION-BYTECODE (X) X NIL) (CL:SETF (CL:GETHASH 'FUNCTION-BYTECODE *BUILTIN-ATOMS*) (CL:FUNCTION FUNCTION-BYTECODE)))
(CL:PROGN (CL:DEFUN MAKE-HASH-TABLE (CL:&KEY (TEST (CL:FUNCTION EQL))) (CL:MAKE-HASH-TABLE :TEST (CL:COND ((CL:EQ TEST (CL:FUNCTION EQ)) (CL:FUNCTION CL:EQ)) ((CL:LABELS ((~G786 (~G755) (CL:COND (~G755 ~G755) (T (CL:EQ TEST (CL:FUNCTION ==)))))) (~G786 (CL:EQ TEST (CL:FUNCTION EQL)))) (CL:FUNCTION CL:EQL)) ((CL:EQ TEST (CL:FUNCTION STRING==)) (CL:FUNCTION CL:EQUAL)) (T TEST)))) (CL:SETF (CL:GETHASH 'MAKE-HASH-TABLE *BUILTIN-ATOMS*) (CL:FUNCTION MAKE-HASH-TABLE)))
(CL:PROGN (CL:DEFUN HASH-TABLE? (X) (CL:HASH-TABLE-P X)) (CL:SETF (CL:GETHASH 'HASH-TABLE? *BUILTIN-ATOMS*) (CL:FUNCTION HASH-TABLE?)))
(CL:PROGN (CL:DEFUN HREF (X I) (CL:GETHASH I X)) (CL:SETF (CL:GETHASH 'HREF *BUILTIN-ATOMS*) (CL:FUNCTION HREF)))
(CL:PROGN (CL:DEFUN =-HREF (V X I) (CL:SETF (CL:GETHASH I X) V)) (CL:SETF (CL:GETHASH '=-HREF *BUILTIN-ATOMS*) (CL:FUNCTION =-HREF)))
(CL:PROGN (CL:DEFUN HREMOVE (X K) (CL:REMHASH K X)) (CL:SETF (CL:GETHASH 'HREMOVE *BUILTIN-ATOMS*) (CL:FUNCTION HREMOVE)))
(CL:PROGN (CL:DEFUN COPY-HASH-TABLE (X) (CL:LABELS ((~G787 (!) (CL:MAPHASH (CL:LAMBDA (K V) (CL:SETF (CL:GETHASH K !) V)) X) !)) (~G787 (CL:MAKE-HASH-TABLE :TEST (CL:HASH-TABLE-TEST X) :SIZE (CL:HASH-TABLE-SIZE X))))) (CL:SETF (CL:GETHASH 'COPY-HASH-TABLE *BUILTIN-ATOMS*) (CL:FUNCTION COPY-HASH-TABLE)))
(CL:PROGN (CL:DEFUN HASHKEYS (X) (CL:LABELS ((~G788 (!) (CL:MAPHASH (CL:LAMBDA (K V) V (CL:PUSH K !)) X) !)) (~G788 NIL))) (CL:SETF (CL:GETHASH 'HASHKEYS *BUILTIN-ATOMS*) (CL:FUNCTION HASHKEYS)))
(CL:PROGN (CL:DEFUN SYS-IMAGE-CREATE (PATHNAME FUN) (SB-EXT:SAVE-LISP-AND-DIE PATHNAME :TOPLEVEL (CL:LAMBDA NIL (CL:FUNCALL FUN)))) (CL:SETF (CL:GETHASH 'SYS-IMAGE-CREATE *BUILTIN-ATOMS*) (CL:FUNCTION SYS-IMAGE-CREATE)))
(CL:PROGN (CL:DEFUN %START-CORE NIL (CL:SETQ *LAUNCHFILE* (CADR (CL:LABELS ((~G789 (~G756) (CL:COND (~G756 ~G756) (T NIL)))) (~G789 SB-EXT:*POSIX-ARGV*))))) (CL:SETF (CL:GETHASH '%START-CORE *BUILTIN-ATOMS*) (CL:FUNCTION %START-CORE)))
(CL:PROGN (CL:DEFUN FILTER (FUN X) (CL:MAPCAR FUN X)) (CL:SETF (CL:GETHASH 'FILTER *BUILTIN-ATOMS*) (CL:FUNCTION FILTER)))
(CL:PROGN (CL:DEFUN APPEND (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:NCONC) (CL:MAPCAR (CL:FUNCTION CL:COPY-LIST) X))) (CL:SETF (CL:GETHASH 'APPEND *BUILTIN-ATOMS*) (CL:FUNCTION APPEND)))
(CL:DEFUN %LOAD-R (S) (CL:COND ((PEEK-CHAR S) (CL:PROGN (CL:CONS (READ S) (%LOAD-R S))))))
(CL:DEFUN %EXPAND (X) (CL:LABELS ((~G790 (!) (CL:COND ((EQUAL X !) X) (T (%EXPAND !))))) (~G790 (QUASIQUOTE-EXPAND (MACROEXPAND (DOT-EXPAND X))))))
(CL:PROGN (CL:DEFUN LOAD (PATHNAME) (PRINT-DEFINITION `(LOAD ,PATHNAME)) (CL:BLOCK NIL (CL:LABELS ((~G791 (~G760) (CL:LABELS ((~G792 (I) (CL:TAGBODY ~G758 (CL:COND ((NOT ~G760) (CL:GO ~G759))) (CL:SETQ I (CL:CAR ~G760)) (EVAL (%EXPAND I)) (CL:SETQ ~G760 (CL:CDR ~G760)) (CL:GO ~G758) ~G759 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G792 NIL)))) (~G791 (CL:LABELS ((~G793 (S) (CL:LABELS ((~G794 (~G757) (CLOSE S) ~G757)) (~G794 (CL:BLOCK NIL (%LOAD-R S)))))) (~G793 (OPEN PATHNAME :DIRECTION 'INPUT))))))) (CL:SETF (CL:GETHASH 'LOAD *BUILTIN-ATOMS*) (CL:FUNCTION LOAD)))
(CL:DEFUN ENV-MACROS NIL (SYMBOL-VALUE (TRE-SYMBOL '*MACROS*)))
(CL:PROGN (CL:DEFUN MACRO? (X) (CL:RASSOC X (ENV-MACROS) :TEST (CL:FUNCTION EQ))) (CL:SETF (CL:GETHASH 'MACRO? *BUILTIN-ATOMS*) (CL:FUNCTION MACRO?)))
(CL:PROGN (CL:DEFUN %%MACROCALL (X) (CL:LABELS ((~G795 (!) (CL:APPLY (CL:CDR !) (ARGUMENT-EXPAND-VALUES (CL:CAR X) (CL:CAR (CL:CAR !)) (CL:CDR X))))) (~G795 (CL:CDR (ASSOC (CL:CAR X) (ENV-MACROS) :TEST (CL:FUNCTION EQ)))))) (CL:SETF (CL:GETHASH '%%MACROCALL *BUILTIN-ATOMS*) (CL:FUNCTION %%MACROCALL)))
(CL:PROGN (CL:DEFUN %%MACRO? (X) (CL:COND ((CONS? X) (CL:COND ((SYMBOL? (CL:CAR X)) (CL:LABELS ((~G796 (!) (CL:COND ((CONS? !) (ASSOC (CL:CAR X) ! :TEST (CL:FUNCTION EQ)))))) (~G796 (ENV-MACROS)))))))) (CL:SETF (CL:GETHASH '%%MACRO? *BUILTIN-ATOMS*) (CL:FUNCTION %%MACRO?)))
(CL:DEFVAR *MACROEXPAND*)
(CL:PROGN (CL:DEFUN MACROEXPAND-1 (X) (CL:LABELS ((~G797 (!) (CL:COND (! (CL:APPLY ! (CL:LIST X))) (T X)))) (~G797 (SYMBOL-VALUE (TRE-SYMBOL '*MACROEXPAND*))))) (CL:SETF (CL:GETHASH 'MACROEXPAND-1 *BUILTIN-ATOMS*) (CL:FUNCTION MACROEXPAND-1)))
(CL:PROGN (CL:DEFUN MACROEXPAND (X) (CL:LABELS ((F (OLD X) (CL:COND ((EQUAL OLD X) X) (T (MACROEXPAND X))))) (F X (MACROEXPAND-1 X)))) (CL:SETF (CL:GETHASH 'MACROEXPAND *BUILTIN-ATOMS*) (CL:FUNCTION MACROEXPAND)))
(CL:PROGN (CL:DEFUN QUIT (CL:&OPTIONAL EXIT-CODE) (SB-EXT:QUIT :UNIX-STATUS EXIT-CODE)) (CL:SETF (CL:GETHASH 'QUIT *BUILTIN-ATOMS*) (CL:FUNCTION QUIT)))
(CL:PROGN (CL:DEFUN NANOTIME NIL 0) (CL:SETF (CL:GETHASH 'NANOTIME *BUILTIN-ATOMS*) (CL:FUNCTION NANOTIME)))
(CL:PROGN (CL:DEFUN CODE-CHAR (X) (CL:COND ((CL:CHARACTERP X) X) (T (CL:CODE-CHAR X)))) (CL:SETF (CL:GETHASH 'CODE-CHAR *BUILTIN-ATOMS*) (CL:FUNCTION CODE-CHAR)))
(CL:DEFUN BITS-INTEGER (BITS) (CL:REDUCE (CL:LAMBDA (A B) (+ (* A 2) B)) BITS))
(CL:DEFUN NUMBER (X) (CL:COND ((CHARACTER? X) (CL:CHAR-CODE X)) (T X)))
(CL:DEFUN INTEGER-BITS (X) (CL:LABELS ((~G798 (!) (CL:LABELS ((~G799 (L) (CL:LABELS ((~G800 (~G761) (CL:BLOCK NIL (CL:LABELS ((~G801 (I) (CL:TAGBODY ~G762 (CL:COND ((== I ~G761) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:MULTIPLE-VALUE-BIND (I R) (CL:TRUNCATE ! 2) (CL:PROGN (CL:SETQ ! I)) (CL:PUSH R L)) (CL:SETQ I (NUMBER+ 1 I)) (CL:GO ~G762)))) (~G801 0))))) (~G800 32)) (CL:COERCE L 'CL:BIT-VECTOR))) (~G799 NIL)))) (~G798 (NUMBER X))))
(CL:PROGN (CL:DEFUN BIT-AND (A B) (BITS-INTEGER (CL:BIT-AND (INTEGER-BITS A) (INTEGER-BITS B)))) (CL:SETF (CL:GETHASH 'BIT-AND *BUILTIN-ATOMS*) (CL:FUNCTION BIT-AND)))
(CL:PROGN (CL:DEFUN BIT-OR (A B) (BITS-INTEGER (CL:BIT-IOR (INTEGER-BITS A) (INTEGER-BITS B)))) (CL:SETF (CL:GETHASH 'BIT-OR *BUILTIN-ATOMS*) (CL:FUNCTION BIT-OR)))
(CL:PROGN (CL:DEFUN BIT-XOR (A B) (BITS-INTEGER (CL:BIT-XOR (INTEGER-BITS A) (INTEGER-BITS B)))) (CL:SETF (CL:GETHASH 'BIT-XOR *BUILTIN-ATOMS*) (CL:FUNCTION BIT-XOR)))
(CL:PROGN (CL:DEFUN >> (X BITS) (CL:LABELS ((~G802 (~G763) (CL:BLOCK NIL (CL:LABELS ((~G803 (N) (CL:TAGBODY ~G764 (CL:COND ((== N ~G763) (CL:RETURN-FROM NIL (CL:PROGN X)))) (CL:MULTIPLE-VALUE-BIND (I R) (CL:TRUNCATE X 2) (CL:PROGN (CL:SETQ X I))) (CL:SETQ N (NUMBER+ 1 N)) (CL:GO ~G764)))) (~G803 0))))) (~G802 BITS))) (CL:SETF (CL:GETHASH '>> *BUILTIN-ATOMS*) (CL:FUNCTION >>)))
(CL:PROGN (CL:DEFUN << (X BITS) (CL:LABELS ((~G804 (~G765) (CL:BLOCK NIL (CL:LABELS ((~G805 (N) (CL:TAGBODY ~G766 (CL:COND ((== N ~G765) (CL:RETURN-FROM NIL (CL:PROGN X)))) (CL:PROGN (CL:SETQ X (* X 2))) (CL:SETQ N (NUMBER+ 1 N)) (CL:GO ~G766)))) (~G805 0))))) (~G804 BITS))) (CL:SETF (CL:GETHASH '<< *BUILTIN-ATOMS*) (CL:FUNCTION <<)))
(CL:PROGN (CL:DEFUN NOT (CL:&REST X) (CL:EVERY (CL:FUNCTION CL:NOT) X)) (CL:SETF (CL:GETHASH 'NOT *BUILTIN-ATOMS*) (CL:FUNCTION NOT)))
(CL:PROGN (CL:DEFUN EQ (A B) (CL:EQ A B)) (CL:SETF (CL:GETHASH 'EQ *BUILTIN-ATOMS*) (CL:FUNCTION EQ)))
(CL:PROGN (CL:DEFUN EQL (A B) (CL:LABELS ((~G806 (~G767) (CL:COND (~G767 ~G767) (T (CL:COND ((CL:COND ((CL:CHARACTERP A) (CL:CHARACTERP B))) (CL:= (CL:CHAR-CODE A) (CL:CHAR-CODE B))) ((CL:COND ((NOT (CL:CHARACTERP A) (CL:CHARACTERP B)) (CL:COND ((NUMBER? A) (NUMBER? B))))) (CL:= A B)) ((CL:COND ((CL:CONSP A) (CL:CONSP B))) (CL:COND ((EQL (CL:CAR A) (CL:CAR B)) (EQL (CL:CDR A) (CL:CDR B))))) ((CL:COND ((CL:STRINGP A) (CL:STRINGP B))) (CL:STRING= A B))))))) (~G806 (CL:EQ A B)))) (CL:SETF (CL:GETHASH 'EQL *BUILTIN-ATOMS*) (CL:FUNCTION EQL)))
(CL:PROGN (CL:DEFUN ELT (SEQ IDX) (CL:COND (SEQ (CL:COND ((CL:< IDX (CL:LENGTH SEQ)) (CL:ELT SEQ IDX)))))) (CL:SETF (CL:GETHASH 'ELT *BUILTIN-ATOMS*) (CL:FUNCTION ELT)))
(CL:PROGN (CL:DEFUN %SET-ELT (OBJ SEQ IDX) (CL:SETF (CL:ELT SEQ IDX) OBJ)) (CL:SETF (CL:GETHASH '%SET-ELT *BUILTIN-ATOMS*) (CL:FUNCTION %SET-ELT)))
(CL:PROGN (CL:DEFUN STRING-CONCAT (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CONCATENATE) 'CL:STRING X)) (CL:SETF (CL:GETHASH 'STRING-CONCAT *BUILTIN-ATOMS*) (CL:FUNCTION STRING-CONCAT)))
(CL:PROGN (CL:DEFUN STRING (X) (CL:COND ((CL:NUMBERP X) (CL:FORMAT NIL "~A" X)) (T (CL:STRING X)))) (CL:SETF (CL:GETHASH 'STRING *BUILTIN-ATOMS*) (CL:FUNCTION STRING)))
(CL:PROGN (CL:DEFUN STRING== (A B) (CL:STRING= A B)) (CL:SETF (CL:GETHASH 'STRING== *BUILTIN-ATOMS*) (CL:FUNCTION STRING==)))
(CL:PROGN (CL:DEFUN LIST-STRING (X) (CL:LABELS ((~G807 (~G768) (CL:COND (~G768 ~G768) (T (ERROR "List expected instead of ~A." X))))) (~G807 (LIST? X))) (CL:CONCATENATE 'CL:STRING X)) (CL:SETF (CL:GETHASH 'LIST-STRING *BUILTIN-ATOMS*) (CL:FUNCTION LIST-STRING)))
(CL:DEFVAR *SPECIAL-FORMS*)
(CL:DEFUN SPECIAL-%%MACROCALL (X) (CL:LABELS ((~G808 (!) (CL:APPLY (CL:CDR !) (ARGUMENT-EXPAND-VALUES (CL:CAR X) (CL:CAR !) (CL:CDR X))))) (~G808 (CL:CDR (ASSOC (CL:CAR X) *SPECIAL-FORMS* :TEST (CL:FUNCTION EQ))))))
(CL:DEFUN SPECIAL-%%MACRO? (X) (CL:COND ((CONS? X) (CL:COND ((SYMBOL? (CL:CAR X)) (ASSOC (CL:CAR X) *SPECIAL-FORMS* :TEST (CL:FUNCTION EQ)))))))
(CL:DEFUN SPECIALEXPAND (X) (CL:LABELS ((~G809 (~G769) (CL:PROGN (CL:SETQ *MACRO?* (CL:FUNCTION SPECIAL-%%MACRO?))) (CL:LABELS ((~G810 (~G770) (CL:PROGN (CL:SETQ *MACRO?* ~G769)) ~G770)) (~G810 (CL:PROGN (CL:LABELS ((~G811 (~G771) (CL:PROGN (CL:SETQ *MACROCALL* (CL:FUNCTION SPECIAL-%%MACROCALL))) (CL:LABELS ((~G812 (~G772) (CL:PROGN (CL:SETQ *MACROCALL* ~G771)) ~G772)) (~G812 (CL:PROGN (CL:LABELS ((F (OLD X) (CL:COND ((EQUAL OLD X) X) (T (F X (%MACROEXPAND X)))))) (F X (%MACROEXPAND X)))))))) (~G811 *MACROCALL*))))))) (~G809 *MACRO?*)))
(CL:DEFUN MAKE-%DEFUN-QUIET (NAME ARGS BODY) `(CL:PROGN (CL:PUSH (CL:CONS ',NAME ',(CL:CONS ARGS BODY)) *FUNCTIONS*) (CL:DEFUN ,NAME ,ARGS ,@BODY)))
(CL:DEFVAR *KEYWORD-PACKAGE*)
(CL:DEFVAR *PACKAGE*)
(CL:PROGN (CL:DEFUN MAKE-SYMBOL (X CL:&OPTIONAL (PACKAGE NIL)) (CL:INTERN X (CL:COND ((CL:NOT PACKAGE) (CL:LABELS ((~G813 (~G773) (CL:COND (~G773 ~G773) (T "TRE")))) (~G813 (CL:LABELS ((~G814 (!) (CL:COND (! (SYMBOL-NAME !))))) (~G814 *PACKAGE*))))) ((CL:PACKAGEP PACKAGE) (CL:PACKAGE-NAME PACKAGE)) ((CL:SYMBOLP PACKAGE) (CL:SYMBOL-NAME PACKAGE)) (T PACKAGE)))) (CL:SETF (CL:GETHASH 'MAKE-SYMBOL *BUILTIN-ATOMS*) (CL:FUNCTION MAKE-SYMBOL)))
(CL:PROGN (CL:DEFUN SYMBOL-NAME (X) (CL:COND ((CL:PACKAGEP X) (CL:PACKAGE-NAME X)) (T (CL:SYMBOL-NAME X)))) (CL:SETF (CL:GETHASH 'SYMBOL-NAME *BUILTIN-ATOMS*) (CL:FUNCTION SYMBOL-NAME)))
(CL:PROGN (CL:DEFUN SYMBOL-VALUE (X) (CL:COND ((CL:BOUNDP X) (CL:SYMBOL-VALUE X)) (T X))) (CL:SETF (CL:GETHASH 'SYMBOL-VALUE *BUILTIN-ATOMS*) (CL:FUNCTION SYMBOL-VALUE)))
(CL:PROGN (CL:DEFUN SYMBOL-FUNCTION (X) (CL:COND ((CL:FBOUNDP X) (CL:SYMBOL-FUNCTION X)))) (CL:SETF (CL:GETHASH 'SYMBOL-FUNCTION *BUILTIN-ATOMS*) (CL:FUNCTION SYMBOL-FUNCTION)))
(CL:PROGN (CL:DEFUN SYMBOL-PACKAGE (X) (CL:SYMBOL-PACKAGE X)) (CL:SETF (CL:GETHASH 'SYMBOL-PACKAGE *BUILTIN-ATOMS*) (CL:FUNCTION SYMBOL-PACKAGE)))
(CL:PROGN (CL:DEFUN =-SYMBOL-FUNCTION (V X) (CL:SETF (CL:SYMBOL-FUNCTION X) V)) (CL:SETF (CL:GETHASH '=-SYMBOL-FUNCTION *BUILTIN-ATOMS*) (CL:FUNCTION =-SYMBOL-FUNCTION)))
(CL:PROGN (CL:DEFUN FIND-SYMBOL (X CL:&OPTIONAL (PKG *PACKAGE*)) (CL:FIND-SYMBOL (SYMBOL-NAME X) (CL:FIND-PACKAGE (SYMBOL-NAME *PACKAGE*)))) (CL:SETF (CL:GETHASH 'FIND-SYMBOL *BUILTIN-ATOMS*) (CL:FUNCTION FIND-SYMBOL)))
(CL:DEFUN TRE-SYMBOL (X) (CL:INTERN (SYMBOL-NAME X) "TRE"))
(CL:PROGN (CL:DEFUN SH (PROGRAM CL:&REST ARGUMENTS) (SB-EXT:RUN-PROGRAM PROGRAM ARGUMENTS :PTY CL:*STANDARD-OUTPUT*)) (CL:SETF (CL:GETHASH 'SH *BUILTIN-ATOMS*) (CL:FUNCTION SH)))
(CL:PROGN (CL:DEFUN UNIX-SH-CP (FROM TO CL:&KEY (VERBOSE? NIL) (RECURSIVELY? NIL)) (CL:APPLY (CL:FUNCTION SH) "/bin/cp" `(,@(CL:COND (VERBOSE? '("-v"))) ,@(CL:COND (RECURSIVELY? '("-r"))) ,FROM ,TO))) (CL:SETF (CL:GETHASH 'UNIX-SH-CP *BUILTIN-ATOMS*) (CL:FUNCTION UNIX-SH-CP)))
(CL:PROGN (CL:DEFUN UNIX-SH-MKDIR (PATHNAME CL:&KEY (PARENTS NIL)) (CL:APPLY (CL:FUNCTION SH) "/bin/mkdir" `(,@(CL:COND (PARENTS '("-p"))) ,PATHNAME))) (CL:SETF (CL:GETHASH 'UNIX-SH-MKDIR *BUILTIN-ATOMS*) (CL:FUNCTION UNIX-SH-MKDIR)))
(CL:PROGN (CL:DEFUN UNIX-SH-RM (X CL:&KEY (VERBOSE? NIL) (RECURSIVELY? NIL) (FORCE? NIL)) (CL:APPLY (CL:FUNCTION SH) "/bin/rm" `(,@(CL:COND (VERBOSE? '("-v"))) ,@(CL:COND (RECURSIVELY? '("-r"))) ,@(CL:COND (FORCE? '("-f"))) ,X))) (CL:SETF (CL:GETHASH 'UNIX-SH-RM *BUILTIN-ATOMS*) (CL:FUNCTION UNIX-SH-RM)))
(CL:PROGN (CL:DEFUN NANOTIME NIL 0) (CL:SETF (CL:GETHASH 'NANOTIME *BUILTIN-ATOMS*) (CL:FUNCTION NANOTIME)))
(CL:PROGN (CL:DEFUN CONS? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CONSP) X)) (CL:SETF (CL:GETHASH 'CONS? *BUILTIN-ATOMS*) (CL:FUNCTION CONS?)))
(CL:PROGN (CL:DEFUN SYMBOL? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:SYMBOLP) X)) (CL:SETF (CL:GETHASH 'SYMBOL? *BUILTIN-ATOMS*) (CL:FUNCTION SYMBOL?)))
(CL:PROGN (CL:DEFUN FUNCTION? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:FUNCTIONP) X)) (CL:SETF (CL:GETHASH 'FUNCTION? *BUILTIN-ATOMS*) (CL:FUNCTION FUNCTION?)))
(CL:PROGN (CL:DEFUN STRING? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:STRINGP) X)) (CL:SETF (CL:GETHASH 'STRING? *BUILTIN-ATOMS*) (CL:FUNCTION STRING?)))
(CL:PROGN (CL:DEFUN ARRAY? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:ARRAYP) X)) (CL:SETF (CL:GETHASH 'ARRAY? *BUILTIN-ATOMS*) (CL:FUNCTION ARRAY?)))
(CL:PROGN (CL:DEFUN NUMBER? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:NUMBERP) X)) (CL:SETF (CL:GETHASH 'NUMBER? *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER?)))
(CL:PROGN (CL:DEFUN CHARACTER? (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CHARACTERP) X)) (CL:SETF (CL:GETHASH 'CHARACTER? *BUILTIN-ATOMS*) (CL:FUNCTION CHARACTER?)))
(CL:PROGN (CL:DEFUN INTEGER (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:FLOOR) X)) (CL:SETF (CL:GETHASH 'INTEGER *BUILTIN-ATOMS*) (CL:FUNCTION INTEGER)))
(CL:PROGN (CL:DEFUN %CODE-CHAR (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CODE-CHAR) X)) (CL:SETF (CL:GETHASH '%CODE-CHAR *BUILTIN-ATOMS*) (CL:FUNCTION %CODE-CHAR)))
(CL:PROGN (CL:DEFUN - (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:-) X)) (CL:SETF (CL:GETHASH '- *BUILTIN-ATOMS*) (CL:FUNCTION -)))
(CL:PROGN (CL:DEFUN * (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:*) X)) (CL:SETF (CL:GETHASH '* *BUILTIN-ATOMS*) (CL:FUNCTION *)))
(CL:PROGN (CL:DEFUN / (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:/) X)) (CL:SETF (CL:GETHASH '/ *BUILTIN-ATOMS*) (CL:FUNCTION /)))
(CL:PROGN (CL:DEFUN == (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:=) X)) (CL:SETF (CL:GETHASH '== *BUILTIN-ATOMS*) (CL:FUNCTION ==)))
(CL:PROGN (CL:DEFUN < (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:<) X)) (CL:SETF (CL:GETHASH '< *BUILTIN-ATOMS*) (CL:FUNCTION <)))
(CL:PROGN (CL:DEFUN > (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:>) X)) (CL:SETF (CL:GETHASH '> *BUILTIN-ATOMS*) (CL:FUNCTION >)))
(CL:PROGN (CL:DEFUN <= (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:<=) X)) (CL:SETF (CL:GETHASH '<= *BUILTIN-ATOMS*) (CL:FUNCTION <=)))
(CL:PROGN (CL:DEFUN >= (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:>=) X)) (CL:SETF (CL:GETHASH '>= *BUILTIN-ATOMS*) (CL:FUNCTION >=)))
(CL:PROGN (CL:DEFUN %* (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:*) X)) (CL:SETF (CL:GETHASH '%* *BUILTIN-ATOMS*) (CL:FUNCTION %*)))
(CL:PROGN (CL:DEFUN %/ (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:/) X)) (CL:SETF (CL:GETHASH '%/ *BUILTIN-ATOMS*) (CL:FUNCTION %/)))
(CL:PROGN (CL:DEFUN NUMBER== (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:=) X)) (CL:SETF (CL:GETHASH 'NUMBER== *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER==)))
(CL:PROGN (CL:DEFUN NUMBER+ (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:+) X)) (CL:SETF (CL:GETHASH 'NUMBER+ *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER+)))
(CL:PROGN (CL:DEFUN NUMBER- (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:-) X)) (CL:SETF (CL:GETHASH 'NUMBER- *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER-)))
(CL:PROGN (CL:DEFUN NUMBER* (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:*) X)) (CL:SETF (CL:GETHASH 'NUMBER* *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER*)))
(CL:PROGN (CL:DEFUN NUMBER/ (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:/) X)) (CL:SETF (CL:GETHASH 'NUMBER/ *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER/)))
(CL:PROGN (CL:DEFUN NUMBER< (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:<) X)) (CL:SETF (CL:GETHASH 'NUMBER< *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER<)))
(CL:PROGN (CL:DEFUN NUMBER> (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:>) X)) (CL:SETF (CL:GETHASH 'NUMBER> *BUILTIN-ATOMS*) (CL:FUNCTION NUMBER>)))
(CL:PROGN (CL:DEFUN CHARACTER== (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CHAR=) X)) (CL:SETF (CL:GETHASH 'CHARACTER== *BUILTIN-ATOMS*) (CL:FUNCTION CHARACTER==)))
(CL:PROGN (CL:DEFUN CHARACTER< (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CHAR<) X)) (CL:SETF (CL:GETHASH 'CHARACTER< *BUILTIN-ATOMS*) (CL:FUNCTION CHARACTER<)))
(CL:PROGN (CL:DEFUN CHARACTER> (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:CHAR>) X)) (CL:SETF (CL:GETHASH 'CHARACTER> *BUILTIN-ATOMS*) (CL:FUNCTION CHARACTER>)))
(CL:PROGN (CL:DEFUN POW (CL:&REST X) (CL:APPLY (CL:FUNCTION CL:EXPT) X)) (CL:SETF (CL:GETHASH 'POW *BUILTIN-ATOMS*) (CL:FUNCTION POW)))
(CL:DEFUN RANGE? (X BOTTOM TOP) (CL:BLOCK RANGE? (CL:BLOCK NIL (CL:COND ((>= X BOTTOM) (<= X TOP))))))
(CL:DEFUN INTEGER-CHARS-0 (X) (CL:BLOCK INTEGER-CHARS-0 (CL:BLOCK NIL (CL:LABELS ((~G815 (!) (CL:CONS (NUMBER-DIGIT !) (CL:COND ((<= 10 X) (INTEGER-CHARS-0 (/ (- X !) 10))))))) (~G815 (INTEGER (CL:MOD X 10)))))))
(CL:DEFUN ABS (X) (CL:BLOCK ABS (CL:BLOCK NIL (CL:COND ((< X 0) (- X)) (T X)))))
(CL:DEFUN NUMBER-DIGIT (X) (CL:BLOCK NUMBER-DIGIT (CL:BLOCK NIL (CODE-CHAR (+ X (CL:CHAR-CODE #\0))))))
(CL:DEFUN DIGIT-NUMBER (X) (CL:BLOCK DIGIT-NUMBER (CL:BLOCK NIL (- (CL:CHAR-CODE X) (CL:CHAR-CODE #\0)))))
(CL:DEFUN CHARRANGE? (X START END) (CL:BLOCK CHARRANGE? (CL:BLOCK NIL (RANGE? (CL:CHAR-CODE X) (CL:CHAR-CODE START) (CL:CHAR-CODE END)))))
(CL:DEFUN %NONDECIMAL-DIGIT? (X START BASE) (CL:BLOCK %NONDECIMAL-DIGIT? (CL:BLOCK NIL (CHARRANGE? X START (CODE-CHAR (+ (CL:CHAR-CODE START) (- BASE 10)))))))
(CL:DEFUN NEXT-TABULATOR-COLUMN (COLUMN SIZE) (CL:BLOCK NEXT-TABULATOR-COLUMN (CL:BLOCK NIL (INTEGER (++ (* SIZE (++ (/ (-- COLUMN) SIZE))))))))
(CL:DEFUN =-STREAM-LOCATION-LINE (VAL ARR) (CL:BLOCK =-STREAM-LOCATION-LINE (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 4)))))
(CL:DEFUN =-STREAM-LOCATION-COLUMN (VAL ARR) (CL:BLOCK =-STREAM-LOCATION-COLUMN (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 5)))))
(CL:DEFUN STREAM-LOCATION-TABSIZE (ARR) (CL:BLOCK STREAM-LOCATION-TABSIZE (CL:BLOCK NIL (CL:AREF ARR 6))))
(CL:DEFUN NONDECIMAL-DIGIT? (X CL:&KEY (BASE 10)) (CL:BLOCK NONDECIMAL-DIGIT? (CL:BLOCK NIL (CL:COND ((< 10 BASE) (CL:LABELS ((~G816 (~G63) (CL:COND (~G63 ~G63) (T (%NONDECIMAL-DIGIT? X #\A BASE))))) (~G816 (%NONDECIMAL-DIGIT? X #\a BASE))))))))
(CL:DEFUN DECIMAL-DIGIT? (X) (CL:BLOCK DECIMAL-DIGIT? (CL:BLOCK NIL (CHARRANGE? X #\0 #\9))))
(CL:DEFUN GENERIC-SPLIT (OBJ SEQ CL:&KEY (TEST (CL:FUNCTION EQL)) (INCLUDE? NIL)) (CL:BLOCK GENERIC-SPLIT (CL:BLOCK NIL (CL:COND (SEQ (CL:LABELS ((~G817 (!) (CL:COND (! (CL:CONS (SUBSEQ SEQ 0 (CL:COND (INCLUDE? (++ !)) (T !))) (GENERIC-SPLIT OBJ (SUBSEQ SEQ (++ !)) :TEST TEST :INCLUDE? INCLUDE?))) (T (CL:LIST SEQ))))) (~G817 (POSITION OBJ SEQ :TEST TEST))))))))
(CL:DEFUN LOWER-CASE? (CL:&REST ~G47) (CL:BLOCK LOWER-CASE? (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G818 (~G51) (CL:LABELS ((~G819 (C) (CL:TAGBODY ~G49 (CL:COND ((NOT ~G51) (CL:GO ~G50))) (CL:SETQ C (CL:CAR ~G51)) (CL:LABELS ((~G820 (~G48) (CL:COND (~G48 ~G48) (T (CL:RETURN-FROM NIL NIL))))) (~G820 (CHARRANGE? C #\a #\z))) (CL:SETQ ~G51 (CL:CDR ~G51)) (CL:GO ~G49) ~G50 (CL:RETURN-FROM NIL (CL:PROGN T))))) (~G819 NIL)))) (~G818 ~G47))))))
(CL:DEFUN CHARACTER<= (CL:&REST X) (CL:BLOCK CHARACTER<= (CL:BLOCK NIL (CL:APPLY (CL:FUNCTION <=) (CL:MAPCAR (CL:FUNCTION CL:CHAR-CODE) X)))))
(CL:DEFUN CHARACTER>= (CL:&REST X) (CL:BLOCK CHARACTER>= (CL:BLOCK NIL (CL:APPLY (CL:FUNCTION >=) (CL:MAPCAR (CL:FUNCTION CL:CHAR-CODE) X)))))
(CL:DEFUN SPECIAL-CHAR? (X) (CL:BLOCK SPECIAL-CHAR? (CL:BLOCK NIL (CL:LABELS ((~G821 (~G234) (CL:COND (~G234 ~G234) (T (CL:LABELS ((~G822 (~G235) (CL:COND (~G235 ~G235) (T (CL:LABELS ((~G823 (~G236) (CL:COND (~G236 ~G236) (T (CL:LABELS ((~G824 (~G237) (CL:COND (~G237 ~G237) (T (CL:LABELS ((~G825 (~G238) (CL:COND (~G238 ~G238) (T (CL:LABELS ((~G826 (~G239) (CL:COND (~G239 ~G239) (T (CL:LABELS ((~G827 (~G240) (CL:COND (~G240 ~G240) (T (CL:LABELS ((~G828 (~G241) (CL:COND (~G241 ~G241) (T (CL:LABELS ((~G829 (~G242) (CL:COND (~G242 ~G242) (T (CL:LABELS ((~G830 (~G243) (CL:COND (~G243 ~G243) (T (CL:LABELS ((~G831 (~G244) (CL:COND (~G244 ~G244) (T (CL:LABELS ((~G832 (~G245) (CL:COND (~G245 ~G245) (T (CL:LABELS ((~G833 (~G246) (CL:COND (~G246 ~G246) (T (EQL X #\^))))) (~G833 (EQL X #\#))))))) (~G832 (EQL X #\;))))))) (~G831 (EQL X #\:))))))) (~G830 (EQL X #\,))))))) (~G829 (EQL X #\`))))))) (~G828 (EQL X #\'))))))) (~G827 (EQL X #\"))))))) (~G826 (EQL X #\}))))))) (~G825 (EQL X #\{))))))) (~G824 (EQL X #\]))))))) (~G823 (EQL X #\[))))))) (~G822 (EQL X #\)))))))) (~G821 (EQL X #\())))))
(CL:DEFUN READ-INTEGER-0 (STR V) (CL:BLOCK READ-INTEGER-0 (CL:BLOCK NIL (CL:COND ((PEEK-DIGIT STR) (READ-INTEGER-0 STR (+ (* V 10) (DIGIT-NUMBER (READ-CHAR STR))))) (T V)))))
(CL:DEFUN PEEK-DIGIT (STR) (CL:BLOCK PEEK-DIGIT (CL:BLOCK NIL (CL:LABELS ((~G834 (!) (CL:COND (! (CL:PROGN (CL:COND ((DIGIT-CHAR? !) !))))))) (~G834 (PEEK-CHAR STR))))))
(CL:DEFUN READ-DECIMAL-PLACES-0 (STR V S) (CL:BLOCK READ-DECIMAL-PLACES-0 (CL:BLOCK NIL (CL:COND ((PEEK-DIGIT STR) (READ-DECIMAL-PLACES-0 STR (+ V (* S (DIGIT-NUMBER (READ-CHAR STR)))) (/ S 10))) (T V)))))
(CL:DEFUN DECIMALS-CHARS (X) (CL:BLOCK DECIMALS-CHARS (CL:BLOCK NIL (CL:LABELS ((~G835 (!) (CL:COND ((< 0 !) (CL:CONS (NUMBER-DIGIT (INTEGER !)) (DECIMALS-CHARS !)))))) (~G835 (CL:MOD (* X 10) 10))))))
(CL:DEFUN INTEGER-CHARS (X) (CL:BLOCK INTEGER-CHARS (CL:BLOCK NIL (REVERSE (INTEGER-CHARS-0 (INTEGER (ABS X)))))))
(CL:DEFUN %FIND-IF-SEQUENCE (PRED SEQ START END FROM-END WITH-INDEX) (CL:BLOCK %FIND-IF-SEQUENCE (CL:BLOCK NIL (CL:COND (SEQ (CL:COND ((< 0 (CL:LENGTH SEQ)) (CL:LABELS ((~G836 (E) (CL:LABELS ((~G837 (S) (CL:COND ((CL:LABELS ((~G838 (~G86) (CL:COND (~G86 ~G86) (T (CL:COND ((< S E) FROM-END)))))) (~G838 (CL:COND ((> S E) (NOT FROM-END))))) (CL:LABELS ((~G839 (~G87) (CL:PROGN (CL:SETQ S E) (CL:SETQ E ~G87)))) (~G839 S)))) (CL:BLOCK NIL (CL:LABELS ((~G840 (I) (CL:TAGBODY ~G88 (CL:COND ((CL:COND (FROM-END (< I E)) (T (> I E))) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:LABELS ((~G841 (!) (CL:COND ((CL:APPLY PRED (CL:CONS ! (CL:COND (WITH-INDEX (CL:LIST I))))) (CL:RETURN-FROM NIL !))))) (~G841 (ELT SEQ I))) (CL:SETQ I (CL:COND (FROM-END (-- I)) (T (++ I)))) (CL:GO ~G88)))) (~G840 S))))) (~G837 (CL:LABELS ((~G842 (~G85) (CL:COND (~G85 ~G85) (T 0)))) (~G842 START)))))) (~G836 (CL:LABELS ((~G843 (~G84) (CL:COND (~G84 ~G84) (T (-- (CL:LENGTH SEQ)))))) (~G843 END)))))))))))
(CL:DEFUN %FIND-IF-LIST (PRED SEQ FROM-END WITH-INDEX) (CL:BLOCK %FIND-IF-LIST (CL:BLOCK NIL (CL:LABELS ((~G844 (!) (CL:COND (WITH-INDEX (CL:LABELS ((~G845 (IDX) (CL:BLOCK NIL (CL:LABELS ((~G846 (~G83) (CL:LABELS ((~G847 (I) (CL:TAGBODY ~G81 (CL:COND ((NOT ~G83) (CL:GO ~G82))) (CL:SETQ I (CL:CAR ~G83)) (CL:COND ((FUNCALL PRED I IDX) (CL:RETURN-FROM NIL I))) (CL:PROGN (CL:SETQ IDX (NUMBER+ IDX 1))) (CL:SETQ ~G83 (CL:CDR ~G83)) (CL:GO ~G81) ~G82 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G847 NIL)))) (~G846 !))))) (~G845 0))) (T (CL:BLOCK NIL (CL:LABELS ((~G848 (~G80) (CL:LABELS ((~G849 (I) (CL:TAGBODY ~G78 (CL:COND ((NOT ~G80) (CL:GO ~G79))) (CL:SETQ I (CL:CAR ~G80)) (CL:COND ((FUNCALL PRED I) (CL:RETURN-FROM NIL I))) (CL:SETQ ~G80 (CL:CDR ~G80)) (CL:GO ~G78) ~G79 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G849 NIL)))) (~G848 !))))))) (~G844 (CL:COND (FROM-END (REVERSE SEQ)) (T SEQ)))))))
(CL:DEFUN REVERSE (LST) (CL:BLOCK REVERSE (CL:BLOCK NIL (CL:LABELS ((~G850 (!) (CL:BLOCK NIL (CL:LABELS ((~G851 (~G21) (CL:LABELS ((~G852 (I) (CL:TAGBODY ~G19 (CL:COND ((NOT ~G21) (CL:GO ~G20))) (CL:SETQ I (CL:CAR ~G21)) (CL:PROGN (CL:SETQ ! (CL:CONS I !))) (CL:SETQ ~G21 (CL:CDR ~G21)) (CL:GO ~G19) ~G20 (CL:RETURN-FROM NIL (CL:PROGN !))))) (~G852 NIL)))) (~G851 LST))))) (~G850 NIL)))))
(CL:DEFUN %NCONC-0 (LSTS) (CL:BLOCK %NCONC-0 (CL:BLOCK NIL (CL:COND (LSTS (CL:PROGN (CL:LABELS ((~G853 (!) (CL:COND (! (CL:PROGN (CL:RPLACD (CL:LAST !) (%NCONC-0 (CL:CDR LSTS))) !)) (T (%NCONC-0 (CL:CDR LSTS)))))) (~G853 (CL:CAR LSTS)))))))))
(CL:DEFUN =-ELT (VAL SEQ IDX) (CL:BLOCK =-ELT (CL:BLOCK NIL (%SET-ELT VAL SEQ IDX))))
(CL:DEFUN FIND-IF (PRED SEQ CL:&KEY (START NIL) (END NIL) (FROM-END NIL) (WITH-INDEX NIL)) (CL:BLOCK FIND-IF (CL:BLOCK NIL (CL:COND ((NOT (CL:ATOM SEQ) START END) (%FIND-IF-LIST PRED SEQ FROM-END WITH-INDEX)) (T (%FIND-IF-SEQUENCE PRED SEQ START END FROM-END WITH-INDEX))))))
(CL:DEFUN ENQUEUE (X CL:&REST VALS) (CL:BLOCK ENQUEUE (CL:BLOCK NIL (CL:RPLACA X (CL:CDR (CL:RPLACD (CL:LABELS ((~G854 (~G8) (CL:COND (~G8 ~G8) (T X)))) (~G854 (CL:CAR X))) VALS))) VALS)))
(CL:DEFUN QUEUE-POP (X) (CL:BLOCK QUEUE-POP (CL:BLOCK NIL (CL:LABELS ((~G855 (~G9) (CL:COND ((NOT (CL:CDR (CL:CDR X))) (CL:RPLACA X NIL))) (CL:COND ((CL:CDR X) (CL:RPLACD X (CL:CDR (CL:CDR X))))) ~G9)) (~G855 (CL:CAR (CL:CDR X)))))))
(CL:DEFUN PRINC-NUMBER (X STR) (CL:BLOCK PRINC-NUMBER (CL:BLOCK NIL (CL:COND ((< X 0) (PRINC #\- STR))) (STREAM-PRINC (INTEGER-CHARS X) STR) (CL:LABELS ((~G856 (!) (CL:COND ((NOT (ZERO? !)) (CL:PROGN (PRINC #\. STR) (STREAM-PRINC (DECIMALS-CHARS !) STR)))))) (~G856 (CL:MOD X 1))))))
(CL:DEFUN NUMBER-NOT-CHARACTER? (X) (CL:BLOCK NUMBER-NOT-CHARACTER? (CL:BLOCK NIL (CL:COND ((NOT (CHARACTER? X)) (NUMBER? X))))))
(CL:DEFUN READ-DECIMAL-PLACES (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-DECIMAL-PLACES (CL:BLOCK NIL (CL:COND ((CL:LABELS ((~G857 (!) (CL:COND (! (DIGIT-CHAR? !))))) (~G857 (PEEK-CHAR STR))) (READ-DECIMAL-PLACES-0 STR 0 0.1))))))
(CL:DEFUN PEEK-DOT (STR) (CL:BLOCK PEEK-DOT (CL:BLOCK NIL (CL:LABELS ((~G858 (!) (CL:COND (! (CL:PROGN (EQL #\. !)))))) (~G858 (PEEK-CHAR STR))))))
(CL:DEFUN READ-INTEGER (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-INTEGER (CL:BLOCK NIL (CL:COND ((PEEK-DIGIT STR) (INTEGER (READ-INTEGER-0 STR 0)))))))
(CL:DEFUN SYMBOL-CHAR? (X) (CL:BLOCK SYMBOL-CHAR? (CL:BLOCK NIL (CL:COND (X (CL:COND ((> (CL:CHAR-CODE X) 32) (NOT (SPECIAL-CHAR? X)))))))))
(CL:DEFUN HEX-DIGIT-CHAR? (X) (CL:BLOCK HEX-DIGIT-CHAR? (CL:BLOCK NIL (CL:LABELS ((~G859 (~G65) (CL:COND (~G65 ~G65) (T (CL:LABELS ((~G860 (~G66) (CL:COND (~G66 ~G66) (T (CL:COND ((CHARACTER>= X #\a) (CHARACTER<= X #\f))))))) (~G860 (CL:COND ((CHARACTER>= X #\A) (CHARACTER<= X #\F))))))))) (~G859 (DIGIT-CHAR? X))))))
(CL:DEFUN CHAR-UPCASE (C) (CL:BLOCK CHAR-UPCASE (CL:BLOCK NIL (CL:COND ((LOWER-CASE? C) (CODE-CHAR (- (+ (CL:CHAR-CODE C) (CL:CHAR-CODE #\A)) (CL:CHAR-CODE #\a)))) (T C)))))
(CL:DEFUN SPLIT (OBJ SEQ CL:&KEY (TEST (CL:FUNCTION EQL)) (INCLUDE? NIL)) (CL:BLOCK SPLIT (CL:BLOCK NIL (GENERIC-SPLIT OBJ SEQ :TEST TEST :INCLUDE? INCLUDE?))))
(CL:DEFUN STREAM-LOCATION-ID (ARR) (CL:BLOCK STREAM-LOCATION-ID (CL:BLOCK NIL (CL:AREF ARR 3))))
(CL:DEFUN STREAM-LOCATION-LINE (ARR) (CL:BLOCK STREAM-LOCATION-LINE (CL:BLOCK NIL (CL:AREF ARR 4))))
(CL:DEFUN STREAM-INPUT-LOCATION (ARR) (CL:BLOCK STREAM-INPUT-LOCATION (CL:BLOCK NIL (CL:AREF ARR 8))))
(CL:DEFUN READ-SYMBOL (STR) (CL:BLOCK READ-SYMBOL (CL:BLOCK NIL (CL:LABELS ((F NIL (CL:BLOCK NIL (CL:COND ((SYMBOL-CHAR? (PEEK-CHAR STR)) (CL:CONS (CHAR-UPCASE (READ-CHAR STR)) (F))))))) (CL:COND ((NOT (SPECIAL-CHAR? (SEEK-CHAR STR))) (CL:PROGN (F))))))))
(CL:DEFUN EVERY (PRED CL:&REST SEQS) (CL:BLOCK EVERY (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G861 (~G92) (CL:LABELS ((~G862 (SEQ) (CL:TAGBODY ~G90 (CL:COND ((NOT ~G92) (CL:GO ~G91))) (CL:SETQ SEQ (CL:CAR ~G92)) (CL:LABELS ((~G863 (~G93) (CL:BLOCK NIL (CL:LABELS ((~G864 (!) (CL:TAGBODY ~G94 (CL:COND ((== ! ~G93) (CL:RETURN-FROM NIL (CL:PROGN NIL)))) (CL:LABELS ((~G865 (~G89) (CL:COND (~G89 ~G89) (T (CL:RETURN-FROM EVERY NIL))))) (~G865 (FUNCALL PRED (ELT SEQ !)))) (CL:SETQ ! (NUMBER+ 1 !)) (CL:GO ~G94)))) (~G864 0))))) (~G863 (CL:LENGTH SEQ))) (CL:SETQ ~G92 (CL:CDR ~G92)) (CL:GO ~G90) ~G91 (CL:RETURN-FROM NIL (CL:PROGN T))))) (~G862 NIL)))) (~G861 SEQS))))))
(CL:DEFUN DIGIT-CHAR? (C CL:&KEY (BASE 10)) (CL:BLOCK DIGIT-CHAR? (CL:BLOCK NIL (CL:COND ((CHARACTER? C) (CL:LABELS ((~G866 (~G64) (CL:COND (~G64 ~G64) (T (NONDECIMAL-DIGIT? C :BASE BASE))))) (~G866 (DECIMAL-DIGIT? C))))))))
(CL:DEFUN QUEUE-LIST (X) (CL:BLOCK QUEUE-LIST (CL:BLOCK NIL (CL:CDR X))))
(CL:DEFUN STREAM-FUN-OUT (ARR) (CL:BLOCK STREAM-FUN-OUT (CL:BLOCK NIL (CL:AREF ARR 4))))
(CL:DEFUN %TRACK-LOCATION (STREAM-LOCATION X) (CL:BLOCK %TRACK-LOCATION (CL:BLOCK NIL (CL:LABELS ((~G867 (STREAM-LOCATION TRACK? ID LINE COLUMN TABSIZE) TRACK? ID LINE COLUMN TABSIZE (CL:COND (TRACK? (CL:PROGN (CL:COND ((STRING? X) (CL:LABELS ((~G868 (~G133) (CL:COND (~G133 (CL:PROGN (CL:LABELS ((~G869 (~G135) (CL:BLOCK NIL (CL:LABELS ((~G870 (~G134) (CL:TAGBODY ~G136 (CL:COND ((== ~G134 ~G135) (CL:RETURN-FROM NIL (CL:PROGN NIL)))) (CL:LABELS ((~G871 (!) (%TRACK-LOCATION STREAM-LOCATION !))) (~G871 (ELT ~G133 ~G134))) (CL:SETQ ~G134 (NUMBER+ 1 ~G134)) (CL:GO ~G136)))) (~G870 0))))) (~G869 (CL:LENGTH ~G133)))))))) (~G868 X))) (T (CL:COND (X (CL:PROGN (CL:COND ((== 10 (CL:CHAR-CODE X)) (CL:PROGN (CL:PROGN (=-STREAM-LOCATION-COLUMN 1 STREAM-LOCATION)) (CL:PROGN (=-STREAM-LOCATION-LINE (NUMBER+ (STREAM-LOCATION-LINE STREAM-LOCATION) 1) STREAM-LOCATION)))) (T (CL:COND ((== 9 (CL:CHAR-CODE X)) (CL:PROGN (=-STREAM-LOCATION-COLUMN (NEXT-TABULATOR-COLUMN COLUMN TABSIZE) STREAM-LOCATION))) ((< 31 (CL:CHAR-CODE X)) (CL:PROGN (=-STREAM-LOCATION-COLUMN (NUMBER+ (STREAM-LOCATION-COLUMN STREAM-LOCATION) 1) STREAM-LOCATION)))))))))))))) X)) (~G867 STREAM-LOCATION (STREAM-LOCATION-TRACK? STREAM-LOCATION) (STREAM-LOCATION-ID STREAM-LOCATION) (STREAM-LOCATION-LINE STREAM-LOCATION) (STREAM-LOCATION-COLUMN STREAM-LOCATION) (STREAM-LOCATION-TABSIZE STREAM-LOCATION))))))
(CL:DEFUN ZERO? (X) (CL:BLOCK ZERO? (CL:BLOCK NIL (CL:COND ((NUMBER? X) (== 0 X))))))
(CL:DEFUN STREAM-LOCATION-COLUMN (ARR) (CL:BLOCK STREAM-LOCATION-COLUMN (CL:BLOCK NIL (CL:AREF ARR 5))))
(CL:DEFUN STREAM-LOCATION-TRACK? (ARR) (CL:BLOCK STREAM-LOCATION-TRACK? (CL:BLOCK NIL (CL:AREF ARR 2))))
(CL:DEFUN STREAM-OUTPUT-LOCATION (ARR) (CL:BLOCK STREAM-OUTPUT-LOCATION (CL:BLOCK NIL (CL:AREF ARR 9))))
(CL:DEFUN FORCE-OUTPUT (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK FORCE-OUTPUT (CL:BLOCK NIL (%FORCE-OUTPUT (STREAM-HANDLE STR)))))
(CL:DEFUN STREAM-PRINC (X STR) (CL:BLOCK STREAM-PRINC (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:BLOCK NIL (CL:LABELS ((~G872 (~G140) (CL:LABELS ((~G873 (I) (CL:TAGBODY ~G138 (CL:COND ((NOT ~G140) (CL:GO ~G139))) (CL:SETQ I (CL:CAR ~G140)) (STREAM-PRINC I STR) (CL:SETQ ~G140 (CL:CDR ~G140)) (CL:GO ~G138) ~G139 (CL:RETURN-FROM NIL (CL:PROGN X))))) (~G873 NIL)))) (~G872 X)))) ((CL:LABELS ((~G874 (~G137) (CL:COND (~G137 ~G137) (T (CHARACTER? X))))) (~G874 (STRING? X))) (CL:COND ((NOT (CL:COND ((STRING? X) (ZERO? (CL:LENGTH X))))) (CL:PROGN (CL:PROGN (=-STREAM-LAST-CHAR (CL:COND ((STRING? X) (ELT X (-- (CL:LENGTH X)))) (T X)) STR)) (%TRACK-LOCATION (STREAM-OUTPUT-LOCATION STR) X) (FUNCALL (STREAM-FUN-OUT STR) X STR))))) (T (FUNCALL (STREAM-FUN-OUT STR) X STR))))))
(CL:DEFUN =-STREAM-USER-DETAIL (VAL ARR) (CL:BLOCK =-STREAM-USER-DETAIL (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 10)))))
(CL:DEFUN MAKE-QUEUE NIL (CL:BLOCK MAKE-QUEUE (CL:BLOCK NIL (CL:CONS NIL NIL))))
(CL:DEFUN QUEUE-STRING (X) (CL:BLOCK QUEUE-STRING (CL:BLOCK NIL (LIST-STRING (QUEUE-LIST X)))))
(CL:DEFUN STREAM-USER-DETAIL (ARR) (CL:BLOCK STREAM-USER-DETAIL (CL:BLOCK NIL (CL:AREF ARR 10))))
(CL:DEFUN VALUES (CL:&REST VALS) (CL:BLOCK VALUES (CL:BLOCK NIL (CL:CONS *VALUES-MAGIC* VALS))))
(CL:DEFUN READ-COMMENT-BLOCK (STR) (CL:BLOCK READ-COMMENT-BLOCK (CL:BLOCK NIL (CL:BLOCK NIL (CL:PROGN (CL:TAGBODY ~G248 (CL:COND ((NOT (NOT (CL:COND ((EQL #\| (READ-CHAR STR)) (EQL #\# (PEEK-CHAR STR)))))) (CL:RETURN-FROM NIL (CL:PROGN (READ-CHAR STR))))) (CL:GO ~G248)))))))
(CL:DEFUN LIST-NUMBER? (X) (CL:BLOCK LIST-NUMBER? (CL:BLOCK NIL (CL:COND ((CL:LABELS ((~G875 (~G249) (CL:COND (~G249 ~G249) (T (DIGIT-CHAR? (CL:CAR X)))))) (~G875 (CL:COND ((CL:CDR X) (CL:LABELS ((~G876 (~G250) (CL:COND (~G250 ~G250) (T (EQL #\. (CL:CAR X)))))) (~G876 (EQL #\- (CL:CAR X)))))))) (CL:COND ((CL:CDR X) (EVERY (CL:LAMBDA (_) (CL:BLOCK NIL (CL:LABELS ((~G877 (~G251) (CL:COND (~G251 ~G251) (T (EQL #\. _))))) (~G877 (DIGIT-CHAR? _))))) (CL:CDR X))) (T T)))))))
(CL:DEFUN READ-SYMBOL-AND-PACKAGE (STR) (CL:BLOCK READ-SYMBOL-AND-PACKAGE (CL:BLOCK NIL (CL:LABELS ((~G878 (!) (CL:COND ((EQL (PEEK-CHAR STR) #\:) (CL:PROGN (READ-CHAR STR) (VALUES (CL:LABELS ((~G879 (~G247) (CL:COND (~G247 ~G247) (T *KEYWORD-PACKAGE*)))) (~G879 (CL:COND (! (LIST-STRING !))))) (READ-SYMBOL STR)))) (T (VALUES NIL !))))) (~G878 (READ-SYMBOL STR))))))
(CL:DEFUN READ-SLOT-VALUE (X) (CL:BLOCK READ-SLOT-VALUE (CL:BLOCK NIL (CL:COND ((NOT X) NIL) ((CL:CDR X) (CL:CONS 'CL:SLOT-VALUE (CL:CONS (READ-SLOT-VALUE (BUTLAST X)) (CL:CONS (CL:CONS 'CL:QUOTE (CL:CONS (MAKE-SYMBOL (CL:CAR (CL:LAST X)) "TRE") NIL)) NIL)))) ((STRING? (CL:CAR X)) (MAKE-SYMBOL (CL:CAR X))) (T (CL:CAR X))))))
(CL:DEFUN READ-CONS (STR) (CL:BLOCK READ-CONS (CL:BLOCK NIL (CL:LABELS ((ERR (_) (CL:BLOCK NIL (CL:LABELS ((~G880 (!) (ERROR "~A at line ~A, column ~A in file ~A." _ (STREAM-LOCATION-LINE !) (STREAM-LOCATION-COLUMN !) (STREAM-LOCATION-ID !)))) (~G880 (STREAM-INPUT-LOCATION STR))))) (F (TOKEN PKG SYM) (CL:COND ((NOT (%READ-CLOSING-BRACKET? TOKEN)) (CL:PROGN (CL:CONS (CL:LABELS ((~G881 (~G260) (CL:COND ((EQL ~G260 :BRACKET-OPEN) (READ-CONS-SLOT STR)) ((EQL ~G260 :SQUARE-BRACKET-OPEN) (CL:CONS 'SQUARE (READ-CONS-SLOT STR))) ((EQL ~G260 :CURLY-BRACKET-OPEN) (CL:CONS 'CURLY (READ-CONS-SLOT STR))) (T (CL:COND ((TOKEN-IS-QUOTE? TOKEN) (READ-QUOTE STR TOKEN)) (T (READ-ATOM STR TOKEN PKG SYM))))))) (~G881 TOKEN)) (CL:LABELS ((~G882 (!) (CL:COND (! (CL:LABELS ((~G883 (~G262) (CL:LABELS ((~G884 (~G263) (CL:LABELS ((~G885 (TOKEN) (CL:LABELS ((~G886 (~G264) (CL:LABELS ((~G887 (PKG) (CL:LABELS ((~G888 (~G265) (CL:LABELS ((~G889 (SYM) (CL:COND ((EQ :DOT TOKEN) (CL:LABELS ((~G890 (X) (CL:LABELS ((~G891 (~G267) (CL:LABELS ((~G892 (~G268) (CL:LABELS ((~G893 (TOKEN) (CL:LABELS ((~G894 (~G269) (CL:LABELS ((~G895 (PKG) (CL:LABELS ((~G896 (~G270) (CL:LABELS ((~G897 (SYM) (CL:LABELS ((~G898 (~G261) (CL:COND (~G261 ~G261) (T (ERR "Only one value allowed after dotted cons"))))) (~G898 (%READ-CLOSING-BRACKET? TOKEN))) X)) (~G897 (CL:CAR ~G270))))) (~G896 (CL:CDR ~G269))))) (~G895 (CL:CAR ~G269))))) (~G894 (CL:CDR ~G268))))) (~G893 (CL:CAR ~G268))))) (~G892 (CL:CDR ~G267))))) (~G891 (READ-TOKEN STR))))) (~G890 (READ-EXPR STR)))) (T (F TOKEN PKG SYM))))) (~G889 (CL:CAR ~G265))))) (~G888 (CL:CDR ~G264))))) (~G887 (CL:CAR ~G264))))) (~G886 (CL:CDR ~G263))))) (~G885 (CL:CAR ~G263))))) (~G884 (CL:CDR ~G262))))) (~G883 !))) (T (ERR "Closing bracket missing"))))) (~G882 (READ-TOKEN STR))))))))) (CL:LABELS ((~G899 (~G272) (CL:LABELS ((~G900 (~G273) (CL:LABELS ((~G901 (TOKEN) (CL:LABELS ((~G902 (~G274) (CL:LABELS ((~G903 (PKG) (CL:LABELS ((~G904 (~G275) (CL:LABELS ((~G905 (SYM) (CL:COND ((EQ TOKEN :DOT) (CL:CONS 'CL:CONS (READ-CONS STR))) (T (F TOKEN PKG SYM))))) (~G905 (CL:CAR ~G275))))) (~G904 (CL:CDR ~G274))))) (~G903 (CL:CAR ~G274))))) (~G902 (CL:CDR ~G273))))) (~G901 (CL:CAR ~G273))))) (~G900 (CL:CDR ~G272))))) (~G899 (READ-TOKEN STR)))))))
(CL:DEFUN %READ-CLOSING-BRACKET? (X) (CL:BLOCK %READ-CLOSING-BRACKET? (CL:BLOCK NIL (CL:LABELS ((~G906 (~G232) (CL:COND (~G232 ~G232) (T (CL:LABELS ((~G907 (~G233) (CL:COND (~G233 ~G233) (T (EQL X :CURLY-BRACKET-CLOSE))))) (~G907 (EQL X :SQUARE-BRACKET-CLOSE))))))) (~G906 (EQL X :BRACKET-CLOSE))))))
(CL:DEFUN READ-SYMBOL-OR-SLOT-VALUE (PKG SYM) (CL:BLOCK READ-SYMBOL-OR-SLOT-VALUE (CL:BLOCK NIL (CL:LABELS ((~G908 (!) (CL:COND ((CL:COND ((CL:CDR !) (CL:COND ((CL:CAR !) (CL:CAR (CL:LAST !)))))) (READ-SLOT-VALUE !)) (T (MAKE-SYMBOL SYM PKG))))) (~G908 (SPLIT #\. SYM))))))
(CL:DEFUN READ-HEX (STR) (CL:BLOCK READ-HEX (CL:BLOCK NIL (CL:LABELS ((REC (V) (CL:LABELS ((~G909 (!) (CL:COND (! (CL:PROGN (READ-CHAR STR) (REC (NUMBER+ (* V 16) (- (CL:CHAR-CODE !) (CL:COND ((DIGIT-CHAR? !) (CL:CHAR-CODE #\0)) (T (- (CL:CHAR-CODE #\A) 10)))))))) (T V)))) (~G909 (CL:COND ((PEEK-CHAR STR) (CL:LABELS ((~G910 (!) (CL:COND ((HEX-DIGIT-CHAR? !) !)))) (~G910 (CHAR-UPCASE (PEEK-CHAR STR)))))))))) (CL:LABELS ((~G911 (~G218) (CL:COND (~G218 ~G218) (T (ERROR "Illegal character '~A' at begin of hexadecimal number." (PEEK-CHAR STR)))))) (~G911 (HEX-DIGIT-CHAR? (PEEK-CHAR STR)))) (CL:LABELS ((~G912 (~G219) (CL:COND ((SYMBOL-CHAR? (PEEK-CHAR STR)) (ERROR "Illegal character '~A' in hexadecimal number." (PEEK-CHAR STR)))) ~G219)) (~G912 (REC 0)))))))
(CL:DEFUN READ-NUMBER (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-NUMBER (CL:BLOCK NIL (* (CL:COND ((EQL #\- (PEEK-CHAR STR)) (CL:PROGN (READ-CHAR STR) -1)) (T 1)) (+ (READ-INTEGER STR) (CL:LABELS ((~G913 (~G220) (CL:COND (~G220 ~G220) (T 0)))) (~G913 (CL:COND ((PEEK-DOT STR) (CL:COND ((READ-CHAR STR) (READ-DECIMAL-PLACES STR))))))))))))
(CL:DEFUN PRINC (X CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK PRINC (CL:BLOCK NIL (CL:LABELS ((~G914 (~G156) (CL:LABELS ((~G915 (S) (CL:LABELS ((~G916 (~G157) (CL:COND (~G156 ~G157) (T (GET-STREAM-STRING S))))) (~G916 (CL:PROGN (CL:COND ((NUMBER-NOT-CHARACTER? X) (PRINC-NUMBER X S)) ((SYMBOL? X) (STREAM-PRINC (SYMBOL-NAME X) S)) (T (STREAM-PRINC X S))) X))))) (~G915 (DEFAULT-STREAM ~G156))))) (~G914 STR)))))
(CL:DEFUN MAKE-STRING-STREAM NIL (CL:BLOCK MAKE-STRING-STREAM (CL:BLOCK NIL (MAKE-STREAM :USER-DETAIL (MAKE-QUEUE) :FUN-IN (CL:LAMBDA (STR) (QUEUE-POP (STREAM-USER-DETAIL STR))) :FUN-OUT (CL:LAMBDA (X STR) (CL:COND ((STRING? X) (CL:LABELS ((~G917 (~G143) (CL:COND (~G143 (CL:PROGN (CL:LABELS ((~G918 (~G145) (CL:BLOCK NIL (CL:LABELS ((~G919 (~G144) (CL:TAGBODY ~G146 (CL:COND ((== ~G144 ~G145) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:LABELS ((~G920 (I) (ENQUEUE (STREAM-USER-DETAIL STR) I))) (~G920 (ELT ~G143 ~G144))) (CL:SETQ ~G144 (NUMBER+ 1 ~G144)) (CL:GO ~G146)))) (~G919 0))))) (~G918 (CL:LENGTH ~G143)))))))) (~G917 X))) (T (ENQUEUE (STREAM-USER-DETAIL STR) X)))) :FUN-EOF (CL:LAMBDA (STR) (NOT (QUEUE-LIST (STREAM-USER-DETAIL STR))))))))
(CL:DEFUN READ-STRING (STR) (CL:BLOCK READ-STRING (CL:BLOCK NIL (CL:LABELS ((F NIL (CL:BLOCK NIL (CL:LABELS ((~G921 (!) (CL:COND ((NOT (EQL ! #\")) (CL:PROGN (CL:CONS (CL:COND ((EQL ! #\\) (READ-CHAR STR)) (T !)) (F))))))) (~G921 (READ-CHAR STR)))))) (LIST-STRING (F))))))
(CL:DEFUN READ-CHAR (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ-CHAR (CL:BLOCK NIL (%TRACK-LOCATION (STREAM-INPUT-LOCATION STR) (READ-CHAR-0 STR)))))
(CL:DEFUN WHITESPACE? (X) (CL:BLOCK WHITESPACE? (CL:BLOCK NIL (CL:COND ((CHARACTER? X) (CL:COND ((< (CL:CHAR-CODE X) 33) (>= (CL:CHAR-CODE X) 0))))))))
(CL:DEFUN SKIP-COMMENT (STR) (CL:BLOCK SKIP-COMMENT (CL:BLOCK NIL (CL:LABELS ((~G922 (!) (CL:COND (! (CL:PROGN (CL:COND ((== (CL:CHAR-CODE !) 10) (SKIP-SPACES STR)) (T (SKIP-COMMENT STR)))))))) (~G922 (READ-CHAR STR))))))
(CL:DEFUN POSITION (OBJ SEQ CL:&KEY (START NIL) (END NIL) (FROM-END NIL) (TEST (CL:FUNCTION EQL))) (CL:BLOCK POSITION (CL:BLOCK NIL (CL:LABELS ((~G923 (!) (FIND-IF (CL:LAMBDA (X I) (CL:COND ((FUNCALL TEST X OBJ) (CL:PROGN (CL:SETQ ! I))))) SEQ :START START :END END :FROM-END FROM-END :WITH-INDEX T) !)) (~G923 NIL)))))
(CL:DEFUN DOT-EXPAND-MAKE-EXPR (WHICH NUM X) (CL:BLOCK DOT-EXPAND-MAKE-EXPR (CL:BLOCK NIL (CL:COND ((< 0 NUM) (CL:CONS WHICH (CL:CONS (DOT-EXPAND-MAKE-EXPR WHICH (-- NUM) X) NIL))) (T X)))))
(CL:DEFUN DOT-EXPAND-TAIL-LENGTH (X CL:&OPTIONAL (NUM 0)) (CL:BLOCK DOT-EXPAND-TAIL-LENGTH (CL:BLOCK NIL (CL:COND ((EQL #\. (CL:CAR (CL:LAST X))) (DOT-EXPAND-TAIL-LENGTH (BUTLAST X) (++ NUM))) (T (VALUES NUM X))))))
(CL:DEFUN DOT-EXPAND-HEAD-LENGTH (X CL:&OPTIONAL (NUM 0)) (CL:BLOCK DOT-EXPAND-HEAD-LENGTH (CL:BLOCK NIL (CL:COND ((EQL #\. (CL:CAR X)) (DOT-EXPAND-HEAD-LENGTH (CL:CDR X) (++ NUM))) (T (VALUES NUM X))))))
(CL:DEFUN %SUBSEQ-SEQUENCE (MAKER SEQ START END) (CL:BLOCK %SUBSEQ-SEQUENCE (CL:BLOCK NIL (CL:COND ((NOT (== START END)) (CL:PROGN (CL:LABELS ((~G924 (!) (CL:COND ((< START !) (CL:PROGN (CL:COND ((>= END !) (CL:PROGN (CL:SETQ END !)))) (CL:LABELS ((~G925 (L) (CL:LABELS ((~G926 (S) (CL:LABELS ((~G927 (~G43) (CL:BLOCK NIL (CL:LABELS ((~G928 (X) (CL:TAGBODY ~G44 (CL:COND ((== X ~G43) (CL:RETURN-FROM NIL (CL:PROGN S)))) (CL:PROGN (=-ELT (ELT SEQ (+ START X)) S X)) (CL:SETQ X (NUMBER+ 1 X)) (CL:GO ~G44)))) (~G928 0))))) (~G927 L)))) (~G926 (FUNCALL MAKER L))))) (~G925 (- END START)))))))) (~G924 (CL:LENGTH SEQ)))))))))
(CL:DEFUN STRING-SUBSEQ (SEQ START CL:&OPTIONAL (END 99999)) (CL:BLOCK STRING-SUBSEQ (CL:BLOCK NIL (CL:COND ((NOT (== START END)) (CL:PROGN (CL:LABELS ((~G929 (!) (CL:COND ((< START !) (CL:PROGN (CL:COND ((>= END !) (CL:PROGN (CL:PROGN (CL:SETQ END !))))) (CL:LABELS ((~G930 (L) (CL:LABELS ((~G931 (S) (CL:LABELS ((~G932 (~G39) (CL:BLOCK NIL (CL:LABELS ((~G933 (X) (CL:TAGBODY ~G40 (CL:COND ((== X ~G39) (CL:RETURN-FROM NIL (CL:PROGN S)))) (CL:PROGN (CL:SETQ S (STRING-CONCAT S (STRING (ELT SEQ (NUMBER+ START X)))))) (CL:SETQ X (NUMBER+ 1 X)) (CL:GO ~G40)))) (~G933 0))))) (~G932 L)))) (~G931 (CL:MAKE-STRING 0))))) (~G930 (- END START)))))))) (~G929 (CL:LENGTH SEQ)))))))))
(CL:DEFUN LIST-SUBSEQ (SEQ START CL:&OPTIONAL (END 999999)) (CL:BLOCK LIST-SUBSEQ (CL:BLOCK NIL (CL:COND ((CL:COND (SEQ (NOT (== START END)))) (CL:PROGN (CL:COND ((> START END) (CL:LABELS ((~G934 (~G41) (CL:PROGN (CL:SETQ START END) (CL:SETQ END ~G41)))) (~G934 START)))) (CL:LABELS ((~G935 (Q) (CL:LABELS ((~G936 (LEN) (CL:LABELS ((~G937 (LST) (CL:BLOCK NIL (CL:PROGN (CL:TAGBODY ~G42 (CL:COND ((NOT (CL:COND (LST (< 0 LEN)))) (CL:RETURN-FROM NIL (CL:PROGN (QUEUE-LIST Q))))) (ENQUEUE Q (CL:CAR LST)) (CL:PROGN (CL:SETQ LEN (- LEN 1))) (CL:PROGN (CL:SETQ LST (CL:CDR LST))) (CL:GO ~G42)))))) (~G937 (CL:NTHCDR START SEQ))))) (~G936 (- END START))))) (~G935 (MAKE-QUEUE)))))))))
(CL:DEFUN %BODY? (X) (CL:BLOCK %BODY? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ '%BODY (CL:CAR X)) X)))))))
(CL:DEFUN %REST? (X) (CL:BLOCK %REST? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ '%REST (CL:CAR X)) X)))))))
(CL:DEFUN KEYWORD? (X) (CL:BLOCK KEYWORD? (CL:BLOCK NIL (CL:COND ((SYMBOL? X) (EQ *KEYWORD-PACKAGE* (SYMBOL-PACKAGE X)))))))
(CL:DEFUN ARGUMENT-NAME? (X) (CL:BLOCK ARGUMENT-NAME? (CL:BLOCK NIL (CL:ATOM X))))
(CL:DEFUN NCONC (CL:&REST LSTS) (CL:BLOCK NCONC (CL:BLOCK NIL (%NCONC-0 LSTS))))
(CL:DEFUN $ (CL:&REST ARGS) (CL:BLOCK $ (CL:BLOCK NIL (MAKE-SYMBOL (CL:APPLY (CL:FUNCTION +) (CL:MAPCAR (CL:FUNCTION STRING) ARGS))))))
(CL:DEFUN ARGDEF-GET-VALUE (DEFS VALS) (CL:BLOCK ARGDEF-GET-VALUE (CL:BLOCK NIL (CL:COND ((CONS? VALS) (CL:CAR VALS)) ((CONS? (CL:CAR DEFS)) (CADR (CL:CAR DEFS))) (T (CL:CAR DEFS))))))
(CL:DEFUN ARGUMENT-KEYWORD? (X) (CL:BLOCK ARGUMENT-KEYWORD? (CL:BLOCK NIL (CL:LABELS ((~G938 (~G165) (CL:COND (~G165 ~G165) (T (CL:LABELS ((~G939 (~G166) (CL:COND (~G166 ~G166) (T (CL:LABELS ((~G940 (~G167) (CL:COND (~G167 ~G167) (T (EQL X 'CL:&KEY))))) (~G940 (EQL X 'CL:&OPTIONAL))))))) (~G939 (EQL X 'CL:&BODY))))))) (~G938 (EQL X 'CL:&REST))))))
(CL:DEFUN ARGDEF-GET-NAME (X) (CL:BLOCK ARGDEF-GET-NAME (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:CAR X)) (T X)))))
(CL:DEFUN MAKE-&KEY-ALIST (DEF) (CL:BLOCK MAKE-&KEY-ALIST (CL:BLOCK NIL (CL:LABELS ((~G941 (KEYS) (CL:LABELS ((MAKE-&KEY-DESCR (_) (CL:BLOCK NIL (CL:COND (_ (CL:PROGN (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR _)) (COPY-DEF-UNTIL-&KEY _)) (T (CL:LABELS ((~G942 (!) (CL:PROGN (CL:SETQ KEYS (CL:CONS (CL:COND ((CONS? !) (CL:CONS (CL:CAR !) (CL:CAR (CL:CDR !)))) (T (CL:CONS ! !))) KEYS))) (MAKE-&KEY-DESCR (CL:CDR _)))) (~G942 (CL:CAR _)))))))))) (COPY-DEF-UNTIL-&KEY (_) (CL:BLOCK NIL (CL:COND (_ (CL:PROGN (CL:COND ((EQ 'CL:&KEY (CL:CAR _)) (MAKE-&KEY-DESCR (CL:CDR _))) (T (CL:CONS (CL:CAR _) (COPY-DEF-UNTIL-&KEY (CL:CDR _))))))))))) (VALUES (COPY-DEF-UNTIL-&KEY DEF) (REVERSE KEYS))))) (~G941 NIL)))))
(CL:DEFVAR *VALUES-MAGIC*)
(CL:DEFUN COPY-HEAD (X SIZE) (CL:BLOCK COPY-HEAD (CL:BLOCK NIL (CL:COND ((CL:COND (X (< 0 SIZE))) (CL:CONS (CL:CAR X) (COPY-HEAD (CL:CDR X) (-- SIZE))))))))
(CL:DEFUN CARLIST (~G105) (CL:BLOCK CARLIST (CL:BLOCK NIL (FILTER (CL:FUNCTION CL:CAR) ~G105))))
(CL:DEFUN ARGUMENT-EXPAND-0 (FUN ADEF ALST APPLY-VALUES? CONCATENATE-SUBLISTS? BREAK-ON-ERRORS?) (CL:BLOCK ARGUMENT-EXPAND-0 (CL:BLOCK NIL (CL:LABELS ((~G943 (~G171) (CL:LABELS ((~G944 (~G172) (CL:LABELS ((~G945 (A) (CL:LABELS ((~G946 (~G173) (CL:LABELS ((~G947 (K) (CL:LABELS ((~G948 (ARGDEFS) (CL:LABELS ((~G949 (KEY-ARGS) (CL:LABELS ((~G950 (NUM) (CL:LABELS ((~G951 (NO-STATIC) (CL:LABELS ((~G952 (REST-ARG) (CL:LABELS ((ERR (MSG ARGS) (CL:COND (BREAK-ON-ERRORS? (CL:RETURN-FROM NIL (ERROR (+ "~L; In argument expansion for ~A: ~A~%" "; Argument definition: ~A~%" "; Given arguments: ~A~%") (SYMBOL-NAME FUN) (CL:APPLY (CL:FUNCTION FORMAT) NIL MSG ARGS) ADEF ALST))) (T 'ERROR))) (EXP-STATIC (DEF VALS) (CL:COND (NO-STATIC (CL:RETURN-FROM NIL (ERR "Static argument definition after ~A." (CL:LIST NO-STATIC))))) (CL:COND (APPLY-VALUES? (CL:COND ((NOT VALS) (CL:RETURN-FROM NIL (ERR "Argument ~A missing." (CL:LIST NUM))))))) (CL:CONS (CL:CONS (ARGDEF-GET-NAME (CL:CAR DEF)) (CL:CAR VALS)) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))) (EXP-OPTIONAL (DEF VALS) (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR DEF)) (CL:RETURN-FROM NIL (ERR "Keyword ~A after &OPTIONAL." (CL:LIST (CL:CAR DEF)))))) (CL:PROGN (CL:SETQ NO-STATIC 'CL:&OPTIONAL)) (CL:CONS (CL:CONS (ARGDEF-GET-NAME (CL:CAR DEF)) (ARGDEF-GET-VALUE DEF VALS)) (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR (CL:CDR DEF))) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS))) ((CL:CDR DEF) (EXP-OPTIONAL (CL:CDR DEF) (CL:CDR VALS))) (T (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))))) (EXP-KEY (DEF VALS) (CL:LABELS ((~G953 (K) (CL:COND (K (CL:LABELS ((~G954 (!) (CL:LABELS ((~G955 (~G170) (CL:COND (~G170 ~G170) (T (CL:RETURN-FROM NIL (ERR "Value of argument ~A missing." (CL:LIST (CL:CAR !)))))))) (~G955 (CL:CDR !))) (CL:RPLACD K (CL:CAR (CL:CDR !))) (EXP-MAIN DEF (CL:CDR (CL:CDR !))))) (~G954 VALS))) (T (EXP-MAIN-NON-KEY DEF VALS))))) (~G953 (ASSOC ($ (CL:CAR VALS)) KEY-ARGS :TEST (CL:FUNCTION EQ))))) (EXP-REST (SYNONYM DEF VALS) (CL:PROGN (CL:SETQ NO-STATIC 'CL:&REST)) (CL:PROGN (CL:SETQ REST-ARG (CL:LIST (CL:CONS (ARGDEF-GET-NAME (CL:CAR (CL:CDR DEF))) (CL:CONS SYNONYM VALS))))) NIL) (EXP-OPTIONAL-REST (DEF VALS) (CL:LABELS ((~G956 (~G168) (CL:COND ((EQ ~G168 'CL:&REST) (EXP-REST '%REST DEF VALS)) ((EQ ~G168 'CL:&BODY) (EXP-REST '%BODY DEF VALS)) ((EQ ~G168 'CL:&OPTIONAL) (EXP-OPTIONAL (CL:CDR DEF) VALS))))) (~G956 (CL:CAR DEF)))) (EXP-SUB (DEF VALS) (CL:COND (NO-STATIC (CL:RETURN-FROM NIL (ERR "Static sublevel argument definition after ~A." (CL:LIST NO-STATIC))))) (CL:COND (APPLY-VALUES? (CL:COND ((CL:ATOM (CL:CAR VALS)) (CL:RETURN-FROM NIL (ERR "Sublist expected for argument ~A." (CL:LIST NUM))))))) (CL:COND (CONCATENATE-SUBLISTS? (NCONC (ARGUMENT-EXPAND-0 FUN (CL:CAR DEF) (CL:CAR VALS) APPLY-VALUES? CONCATENATE-SUBLISTS? BREAK-ON-ERRORS?) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))) (T (CL:CONS (CL:CONS NIL (ARGUMENT-EXPAND-0 FUN (CL:CAR DEF) (CL:CAR VALS) APPLY-VALUES? CONCATENATE-SUBLISTS? BREAK-ON-ERRORS?)) (EXP-MAIN (CL:CDR DEF) (CL:CDR VALS)))))) (EXP-CHECK-TOO-MANY (DEF VALS) (CL:COND ((NOT DEF) (CL:COND (VALS (CL:RETURN-FROM NIL (ERR "Too many arguments. Maximum is ~A, but ~A more given." (CL:LIST (CL:LENGTH ARGDEFS) (CL:LENGTH VALS))))))))) (EXP-MAIN-NON-KEY (DEF VALS) (EXP-CHECK-TOO-MANY DEF VALS) (CL:COND ((ARGUMENT-KEYWORD? (CL:CAR DEF)) (EXP-OPTIONAL-REST DEF VALS)) ((NOT (ARGUMENT-NAME? (CL:CAR DEF))) (EXP-SUB DEF VALS)) (T (EXP-STATIC DEF VALS)))) (EXP-MAIN (DEF VALS) (CL:PROGN (CL:SETQ NUM (NUMBER+ NUM 1))) (CL:COND ((KEYWORD? (CL:CAR VALS)) (EXP-KEY DEF VALS)) (T (CL:LABELS ((~G957 (~G169) (CL:COND (~G169 ~G169) (T (CL:COND (DEF (EXP-MAIN-NON-KEY DEF VALS))))))) (~G957 (EXP-CHECK-TOO-MANY DEF VALS))))))) (CL:LABELS ((~G958 (!) (CL:COND ((EQ ! 'ERROR) !) (T (NCONC ! (NCONC (CL:MAPCAR (CL:LAMBDA (_) (CL:BLOCK NIL (CL:CONS (CL:CAR _) (CL:CONS '%KEY (CL:CDR _))))) KEY-ARGS) REST-ARG)))))) (~G958 (EXP-MAIN ARGDEFS ALST)))))) (~G952 NIL)))) (~G951 NIL)))) (~G950 0)))) (~G949 K)))) (~G948 A)))) (~G947 (CL:CAR ~G173))))) (~G946 (CL:CDR ~G172))))) (~G945 (CL:CAR ~G172))))) (~G944 (CL:CDR ~G171))))) (~G943 (MAKE-&KEY-ALIST ADEF))))))
(CL:DEFUN %KEY? (X) (CL:BLOCK %KEY? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ '%KEY (CL:CAR X)) X)))))))
(CL:DEFUN %REST-OR-%BODY? (X) (CL:BLOCK %REST-OR-%BODY? (CL:BLOCK NIL (CL:LABELS ((~G959 (~G162) (CL:COND (~G162 ~G162) (T (%BODY? X))))) (~G959 (%REST? X))))))
(CL:DEFUN ++ (X) (NUMBER+ X 1))
(CL:DEFUN LIST-SYMBOL (X) (CL:BLOCK LIST-SYMBOL (CL:BLOCK NIL (MAKE-SYMBOL (LIST-STRING X)))))
(CL:DEFUN SUBSEQ (SEQ START CL:&OPTIONAL (END 99999)) (CL:BLOCK SUBSEQ (CL:BLOCK NIL (CL:COND (SEQ (CL:PROGN (CL:COND ((> START END) (CL:LABELS ((~G960 (~G45) (CL:PROGN (CL:SETQ START END) (CL:SETQ END ~G45)))) (~G960 START)))) (CL:LABELS ((~G961 (~G46) (CL:COND ((CONS? ~G46) (LIST-SUBSEQ SEQ START END)) ((STRING? ~G46) (STRING-SUBSEQ SEQ START END)) ((ARRAY? ~G46) (%SUBSEQ-SEQUENCE (CL:FUNCTION MAKE-ARRAY) SEQ START END)) (T (ERROR "Type of ~A not supported." SEQ))))) (~G961 SEQ))))))))
(CL:DEFUN DOT-EXPAND-LIST (X) (CL:BLOCK DOT-EXPAND-LIST (CL:BLOCK NIL (CL:LABELS ((~G962 (~G95) (CL:LABELS ((~G963 (~G96) (CL:LABELS ((~G964 (NUM-CDRS) (CL:LABELS ((~G965 (~G97) (CL:LABELS ((~G966 (WITHOUT-START) (CL:LABELS ((~G967 (~G99) (CL:LABELS ((~G968 (~G100) (CL:LABELS ((~G969 (NUM-CARS) (CL:LABELS ((~G970 (~G101) (CL:LABELS ((~G971 (WITHOUT-END) (DOT-EXPAND-MAKE-EXPR 'CL:CAR NUM-CARS (DOT-EXPAND-MAKE-EXPR 'CL:CDR NUM-CDRS (DOT-EXPAND (LIST-SYMBOL WITHOUT-END)))))) (~G971 (CL:CAR ~G101))))) (~G970 (CL:CDR ~G100))))) (~G969 (CL:CAR ~G100))))) (~G968 (CL:CDR ~G99))))) (~G967 (DOT-EXPAND-TAIL-LENGTH WITHOUT-START))))) (~G966 (CL:CAR ~G97))))) (~G965 (CL:CDR ~G96))))) (~G964 (CL:CAR ~G96))))) (~G963 (CL:CDR ~G95))))) (~G962 (DOT-EXPAND-HEAD-LENGTH X))))))
(CL:DEFUN HAS-DOT-NOTATION? (X) (CL:BLOCK HAS-DOT-NOTATION? (CL:BLOCK NIL (CL:LABELS ((~G972 (SL) (CL:LABELS ((~G973 (~G104) (CL:COND (~G104 ~G104) (T (EQL #\. (CL:CAR (CL:LAST SL))))))) (~G973 (EQL #\. (CL:CAR SL)))))) (~G972 (STRING-LIST (SYMBOL-NAME X)))))))
(CL:DEFUN NO-DOT-NOTATION? (X) (CL:BLOCK NO-DOT-NOTATION? (CL:BLOCK NIL (CL:LABELS ((~G974 (SL) (CL:LABELS ((~G975 (L) (CL:LABELS ((~G976 (P) (CL:LABELS ((~G977 (~G103) (CL:COND (~G103 ~G103) (T (NOT P))))) (~G977 (== 1 L))))) (~G976 (DOT-POSITION SL))))) (~G975 (CL:LENGTH SL))))) (~G974 (STRING-LIST (SYMBOL-NAME X)))))))
(CL:DEFUN DOT-POSITION (X) (CL:BLOCK DOT-POSITION (CL:BLOCK NIL (POSITION #\. X :TEST (CL:FUNCTION CHARACTER==)))))
(CL:DEFUN SKIP-SPACES (STR) (CL:BLOCK SKIP-SPACES (CL:BLOCK NIL (CL:COND ((EQL #\; (PEEK-CHAR STR)) (CL:PROGN (SKIP-COMMENT STR)))) (CL:COND ((WHITESPACE? (PEEK-CHAR STR)) (CL:PROGN (READ-CHAR STR) (SKIP-SPACES STR)))))))
(CL:DEFUN READ-ATOM (STR TOKEN PKG SYM) (CL:BLOCK READ-ATOM (CL:BLOCK NIL (CL:LABELS ((~G978 (~G258) (CL:COND ((EQ ~G258 :DBLQUOTE) (READ-STRING STR)) ((EQ ~G258 :CHAR) (READ-CHAR STR)) ((EQ ~G258 :NUMBER) (CL:LABELS ((~G979 (S) (PRINC SYM S) (READ-NUMBER S))) (~G979 (MAKE-STRING-STREAM)))) ((EQ ~G258 :HEXNUM) (READ-HEX STR)) ((EQ ~G258 :FUNCTION) (CL:CONS 'CL:FUNCTION (CL:CONS (READ-EXPR STR) NIL))) ((EQ ~G258 :SYMBOL) (READ-SYMBOL-OR-SLOT-VALUE PKG SYM)) (T (CL:COND ((%READ-CLOSING-BRACKET? TOKEN) (ERROR "Unexpected closing ~A bracket." (CL:LABELS ((~G980 (~G259) (CL:COND ((EQL ~G259 :BRACKET-CLOSE) "round") ((EQL ~G259 :CURLY-BRACKET-CLOSE) "curly") ((EQL ~G259 :SQUARE-BRACKET-CLOSE) "square")))) (~G980 TOKEN)))) (T (ERROR "Closing bracket missing."))))))) (~G978 TOKEN)))))
(CL:DEFUN READ-QUOTE (STR TOKEN) (CL:BLOCK READ-QUOTE (CL:BLOCK NIL (CL:LIST (MAKE-SYMBOL (SYMBOL-NAME TOKEN)) (READ-EXPR STR)))))
(CL:DEFUN TOKEN-IS-QUOTE? (X) (CL:BLOCK TOKEN-IS-QUOTE? (CL:BLOCK NIL (CL:LABELS ((~G981 (~G228) (CL:COND (~G228 ~G228) (T (CL:LABELS ((~G982 (~G229) (CL:COND (~G229 ~G229) (T (CL:LABELS ((~G983 (~G230) (CL:COND (~G230 ~G230) (T (CL:LABELS ((~G984 (~G231) (CL:COND (~G231 ~G231) (T (EQL X :ACCENT-CIRCONFLEX))))) (~G984 (EQL X :QUASIQUOTE-SPLICE))))))) (~G983 (EQL X :QUASIQUOTE))))))) (~G982 (EQL X :BACKQUOTE))))))) (~G981 (EQL X :QUOTE))))))
(CL:DEFUN READ-CONS-SLOT (STR) (CL:BLOCK READ-CONS-SLOT (CL:BLOCK NIL (CL:LABELS ((~G985 (!) (CL:COND ((EQL #\. (PEEK-CHAR STR)) (CL:PROGN (READ-CHAR STR) (CL:LABELS ((~G986 (~G277) (CL:LABELS ((~G987 (~G278) (CL:LABELS ((~G988 (TOKEN) (CL:LABELS ((~G989 (~G279) (CL:LABELS ((~G990 (PKG) (CL:LABELS ((~G991 (~G280) (CL:LABELS ((~G992 (SYM) (READ-SLOT-VALUE (CL:LIST ! SYM)))) (~G992 (CL:CAR ~G280))))) (~G991 (CL:CDR ~G279))))) (~G990 (CL:CAR ~G279))))) (~G989 (CL:CDR ~G278))))) (~G988 (CL:CAR ~G278))))) (~G987 (CL:CDR ~G277))))) (~G986 (READ-TOKEN STR))))) (T !)))) (~G985 (READ-CONS STR))))))
(CL:DEFUN READ-TOKEN (STR) (CL:BLOCK READ-TOKEN (CL:BLOCK NIL (CL:LABELS ((~G993 (!) (CL:COND (! (CL:PROGN (CL:LABELS ((~G994 (~G254) (CL:LABELS ((~G995 (~G255) (CL:LABELS ((~G996 (PKG) (CL:LABELS ((~G997 (~G256) (CL:LABELS ((~G998 (SYM) (VALUES (CL:COND ((CL:COND (SYM (CL:COND ((NOT (CL:CDR SYM)) (EQL #\. (CL:CAR SYM)))))) :DOT) (T (CL:COND (SYM (CL:COND ((LIST-NUMBER? SYM) :NUMBER) (T :SYMBOL))) (T (CL:LABELS ((~G999 (~G252) (CL:COND ((EQL ~G252 #\() :BRACKET-OPEN) ((EQL ~G252 #\)) :BRACKET-CLOSE) ((EQL ~G252 #\[) :SQUARE-BRACKET-OPEN) ((EQL ~G252 #\]) :SQUARE-BRACKET-CLOSE) ((EQL ~G252 #\{) :CURLY-BRACKET-OPEN) ((EQL ~G252 #\}) :CURLY-BRACKET-CLOSE) ((EQL ~G252 #\') :QUOTE) ((EQL ~G252 #\`) :BACKQUOTE) ((EQL ~G252 #\^) :ACCENT-CIRCONFLEX) ((EQL ~G252 #\") :DBLQUOTE) ((EQL ~G252 #\,) (CL:COND ((EQL #\@ (PEEK-CHAR STR)) (CL:COND ((READ-CHAR STR) :QUASIQUOTE-SPLICE))) (T :QUASIQUOTE))) ((EQL ~G252 #\#) (CL:LABELS ((~G1000 (~G253) (CL:COND ((EQL ~G253 #\\) :CHAR) ((EQL ~G253 #\x) :HEXNUM) ((EQL ~G253 #\') :FUNCTION) ((EQL ~G253 #\|) (READ-COMMENT-BLOCK STR)) (T (ERROR "Invalid character after '#'."))))) (~G1000 (READ-CHAR STR)))) ((EQL ~G252 -1) :EOF)))) (~G999 (READ-CHAR STR))))))) PKG (LIST-STRING SYM)))) (~G998 (CL:CAR ~G256))))) (~G997 (CL:CDR ~G255))))) (~G996 (CL:CAR ~G255))))) (~G995 (CL:CDR ~G254))))) (~G994 !))))))) (~G993 (READ-SYMBOL-AND-PACKAGE STR))))))
(CL:DEFUN =-STREAM-LAST-CHAR (VAL ARR) (CL:BLOCK =-STREAM-LAST-CHAR (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 6)))))
(CL:DEFUN STREAM-FUN-IN (ARR) (CL:BLOCK STREAM-FUN-IN (CL:BLOCK NIL (CL:AREF ARR 3))))
(CL:DEFUN READ-PEEKED-CHAR (STR) (CL:BLOCK READ-PEEKED-CHAR (CL:BLOCK NIL (CL:LABELS ((~G1001 (!) (CL:COND (! (CL:PROGN (CL:PROGN (=-STREAM-PEEKED-CHAR NIL STR)) !))))) (~G1001 (STREAM-PEEKED-CHAR STR))))))
(CL:DEFUN GET-STREAM-STRING (STR) (CL:BLOCK GET-STREAM-STRING (CL:BLOCK NIL (CL:LABELS ((~G1002 (~G147) (CL:PROGN (=-STREAM-USER-DETAIL (MAKE-QUEUE) STR)) ~G147)) (~G1002 (QUEUE-STRING (STREAM-USER-DETAIL STR)))))))
(CL:DEFUN TERPRI (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK TERPRI (CL:BLOCK NIL (CL:LABELS ((~G1003 (~G158) (CL:LABELS ((~G1004 (S) (CL:LABELS ((~G1005 (~G159) (CL:COND (~G158 ~G159) (T (GET-STREAM-STRING S))))) (~G1005 (CL:PROGN (STREAM-PRINC (CODE-CHAR 10) S) (FORCE-OUTPUT S) NIL))))) (~G1004 (DEFAULT-STREAM ~G158))))) (~G1003 STR)))))
(CL:DEFUN FRESH-LINE? (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK FRESH-LINE? (CL:BLOCK NIL (CL:LABELS ((~G1006 (!) (CL:COND ((STREAM-LOCATION-TRACK? !) (== 1 (STREAM-LOCATION-COLUMN !)))))) (~G1006 (STREAM-OUTPUT-LOCATION STR))))))
(CL:DEFUN DEFAULT-STREAM (X) (CL:BLOCK DEFAULT-STREAM (CL:BLOCK NIL (CL:LABELS ((~G1007 (~G141) (CL:COND ((EQL ~G141 NIL) (MAKE-STRING-STREAM)) ((EQL ~G141 T) *STANDARD-OUTPUT*) (T X)))) (~G1007 X)))))
(CL:DEFUN -- (X) (NUMBER- X 1))
(CL:DEFUN MAKE-STREAM (CL:&KEY (HANDLE 'HANDLE) (FUN-IN 'FUN-IN) (FUN-OUT 'FUN-OUT) (FUN-EOF 'FUN-EOF) (LAST-CHAR 'LAST-CHAR) (PEEKED-CHAR 'PEEKED-CHAR) (INPUT-LOCATION 'INPUT-LOCATION) (OUTPUT-LOCATION 'OUTPUT-LOCATION) (USER-DETAIL 'USER-DETAIL)) (CL:BLOCK MAKE-STREAM (CL:BLOCK NIL (CL:LABELS ((~G1008 (~G132) (CL:PROGN (=-AREF 'STRUCT ~G132 0) (=-AREF 'STREAM ~G132 1)) (CL:PROGN (=-AREF (CL:COND ((EQ HANDLE 'HANDLE) NIL) (T HANDLE)) ~G132 2)) (CL:PROGN (=-AREF (CL:COND ((EQ FUN-IN 'FUN-IN) NIL) (T FUN-IN)) ~G132 3)) (CL:PROGN (=-AREF (CL:COND ((EQ FUN-OUT 'FUN-OUT) NIL) (T FUN-OUT)) ~G132 4)) (CL:PROGN (=-AREF (CL:COND ((EQ FUN-EOF 'FUN-EOF) NIL) (T FUN-EOF)) ~G132 5)) (CL:PROGN (=-AREF (CL:COND ((EQ LAST-CHAR 'LAST-CHAR) NIL) (T LAST-CHAR)) ~G132 6)) (CL:PROGN (=-AREF (CL:COND ((EQ PEEKED-CHAR 'PEEKED-CHAR) NIL) (T PEEKED-CHAR)) ~G132 7)) (CL:PROGN (=-AREF (CL:COND ((EQ INPUT-LOCATION 'INPUT-LOCATION) (MAKE-STREAM-LOCATION)) (T INPUT-LOCATION)) ~G132 8)) (CL:PROGN (=-AREF (CL:COND ((EQ OUTPUT-LOCATION 'OUTPUT-LOCATION) (MAKE-STREAM-LOCATION :TRACK? NIL)) (T OUTPUT-LOCATION)) ~G132 9)) (CL:PROGN (=-AREF (CL:COND ((EQ USER-DETAIL 'USER-DETAIL) NIL) (T USER-DETAIL)) ~G132 10)) ~G132)) (~G1008 (MAKE-ARRAY 11))))))
(CL:DEFUN %MACROEXPAND-BACKQUOTE (X) (CL:COND ((CL:ATOM X) X) ((CL:ATOM (CL:CAR X)) (CL:CONS (CL:CAR X) (%MACROEXPAND-BACKQUOTE (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'QUASIQUOTE) (CL:CONS (CL:CONS 'QUASIQUOTE (%MACROEXPAND (CL:CDR (CL:CAR X)))) (%MACROEXPAND-BACKQUOTE (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'QUASIQUOTE-SPLICE) (CL:CONS (CL:CONS 'QUASIQUOTE-SPLICE (%MACROEXPAND (CL:CDR (CL:CAR X)))) (%MACROEXPAND-BACKQUOTE (CL:CDR X)))) (T (CL:CONS (%MACROEXPAND-BACKQUOTE (CL:CAR X)) (%MACROEXPAND-BACKQUOTE (CL:CDR X))))))
(CL:DEFUN MAKE-STANDARD-STREAM NIL (CL:BLOCK MAKE-STANDARD-STREAM (CL:BLOCK NIL (MAKE-STREAM :FUN-IN (CL:LAMBDA (_) (CL:BLOCK NIL (%READ-CHAR NIL))) :FUN-OUT (CL:LAMBDA (C STR) (%PRINC C NIL)) :FUN-EOF (CL:LAMBDA (_) (CL:BLOCK NIL (%FEOF NIL)))))))
(CL:DEFUN GENSYM-NUMBER NIL (CL:SETQ *GENSYM-COUNTER* (+ 1 *GENSYM-COUNTER*)))
(CL:DEFUN MAPCAN (FUNC CL:&REST LISTS) (CL:BLOCK MAPCAN (CL:BLOCK NIL (CL:APPLY (CL:FUNCTION NCONC) (CL:APPLY (CL:FUNCTION CL:MAPCAR) FUNC LISTS)))))
(CL:DEFUN STRING-LIST (X) (CL:BLOCK STRING-LIST (CL:BLOCK NIL (CL:LABELS ((~G1009 (L) (CL:LABELS ((~G1010 (S) (CL:BLOCK NIL (CL:LABELS ((~G1011 (I) (CL:TAGBODY ~G75 (CL:COND ((< I 0) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:PROGN (CL:SETQ S (CL:PROGN (CL:SETQ S (CL:CONS (ELT X I) S))))) (CL:SETQ I (-- I)) (CL:GO ~G75)))) (~G1011 (-- L)))) S)) (~G1010 NIL)))) (~G1009 (CL:LENGTH X))))))
(CL:DEFUN BACKQUOTE? (X) (CL:BLOCK BACKQUOTE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'BACKQUOTE (CL:CAR X)) X)))))))
(CL:DEFUN QUOTE? (X) (CL:BLOCK QUOTE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'CL:QUOTE (CL:CAR X)) X)))))))
(CL:DEFUN QUASIQUOTE-SPLICE? (X) (CL:BLOCK QUASIQUOTE-SPLICE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'QUASIQUOTE-SPLICE (CL:CAR X)) X)))))))
(CL:DEFUN QUASIQUOTE? (X) (CL:BLOCK QUASIQUOTE? (CL:BLOCK NIL (CL:COND ((CONS? X) (CL:COND ((EQ 'QUASIQUOTE (CL:CAR X)) X)))))))
(CL:DEFUN ANY-QUASIQUOTE? (X) (CL:COND ((CONS? X) (CL:COND ((EQ (CL:CAR X) 'QUASIQUOTE) T) ((EQ (CL:CAR X) 'QUASIQUOTE-SPLICE) T)))))
(CL:DEFUN CONSTANT-LITERAL? (X) (CL:BLOCK CONSTANT-LITERAL? (CL:BLOCK NIL (CL:LABELS ((~G1012 (~G400) (CL:COND (~G400 ~G400) (T (CL:LABELS ((~G1013 (~G401) (CL:COND (~G401 ~G401) (T (CL:LABELS ((~G1014 (~G402) (CL:COND (~G402 ~G402) (T (CL:LABELS ((~G1015 (~G403) (CL:COND (~G403 ~G403) (T (CL:LABELS ((~G1016 (~G404) (CL:COND (~G404 ~G404) (T (CL:LABELS ((~G1017 (~G405) (CL:COND (~G405 ~G405) (T (HASH-TABLE? X))))) (~G1017 (ARRAY? X))))))) (~G1016 (STRING? X))))))) (~G1015 (CHARACTER? X))))))) (~G1014 (NUMBER? X))))))) (~G1013 (EQ T X))))))) (~G1012 (NOT X))))))
(CL:DEFUN FRESH-LINE (CL:&OPTIONAL (STR *STANDARD-OUTPUT*)) (CL:BLOCK FRESH-LINE (CL:BLOCK NIL (CL:LABELS ((~G1018 (~G160) (CL:LABELS ((~G1019 (S) (CL:LABELS ((~G1020 (~G161) (CL:COND (~G160 ~G161) (T (GET-STREAM-STRING S))))) (~G1020 (CL:PROGN (CL:COND ((NOT (FRESH-LINE? S)) (CL:PROGN (TERPRI S) T)))))))) (~G1019 (DEFAULT-STREAM ~G160))))) (~G1018 STR)))))
(CL:DEFUN =-STREAM-PEEKED-CHAR (VAL ARR) (CL:BLOCK =-STREAM-PEEKED-CHAR (CL:BLOCK NIL (CL:PROGN (=-AREF VAL ARR 7)))))
(CL:DEFUN READ-CHAR-0 (STR) (CL:BLOCK READ-CHAR-0 (CL:BLOCK NIL (CL:LABELS ((~G1021 (~G216) (CL:COND (~G216 ~G216) (T (CL:PROGN (=-STREAM-LAST-CHAR (FUNCALL (STREAM-FUN-IN STR) STR) STR)))))) (~G1021 (READ-PEEKED-CHAR STR))))))
(CL:DEFUN STREAM-PEEKED-CHAR (ARR) (CL:BLOCK STREAM-PEEKED-CHAR (CL:BLOCK NIL (CL:AREF ARR 7))))
(CL:DEFUN READ-EXPR (STR) (CL:BLOCK READ-EXPR (CL:BLOCK NIL (CL:LABELS ((~G1022 (~G283) (CL:LABELS ((~G1023 (~G284) (CL:LABELS ((~G1024 (TOKEN) (CL:LABELS ((~G1025 (~G285) (CL:LABELS ((~G1026 (PKG) (CL:LABELS ((~G1027 (~G286) (CL:LABELS ((~G1028 (SYM) (CL:LABELS ((~G1029 (~G282) (CL:COND ((EQL ~G282 NIL) NIL) ((EQL ~G282 :EOF) NIL) ((EQL ~G282 :BRACKET-OPEN) (READ-CONS-SLOT STR)) ((EQL ~G282 :SQUARE-BRACKET-OPEN) (CL:CONS 'SQUARE (READ-CONS-SLOT STR))) ((EQL ~G282 :CURLY-BRACKET-OPEN) (CL:CONS 'CURLY (READ-CONS-SLOT STR))) (T (CL:COND ((TOKEN-IS-QUOTE? TOKEN) (READ-QUOTE STR TOKEN)) (T (READ-ATOM STR TOKEN PKG SYM))))))) (~G1029 TOKEN)))) (~G1028 (CL:CAR ~G286))))) (~G1027 (CL:CDR ~G285))))) (~G1026 (CL:CAR ~G285))))) (~G1025 (CL:CDR ~G284))))) (~G1024 (CL:CAR ~G284))))) (~G1023 (CL:CDR ~G283))))) (~G1022 (READ-TOKEN STR))))))
(CL:DEFUN SEEK-CHAR (STR) (CL:BLOCK SEEK-CHAR (CL:BLOCK NIL (SKIP-SPACES STR) (PEEK-CHAR STR))))
(CL:DEFUN DOT-EXPAND-CONV (X) (CL:BLOCK DOT-EXPAND-CONV (CL:BLOCK NIL (CL:LABELS ((~G1030 (SL) (CL:LABELS ((~G1031 (P) (CL:COND ((NO-DOT-NOTATION? X) X) ((HAS-DOT-NOTATION? X) (DOT-EXPAND-LIST SL)) (T (CL:CONS '%SLOT-VALUE (CL:CONS (LIST-SYMBOL (SUBSEQ SL 0 P)) (CL:CONS (DOT-EXPAND-CONV (LIST-SYMBOL (SUBSEQ SL (++ P)))) NIL))))))) (~G1031 (DOT-POSITION SL))))) (~G1030 (STRING-LIST (SYMBOL-NAME X)))))))
(CL:DEFUN %QUASIQUOTE-EXPAND (X) (CL:COND ((CL:ATOM X) X) ((CL:ATOM (CL:CAR X)) (CL:CONS (CL:CAR X) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'CL:QUOTE) (CL:CONS (CL:CAR X) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'BACKQUOTE) (CL:CONS (CL:CAR X) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'QUASIQUOTE) (CL:CONS (EVAL (MACROEXPAND (CL:CAR (CL:CDR (CL:CAR X))))) (%QUASIQUOTE-EXPAND (CL:CDR X)))) ((EQ (CL:CAR (CL:CAR X)) 'QUASIQUOTE-SPLICE) (APPEND (EVAL (MACROEXPAND (CL:CAR (CL:CDR (CL:CAR X))))) (%QUASIQUOTE-EXPAND (CL:CDR X)))) (T (CL:CONS (%QUASIQUOTE-EXPAND (CL:CAR X)) (%QUASIQUOTE-EXPAND (CL:CDR X))))))
(CL:DEFUN MAKE-STREAM-STREAM (CL:&KEY STREAM (INPUT-LOCATION (MAKE-STREAM-LOCATION)) (OUTPUT-LOCATION (MAKE-STREAM-LOCATION))) (CL:BLOCK MAKE-STREAM-STREAM (CL:BLOCK NIL (MAKE-STREAM :HANDLE STREAM :INPUT-LOCATION INPUT-LOCATION :OUTPUT-LOCATION OUTPUT-LOCATION :FUN-IN (CL:LAMBDA (_) (CL:BLOCK NIL (%READ-CHAR (STREAM-HANDLE _)))) :FUN-OUT (CL:LAMBDA (C STR) (%PRINC C (STREAM-HANDLE STR))) :FUN-EOF (CL:LAMBDA (_) (CL:BLOCK NIL (%FEOF (STREAM-HANDLE _))))))))
(CL:DEFUN MAKE-STREAM-LOCATION (CL:&KEY (TRACK? 'TRACK?) (ID 'ID) (LINE 'LINE) (COLUMN 'COLUMN) (TABSIZE 'TABSIZE)) (CL:BLOCK MAKE-STREAM-LOCATION (CL:BLOCK NIL (CL:LABELS ((~G1032 (~G131) (CL:PROGN (=-AREF 'STRUCT ~G131 0) (=-AREF 'STREAM-LOCATION ~G131 1)) (CL:PROGN (=-AREF (CL:COND ((EQ TRACK? 'TRACK?) T) (T TRACK?)) ~G131 2)) (CL:PROGN (=-AREF (CL:COND ((EQ ID 'ID) NIL) (T ID)) ~G131 3)) (CL:PROGN (=-AREF (CL:COND ((EQ LINE 'LINE) 1) (T LINE)) ~G131 4)) (CL:PROGN (=-AREF (CL:COND ((EQ COLUMN 'COLUMN) 1) (T COLUMN)) ~G131 5)) (CL:PROGN (=-AREF (CL:COND ((EQ TABSIZE 'TABSIZE) *DEFAULT-STREAM-TABSIZE*) (T TABSIZE)) ~G131 6)) ~G131)) (~G1032 (MAKE-ARRAY 7))))))
(CL:DEFUN %FOPEN-DIRECTION (DIRECTION) (CL:BLOCK %FOPEN-DIRECTION (CL:BLOCK NIL (CL:LABELS ((~G1033 (~G142) (CL:COND ((EQL ~G142 'INPUT) "r") ((EQL ~G142 'OUTPUT) "w") ((EQL ~G142 'APPEND) "a") (T (ERROR ":DIRECTION isn't specified."))))) (~G1033 DIRECTION)))))
(CL:DEFUN STREAM-HANDLE (ARR) (CL:BLOCK STREAM-HANDLE (CL:BLOCK NIL (CL:AREF ARR 2))))
(CL:DEFUN FUNCALL (FUN CL:&REST ARGS) (CL:BLOCK FUNCALL (CL:BLOCK NIL (CL:APPLY FUN ARGS))))
(CL:DEFUN CDRLIST (~G106) (CL:BLOCK CDRLIST (CL:BLOCK NIL (FILTER (CL:FUNCTION CL:CDR) ~G106))))
(CL:DEFUN ARGUMENT-SYNONYM? (X) (CL:BLOCK ARGUMENT-SYNONYM? (CL:BLOCK NIL (CL:LABELS ((~G1034 (~G163) (CL:COND (~G163 ~G163) (T (%KEY? X))))) (~G1034 (%REST-OR-%BODY? X))))))
(CL:DEFUN %MACROEXPAND-REST (X) (CL:COND ((CL:ATOM X) X) (T (CL:CONS (%MACROEXPAND (CL:CAR X)) (%MACROEXPAND-REST (CL:CDR X))))))
(CL:DEFUN ARGUMENT-EXPAND (FUN DEF VALS CL:&KEY (APPLY-VALUES? T) (CONCATENATE-SUBLISTS? T) (BREAK-ON-ERRORS? T)) (CL:BLOCK ARGUMENT-EXPAND (CL:BLOCK NIL (CL:LABELS ((~G1035 (!) (CL:COND ((CL:LABELS ((~G1036 (~G175) (CL:COND (~G175 ~G175) (T (EQ ! 'ERROR))))) (~G1036 APPLY-VALUES?)) !) (T (CARLIST !))))) (~G1035 (ARGUMENT-EXPAND-0 FUN DEF VALS APPLY-VALUES? CONCATENATE-SUBLISTS? BREAK-ON-ERRORS?))))))
(CL:DEFUN BUTLAST (PLIST) (CL:BLOCK BUTLAST (CL:BLOCK NIL (CL:COND ((CL:CDR PLIST) (CL:CONS (CL:CAR PLIST) (BUTLAST (CL:CDR PLIST))))))))
(CL:DEFUN GROUP (X SIZE) (CL:BLOCK GROUP (CL:BLOCK NIL (CL:COND (X (CL:CONS (COPY-HEAD X SIZE) (GROUP (CL:NTHCDR SIZE X) SIZE)))))))
(CL:DEFVAR *STANDARD-OUTPUT*)
(CL:DEFVAR *GENSYM-COUNTER*)
(CL:DEFUN MAKE-? (BODY) (CL:BLOCK MAKE-? (CL:BLOCK NIL (CL:LABELS ((~G1037 (TESTS) (CL:LABELS ((~G1038 (END) (CL:LABELS ((~G1039 (~G698) (CL:COND (~G698 ~G698) (T (ERROR "Body is missing."))))) (~G1039 BODY)) (CL:CONS 'CL:COND (APPEND (CL:COND ((CL:CDR END) TESTS) (T (+ (BUTLAST TESTS) (CL:LIST (CL:CONS T END))))) NIL)))) (~G1038 (CL:CAR (CL:LAST TESTS)))))) (~G1037 (GROUP BODY 2))))))
(CL:DEFUN ARGUMENT-EXPAND-NAMES (FUN DEF) (CL:BLOCK ARGUMENT-EXPAND-NAMES (CL:BLOCK NIL (ARGUMENT-EXPAND FUN DEF NIL :APPLY-VALUES? NIL))))
(CL:DEFUN %MACROEXPAND (X) (CL:COND ((CL:ATOM X) X) ((CL:APPLY *MACRO?* (CL:LIST X)) (CL:LABELS ((~G1040 (X) (CL:COND ((CONS? X) (CL:CONS (CL:CAR X) (%MACROEXPAND-REST (CL:CDR X)))) (T X)))) (~G1040 (CL:APPLY *MACROCALL* (CL:LIST X))))) ((EQ (CL:CAR X) 'CL:QUOTE) X) ((EQ (CL:CAR X) 'BACKQUOTE) (CL:CONS 'BACKQUOTE (CL:APPLY *MACROEXPAND-BACKQUOTE* (CL:LIST (CL:CDR X))))) ((EQ (CL:CAR X) 'QUASIQUOTE) (CL:CONS 'QUASIQUOTE (%MACROEXPAND (CL:CDR X)))) ((EQ (CL:CAR X) 'QUASIQUOTE-SPLICE) (CL:CONS 'QUASIQUOTE-SPLICE (%MACROEXPAND (CL:CDR X)))) (T (CL:CONS (%MACROEXPAND (CL:CAR X)) (%MACROEXPAND-REST (CL:CDR X))))))
(CL:DEFUN LIST? (X) (CL:COND ((CONS? X) T) (T (NOT X))))
(CL:DEFUN ARGUMENT-EXPAND-VALUES (FUN DEF VALS CL:&KEY (BREAK-ON-ERRORS? T)) (CL:BLOCK ARGUMENT-EXPAND-VALUES (CL:BLOCK NIL (CL:MAPCAR (CL:LAMBDA (_) (CL:BLOCK NIL (CL:COND ((ARGUMENT-SYNONYM? _) (CL:CDR _)) (T _)))) (CDRLIST (ARGUMENT-EXPAND FUN DEF VALS :BREAK-ON-ERRORS? BREAK-ON-ERRORS?))))))
(CL:DEFUN ASSOC (KEY LST CL:&KEY (TEST (CL:FUNCTION EQL))) (CL:BLOCK ASSOC (CL:BLOCK NIL (CL:COND (LST (CL:BLOCK NIL (CL:LABELS ((~G1041 (~G110) (CL:LABELS ((~G1042 (I) (CL:TAGBODY ~G108 (CL:COND ((NOT ~G110) (CL:GO ~G109))) (CL:SETQ I (CL:CAR ~G110)) (CL:COND ((CONS? I) (CL:COND ((FUNCALL TEST KEY (CL:CAR I)) (CL:RETURN-FROM NIL I)))) (T (ERROR "Pair expected instead of ~A." I))) (CL:SETQ ~G110 (CL:CDR ~G110)) (CL:GO ~G108) ~G109 (CL:RETURN-FROM NIL (CL:PROGN))))) (~G1042 NIL)))) (~G1041 LST))))))))
(CL:DEFUN CLOSE (STR) (CL:BLOCK CLOSE (CL:BLOCK NIL (%FCLOSE (STREAM-HANDLE STR)))))
(CL:DEFUN OPEN (PATH CL:&KEY DIRECTION) (CL:BLOCK OPEN (CL:BLOCK NIL (CL:LABELS ((~G1043 (!) (CL:COND (! (MAKE-STREAM-STREAM :STREAM ! :INPUT-LOCATION (MAKE-STREAM-LOCATION :ID PATH))) (T (ERROR "Couldn't open file `~A'." PATH))))) (~G1043 (%FOPEN PATH (%FOPEN-DIRECTION DIRECTION)))))))
(CL:DEFUN QUASIQUOTE-EXPAND (X) (CL:CAR (%QUASIQUOTE-EXPAND (CL:LIST X))))
(CL:DEFUN DOT-EXPAND (X) (CL:BLOCK DOT-EXPAND (CL:BLOCK NIL (CL:COND ((SYMBOL? X) (DOT-EXPAND-CONV X)) ((CONS? X) (CL:CONS (DOT-EXPAND (CL:CAR X)) (DOT-EXPAND (CL:CDR X)))) (T X)))))
(CL:DEFUN READ (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK READ (CL:BLOCK NIL (CL:COND ((SEEK-CHAR STR) (READ-EXPR STR))))))
(CL:DEFUN PEEK-CHAR (CL:&OPTIONAL (STR *STANDARD-INPUT*)) (CL:BLOCK PEEK-CHAR (CL:BLOCK NIL (CL:LABELS ((~G1044 (~G217) (CL:COND (~G217 ~G217) (T (CL:PROGN (=-STREAM-PEEKED-CHAR (READ-CHAR-0 STR) STR)))))) (~G1044 (STREAM-PEEKED-CHAR STR))))))
(CL:DEFUN CADR (LST) (CL:CAR (CL:CDR LST)))
(CL:DEFUN ERROR (MSG CL:&REST ARGS) (CL:BLOCK ERROR (CL:BLOCK NIL (CL:LABELS ((~G1045 (~G301) (CL:PROGN (CL:SETQ *PRINT-AUTOMATIC-NEWLINE?* NIL)) (CL:LABELS ((~G1046 (~G302) (CL:PROGN (CL:SETQ *PRINT-AUTOMATIC-NEWLINE?* ~G301)) ~G302)) (~G1046 (CL:PROGN (FRESH-LINE) (%ERROR (CL:APPLY (CL:FUNCTION FORMAT) NIL MSG ARGS))))))) (~G1045 *PRINT-AUTOMATIC-NEWLINE?*)))))
(CL:DEFUN QUOTE-EXPAND (X) (CL:BLOCK QUOTE-EXPAND (CL:BLOCK NIL (CL:LABELS ((ATOMIC (_) (CL:BLOCK NIL (CL:COND ((CONSTANT-LITERAL? _) _) (T (CL:CONS 'CL:QUOTE (CL:CONS _ NIL)))))) (STATIC (_) (CL:BLOCK NIL (CL:COND ((CL:ATOM _) (ATOMIC _)) (T (CL:CONS 'CL:CONS (CL:CONS (STATIC (CL:CAR _)) (CL:CONS (STATIC (CL:CDR _)) NIL))))))) (QQ (_) (CL:BLOCK NIL (CL:COND ((ANY-QUASIQUOTE? (CADR (CL:CAR _))) (CL:CONS 'CL:CONS (CL:CONS (BACKQ (CADR (CL:CAR _))) (CL:CONS (BACKQ (CL:CDR _)) NIL)))) (T (CL:CONS 'CL:CONS (CL:CONS (CADR (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL))))))) (QQS (_) (CL:BLOCK NIL (CL:COND ((ANY-QUASIQUOTE? (CADR (CL:CAR _))) (ERROR "Illegal ~A as argument to ,@ (QUASIQUOTE-SPLICE)." (CADR (CL:CAR _)))) (T (CL:CONS 'APPEND (CL:CONS (CADR (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL))))))) (BACKQ (_) (CL:BLOCK NIL (CL:COND ((CL:ATOM _) (ATOMIC _)) (T (CL:LABELS ((~G1047 (~G631) (CL:COND ((CL:ATOM ~G631) (CL:CONS 'CL:CONS (CL:CONS (ATOMIC (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL)))) ((QUASIQUOTE? ~G631) (QQ _)) ((QUASIQUOTE-SPLICE? ~G631) (QQS _)) (T (CL:CONS 'CL:CONS (CL:CONS (BACKQ (CL:CAR _)) (CL:CONS (BACKQ (CL:CDR _)) NIL))))))) (~G1047 (CL:CAR _))))))) (DISP (_) (CL:BLOCK NIL (CL:LABELS ((~G1048 (~G632) (CL:COND ((QUOTE? ~G632) (STATIC (CL:CAR (CL:CDR _)))) ((BACKQUOTE? ~G632) (BACKQ (CL:CAR (CL:CDR _)))) (T _)))) (~G1048 _)))) (WALK (_) (CL:BLOCK NIL (CL:COND ((CL:ATOM _) (DISP _)) (T (CL:CONS (WALK (DISP (CL:CAR _))) (WALK (CL:CDR _)))))))) (CL:CAR (WALK (CL:LIST X)))))))
(CL:DEFUN NEUTRALIZE-FORMAT-STRING (X) (CL:BLOCK NEUTRALIZE-FORMAT-STRING (CL:BLOCK NIL (LIST-STRING (MAPCAN (CL:LAMBDA (_) (CL:BLOCK NIL (CL:COND ((EQL _ #\~) (CL:LIST _ _)) (T (CL:LIST _))))) (STRING-LIST X))))))
(CL:DEFUN EQUAL (X Y) (CL:BLOCK EQUAL (CL:BLOCK NIL (CL:COND ((CL:LABELS ((~G1049 (~G7) (CL:COND (~G7 ~G7) (T (CL:ATOM Y))))) (~G1049 (CL:ATOM X))) (EQL X Y)) ((EQUAL (CL:CAR X) (CL:CAR Y)) (EQUAL (CL:CDR X) (CL:CDR Y)))))))
(CL:DEFUN CADAR (LST) (CADR (CL:CAR LST)))
(CL:DEFUN GENSYM NIL (CL:LABELS ((~G1050 (X) (CL:COND ((EQ (SYMBOL-VALUE X) X) (CL:COND ((SYMBOL-FUNCTION X) (GENSYM)) (T X))) (T (GENSYM))))) (~G1050 (MAKE-SYMBOL (STRING-CONCAT *GENSYM-PREFIX* (STRING (GENSYM-NUMBER)))))))
(CL:DEFUN + (CL:&REST X) (CL:LABELS ((~G1051 (A) (CL:COND (A (CL:APPLY (CL:COND ((CONS? A) (CL:FUNCTION APPEND)) ((STRING? A) (CL:FUNCTION STRING-CONCAT)) (T (CL:FUNCTION NUMBER+))) X)) (T (CL:COND ((CL:CDR X) (CL:APPLY (CL:FUNCTION +) (CL:CDR X)))))))) (~G1051 (CL:CAR X))))
(CL:DEFUN MEMBER (ELM LST CL:&KEY (TEST (CL:FUNCTION EQL))) (CL:BLOCK MEMBER (CL:BLOCK NIL (CL:BLOCK NIL (CL:LABELS ((~G1052 (I) (CL:TAGBODY ~G10 (CL:COND ((NOT I) (CL:RETURN-FROM NIL (CL:PROGN)))) (CL:COND ((FUNCALL TEST ELM (CL:CAR I)) (CL:RETURN-FROM MEMBER I))) (CL:SETQ I (CL:CDR I)) (CL:GO ~G10)))) (~G1052 LST))))))
(CL:DEFUN PRINT-DEFINITION (X) (CL:COND (*PRINT-DEFINITIONS?* (CL:APPLY *DEFINITION-PRINTER* (CL:LIST X)))))
(CL:DEFUN IDENTITY (X) X)
(CL:DEFVAR *DEFINITION-PRINTER*)
(CL:DEFVAR *GENSYM-PREFIX*)
(CL:DEFVAR *PRINT-AUTOMATIC-NEWLINE?*)
(CL:DEFVAR *STANDARD-INPUT*)
(CL:DEFVAR *MACROEXPAND-BACKQUOTE*)
(CL:DEFVAR *MACROCALL*)
(CL:DEFVAR *MACRO?*)
(CL:DEFVAR +CL-FUNCTION-IMPORTS+)
"Section DELAYED-EXPRS"
(CL:SETQ *UNIVERSE* NIL)
(CL:SETQ *VARIABLES* NIL)
(CL:SETQ *LAUNCHFILE* NIL)
(CL:SETQ *POINTER-SIZE* 4)
(CL:SETQ *ASSERT?* NIL)
(CL:SETQ *ENDIANESS* NIL)
(CL:SETQ *CPU-TYPE* NIL)
(CL:SETQ *LIBC-PATH* NIL)
(CL:SETQ *RAND-MAX* NIL)
(CL:SETQ *PRINT-DEFINITIONS?* NIL)
(CL:SETQ *DEFAULT-STREAM-TABSIZE* 8)
(CL:SETQ *QUASIQUOTE-EXPAND* NIL)
(CL:SETQ *DOT-EXPAND* NIL)
(CL:SETQ *ENVIRONMENT-PATH* ".")
(CL:SETQ *ENVIRONMENT-FILENAMES* NIL)
(CL:SETQ +ANONYMOUS-FUNCTION-SOURCES?+ NIL)
(CL:SETQ *EVAL* NIL)
(CL:SETQ *FUNCTIONS* NIL)
(CL:SETQ *MACROEXPAND* NIL)
(CL:SETQ *SPECIAL-FORMS* NIL)
(CL:PUSH (CL:CONS (TRE-SYMBOL '%DEFUN-QUIET) (CL:CONS '(NAME ARGS CL:&BODY BODY) (CL:LAMBDA (NAME ARGS BODY) (MAKE-%DEFUN-QUIET NAME ARGS BODY)))) *SPECIAL-FORMS*)
(CL:PUSH (CL:CONS (TRE-SYMBOL '%DEFUN) (CL:CONS '(NAME ARGS CL:&BODY BODY) (CL:LAMBDA (NAME ARGS BODY) (PRINT-DEFINITION `(%DEFUN ,NAME ,ARGS)) (MAKE-%DEFUN-QUIET NAME ARGS BODY)))) *SPECIAL-FORMS*)
(CL:PUSH (CL:CONS (TRE-SYMBOL '%DEFMACRO) (CL:CONS '(NAME ARGS CL:&BODY BODY) (CL:LAMBDA (NAME ARGS BODY) (PRINT-DEFINITION `(%DEFMACRO ,NAME ,ARGS)) `(CL:PUSH (CL:CONS ',NAME (CL:CONS ',(CL:CONS ARGS BODY) (CL:LAMBDA ,(ARGUMENT-EXPAND-NAMES '%DEFMACRO ARGS) ,@BODY))) ,(TRE-SYMBOL '*MACROS*))))) *SPECIAL-FORMS*)
(CL:PUSH (CL:CONS (TRE-SYMBOL '%DEFVAR) (CL:CONS '(NAME CL:&OPTIONAL (INIT NIL)) (CL:LAMBDA (NAME INIT) (PRINT-DEFINITION `(%DEFVAR ,NAME)) `(CL:PROGN (CL:PUSH (CL:CONS ',NAME ',INIT) *VARIABLES*) (CL:DEFVAR ,NAME ,INIT))))) *SPECIAL-FORMS*)
(CL:PUSH (CL:CONS (TRE-SYMBOL '?) (CL:CONS '(CL:&BODY BODY) (CL:LAMBDA (BODY) (MAKE-? BODY)))) *SPECIAL-FORMS*)
(CL:SETQ *KEYWORD-PACKAGE* (CL:FIND-PACKAGE "KEYWORD"))
(CL:SETQ *PACKAGE* NIL)
(CL:SETQ *DEFINITION-PRINTER* (CL:FUNCTION CL:PRINT))
(CL:SETQ *GENSYM-PREFIX* "~G")
(CL:SETQ *PRINT-AUTOMATIC-NEWLINE?* T)
(CL:SETQ *STANDARD-INPUT* (MAKE-STANDARD-STREAM))
(CL:SETQ *MACROEXPAND-BACKQUOTE* (CL:FUNCTION %MACROEXPAND-BACKQUOTE))
(CL:SETQ *MACROCALL* NIL)
(CL:SETQ *MACRO?* NIL)
(CL:SETQ +CL-FUNCTION-IMPORTS+ (CL:CONS 'CL:ATOM (CL:CONS 'CL:APPLY (CL:CONS 'CL:CONS (CL:CONS 'CL:CAR (CL:CONS 'CL:CDR (CL:CONS 'CL:RPLACA (CL:CONS 'CL:RPLACD (CL:CONS 'CL:LIST (CL:CONS 'CL:LAST (CL:CONS 'CL:COPY-LIST (CL:CONS 'CL:NTHCDR (CL:CONS 'CL:NTH (CL:CONS 'CL:MAPCAR (CL:CONS 'CL:LENGTH (CL:CONS 'CL:MAKE-STRING (CL:CONS 'CL:MOD (CL:CONS 'CL:SQRT (CL:CONS 'CL:SIN (CL:CONS 'CL:COS (CL:CONS 'CL:ATAN (CL:CONS 'CL:EXP (CL:CONS 'CL:ROUND (CL:CONS 'CL:FLOOR (CL:CONS 'CL:AREF (CL:CONS 'CL:CHAR-CODE (CL:CONS 'CL:MAKE-PACKAGE (CL:CONS 'CL:PACKAGE-NAME (CL:CONS 'CL:FIND-PACKAGE (CL:CONS 'CL:PRINT (CL:CONS 'CL:BREAK NIL)))))))))))))))))))))))))))))))
(CL:SETQ *STANDARD-OUTPUT* (MAKE-STANDARD-STREAM))
(CL:SETQ *GENSYM-COUNTER* 0)
(CL:SETQ *VALUES-MAGIC* 'VALUES-~G22)
"Section DUMMY"
(cl:in-package :tre)
(cl:format t "Loading environment...\~%")
(env-load "main.lisp")