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