1 ;;;; tests for the code walker
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; This software is derived from software originally released by Xerox
7 ;;;; Corporation. Copyright and release statements follow. Later modifications
8 ;;;; to the software are in the public domain and are provided with
9 ;;;; absolutely no warranty. See the COPYING and CREDITS files for more
12 ;;;; copyright information from original PCL sources:
14 ;;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
15 ;;;; All rights reserved.
17 ;;;; Use and copying of this software and preparation of derivative works based
18 ;;;; upon this software are permitted. Any distribution of this software or
19 ;;;; derivative works must comply with all applicable United States export
22 ;;;; This software is made available AS IS, and Xerox Corporation makes no
23 ;;;; warranty about the software, its performance or its conformity to any
26 (in-package :sb-walker)
28 ;;;; stuff based on the tests at the end of the original CMU CL
29 ;;;; pcl/walk.lisp file
31 (defmacro take-it-out-for-a-test-walk (form)
32 `(take-it-out-for-a-test-walk-1 ',form))
34 (defun take-it-out-for-a-test-walk-1 (form)
35 (let ((copy-of-form (copy-tree form))
36 (result (walk-form form nil
38 (format t "~&Form: ~S ~3T Context: ~A" x y)
40 (let ((lexical (variable-lexical-p x env))
41 (special (variable-special-p x env)))
44 (format t "lexically bound"))
47 (format t "declared special"))
50 (format t "bound: ~S " (eval x)))))
52 (cond ((not (equal result copy-of-form))
53 (format t "~%Warning: Result not EQUAL to copy of start."))
54 ((not (eq result form))
55 (format t "~%Warning: Result not EQ to copy of start.")))
59 (defmacro foo (&rest ignore)
60 (declare (ignore ignore))
63 (defmacro bar (&rest ignore)
64 (declare (ignore ignore))
68 (with-output-to-string (*standard-output*)
69 (take-it-out-for-a-test-walk (list arg1 arg2 arg3)))
70 "Form: (LIST ARG1 ARG2 ARG3) Context: EVAL
71 Form: ARG1 Context: EVAL
72 Form: ARG2 Context: EVAL
73 Form: ARG3 Context: EVAL
74 (LIST ARG1 ARG2 ARG3)"))
77 (with-output-to-string (*standard-output*)
78 (take-it-out-for-a-test-walk (list (cons 1 2) (list 3 4 5))))
79 "Form: (LIST (CONS 1 2) (LIST 3 4 5)) Context: EVAL
80 Form: (CONS 1 2) Context: EVAL
83 Form: (LIST 3 4 5) Context: EVAL
87 (LIST (CONS 1 2) (LIST 3 4 5))"))
90 (with-output-to-string (*standard-output*)
91 (take-it-out-for-a-test-walk (progn (foo) (bar 1))))
92 "Form: (PROGN (FOO) (BAR 1)) Context: EVAL
93 Form: (FOO) Context: EVAL
94 Form: 'GLOBAL-FOO Context: EVAL
95 Form: (BAR 1) Context: EVAL
96 Form: 'GLOBAL-BAR Context: EVAL
97 (PROGN (FOO) (BAR 1))"))
100 (with-output-to-string (*standard-output*)
101 (take-it-out-for-a-test-walk (block block-name a b c)))
102 "Form: (BLOCK BLOCK-NAME A B C) Context: EVAL
103 Form: A Context: EVAL
104 Form: B Context: EVAL
105 Form: C Context: EVAL
106 (BLOCK BLOCK-NAME A B C)"))
109 (with-output-to-string (*standard-output*)
110 (take-it-out-for-a-test-walk (block block-name (list a) b c)))
111 "Form: (BLOCK BLOCK-NAME (LIST A) B C) Context: EVAL
112 Form: (LIST A) Context: EVAL
113 Form: A Context: EVAL
114 Form: B Context: EVAL
115 Form: C Context: EVAL
116 (BLOCK BLOCK-NAME (LIST A) B C)"))
119 (with-output-to-string (*standard-output*)
120 (take-it-out-for-a-test-walk (catch catch-tag (list a) b c)))
121 "Form: (CATCH CATCH-TAG (LIST A) B C) Context: EVAL
122 Form: CATCH-TAG Context: EVAL
123 Form: (LIST A) Context: EVAL
124 Form: A Context: EVAL
125 Form: B Context: EVAL
126 Form: C Context: EVAL
127 (CATCH CATCH-TAG (LIST A) B C)"))
129 ;;; This is a fairly simple MACROLET case. While walking the body of the
130 ;;; macro, X should be lexically bound. In the body of the MACROLET form
131 ;;; itself, X should not be bound.
133 (with-output-to-string (*standard-output*)
134 (take-it-out-for-a-test-walk
135 (macrolet ((foo (x) (list x) ''inner))
138 "Form: (MACROLET ((FOO (X)
142 (FOO 1)) Context: EVAL
143 Form: (LIST X) Context: EVAL
144 Form: X Context: EVAL; lexically bound
145 Form: ''INNER Context: EVAL
146 Form: X Context: EVAL
147 Form: (FOO 1) Context: EVAL
148 Form: 'INNER Context: EVAL
156 ;;; A slightly more complex MACROLET case. In the body of the macro X
157 ;;; should not be lexically bound. In the body of the macrolet form itself
158 ;;; X should be bound. Note that THIS CASE WILL CAUSE AN ERROR when it
159 ;;; tries to macroexpand the call to FOO.
161 #+nil ; FIXME: broken under 0.pre7.15
162 (multiple-value-bind (res cond)
164 (take-it-out-for-a-test-walk
166 (macrolet ((foo () (list x) ''inner))
169 (assert (and (null res) cond)))
172 (with-output-to-string (*standard-output*)
173 (take-it-out-for-a-test-walk
174 (flet ((foo (x) (list x y))
175 (bar (x) (list x y)))
177 "Form: (FLET ((FOO (X)
181 (FOO 1)) Context: EVAL
182 Form: (LIST X Y) Context: EVAL
183 Form: X Context: EVAL; lexically bound
184 Form: Y Context: EVAL
185 Form: (LIST X Y) Context: EVAL
186 Form: X Context: EVAL; lexically bound
187 Form: Y Context: EVAL
188 Form: (FOO 1) Context: EVAL
189 Form: 1 Context: EVAL
197 (with-output-to-string (*standard-output*)
198 (take-it-out-for-a-test-walk
200 (flet ((foo (x) (list x y))
201 (bar (x) (list x y)))
208 (FOO 1))) Context: EVAL
209 Form: 2 Context: EVAL
210 Form: (FLET ((FOO (X)
214 (FOO 1)) Context: EVAL
215 Form: (LIST X Y) Context: EVAL
216 Form: X Context: EVAL; lexically bound
217 Form: Y Context: EVAL; lexically bound
218 Form: (LIST X Y) Context: EVAL
219 Form: X Context: EVAL; lexically bound
220 Form: Y Context: EVAL; lexically bound
221 Form: (FOO 1) Context: EVAL
222 Form: 1 Context: EVAL
231 (with-output-to-string (*standard-output*)
232 (take-it-out-for-a-test-walk
233 (labels ((foo (x) (bar x))
236 "Form: (LABELS ((FOO (X)
240 (FOO 1)) Context: EVAL
241 Form: (BAR X) Context: EVAL
242 Form: X Context: EVAL; lexically bound
243 Form: (FOO X) Context: EVAL
244 Form: X Context: EVAL; lexically bound
245 Form: (FOO 1) Context: EVAL
246 Form: 1 Context: EVAL
254 (with-output-to-string (*standard-output*)
255 (take-it-out-for-a-test-walk
256 (flet ((foo (x) (foo x)))
258 "Form: (FLET ((FOO (X)
260 (FOO 1)) Context: EVAL
261 Form: (FOO X) Context: EVAL
262 Form: 'GLOBAL-FOO Context: EVAL
263 Form: (FOO 1) Context: EVAL
264 Form: 1 Context: EVAL
270 (with-output-to-string (*standard-output*)
271 (take-it-out-for-a-test-walk
272 (flet ((foo (x) (foo x)))
273 (flet ((bar (x) (foo x)))
275 "Form: (FLET ((FOO (X)
279 (BAR 1))) Context: EVAL
280 Form: (FOO X) Context: EVAL
281 Form: 'GLOBAL-FOO Context: EVAL
282 Form: (FLET ((BAR (X)
284 (BAR 1)) Context: EVAL
285 Form: (FOO X) Context: EVAL
286 Form: X Context: EVAL; lexically bound
287 Form: (BAR 1) Context: EVAL
288 Form: 1 Context: EVAL
296 (with-output-to-string (*standard-output*)
297 (take-it-out-for-a-test-walk (prog () (declare (special a b)))))
298 "Form: (PROG () (DECLARE (SPECIAL A B))) Context: EVAL
301 (DECLARE (SPECIAL A B))
302 (TAGBODY))) Context: EVAL
304 (DECLARE (SPECIAL A B))
305 (TAGBODY)) Context: EVAL
306 Form: (TAGBODY) Context: EVAL
307 (PROG () (DECLARE (SPECIAL A B)))"))
310 (with-output-to-string (*standard-output*)
311 (take-it-out-for-a-test-walk (let (a b c)
312 (declare (special a b))
315 (DECLARE (SPECIAL A B))
319 Form: (FOO A) Context: EVAL
320 Form: 'GLOBAL-FOO Context: EVAL
321 Form: B Context: EVAL; lexically bound
322 Form: C Context: EVAL; lexically bound
324 (DECLARE (SPECIAL A B))
330 (with-output-to-string (*standard-output*)
331 (take-it-out-for-a-test-walk (let (a b c)
332 (declare (special a) (special b))
335 (DECLARE (SPECIAL A) (SPECIAL B))
339 Form: (FOO A) Context: EVAL
340 Form: 'GLOBAL-FOO Context: EVAL
341 Form: B Context: EVAL; lexically bound; declared special
342 Form: C Context: EVAL; lexically bound
344 (DECLARE (SPECIAL A) (SPECIAL B))
350 (with-output-to-string (*standard-output*)
351 (take-it-out-for-a-test-walk (let (a b c)
352 (declare (special a))
353 (declare (special b))
356 (DECLARE (SPECIAL A))
357 (DECLARE (SPECIAL B))
361 Form: (FOO A) Context: EVAL
362 Form: 'GLOBAL-FOO Context: EVAL
363 Form: B Context: EVAL; lexically bound; declared special
364 Form: C Context: EVAL; lexically bound
366 (DECLARE (SPECIAL A))
367 (DECLARE (SPECIAL B))
373 (with-output-to-string (*standard-output*)
374 (take-it-out-for-a-test-walk (let (a b c)
375 (declare (special a))
376 (declare (special b))
380 (DECLARE (SPECIAL A))
381 (DECLARE (SPECIAL B))
390 Form: 1 Context: EVAL
391 Form: (FOO A) Context: EVAL
392 Form: 'GLOBAL-FOO Context: EVAL
393 Form: B Context: EVAL; lexically bound; declared special
394 Form: C Context: EVAL; lexically bound
396 (DECLARE (SPECIAL A))
397 (DECLARE (SPECIAL B))
404 (with-output-to-string (*standard-output*)
405 (take-it-out-for-a-test-walk (eval-when ()
408 "Form: (EVAL-WHEN NIL A (FOO A)) Context: EVAL
409 Form: A Context: EVAL
410 Form: (FOO A) Context: EVAL
411 Form: 'GLOBAL-FOO Context: EVAL
412 (EVAL-WHEN NIL A (FOO A))"))
415 (with-output-to-string (*standard-output*)
416 (take-it-out-for-a-test-walk
417 (eval-when (:execute :compile-toplevel :load-toplevel)
420 "Form: (EVAL-WHEN (:EXECUTE :COMPILE-TOPLEVEL :LOAD-TOPLEVEL) A (FOO A)) Context: EVAL
421 Form: A Context: EVAL
422 Form: (FOO A) Context: EVAL
423 Form: 'GLOBAL-FOO Context: EVAL
424 (EVAL-WHEN (:EXECUTE :COMPILE-TOPLEVEL :LOAD-TOPLEVEL) A (FOO A))"))
427 (with-output-to-string (*standard-output*)
428 (take-it-out-for-a-test-walk (multiple-value-bind (a b)
429 (foo a b) (list a b))))
430 "Form: (MULTIPLE-VALUE-BIND (A B) (FOO A B) (LIST A B)) Context: EVAL
431 Form: (FOO A B) Context: EVAL
432 Form: 'GLOBAL-FOO Context: EVAL
433 Form: (LIST A B) Context: EVAL
434 Form: A Context: EVAL; lexically bound
435 Form: B Context: EVAL; lexically bound
436 (MULTIPLE-VALUE-BIND (A B) (FOO A B) (LIST A B))"))
439 (with-output-to-string (*standard-output*)
440 (take-it-out-for-a-test-walk (multiple-value-bind (a b)
442 (declare (special a))
444 "Form: (MULTIPLE-VALUE-BIND (A B) (FOO A B) (DECLARE (SPECIAL A)) (LIST A B)) Context: EVAL
445 Form: (FOO A B) Context: EVAL
446 Form: 'GLOBAL-FOO Context: EVAL
447 Form: (LIST A B) Context: EVAL
448 Form: A Context: EVAL; lexically bound
449 Form: B Context: EVAL; lexically bound
450 (MULTIPLE-VALUE-BIND (A B) (FOO A B) (DECLARE (SPECIAL A)) (LIST A B))"))
453 (with-output-to-string (*standard-output*)
454 (take-it-out-for-a-test-walk (progn (function foo))))
455 "Form: (PROGN #'FOO) Context: EVAL
456 Form: #'FOO Context: EVAL
460 (with-output-to-string (*standard-output*)
461 (take-it-out-for-a-test-walk (progn a b (go a))))
462 "Form: (PROGN A B (GO A)) Context: EVAL
463 Form: A Context: EVAL
464 Form: B Context: EVAL
465 Form: (GO A) Context: EVAL
466 (PROGN A B (GO A))"))
469 (with-output-to-string (*standard-output*)
470 (take-it-out-for-a-test-walk (if a b c)))
471 "Form: (IF A B C) Context: EVAL
472 Form: A Context: EVAL
473 Form: B Context: EVAL
474 Form: C Context: EVAL
478 (with-output-to-string (*standard-output*)
479 (take-it-out-for-a-test-walk (if a b)))
480 "Form: (IF A B) Context: EVAL
481 Form: A Context: EVAL
482 Form: B Context: EVAL
483 Form: NIL Context: EVAL; bound: NIL
487 (with-output-to-string (*standard-output*)
488 (take-it-out-for-a-test-walk ((lambda (a b) (list a b)) 1 2)))
489 "Form: ((LAMBDA (A B) (LIST A B)) 1 2) Context: EVAL
490 Form: (LAMBDA (A B) (LIST A B)) Context: EVAL
491 Form: (LIST A B) Context: EVAL
492 Form: A Context: EVAL; lexically bound
493 Form: B Context: EVAL; lexically bound
494 Form: 1 Context: EVAL
495 Form: 2 Context: EVAL
496 ((LAMBDA (A B) (LIST A B)) 1 2)"))
499 (with-output-to-string (*standard-output*)
500 (take-it-out-for-a-test-walk ((lambda (a b)
501 (declare (special a))
504 "Form: ((LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B)) 1 2) Context: EVAL
505 Form: (LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B)) Context: EVAL
506 Form: (LIST A B) Context: EVAL
507 Form: A Context: EVAL; lexically bound; declared special
508 Form: B Context: EVAL; lexically bound
509 Form: 1 Context: EVAL
510 Form: 2 Context: EVAL
511 ((LAMBDA (A B) (DECLARE (SPECIAL A)) (LIST A B)) 1 2)"))
514 (with-output-to-string (*standard-output*)
515 (take-it-out-for-a-test-walk (let ((a a) (b a) (c b))
517 "Form: (LET ((A A) (B A) (C B))
518 (LIST A B C)) Context: EVAL
519 Form: A Context: EVAL
520 Form: A Context: EVAL
521 Form: B Context: EVAL
522 Form: (LIST A B C) Context: EVAL
523 Form: A Context: EVAL; lexically bound
524 Form: B Context: EVAL; lexically bound
525 Form: C Context: EVAL; lexically bound
526 (LET ((A A) (B A) (C B))
530 (with-output-to-string (*standard-output*)
531 (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b)) (list a b c))))
532 "Form: (LET* ((A A) (B A) (C B))
533 (LIST A B C)) Context: EVAL
534 Form: A Context: EVAL
535 Form: A Context: EVAL; lexically bound
536 Form: B Context: EVAL; lexically bound
537 Form: (LIST A B C) Context: EVAL
538 Form: A Context: EVAL; lexically bound
539 Form: B Context: EVAL; lexically bound
540 Form: C Context: EVAL; lexically bound
541 (LET* ((A A) (B A) (C B))
545 (with-output-to-string (*standard-output*)
546 (take-it-out-for-a-test-walk (let ((a a) (b a) (c b))
547 (declare (special a b))
549 "Form: (LET ((A A) (B A) (C B))
550 (DECLARE (SPECIAL A B))
551 (LIST A B C)) Context: EVAL
552 Form: A Context: EVAL
553 Form: A Context: EVAL
554 Form: B Context: EVAL
555 Form: (LIST A B C) Context: EVAL
556 Form: A Context: EVAL; lexically bound; declared special
557 Form: B Context: EVAL; lexically bound
558 Form: C Context: EVAL; lexically bound
559 (LET ((A A) (B A) (C B))
560 (DECLARE (SPECIAL A B))
564 (with-output-to-string (*standard-output*)
565 (take-it-out-for-a-test-walk (let* ((a a) (b a) (c b))
566 (declare (special a b))
568 "Form: (LET* ((A A) (B A) (C B))
569 (DECLARE (SPECIAL A B))
570 (LIST A B C)) Context: EVAL
571 Form: A Context: EVAL
572 Form: A Context: EVAL; lexically bound
573 Form: B Context: EVAL; lexically bound
574 Form: (LIST A B C) Context: EVAL
575 Form: A Context: EVAL; lexically bound; declared special
576 Form: B Context: EVAL; lexically bound
577 Form: C Context: EVAL; lexically bound
578 (LET* ((A A) (B A) (C B))
579 (DECLARE (SPECIAL A B))
583 (with-output-to-string (*standard-output*)
584 (take-it-out-for-a-test-walk (let ((a 1) (b 2))
587 (declare (special a))
589 "Form: (LET ((A 1) (B 2))
592 (DECLARE (SPECIAL A))
593 (FOO A B))) Context: EVAL
594 Form: 1 Context: EVAL
595 Form: 2 Context: EVAL
596 Form: (FOO BAR) Context: EVAL
597 Form: 'GLOBAL-FOO Context: EVAL
599 (DECLARE (SPECIAL A))
600 (FOO A B)) Context: EVAL
601 Form: (FOO A B) Context: EVAL
602 Form: 'GLOBAL-FOO Context: EVAL
606 (DECLARE (SPECIAL A))
610 (with-output-to-string (*standard-output*)
611 (take-it-out-for-a-test-walk (multiple-value-call #'foo a b c)))
612 "Form: (MULTIPLE-VALUE-CALL #'FOO A B C) Context: EVAL
613 Form: #'FOO Context: EVAL
614 Form: A Context: EVAL
615 Form: B Context: EVAL
616 Form: C Context: EVAL
617 (MULTIPLE-VALUE-CALL #'FOO A B C)"))
620 (with-output-to-string (*standard-output*)
621 (take-it-out-for-a-test-walk (multiple-value-prog1 a b c)))
622 "Form: (MULTIPLE-VALUE-PROG1 A B C) Context: EVAL
623 Form: A Context: EVAL
624 Form: B Context: EVAL
625 Form: C Context: EVAL
626 (MULTIPLE-VALUE-PROG1 A B C)"))
629 (with-output-to-string (*standard-output*)
630 (take-it-out-for-a-test-walk (progn a b c)))
631 "Form: (PROGN A B C) Context: EVAL
632 Form: A Context: EVAL
633 Form: B Context: EVAL
634 Form: C Context: EVAL
638 (with-output-to-string (*standard-output*)
639 (take-it-out-for-a-test-walk (progv vars vals a b c)))
640 "Form: (PROGV VARS VALS A B C) Context: EVAL
641 Form: VARS Context: EVAL
642 Form: VALS Context: EVAL
643 Form: A Context: EVAL
644 Form: B Context: EVAL
645 Form: C Context: EVAL
646 (PROGV VARS VALS A B C)"))
649 (with-output-to-string (*standard-output*)
650 (take-it-out-for-a-test-walk (quote a)))
651 "Form: 'A Context: EVAL
655 (with-output-to-string (*standard-output*)
656 (take-it-out-for-a-test-walk (return-from block-name a b c)))
657 "Form: (RETURN-FROM BLOCK-NAME A B C) Context: EVAL
658 Form: A Context: EVAL
659 Form: B Context: EVAL
660 Form: C Context: EVAL
661 (RETURN-FROM BLOCK-NAME A B C)"))
664 (with-output-to-string (*standard-output*)
665 (take-it-out-for-a-test-walk (setq a 1)))
666 "Form: (SETQ A 1) Context: EVAL
668 Form: 1 Context: EVAL
673 (with-output-to-string (*standard-output*)
674 (take-it-out-for-a-test-walk (setq a (foo 1) b (bar 2) c 3)))
675 "Form: (SETQ A (FOO 1) B (BAR 2) C 3) Context: EVAL
676 Form: (SETQ A (FOO 1)) Context: EVAL
678 Form: (FOO 1) Context: EVAL
679 Form: 'GLOBAL-FOO Context: EVAL
680 Form: (SETQ B (BAR 2)) Context: EVAL
682 Form: (BAR 2) Context: EVAL
683 Form: 'GLOBAL-BAR Context: EVAL
684 Form: (SETQ C 3) Context: EVAL
686 Form: 3 Context: EVAL
687 (SETQ A (FOO 1) B (BAR 2) C 3)"))
693 (with-output-to-string (*standard-output*)
694 (take-it-out-for-a-test-walk (tagbody a b c (go a))))
695 "Form: (TAGBODY A B C (GO A)) Context: EVAL
696 Form: A Context: QUOTE
697 Form: B Context: QUOTE
698 Form: C Context: QUOTE
699 Form: (GO A) Context: EVAL
700 (TAGBODY A B C (GO A))"))
703 (with-output-to-string (*standard-output*)
704 (take-it-out-for-a-test-walk (the foo (foo-form a b c))))
705 "Form: (THE FOO (FOO-FORM A B C)) Context: EVAL
706 Form: (FOO-FORM A B C) Context: EVAL
707 Form: A Context: EVAL
708 Form: B Context: EVAL
709 Form: C Context: EVAL
710 (THE FOO (FOO-FORM A B C))"))
713 (with-output-to-string (*standard-output*)
714 (take-it-out-for-a-test-walk (throw tag-form a)))
715 "Form: (THROW TAG-FORM A) Context: EVAL
716 Form: TAG-FORM Context: EVAL
717 Form: A Context: EVAL
718 (THROW TAG-FORM A)"))
721 (with-output-to-string (*standard-output*)
722 (take-it-out-for-a-test-walk (unwind-protect (foo a b) d e f)))
723 "Form: (UNWIND-PROTECT (FOO A B) D E F) Context: EVAL
724 Form: (FOO A B) Context: EVAL
725 Form: 'GLOBAL-FOO Context: EVAL
726 Form: D Context: EVAL
727 Form: E Context: EVAL
728 Form: F Context: EVAL
729 (UNWIND-PROTECT (FOO A B) D E F)"))
731 (defmacro flet-1 (a b)
732 (declare (ignore a b))
735 (defmacro labels-1 (a b)
736 (declare (ignore a b))
740 (with-output-to-string (*standard-output*)
741 (take-it-out-for-a-test-walk
742 (flet ((flet-1 (a b) () (flet-1 a b) (list a b)))
745 "Form: (FLET ((FLET-1 (A B)
750 (FOO 1 2)) Context: EVAL
751 Form: NIL Context: EVAL; bound: NIL
752 Form: (FLET-1 A B) Context: EVAL
753 Form: 'OUTER Context: EVAL
754 Form: (LIST A B) Context: EVAL
755 Form: A Context: EVAL; lexically bound
756 Form: B Context: EVAL; lexically bound
757 Form: (FLET-1 1 2) Context: EVAL
758 Form: 1 Context: EVAL
759 Form: 2 Context: EVAL
760 Form: (FOO 1 2) Context: EVAL
761 Form: 'GLOBAL-FOO Context: EVAL
770 (with-output-to-string (*standard-output*)
771 (take-it-out-for-a-test-walk
772 (labels ((label-1 (a b) () (label-1 a b)(list a b)))
775 "Form: (LABELS ((LABEL-1 (A B)
780 (FOO 1 2)) Context: EVAL
781 Form: NIL Context: EVAL; bound: NIL
782 Form: (LABEL-1 A B) Context: EVAL
783 Form: A Context: EVAL; lexically bound
784 Form: B Context: EVAL; lexically bound
785 Form: (LIST A B) Context: EVAL
786 Form: A Context: EVAL; lexically bound
787 Form: B Context: EVAL; lexically bound
788 Form: (LABEL-1 1 2) Context: EVAL
789 Form: 1 Context: EVAL
790 Form: 2 Context: EVAL
791 Form: (FOO 1 2) Context: EVAL
792 Form: 'GLOBAL-FOO Context: EVAL
793 (LABELS ((LABEL-1 (A B)
801 (with-output-to-string (*standard-output*)
802 (take-it-out-for-a-test-walk (macrolet ((macrolet-1 (a b) (list a b)))
805 "Form: (MACROLET ((MACROLET-1 (A B)
808 (FOO 1 2)) Context: EVAL
809 Form: (LIST A B) Context: EVAL
810 Form: A Context: EVAL; lexically bound
811 Form: B Context: EVAL; lexically bound
812 Form: (MACROLET-1 A B) Context: EVAL
813 Form: (A B) Context: EVAL
814 Form: B Context: EVAL
815 Form: (FOO 1 2) Context: EVAL
816 Form: 'GLOBAL-FOO Context: EVAL
817 (MACROLET ((MACROLET-1 (A B)
823 (with-output-to-string (*standard-output*)
824 (take-it-out-for-a-test-walk (macrolet ((foo (a) `(inner-foo-expanded ,a)))
826 "Form: (MACROLET ((FOO (A)
827 `(INNER-FOO-EXPANDED ,A)))
828 (FOO 1)) Context: EVAL
829 Form: `(INNER-FOO-EXPANDED ,A) Context: EVAL
830 Form: 'INNER-FOO-EXPANDED Context: EVAL
831 Form: A Context: EVAL; lexically bound
832 Form: (FOO 1) Context: EVAL
833 Form: (INNER-FOO-EXPANDED 1) Context: EVAL
834 Form: 1 Context: EVAL
836 `(INNER-FOO-EXPANDED ,A)))
840 (with-output-to-string (*standard-output*)
841 (take-it-out-for-a-test-walk (progn (bar 1)
843 `(inner-bar-expanded ,a)))
848 `(INNER-BAR-EXPANDED ,A)))
849 (BAR 2))) Context: EVAL
850 Form: (BAR 1) Context: EVAL
851 Form: 'GLOBAL-BAR Context: EVAL
852 Form: (MACROLET ((BAR (A)
853 `(INNER-BAR-EXPANDED ,A)))
854 (BAR 2)) Context: EVAL
855 Form: `(INNER-BAR-EXPANDED ,A) Context: EVAL
856 Form: 'INNER-BAR-EXPANDED Context: EVAL
857 Form: A Context: EVAL; lexically bound
858 Form: (BAR 2) Context: EVAL
859 Form: (INNER-BAR-EXPANDED 2) Context: EVAL
860 Form: 2 Context: EVAL
864 `(INNER-BAR-EXPANDED ,A)))
868 (with-output-to-string (*standard-output*)
869 (take-it-out-for-a-test-walk (progn (bar 1)
872 `(inner-bar-expanded ,s)))
878 `(INNER-BAR-EXPANDED ,S)))
879 (BAR 2))) Context: EVAL
880 Form: (BAR 1) Context: EVAL
881 Form: 'GLOBAL-BAR Context: EVAL
882 Form: (MACROLET ((BAR (S)
884 `(INNER-BAR-EXPANDED ,S)))
885 (BAR 2)) Context: EVAL
886 Form: (BAR S) Context: EVAL
887 Form: 'GLOBAL-BAR Context: EVAL
888 Form: `(INNER-BAR-EXPANDED ,S) Context: EVAL
889 Form: 'INNER-BAR-EXPANDED Context: EVAL
890 Form: S Context: EVAL; lexically bound
891 Form: (BAR 2) Context: EVAL
892 Form: (INNER-BAR-EXPANDED 2) Context: EVAL
893 Form: 2 Context: EVAL
898 `(INNER-BAR-EXPANDED ,S)))
902 (with-output-to-string (*standard-output*)
903 (take-it-out-for-a-test-walk (cond (a b)
904 ((foo bar) a (foo a)))))
905 "Form: (COND (A B) ((FOO BAR) A (FOO A))) Context: EVAL
906 Form: (IF A (PROGN B) (COND ((FOO BAR) A (FOO A)))) Context: EVAL
907 Form: A Context: EVAL
908 Form: (PROGN B) Context: EVAL
909 Form: B Context: EVAL
910 Form: (COND ((FOO BAR) A (FOO A))) Context: EVAL
911 Form: (IF (FOO BAR) (PROGN A (FOO A)) (COND)) Context: EVAL
912 Form: (FOO BAR) Context: EVAL
913 Form: 'GLOBAL-FOO Context: EVAL
914 Form: (PROGN A (FOO A)) Context: EVAL
915 Form: A Context: EVAL
916 Form: (FOO A) Context: EVAL
917 Form: 'GLOBAL-FOO Context: EVAL
918 Form: (COND) Context: EVAL
919 Form: NIL Context: EVAL; bound: NIL
920 (COND (A B) ((FOO BAR) A (FOO A)))"))
923 (with-output-to-string (*standard-output*)
924 (let ((the-lexical-variables ()))
925 (walk-form '(let ((a 1) (b 2))
926 #'(lambda (x) (list a b x y)))
928 #'(lambda (form context env)
929 (declare (ignore context))
930 (when (and (symbolp form)
931 (variable-lexical-p form env))
932 (push form the-lexical-variables))
934 (or (and (= (length the-lexical-variables) 3)
935 (member 'a the-lexical-variables)
936 (member 'b the-lexical-variables)
937 (member 'x the-lexical-variables))
938 (error "Walker didn't do lexical variables of a closure properly."))))
941 (quit :unix-status 104)