In the mips sigtrap hander, and for the case of a break instruction in a
[sbcl.git] / tests / define-compiler-macro.impure.lisp
1 ;;;; Compiler-macro tests
2
3 ;;; taken from CLHS example
4 (defun square (x)
5   (expt x 2))
6
7 (define-compiler-macro square (&whole form arg)
8   (if (atom arg)
9       `(expt ,arg 2)
10       (case (car arg)
11         (square (if (= (length arg) 2)
12                     `(expt ,(nth 1 arg) 4)
13                     form))
14         (expt   (if (= (length arg) 3)
15                     (if (numberp (nth 2 arg))
16                         `(expt ,(nth 1 arg) ,(* 2 (nth 2 arg)))
17                          `(expt ,(nth 1 arg) (* 2 ,(nth 2 arg))))
18                     form))
19         (otherwise `(expt ,arg 2)))))
20
21 (assert (eql 81 (square (square 3))))
22
23 (multiple-value-bind (expansion expanded-p) (macroexpand '(square x))
24   (assert (equal '(square x) expansion))
25   (assert (not expanded-p)))
26
27 (assert (equal '(expt x 2)
28                (funcall (compiler-macro-function 'square)
29                         '(square x)
30                         nil)))
31
32 (assert (equal '(expt x 4)
33                (funcall (compiler-macro-function 'square)
34                         '(square (square x))
35                         nil)))
36
37 (assert (equal '(expt x 2)
38                (funcall (compiler-macro-function 'square)
39                         '(funcall #'square x)
40                         nil)))
41