1;; -*- Lisp -*- vim:filetype=lisp
2;; test the macro functions; chapter 8
3;; -----------------------------------
4
5
6;; 8.1
7;macro-function | defmacro
8
9
10(and (macro-function 'push) T)
11T
12
13(and (macro-function 'member) T)
14NIL
15
16(defmacro arithmetic-if (test neg-form zero-form pos-form)
17  (let ((var (gensym)))
18    `(let ((,var ,test))
19       (cond ((< ,var 0) ,neg-form)
20             ((= ,var 0) ,zero-form)
21             (T ,pos-form)))))
22arithmetic-if
23
24
25(and (macro-function 'arithmetic-if) T)
26T
27
28(setf x 8)
298
30
31(arithmetic-if (- x 4)(- x)(LIST "ZERO") x)
328
33
34
35(setf x 4)
364
37
38(arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
39("ZERO")
40
41(setf x 3)
423
43
44(arithmetic-if (- x 4)(- x)(LIST "ZERO")x)
45-3
46
47(defmacro arithmetic-if (test neg-form &optional zero-form pos-form)
48  (let ((var (gensym)))
49    `(let ((,var ,test))
50       (cond ((< ,var 0) ,neg-form)
51             ((= ,var 0) ,zero-form)
52             (T ,pos-form)))))
53arithmetic-if
54
55(setf x 8)
568
57
58(arithmetic-if (- x 4)(- x))
59nil
60
61(setf x 4)
624
63
64(arithmetic-if (- x 4)(- x))
65NIL
66
67(setf x 3)
683
69
70(arithmetic-if (- x 4)(- x))
71-3
72
73(defmacro halibut ((mouth eye1 eye2)
74                   ((fin1 length1)(fin2 length2))
75                   tail)
76  `(list ,mouth ,eye1 ,eye2 ,fin1 ,length1 ,fin2 ,length2 ,tail))
77halibut
78
79(setf m 'red-mouth
80      eyes '(left-eye . right-eye)
81      f1 '(1 2 3 4 5)
82      f2 '(6 7 8 9 0)
83      my-favorite-tail '(list of all parts of tail))
84(list of all parts of tail)
85
86(halibut (m (car eyes)(cdr eyes))
87         ((f1 (length f1))(f2 (length f2)))
88         my-favorite-tail)
89(RED-MOUTH LEFT-EYE RIGHT-EYE (1 2 3 4 5) 5 (6 7 8 9 0) 5
90(LIST OF ALL PARTS OF TAIL))
91
92;; 8.2
93; macroexpand | macroexpand-1
94
95(ecase 'otherwise
96  (otherwise 4))
974
98
99;; Issue MACRO-FUNCTION-ENVIRONMENT:YES
100(macrolet ((foo (&environment env)
101             (if (macro-function 'bar env)
102                 ''yes
103                 ''no)))
104  (list (foo)
105        (macrolet ((bar () :beep))
106          (foo))))
107(no yes)
108
109(macrolet ((%m (()) :good)) (%m ())) :GOOD
110(macrolet ((%m (()) :good)) (%m 10)) ERROR
111
112;; 3.2.2.1 Compiler Macros
113(define-compiler-macro testp () '(progn 2))
114TESTP
115
116(defun testp () 'B)
117TESTP
118
119(locally (declare (notinline testp))
120  (defun test11 () (testp)))
121TEST11
122
123(test11)
124B
125
126(defun test11 () (testp))
127TEST11
128
129(compile 'test11)
130TEST11
131
132(test11)
1332
134
135(define-compiler-macro testc () ''A)
136testc
137
138(defun testc () 'b)
139testc
140
141(locally (declare (notinline testc))
142  (defun test6 () (testc)))
143test6
144
145(test6)
146B
147
148(defun test6 () (testc))
149test6
150
151(compile 'test6)
152test6
153
154(test6)
155A
156
157(define-compiler-macro testw () ''#(a 3))
158testw
159
160(defun testw () 'b)
161testw
162
163(locally (declare (notinline testw))
164  (defun test9 () (testw)))
165test9
166
167(test9)
168B
169
170(defun test9 () (testw))
171test9
172
173(compile 'test9)
174test9
175
176(test9)
177#(a 3)
178
179(define-compiler-macro testf () '(FUNCTION print))
180testf
181
182(defun testf () 'b)
183testf
184
185(locally (declare (notinline testf))
186  (defun test10 () (testf)))
187test10
188
189(test10)
190B
191
192(defun test10 () (testf))
193test10
194
195(compile 'test10)
196test10
197
198(test10)
199#.#'print
200
201(define-compiler-macro testp () '(progn (print 'a) 2))
202testp
203
204(defun testp () 'b)
205testp
206
207(locally (declare (notinline testp))
208  (defun test11 () (testp)))
209test11
210
211(test11)
212B
213
214(defun test11 () (testp))
215test11
216
217(compile 'test11)
218test11
219
220(test11)
2212
222
223;; https://sourceforge.net/p/clisp/bugs/318/
224(progn
225  (defmacro test12 ()
226    `(let () (eval-when (compile) (print "compiling"))))
227  (define-compiler-macro test12 ()
228    (princ "Optimizing-")
229    '((lambda (x) (princ X)) 123))
230  (with-output-to-string (*standard-output*)
231    (funcall (lambda () (declare (compile)) (test12)))))
232"Optimizing-123"
233
234;; check that declaration processing does not modify code
235(let* ((f '(locally (declare (optimize safety abazonk (debug 20))) (+ 3 4)))
236       (c (copy-tree f)))
237  (list (eval f) (equal f c)))
238(7 T)
239
240(defun test-compiler (lambda-expression &rest args)
241  (let ((ret-i (apply lambda-expression args))
242        (ret-c (apply (compile nil lambda-expression) args)))
243    (list (equal ret-i ret-c) ret-i ret-c)))
244TEST-COMPILER
245
246;; https://sourceforge.net/p/clisp/bugs/109/
247(test-compiler (lambda ()
248                 (block test12
249                   (flet ((test12-o ()
250                            (flet ((test12-i () (return-from test12 nil)))
251                              (test12-i))))
252                     (test12-o)))))
253(T NIL NIL)
254
255;; a crash compiling sbcl, reported by Christophe Rhodes
256;; (Corrupted STACK in #<COMPILED-CLOSURE STEM> at byte 45)
257;; the bug was fixed by bruno in compiler.lisp 1.80
258(progn
259  (defun stem (&key (obj (error "missing OBJ")))
260    (with-open-file (stream obj :direction :output #+(or CMU SBCL)
261                            :if-exists #+(or CMU SBCL) :supersede)
262      (truename stream)))
263  (compile 'stem)
264  (delete-file (stem :obj "lambda-tst-foo-bar-zot"))
265  t)
266t
267
268;; bug in compiled repeated keywords
269;; fixed by sds in compiler.lisp 1.92
270(defparameter x 1)
271x
272
273(defun test-key () (find 1 #(0 1 2 3) :test #'= :test (incf x)))
274test-key
275
276(test-key)
2771
278
279x
2802
281
282(compile 'test-key)
283test-key
284
285(test-key)
2861
287
288x
2893
290
291(destructuring-bind ((a &optional (b 'bee)) one two three)
292    `((alpha) 1 2 3)
293  (list a b three two one))
294(ALPHA BEE 3 2 1)
295
296;; http://article.gmane.org/gmane.lisp.clisp.general:7897
297;; https://sourceforge.net/p/clisp/mailman/message/11011537/
298(defmacro foo (&key ((key var))) `(list ',var))  FOO
299(foo key 42)  (42)
300
301(defun foo (&key ((key var))) `(list ',var))  FOO
302(foo 'key 42)  (list '42)
303
304(fmakunbound 'foo)  FOO
305
306(defmacro m (&key (x x)) `,x)
307m
308
309(m)
3103
311
312(destructuring-bind (&key (x x)) nil x)
3133
314
315(destructuring-bind (&whole (a  . b) c . d) '(1 . 2) (list a b c d))
316(1 2 1 2)
317
318#+(or CLISP CMU SBCL)
319(destructuring-bind (() a b) (list () 2 3) (+ a b))
320#+(or CLISP CMU SBCL) 5
321
322(destructuring-bind (x . y) '(1 . 10) (list x y))
323(1 10)
324
325(macrolet ((%m (&whole (m a b) c d) `'(,m ,a ,b ,c ,d))) (%m 1 2))
326(%M 1 2 1 2)
327
328(macrolet ((%m (&key ((:a (b c)))) `'(,c ,b))) (%m :a (1 2)))
329(2 1)
330
331(macrolet ((%m (&key ((:a (b c)) '(3 4))) `'(,c ,b)))
332  (list (%m :a (1 2)) (%m :a (1 2) :a (10 11)) (%m)))
333((2 1) (2 1) (4 3))
334
335(macrolet ((%m (&key ((:a (b c)) '(3 4) a-p)) `'(,a-p ,c ,b)))
336 (list (%m :a (1 2)) (%m :a (1 2) :a (10 11)) (%m)))
337((T 2 1) (T 2 1) (NIL 4 3))
338
339(macrolet ((%m (&key a b c) `'(,a ,b ,c)))
340  (list (%m :allow-other-keys nil)
341        (%m :a 1 :allow-other-keys nil)
342        (%m :allow-other-keys t)
343        (%m :allow-other-keys t :allow-other-keys nil :foo t)
344        (%m :allow-other-keys t :c 1 :b 2 :a 3)
345        (%m :c 1 :b 2 :a 3 :allow-other-keys t)
346        (%m :allow-other-keys nil :c 1 :b 2 :a 3)))
347((NIL NIL NIL) (1 NIL NIL) (NIL NIL NIL) (NIL NIL NIL) (3 2 1) (3 2 1) (3 2 1))
348
349;;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/fun_macroexpa_acroexpand-1.html>
350(defmacro alpha (x y) `(beta ,x ,y))   ALPHA
351(defmacro beta (x y) `(gamma ,x ,y))   BETA
352(defmacro delta (x y) `(gamma ,x ,y))  DELTA
353(defmacro mexpand (form &environment env)
354  (multiple-value-bind (expansion expanded-p)
355      (macroexpand form env)
356    `(list ',expansion ',expanded-p)))
357MEXPAND
358(defmacro mexpand-1 (form &environment env)
359  (multiple-value-bind (expansion expanded-p)
360      (macroexpand-1 form env)
361    `(list ',expansion ',expanded-p)))
362MEXPAND-1
363(defun fexpand (form &optional env)
364  (multiple-value-list (macroexpand form env)))
365FEXPAND
366(defun fexpand-1 (form &optional env)
367  (multiple-value-list (macroexpand-1 form env)))
368FEXPAND-1
369
370;; Simple examples involving just the global environment
371(fexpand-1 '(alpha a b))
372((BETA A B) T)
373(mexpand-1 (alpha a b))
374((BETA A B) T)
375(fexpand '(alpha a b))
376((GAMMA A B) T)
377(mexpand (alpha a b))
378((GAMMA A B) T)
379(fexpand-1 'not-a-macro)
380(NOT-A-MACRO NIL)
381(mexpand-1 not-a-macro)
382(NOT-A-MACRO NIL)
383(fexpand '(not-a-macro a b))
384((NOT-A-MACRO A B) NIL)
385(mexpand (not-a-macro a b))
386((NOT-A-MACRO A B) NIL)
387
388;; Examples involving lexical environments
389(macrolet ((alpha (x y) `(delta ,x ,y)))
390  (fexpand-1 '(alpha a b)))
391((BETA A B) T)
392(macrolet ((alpha (x y) `(delta ,x ,y)))
393  (mexpand-1 (alpha a b)))
394((DELTA A B) T)
395(macrolet ((alpha (x y) `(delta ,x ,y)))
396  (fexpand '(alpha a b)))
397((GAMMA A B) T)
398(macrolet ((alpha (x y) `(delta ,x ,y)))
399  (mexpand (alpha a b)))
400((GAMMA A B) T)
401(macrolet ((beta (x y) `(epsilon ,x ,y)))
402  (mexpand (alpha a b)))
403((EPSILON A B) T)
404(let ((x (list 1 2 3)))
405  (symbol-macrolet ((a-sm (first x)))
406    (mexpand a-sm)))
407((FIRST X) T)
408(let ((x (list 1 2 3)))
409  (symbol-macrolet ((a-sm (first x)))
410    (fexpand 'a-sm)))
411(A-SM NIL)
412(symbol-macrolet ((b-sm (alpha x y)))
413  (mexpand-1 b-sm))
414((ALPHA X Y) T)
415(symbol-macrolet ((b-sm (alpha x y)))
416  (mexpand b-sm))
417((GAMMA X Y) T)
418(symbol-macrolet ((b-sm (alpha x y))
419                  (a-sm b-sm))
420  (mexpand-1 a-sm))
421(B-SM T)
422(symbol-macrolet ((b-sm (alpha x y))
423                  (a-sm b-sm))
424  (mexpand a-sm))
425((GAMMA X Y) T)
426
427;; Examples of shadowing behavior
428(flet ((beta (x y) (+ x y)))
429  (mexpand (alpha a b)))
430((BETA A B) T)
431(macrolet ((alpha (x y) `(delta ,x ,y)))
432  (flet ((alpha (x y) (+ x y)))
433    (mexpand (alpha a b))))
434((ALPHA A B) NIL)
435(let ((x (list 1 2 3)))
436  (symbol-macrolet ((a-sm (first x)))
437    (let ((a-sm x))
438      (mexpand a-sm))))
439(A-SM NIL)
440
441;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/speope_fletcm_scm_macrolet.html>
442;; The macro-expansion functions defined by macrolet are defined in the
443;; lexical environment in which the macrolet form appears
444(symbol-macrolet ((foo 12))
445  (macrolet ((bar (x) `(+ ,x ,(1+ foo))))
446    (bar 10)))
44723
448
449(symbol-macrolet ((foo 12))
450  (macrolet ((bar (x) (+ x foo)))
451    (bar 10)))
45222
453
454(let ((f (gensym "FUNC-")) (a (gensym "A-")) (b (gensym "B-")))
455  (eval
456   `(defun ,f ()
457      (let ((,a 1) (,b 2))
458        (symbol-macrolet ((,a 5))
459          (symbol-macrolet ((,b ,a)) ,b)))))
460  (funcall f))
4615
462
463;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/sec_3-2-2-3.html> does _not_ force
464;; programs to provide definitions for symbol-macros in the compile-time
465;; environment. If a symbol is a symbol-macro in the run-time environment
466;; only, CLHS 3.2.2.3 requires either an error or to treat the symbol-macro
467;; as absent or as present.
468(let ((f (gensym "FUNC-")) (a (gensym "A-")) (b (gensym "B-")))
469  (eval
470    `(progn
471       (defvar ,a 2)
472       (setq ,b 3)
473       (defun ,f () ,b)
474       (compile ',f)
475       (define-symbol-macro ,b ,a)
476       (,f))))
477; Must return either ERROR or 3 or 2.
4783
479
480;; A symbol-macro can refer to its own symbol-value. (Nothing in CLHS forbids
481;; the use of SYMBOL-VALUE on a symbol defined as symbol-macro.)
482(progn
483  (define-symbol-macro foo137 (symbol-value 'foo137))
484  (setq foo137 73)
485  foo137)
48673
487
488;; Also check that it's possible to iterate over the property-list in
489;; interpreted mode.
490(progn
491  (define-symbol-macro foo138 (error "should not occur"))
492  (dolist (x (symbol-plist 'foo138)) (atom x)))
493NIL
494
495#+clisp
496(progn (define-symbol-macro foo139 1)
497       (appease-cerrors (defvar foo139 t))
498       foo139)
499T
500
501#+clisp
502(progn (define-symbol-macro foo140 1)
503       (appease-cerrors (defconstant foo140 t))
504       foo140)
505T
506
507#+clisp
508(let ((s (make-symbol "FOO141")))
509  (eval `(define-symbol-macro ,s t))
510  (appease-cerrors (import s "KEYWORD"))
511  (eq s (symbol-value s)))
512T
513
514#+clisp
515(progn (defvar foo142 1)
516       (appease-cerrors (define-symbol-macro foo142 t))
517       foo142)
518T
519
520(let ((s (define-symbol-macro foo143 t)))
521  (import s "KEYWORD")
522  (eval s))
523T
524
525;; https://sourceforge.net/p/clisp/bugs/144/
526(defparameter *my-typeof-counter* 0)
527*my-typeof-counter*
528(defmacro my-typeof (place &environment env)
529  (let ((exp-place (macroexpand place env)))
530    (unless (and (consp exp-place) (eq (car exp-place) 'FOREIGN-VALUE))
531      (error "MY-TYPEOF not upon a place: ~S" exp-place))
532    (incf *my-typeof-counter*)
533    (second exp-place)))
534my-typeof
535
536(defmacro with-var ((var fvar) &body body)
537  (let ((fv (gensym (symbol-name var))))
538    `(LET ((,fv ,fvar))
539       (SYMBOL-MACROLET ((,var (FOREIGN-VALUE ,fv)))
540         ,@body))))
541with-var
542
543(with-var (my-var "fake variable") (my-typeof my-var))
544"fake variable"
545
546*my-typeof-counter*
5471
548
549(funcall (lambda ()
550           (declare (compile))
551           (with-var (my-var "fake variable")
552             (my-typeof my-var))))
553"fake variable"
554
555*my-typeof-counter*
5562
557
558;; from Christophe Rhodes <csr21@cam.ac.uk>
559(defmacro my-mac (&optional (x (error "missing arg"))
560                  &key (y (error "missing arg")))
561  `'(,x ,y))
562MY-MAC
563(my-mac 1 :y 10)           (1 10)
564(defmacro my-mac (&key (b t)) (if b 'c 'd)) MY-MAC
565(macroexpand '(my-mac))        C
566(macroexpand '(my-mac :b nil)) D
567(defmacro my-mac (&key (a t b)) `(,a ,b))   MY-MAC
568(macroexpand '(my-mac :a 1))   (1 T)
569(macroexpand '(my-mac))        (T NIL)
570
571;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/mac_defmacro.html>
572(defmacro dm1a (&whole x) `',x) dm1a
573(macroexpand '(dm1a))           '(DM1A)
574
575(defmacro dm1b (&whole x a &optional b) `'(,x ,a ,b)) dm1b
576(macroexpand '(dm1b q))   '((DM1B Q) Q NIL)
577(macroexpand '(dm1b q r)) '((DM1B Q R) Q R)
578
579(defmacro dm2a (&whole form a b) `'(form ,form a ,a b ,b)) dm2a
580(macroexpand '(dm2a x y)) '(FORM (DM2A X Y) A X B Y)
581(dm2a x y)                (FORM (DM2A X Y) A X B Y)
582
583(defmacro incfq (x) `(setq ,x (+ ,x 1)))
584incfq
585
586(defmacro dm2b (&whole form a (&whole b (c . d) &optional (e 5))
587                &body f &environment env)
588  ``(,',form ,,a ,',b ,',(macroexpand c env) ,',d ,',e ,',f))
589dm2b
590(dm2b :x1 (((incfq x2) x3 x4)) x5 x6)
591((DM2B :X1 (((INCFQ X2) X3 X4)) X5 X6) :X1 (((INCFQ X2) X3 X4))
592 (SETQ X2 (+ X2 1)) (X3 X4) 5 (X5 X6))
593
594(let ((x1 5))
595  (macrolet ((segundo (x) `(cadr ,x)))
596    (dm2b x1 (((segundo x2) x3 x4)) x5 x6)))
597((DM2B X1 (((SEGUNDO X2) X3 X4)) X5 X6)
598 5 (((SEGUNDO X2) X3 X4)) (CADR X2) (X3 X4) 5 (X5 X6))
599
600;; -C test
601;; http://article.gmane.org/gmane.lisp.clisp.general/7393
602;; https://sourceforge.net/p/clisp/mailman/message/11010681/
603#+CLISP
604(loop :for a :in
605  (funcall
606   (sys::compile-form-in-toplevel-environment
607    '(list (list #'equal 2 2) (list #'equal 2 3))))
608  :collect (funcall (car a) (cadr a) (caddr a)))
609#+CLISP (T NIL)
610
611#+CLISP
612(progn
613  (defclass t1 () ((foo :accessor foo :initform :foo)))
614  (list
615   (funcall
616    (compile nil (lambda () (typep (make-instance 't1) 't1))))
617   (funcall
618    (sys::compile-form-in-toplevel-environment
619     '(typep (make-instance 't1) 't1)))))
620#+CLISP (T T)
621
622(progn
623  ;; the first definition of NOTINLINE-TEST-FUNC-1 is side-effect-free,
624  ;; so the compiler could have eliminated the call to it in
625  ;; NOTINLINE-TEST-FUNC-2,
626  ;; except that the NOTINLINE declaration should prevent that
627  (declaim (notinline notinline-test-func-1))
628  (defun notinline-test-func-1 (x) x)
629  (compile 'notinline-test-func-1)
630  (defun notinline-test-func-2 (x) (notinline-test-func-1 x) x)
631  (compile 'notinline-test-func-2)
632  (defvar *notinline-test-var* 10)
633  (defun notinline-test-func-1 (x) (incf *notinline-test-var* x))
634  (list (notinline-test-func-2 12) *notinline-test-var*))
635(12 22)
636
637(let ((file "macro8-tst-tmp.lisp"))
638  (with-open-file (o file :direction :output #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
639    (write-line "(defun caller (a b) (foo a b))" o)
640    (write-line "(defun foo (a b c) (list a b c))" o))
641  (unwind-protect
642      (progn
643        (load file #+CLISP :compiling #+CLISP t)
644        (foo 1 2 3))
645    (delete-file file)))
646(1 2 3)
647
648(let ((file1 "macro8-tst-tmp1.lisp") (file2 "macro8-tst-tmp2.lisp"))
649  (with-open-file (o file1 :direction :output
650                     #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
651    (write-line "(defun foo (a b c) (cons b c a))" o)
652    (format o "(load ~S)~%" file2))
653  (with-open-file (o file2 :direction :output
654                     #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
655    (write-line "(defun bar (a b) (sin (1+ a) (1- b a)))" o))
656  (unwind-protect
657      (progn
658        (load file1 #+CLISP :compiling #+CLISP t)
659        (list (not (null (fboundp 'foo))) (not (null (fboundp 'bar)))))
660    (delete-file file1) (delete-file file2)))
661(T T)
662
663;; the following 3 tests are generated
664;; by the random tester in the GCL ANSI CL testsuite
665;; https://sourceforge.net/p/clisp/bugs/175/
666(test-compiler (lambda (a)
667                 (if (and (if a t nil) nil) a (min (block b5 -1) a)))
668               123)
669(T -1 -1)
670
671(test-compiler (lambda (a b c)
672                 (if (or (not (and a nil))
673                         (and (or b (ldb-test (byte 26 31) c)) t))
674                     b b))
675               123 144 532)
676(T 144 144)
677
678(test-compiler (lambda (c)
679                 (if (or (not (if c nil nil))
680                         (and (and (ldb-test (byte 13 25) -707966251)
681                                   (logbitp 5 c))
682                              (ldb-test (byte 13 26) -396394270089)))
683                     513972305 19641756))
684               125)
685(T 513972305 513972305)
686
687;; http://article.gmane.org/gmane.lisp.clisp.devel/10566
688;; https://sourceforge.net/p/clisp/mailman/message/12563174/
689(let ((file "macro8-tst-tmp.lisp"))
690  (with-open-file (out file :direction :output
691                       #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
692    (write '(eval-when (load compile eval)
693             (+ (funcall (compile nil (lambda () (load-time-value (+ 2 3)))))
694              120))
695           :stream out))
696  (unwind-protect (compile-file file)
697    (post-compile-file-cleanup file))
698  nil)
699nil
700
701;; compile-file is allowed to collapse different occurrences of the same
702;; LOAD-TIME-VALUE form, and in fact, CLISP does so.
703(let ((file "macro8-tst-tmp.lisp"))
704  (with-open-file (out file :direction :output
705                       #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
706    (write-string
707     "(defun ltv1 () (eq #1=(load-time-value (cons nil nil)) #1#))" out))
708  (unwind-protect
709      (progn (compile-file file) (load (compile-file-pathname file)))
710    (post-compile-file-cleanup file))
711  (ltv1))
712#+CLISP T #+(or CMU SBCL OpenMCL LISPWORKS) NIL
713#-(or CLISP CMU SBCL OpenMCL LISPWORKS) UNKNOWN
714
715;; compile-file is not allowed to collapse different LOAD-TIME-VALUE forms
716;; even if the inner form is the same.
717(let ((file "macro8-tst-tmp.lisp"))
718  (with-open-file (out file :direction :output
719                       #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
720    (write-string "(defun ltv2 () (eq (load-time-value #1=(cons nil nil)) (load-time-value #1#)))" out))
721  (unwind-protect
722      (progn (compile-file file) (load (compile-file-pathname file)))
723    (post-compile-file-cleanup file))
724  (ltv2))
725NIL
726
727;; compile-file is not allowed to collapse different LOAD-TIME-VALUE forms.
728(let ((file "macro8-tst-tmp.lisp"))
729  (with-open-file (out file :direction :output #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede)
730    (write-string "(defun ltv3 () (eq (load-time-value (cons nil nil)) (load-time-value (cons nil nil))))" out))
731  (unwind-protect
732      (progn (compile-file file) (load (compile-file-pathname file)))
733    (post-compile-file-cleanup file))
734  (ltv3))
735NIL
736
737(FUNCALL
738 (COMPILE NIL (LAMBDA (A) (UNWIND-PROTECT (BLOCK B2 (RETURN-FROM B2 A)))))
739 77759)
74077759
741
742;; COMPILER-DIAGNOSTICS:USE-HANDLER:
743;; COMPILE-FILE must notice the warnings signaled by EVAL-WHEN
744(let ((file "macro8-tst-warn.lisp"))
745  (with-open-file (out file :direction :output)
746    (write '(eval-when (:compile-toplevel)
747             (define-condition test-warning-compile-file-1 (style-warning) nil)
748             (warn (make-condition 'test-warning-compile-file-1)))
749           :stream out)
750    (terpri out)
751    (write '(eval-when (:compile-toplevel)
752             (define-condition test-warning-compile-file-2 (warning) nil)
753             (warn (make-condition 'test-warning-compile-file-2)))
754           :stream out)
755    (terpri out))
756  (unwind-protect
757       (cdr (multiple-value-list (compile-file file)))
758    (post-compile-file-cleanup file)))
759(2 1)                         ; 2 warnings, 1 of them serious
760
761;; https://sourceforge.net/p/clisp/bugs/189/
762(test-compiler
763 (lambda ()
764   (labels ((%f17 (f17-1 f17-2)
765              (multiple-value-prog1 f17-1 f17-2 100 (return-from %f17 12))))
766     (%f17 1 2))))
767(T 12 12)
768
769(test-compiler (lambda (a)
770                 (block b6 (multiple-value-prog1 a (return-from b6 100))))
771               :wrong)
772(T 100 100)
773
774(test-compiler (lambda ()
775                 (block b3
776                   (return-from b3 (multiple-value-prog1 10
777                                     (return-from b3 100))))))
778(T 100 100)
779
780;; https://sourceforge.net/p/clisp/bugs/182/
781(test-compiler
782 (LAMBDA (A B)
783   (UNWIND-PROTECT
784        (BLOCK B2
785          (FLET ((%F1 NIL B))
786            (LOGIOR (IF A (IF (LDB-TEST (BYTE 23 1) 253966182)
787                              (RETURN-FROM B2 A) -103275090)
788                        62410)
789                    (IF (NOT (NOT (IF (NOT NIL) T
790                                      (LDB-TEST (BYTE 2 27)
791                                                253671809))))
792                        (RETURN-FROM B2 -22)
793                        (%F1)))))
794     (setq a (+ a b))))
795 777595384624 -1510893868)
796(T 777595384624 777595384624)
797
798;; https://sourceforge.net/p/clisp/bugs/183/
799(test-compiler
800 (LAMBDA (A C)
801   (FLET ((%F10 () 10))
802     (FLET ((%F4 (&OPTIONAL
803                  (F4-1 (SETQ C (%F10)))
804                  (F4-2 (SETQ A 0)))
805              (+ F4-1 F4-2)
806              123))
807       (%F4 -5))))
808 13 17)
809(T 123 123)
810
811;; https://sourceforge.net/p/clisp/bugs/181/
812(test-compiler
813 (LAMBDA (A C)
814   (IF (OR (LDB-TEST (BYTE 12 18) A)
815           (NOT (AND T (NOT (IF (NOT (AND C T)) NIL NIL)))))
816       170
817       -110730))
818 123 456)
819(T -110730 -110730)
820
821;; https://sourceforge.net/p/clisp/bugs/190/
822(test-compiler (lambda () (tagbody (flet ((f6 () (go 18))) (f6)) 18)))
823(T NIL NIL)
824
825;; https://sourceforge.net/p/clisp/bugs/191/
826(test-compiler
827 (lambda ()
828   (tagbody (flet ((%f1 (f1-1)
829                     (flet ((%f9 (&optional (f9-1 b) (f9-2 (go tag2))
830                                            (f9-3 0)) 0))
831                       (%f9 0 0 0))))
832              (%f1 0))
833    tag2)))
834(T NIL NIL)
835
836(test-compiler
837 (lambda (x)
838   (tagbody
839     (flet ((foo-1 ()
840              (flet ((foo-2 ()
841                       (flet ((foo-3 ()
842                                (incf x)
843                                (go foo-tag)))
844                         (foo-3))))
845                (foo-2))))
846       (foo-1))
847    foo-tag)
848   x)
849 12)
850(T 13 13)
851
852;; https://sourceforge.net/p/clisp/bugs/193/
853(test-compiler (lambda ()
854                 (let ((*s4* :right))
855                   (declare (special *s4*))
856                   (progv '(*s4*) (list :wrong1) (setq *s4* :wrong2))
857                   *s4*)))
858(T :RIGHT :RIGHT)
859
860(unwind-protect
861     (test-compiler (lambda ()
862                      (setq *print-level* 20)
863                      (nconc
864                       (let ((*print-level* 30) (foo (setq *print-level* 40)))
865                         (list *print-level* foo))
866                       (list *print-level*))))
867  (setq *print-level* nil))     ; restore the value
868(T (30 40 40) (30 40 40))
869
870;; https://sourceforge.net/p/clisp/bugs/197/
871(test-compiler
872 (lambda (d)
873   (gcd 39 (catch 'ct2
874             (block b7
875               (throw 'ct2
876                 (unwind-protect (return-from b7 17)
877                   (return-from b7 (progv '(*s6*) (list 31) d))))))))
878 65)
879(T 13 13)
880
881(test-compiler
882 (lambda (d)
883   (block b7
884     (throw 'ct2
885       (unwind-protect (return-from b7 17)
886         (return-from b7 (progv '(*s6*) (list 31) d))))))
887 65)
888(T 65 65)
889
890;; https://sourceforge.net/p/clisp/bugs/199/
891(test-compiler
892 (lambda (b)
893   (labels ((%f2 ()
894              (let ((v10 (progn (dotimes (iv2 0 0) iv2) b)))
895                (unwind-protect b (labels ((%f6 ())) (%f6))))))
896     (%f2)))
897 :good)
898(T :GOOD :GOOD)
899
900(test-compiler
901 (lambda (b)
902   (let ((v10 (progn (dotimes (iv2 0 0) iv2) b)))
903     (unwind-protect b (labels ((%f6 ())) (%f6)))))
904 :good)
905(T :GOOD :GOOD)
906
907(test-compiler
908 (lambda (b)
909   (let ((v10 (progn (print 321) b)))
910     (unwind-protect b (print 123))))
911 :good)
912(T :GOOD :GOOD)
913
914;; https://sourceforge.net/p/clisp/bugs/250/
915(test-compiler
916 (lambda (a b)
917   (declare (ignorable a b))
918   (declare (optimize (space 3) (debug 0) (safety 1)
919                      (compilation-speed 3) (speed 1)))
920   (prog2
921       (catch 'ct1 (if (or (and t (not (and (and (or a t) nil) nil))) nil)
922                       a
923                       (reduce #'(lambda (lmv5 lmv2) 0) (vector b 0 a))))
924       0))
925 2212755 3154856)
926(T 0 0)
927
928;; https://sourceforge.net/p/clisp/bugs/372/
929(test-compiler
930 (lambda () (labels ((foo () (apply #'bar nil)) (bar ())))))
931(T NIL NIL)
932
933;; https://sourceforge.net/p/clisp/bugs/200/
934(progn (load (merge-pathnames "bug001.lisp" *run-test-truename*)) t)
935T
936(progn (load (merge-pathnames "bug002.lisp" *run-test-truename*)) t)
937T
938
939;; http://clisp.org/impnotes/evaluation.html#defun-accept-spelalist
940#+CLISP
941(let ((f (lambda ((x1 fixnum) (x2 integer) (x3 number) y z)
942           (list x1 x2 x3 y z))))
943  (flet ((g ((x1 fixnum) (x2 integer) (x3 number) y z)
944           (list z y x3 x2 x1)))
945    (list (funcall f 0 1 2 3 4)
946          (funcall (compile nil f) 5 6 7 8 9)
947          (g 'a 'b 'c 'd 'e))))
948#+CLISP
949((0 1 2 3 4) (5 6 7 8 9) (e d c b a))
950
951;; http://article.gmane.org/gmane.lisp.clisp.devel/10566
952;; https://sourceforge.net/p/clisp/mailman/message/12563174/
953(let ((fname "macro8-tst-donc.lisp") (results '()) compiled)
954  (with-open-file (out fname :direction :output
955                       #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede
956                       :if-exists :overwrite :if-does-not-exist :create)
957    (write '(defparameter *donc* nil) :stream out)
958    (terpri out)
959    (write '(eval-when (:load-toplevel :compile-toplevel :execute)
960             (setq *donc* (funcall (compile (defun g ()
961                                              (load-time-value (+ 2 3)))))))
962           :stream out)
963    (terpri out))
964  (load fname)
965  (push *donc* results)
966  (setq compiled (compile-file fname))
967  (push *donc* results)
968  (load compiled)
969  (push *donc* results)
970  (post-compile-file-cleanup fname)
971  (nreverse results))
972(5 5 5)
973
974;; http://article.gmane.org/gmane.lisp.clisp.devel/13127
975;; https://sourceforge.net/p/clisp/mailman/message/13749992/
976(let ((fname "macro8-tst-donc.lisp") (results '()) compiled)
977  (with-open-file (out fname :direction :output
978                       #+(or CMU SBCL) :if-exists #+(or CMU SBCL) :supersede
979                       :if-exists :overwrite :if-does-not-exist :create)
980    (write '(defmacro m1 (x)
981             (compile x (lambda nil (load-time-value (+ 2 3)))) 4)
982           :stream out)
983    (terpri out)
984    (write '(defun foo () (m1 bar)) :stream out)
985    (terpri out))
986  (load fname)
987  (push (bar) results)
988  (push (foo) results)
989  (setq compiled (compile-file fname))
990  (push (bar) results)
991  (push (foo) results)
992  (load compiled)
993  (push (bar) results)
994  (push (foo) results)
995  (post-compile-file-cleanup fname)
996  (nreverse results))
997(5 4 5 4 5 4)
998
999(let* ((f "macro8-tst-test-compile-file-output-argument.lisp")
1000       (c (open (make-pathname :type "fas" :defaults f)
1001                :direction :probe :if-does-not-exist :create)))
1002  (with-open-file (s f :direction :output :if-exists :supersede
1003                     :if-does-not-exist :create)
1004    (format s "(defun foo (x) (1+ x))~%"))
1005  (unwind-protect (progn (compile-file f :output-file c) t)
1006    (post-compile-file-cleanup f)))
1007T
1008
1009;; http://article.gmane.org/gmane.lisp.clisp.devel:13153
1010;; https://sourceforge.net/p/clisp/mailman/message/13750057/
1011(defun test-constant-folding (x) (* 1d200 x 1d200))
1012TEST-CONSTANT-FOLDING
1013(multiple-value-list (compile 'test-constant-folding))
1014#+CLISP (TEST-CONSTANT-FOLDING 1 1)
1015#-CLISP (TEST-CONSTANT-FOLDING NIL NIL)
1016(test-constant-folding 12)
1017ERROR
1018
1019;; http://article.gmane.org/gmane.lisp.clisp.general:9093
1020;; https://sourceforge.net/p/clisp/mailman/message/11679435/
1021(multiple-value-list (compile nil #'test-constant-folding))
1022(#.#'test-constant-folding nil nil)
1023
1024(funcall (compile nil (lambda () (cond (nil)))))
1025NIL
1026
1027(funcall (compile nil (lambda () (cond (t)) nil)))
1028NIL
1029
1030(let (x)
1031  (defun circularity-in-code () '(one two three . #1=(many . #1#)))
1032  (setq x (circularity-in-code))
1033  (subseq x 0 7))
1034(ONE TWO THREE MANY MANY MANY MANY)
1035
1036#+clisp
1037(let* ((f "macro8-tst-test-compiled-file-p.lisp") (c (compile-file-pathname f)))
1038  (open f :direction :probe :if-does-not-exist :create)
1039  (delete-file c)
1040  (list (multiple-value-list (ext:compiled-file-p c))
1041        (multiple-value-list (ext:compiled-file-p f))
1042        (unwind-protect (multiple-value-list
1043                         (ext:compiled-file-p (setq c (compile-file f))))
1044          (post-compile-file-cleanup f))))
1045#+clisp
1046((NIL) (NIL) (T))
1047
1048#+clisp
1049(let ((f "macro8-tst-test-compile-time-value.lisp"))
1050  (defparameter test-compile-time-value-c 0)
1051  (with-open-file (*standard-output* f :direction :output)
1052    (write '(defun test-compile-time-value-f ()
1053             (incf test-compile-time-value-c) 'test-compile-time-value))
1054    (terpri)
1055    (write '(defparameter test-compile-time-value-v
1056             (compile-time-value (test-compile-time-value-f))))
1057    (terpri))
1058  (unwind-protect
1059       (list (progn (load f)
1060                    (list test-compile-time-value-c test-compile-time-value-v))
1061             (progn (compile-file f)
1062                    (list test-compile-time-value-c test-compile-time-value-v))
1063             (progn (load (compile-file-pathname f))
1064                    (list test-compile-time-value-c test-compile-time-value-v)))
1065    (post-compile-file-cleanup f)))
1066#+clisp ((0 NIL) (1 NIL) (1 TEST-COMPILE-TIME-VALUE))
1067
1068;; https://sourceforge.net/p/clisp/bugs/373/
1069(let* ((f "macro8-tst-test-crlf-print-read.lisp")
1070       (v #(#\a #\return #\newline #\null #\b))
1071       (s (coerce v 'string)))
1072  (unwind-protect
1073       (progn
1074         (with-open-file (out f :direction :output)
1075           (let ((*print-readably* t))
1076             #+clisp (sys::set-output-stream-fasl out)
1077             (format out "(defparameter *v* ~S)~%" v)
1078             (format out "(defparameter *s* ~S)~%" s)))
1079         (load (compile-file f))
1080         (list (string= s *s*)
1081               (equalp v *v*)
1082               (= (length s) (length v))))
1083    (post-compile-file-cleanup f)
1084    (makunbound '*v*) (unintern '*v*)
1085    (makunbound '*s*) (unintern '*s*)))
1086(T T T)
1087
1088(let ((f "macro8-tst-test-crlf-print-read.lisp")
1089      (code '(defmacro add-crlf (string)
1090              (with-output-to-string (o)
1091                (write-string string o)
1092                (princ #\Return o)
1093                (princ #\LineFeed o)))))
1094  (unwind-protect
1095       (progn
1096         (with-open-file (out f :direction :output)
1097           (write code :stream out :pretty t)
1098           (format out "(defparameter *z* (length (add-crlf \"a\")))~%"))
1099         (list (progn (load f) *z*)
1100               (progn (load (compile-file f)) *z*)))
1101    (post-compile-file-cleanup f)
1102    (makunbound '*z*)
1103    (unintern '*z*)))
1104(3 3)
1105
1106(let* ((f "macro8-tst-test-crlf-print-read.lisp")
1107       #+clisp (*package* (find-package "CS-COMMON-LISP-USER"))
1108       (c (read-from-string "*c*")))
1109  (unwind-protect
1110       (progn
1111         (with-open-file (out f :direction :output)
1112           (format out "(defconstant *c* #\\Null)~%"))
1113         (load (compile-file f))
1114         (char-code (symbol-value c)))
1115    (post-compile-file-cleanup f)
1116    (proclaim (list 'special c)) ; cannot makunbound a constant!
1117    (makunbound c) (unintern c)))
11180
1119
1120(let ((f "macro8-tst-test-pr-kw.lisp"))
1121  (with-open-file (o f :direction :output)
1122    (format o "(defpackage m (:modern t))~%(in-package m)~%~
1123\(defparameter p #.(make-pathname :type \"mem\"))~%"))
1124  (unwind-protect
1125       (progn (load (compile-file f))
1126	      (symbol-value (read-from-string "m::p")))
1127    (post-compile-file-cleanup f)
1128    (delete-package "M")))
1129#.(make-pathname :type "mem")
1130
1131;; https://sourceforge.net/p/clisp/bugs/394/
1132(funcall (compile nil '(lambda () (declare (optimize foo)))))
1133NIL
1134
1135;; https://sourceforge.net/p/clisp/bugs/588/
1136(multiple-value-list
1137 (compile 'x (lambda () (directory "/" 'a t 'b 1 'c 0 :allow-other-keys t))))
1138(X 3 NIL)
1139(multiple-value-list
1140 (compile 'x (lambda () (directory "/" :allow-other-keys t 'a t)))) (X 1 NIL)
1141(multiple-value-list (compile 'x (lambda () (directory "/" 'a t)))) (X 1 1)
1142(multiple-value-list (compile 'x (lambda () (directory "/" 'a t 'b 2)))) (X 1 1)
1143
1144#+clisp
1145(let (ret)
1146  (defmacro test-macro-arglist (a) a)
1147  (push (arglist 'test-macro-arglist) ret)
1148  (compile 'test-macro-arglist)
1149  (push (arglist 'test-macro-arglist) ret)
1150  ret)
1151#+clisp ((A) (A))
1152
1153#+clisp
1154(let (ret)
1155  (defmacro test-macro-arglist (a) a)
1156  (push (arglist 'test-macro-arglist) ret)
1157  (trace test-macro-arglist)
1158  (push (arglist 'test-macro-arglist) ret)
1159  ret)
1160#+clisp ((A) (A))
1161
1162#+clisp
1163(locally (declare (optimize (space 2)))
1164  (defmacro test-macro-arglist (a) a)
1165  (compile 'test-macro-arglist)
1166  (arglist 'test-macro-arglist))
1167#+clisp (A)
1168
1169#+clisp
1170(locally (declare (optimize (space 3)))
1171  (defmacro test-macro-arglist (a) a)
1172  (compile 'test-macro-arglist)
1173  (stringp
1174   (princ (with-output-to-string (s) (describe 'test-macro-arglist s)))))
1175#+clisp T
1176
1177#+clisp
1178(locally (declare (optimize (space 2)))
1179  (defun test-fun-arglist (a) (declare (compile)) a)
1180  (arglist 'test-fun-arglist))
1181#+clisp (A)
1182
1183#+clisp
1184(locally (declare (optimize (space 3)))
1185  (defun test-fun-arglist (a) (declare (compile)) a)
1186  (princ-to-string (arglist 'test-fun-arglist)))
1187#+clisp "(ARG0)"
1188
1189#+clisp (listp (arglist 'sys::backquote)) #+clisp t
1190
1191;; check constant folding
1192#-clisp (setf (fdefinition 'check-const-fold) #'eval) #+clisp
1193(defun check-const-fold (form)
1194  (sys::closure-const (compile nil `(lambda () ,form)) 0))
1195check-const-fold
1196#+clisp (check-const-fold '(! 10)) #+clisp 3628800
1197(check-const-fold '(char-code #\a)) 97
1198(check-const-fold '(code-char 97)) #\a
1199(check-const-fold '(char-upcase #\a)) #\A
1200#+clisp (check-const-fold '(char-invertcase #\a)) #+clisp #\A
1201#+clisp (check-const-fold '(mod-expt 29 13 17)) #+clisp 14
1202#+clisp (sys::closure-consts (compile nil (lambda () (atom 12)))) #+clisp ()
1203#+clisp (sys::closure-consts (compile nil (lambda () (consp 12)))) #+clisp ()
1204#+clisp (sys::closure-consts (compile nil (lambda () (xor 1 nil 2)))) #+clisp ()
1205#+clisp (check-const-fold '(hash-table-test #s(hash-table eq))) #+clisp FASTHASH-EQ
1206
1207(funcall (COMPILE NIL (LAMBDA (B C) (BLOCK B3 (IF (IF B (NOT NIL) C) (RETURN-FROM B3 124))))) 1 2) 124
1208
1209(progn
1210  (defmacro test-macro-dotted-args (&rest f) `',f)
1211  (list (test-macro-dotted-args 123)
1212        (test-macro-dotted-args . 123)
1213        (test-macro-dotted-args 1 2 . 3)))
1214((123) 123 (1 2 . 3))
1215
1216;; check unused function warnings
1217(multiple-value-list (compile 'x (lambda (y) (when nil (format t "arg=~S" y)))))
1218(X NIL NIL)
1219(multiple-value-list (compile 'x (lambda (y) (flet ((f (z) (1+ z))) (f y)))))
1220(X NIL NIL)
1221(multiple-value-list (compile 'x (lambda (y) (flet ((f (z) (1+ z))) y))))
1222(X 1 NIL)
1223(multiple-value-list (compile 'x (lambda () (flet ((f (z) (1+ z))) #'f))))
1224(X NIL NIL)
1225(multiple-value-list (compile 'x (lambda (y) (flet ((f (z) (1+ z))) y))))
1226(X 1 NIL)
1227(multiple-value-list (compile 'x (lambda (y) (flet ((f (z) (1+ z))) (declare (ignorable #'f)) y))))
1228(X NIL NIL)
1229(multiple-value-list (compile 'x (lambda (y) (flet ((f (z) (1+ z))) (declare (ignore #'f)) y))))
1230(X NIL NIL)
1231(multiple-value-list (compile 'x (lambda () (flet ((f (z) (1+ z))) (declare (ignore #'f)) #'f))))
1232(X 1 NIL)
1233(multiple-value-list (compile 'x (lambda (y) (flet ((f (z) (1+ z))) (declare (ignore #'f)) #'f))))
1234(X 2 NIL)
1235(multiple-value-list (compile 'x (lambda (y) (declare (ignore y)) (flet ((f (z) (1+ z))) #'f))))
1236(X NIL NIL)
1237(multiple-value-list (compile 'x (lambda (y) (declare (ignore y)) (flet ((f (z) (1+ z))) (f y)))))
1238(X 1 NIL)
1239
1240;; funcall elimination
1241;; AREF: no advertised "exceptional situations", so eliminated in unsafe code
1242(handler-case
1243    ;; safe code, AREF not eliminated
1244    (funcall (locally (declare (optimize (safety 3)))
1245               (compile nil (lambda (a) (aref a 0) 1)))
1246             2)
1247  (type-error (c) (princ-error c) :good)
1248  (error (c) (princ-error c) :bad))
1249:GOOD
1250
1251;; unsafe code, AREF eliminated
1252(funcall (locally (declare (optimize (safety 2)))
1253           (compile nil (lambda (a) (aref a 0) 1)))
1254         2)
12551
1256
1257;; PARSE-INTEGER (advertised to signal errors in unsafe code) never eliminated
1258(handler-case
1259    (funcall (locally (declare (optimize (safety 0)))
1260               (compile nil (lambda (s) (parse-integer s) 1)))
1261             "a")
1262  (error (c) (princ-error c) :good))
1263:GOOD
1264
1265;; compiler warnings
1266(multiple-value-list (compile 'x (lambda () (let (a) t)))) (X 1 NIL)
1267(multiple-value-list (compile 'x (lambda () t))) (X NIL NIL)
1268(multiple-value-list (compile 'x (lambda () (let (a) (setq a 1))))) (X 1 NIL)
1269(multiple-value-list (compile 'x (lambda (&optional a &key b) (cons a b)))) (X 1 NIL)
1270(multiple-value-list (compile 'x (lambda (s) (read-from-string s :start 7)))) (X 1 NIL)
1271(multiple-value-list (compile 'x (lambda (s) (read-from-string s t t :start 7)))) (X NIL NIL)
1272(multiple-value-list (compile 'x (lambda (s) (format "~A" s)))) (X 1 1)
1273
1274(symbols-cleanup
1275 '(*c* *donc* *my-typeof-counter* *notinline-test-var* *s* *v* *z* add-crlf
1276   alpha arithmetic-if bar beta caller check-const-fold circularity-in-code
1277   delta dm1a dm1b dm2a dm2b fexpand fexpand-1 foo foo137 foo138 foo140 foo141
1278   foo142 foo143 g halibut incfq ltv1 ltv2 ltv3 test-warning-compile-file-1
1279   test-warning-compile-file-2 m m1 mexpand mexpand-1 my-mac my-typeof
1280   notinline-test-func-1 notinline-test-func-2 p stem t1 test-compile-time-value-c
1281   test-compile-time-value-f test-compile-time-value-v test-compiler
1282   test-constant-folding test-fun-arglist test-key test-macro-arglist
1283   test-macro-dotted-args test10 test11 test12 test6 test9 testf testp testw
1284   with-var x))
1285()
1286