244 lines
8.2 KiB
Plaintext
244 lines
8.2 KiB
Plaintext
;; Function To Be Tested: macrolet
|
|
;;
|
|
;; Source: CLtL Section 7.5: Establishing New Variable Bindings Page: 113
|
|
;;
|
|
;; Created By: Pavel , Karin M. Sye
|
|
;;
|
|
;; Creation Date: May 30 ,1986
|
|
;;
|
|
;; Last Update: Jan 28, 1987 Jim Blum - changed (special *foo*) to
|
|
;; (declare (special *foo*))
|
|
;; Feb 4, 1987 Jim Blum - Added #+Xerox before first test, since it is Xerox specific
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>7-5-macrolet.test
|
|
;;
|
|
;;
|
|
;; Syntax: macrolet ({(NAME LAMBDA-LIST {DECLARATION | DOC-STRING}* {FORM}*)}*) {FORM}*
|
|
;;
|
|
;; Function Description: macrolet may be used to define locally named macros. Within the body of the macrolet form, macro names
|
|
;; matching those defined by the macrolet refer to the locally defined macros rather than to the global
|
|
;; macro definitions of the same name. Each definition is similar in format to a defmacro form.
|
|
;; Lexically scoped entities are not visible within the expansion functions. However, they are visible within
|
|
;; the body of the macrolet form and are visible to the code that is the expansion of a macro call.
|
|
;;
|
|
;; Argument(s): NAME - a macro name
|
|
;; LAMBDA-LIST -
|
|
;; DECLARATION -
|
|
;; DOC-STRING - a string
|
|
;; FORM -
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
;;
|
|
;;; Test cases for macrolet, constantp, and other lexical macro facilities.
|
|
;;;
|
|
;;; Pavel, May 30, 1986
|
|
|
|
#+Xerox
|
|
(do-test lexical-macros-and-constantp
|
|
(macrolet ((foo (x)
|
|
`(get ,x 'foo))
|
|
(bar (x &environment env)
|
|
(if (macro-function x env)
|
|
7 ; A constant expression
|
|
'(baz) ; A non-constant expression
|
|
))
|
|
(my-constantp (x &environment env)
|
|
`(constantp ,x ',env)) )
|
|
(my-constantp (bar foo))
|
|
)
|
|
)
|
|
|
|
(do-test lexical-macros-for-declarations
|
|
(macrolet ((special (&rest x) `(declare (special ,@x))))
|
|
(macrolet ((test (x)
|
|
(declare (special *foo*))
|
|
`(eql ,x ,x)))
|
|
(macrolet ((special (&rest y) `(this-is-an-undefined-function ,@y)))
|
|
(test 7)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test "test macrolet - test case copied from page 113 of CLtL (flet was replaced by macrolet)"
|
|
|
|
(macrolet ((safesqrt (x) `(sqrt (abs ,x)) ))
|
|
;;
|
|
;; The safesqrt function is used in two places
|
|
;;
|
|
(let ( (longlist1 '(1 4 -25 100 -144)) (longlist2 '(10000 -25 9 16 -36)) (longlist3 '( -1.21 4.84 -10.89 19.36 -30.25)) )
|
|
(and
|
|
(= (safesqrt (apply #'+ (map 'list #'(lambda (x) (safesqrt x)) longlist1))) (sqrt 30))
|
|
(= (safesqrt (apply #'+ (map 'list #'(lambda (x) (safesqrt x)) longlist2))) (sqrt 118))
|
|
(= (safesqrt (apply #'+ (map 'list #'(lambda (x) (safesqrt x)) longlist3))) (sqrt 16.5))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(do-test-group ( "test macrolet - test case copied from page 114 of CLtL"
|
|
:before (test-defun foo1 (x flag)
|
|
(macrolet ((fudge (z)
|
|
; The parameters x and flag are not accessible
|
|
; at this point.
|
|
`(if flag (* ,z ,z) ,z) ))
|
|
|
|
; The parameters x and flag are accessible here
|
|
(+ x (fudge x)
|
|
(fudge (+ x 1))) )))
|
|
|
|
(do-test "test macrolet - test case copied from page 114 of CLtL"
|
|
|
|
(and (= (foo1 2 t) 15)
|
|
(= (foo1 2 nil) 7)
|
|
(= (foo1 (1+ 5) t) 91)
|
|
(= (foo1 (+ 1 5) nil) 19)
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
|
|
(do-test "test macrolet - with empty macrolet body"
|
|
|
|
(and
|
|
(eq (macrolet ()) nil)
|
|
(eq (macrolet ( (fun1 () "this is an empty function") ) ) nil)
|
|
(eq (macrolet ( (fun1 (m n) (declare (integer m)) "m is declared to be an integer"
|
|
(declare (special n)) "n is a special variable" ) ) ) nil)
|
|
)
|
|
)
|
|
|
|
(do-test "test macrolet - with declare statements/parameter list keywords"
|
|
|
|
(and
|
|
(eq (macrolet () t) t)
|
|
|
|
(equal (multiple-value-list (macrolet ( (let1 () `(values 10 20 30 40))
|
|
(let2 () `(values "a" "b" "c" "d" "e"))
|
|
(let3 () `(values-list '(writing code for macrolet))) )
|
|
(values (let1) (let2) (let3)) ))
|
|
|
|
'(10 "a" writing ) )
|
|
|
|
|
|
(equalp (macrolet ( (fun1 (m n) (declare (integer m n)) `(+ ,m ,n))
|
|
(fun2 (m n ) (declare (string m n)) `(concatenate 'string ,m ,n))
|
|
(fun3 (m n o p) (declare (type (integer 2 10) m n o p)) `(max ,m ,n ,o ,p))
|
|
(fun4 (s) (declare (complex s)) `(type-of ,s))
|
|
(fun5 (s r) (declare (number s r)) `(vector (gcd ,s ,r) (lcm ,s ,r))) )
|
|
|
|
(list (fun1 30 29) (fun2 "ac" "e") (fun3 5 7 6 3) (fun4 #c(2 -1)) (fun5 100 23)) )
|
|
|
|
(list 59 "ace" 7 'complex (vector 1 2300)) )
|
|
|
|
|
|
(equal (macrolet ( (fun1 (m n &key o p) `'(,m ,n ,o ,p))
|
|
(fun2 (m n &optional (o 2 oflag) (p 30 pflag)) `'(,m ,n ,o ,p ,oflag ,pflag))
|
|
(fun3 (m n &rest x &key (y 6) (z 7 zflag)) `'( ,m ,n ,x ,y ,z ,zflag)) )
|
|
|
|
(list (fun1 3 4 :p 7 :o 10) (fun2 1 2 3) (fun2 10 20 30 4) (fun3 9 8 :z 11) (fun3 7 6 :y 10) (fun3 3 2)) )
|
|
|
|
'( (3 4 10 7) (1 2 3 30 t nil) (10 20 30 4 t t) (9 8 (:z 11) 6 11 t) (7 6 (:y 10) 10 7 nil) (3 2 nil 6 7 nil)) )
|
|
)
|
|
)
|
|
|
|
|
|
(do-test-group ("more tests for macrolet"
|
|
:before (progn
|
|
(defmacro fun1 () 1)
|
|
(defmacro fun2 () 2)
|
|
(defmacro fun3 () 3)
|
|
(defmacro fun4 () 4) ))
|
|
|
|
(do-test "test macrolet - locally defined functions overshadow the global functions of the same names"
|
|
|
|
(equal (list (fun1) (fun2) (fun3)
|
|
(macrolet ( (fun1 () 10)
|
|
(fun2 () 20)
|
|
(fun3 () 30))
|
|
|
|
(list (fun1) (fun2) (fun3) (fun4)) )
|
|
(fun1) (fun2) (fun3) (fun4) )
|
|
|
|
'(1 2 3 ( 10 20 30 4) 1 2 3 4))
|
|
)
|
|
|
|
(do-test "test macrolet - one can locally redefine a global function and the new definition can refer to the global definition"
|
|
|
|
(equal (macrolet ( (fun1 () (+ (fun1) (fun2) (fun3)))
|
|
(fun2 () (* (fun1) (fun3)))
|
|
(fun3 () (+ (fun2) (fun4))) )
|
|
|
|
(list (fun1) (fun2) (fun3)) )
|
|
|
|
'(6 3 6))
|
|
)
|
|
)
|
|
|
|
(do-test "test macrolet - using macro to define special declaration"
|
|
|
|
(let (buf)
|
|
(macrolet ((special1 (&rest x) `(declare (special ,@x)) ))
|
|
|
|
;; set only works on special variables
|
|
|
|
(prog ((a 2) (b 4) (c 8))
|
|
(set 'a 22) (set 'b 44) (set 'c 88)
|
|
(push a buf) (push b buf) (push c buf) )
|
|
|
|
(prog ((a 2) (b 4) (c 8))
|
|
(special1 a b c)
|
|
(set 'a 22) (set 'b 44) (set 'c 88)
|
|
(push a buf) (push b buf) (push c buf) ))
|
|
|
|
(equal buf '(88 44 22 8 4 2))
|
|
)
|
|
)
|
|
|
|
(do-test-group ("test macro - lexically scoped entities are not visible within the expansion functions"
|
|
|
|
:before (progn
|
|
(test-setq num 100)
|
|
(test-setq varlist '(10 8 12))
|
|
(test-defun lisper (num)
|
|
(let ((var (pop varlist)))
|
|
(macrolet ((mac1 (item)
|
|
;; the parameter num is not accessible at this point;
|
|
;; a reference to num would be to the global variable.
|
|
(cond ((plusp num)
|
|
`(list "global num is > 0"
|
|
(format nil "local num is ~A" num)
|
|
(* ,item ,item ,item)))
|
|
((zerop num)
|
|
`(list "global num is = 0"
|
|
(format nil "local num is ~A" num)
|
|
(- 100 ,item )))
|
|
(t
|
|
`(list "global num is < 0"
|
|
(format nil "local num is ~A" num)
|
|
(expt ,item 2))))
|
|
))
|
|
;; The parameter num is accessible from here
|
|
(list var (mac1 var))
|
|
)))
|
|
))
|
|
|
|
(do-test "test macro - lexically scoped entities are not visible within the expansion functions"
|
|
;; global variable num was defined in :before section
|
|
(and (equal (lisper -4)
|
|
'(10 ("global num is > 0" "local num is -4" 1000)))
|
|
(equal (progn (set 'num 0) (lisper 30))
|
|
'(8 ("global num is = 0" "local num is 30" 92)))
|
|
(equal (progn (set 'num -9) (lisper 0))
|
|
'(12 ("global num is < 0" "local num is 0" 144)))))
|
|
)
|
|
STOP
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|