78 lines
2.3 KiB
Plaintext
78 lines
2.3 KiB
Plaintext
;; Function To Be Tested: CDDR
|
|
;;
|
|
;; Source: Steele's book Section 15.1: Conses Page: 263
|
|
;;
|
|
;; Created By: Karin M. Sye
|
|
;;
|
|
;; Creation Date: July 10 ,1986
|
|
;;
|
|
;; Last Update: July 10 ,1986
|
|
;;
|
|
;; Filed As: {eris}<lispcore>cml>test>15-1-cddr.test
|
|
;;
|
|
;;
|
|
;; Syntax: CDDR LIST
|
|
;;
|
|
;; Function Description: CDDR performs the cdr operation 2 times on LIST, and returns the result.
|
|
;;
|
|
;; Argument(s): LIST - a list
|
|
;;
|
|
;; Returns: anything
|
|
;;
|
|
|
|
(defun mac (list elm)
|
|
(typecase elm (number (= (cddr list) elm))
|
|
((or cons string) (equal (cddr list) elm))
|
|
(t (eq (cddr list) elm))
|
|
)
|
|
)
|
|
(do-test "test cddr0"
|
|
(prog1
|
|
(and (mac '((1) 2 ) ())
|
|
(mac '(#\a #\b #\c) '(#\c))
|
|
(mac '("a" ("b" ("c" . d) . e) . f) 'f)
|
|
(mac '((( 1 2 3 4) 5) 6 7 8 9) '(7 8 9))
|
|
(mac '(( 1 a) (2 b) (3 c)) '((3 c)))
|
|
(mac '((foo bar) (foo1 . bar1) ((foo2 bar2)) ((foo3) bar3) (foo4 (bar4)) (((foo5 bar5))))
|
|
'(((foo2 bar2)) ((foo3) bar3) (foo4 (bar4)) (((foo5 bar5)))) )
|
|
(mac '((#\F) #\o "o1" "foo2" ((foo3)) (foo4 . foo5)) '("o1" "foo2" ((foo3)) (foo4 . foo5)))
|
|
(mac '((("the weather in January" ("is usually clear and sunny")) "with temperatures usually in the " fifties)
|
|
(in the day time) (and ) (the "20's" at night))
|
|
'((and ) (the "20's" at night)) )
|
|
))
|
|
)
|
|
|
|
(do-test "test cddr1"
|
|
(progn (setq a (list (list #'null #'identity) (list #'list #'max #'min #'evenp) #'(lambda (x) (list-length x))))
|
|
(equal (mapcar (car (cddr a)) (mapcar #'cddr '( (()) ((1 2) 3 4) (#\a #\b (7 8)) ((#\d) #\e #\f #\g #\h)) ) )
|
|
'(0 1 1 3 ))
|
|
)
|
|
)
|
|
|
|
(do-test "test cddr2"
|
|
(let ((aa '(1 3 (5) 7 9 ((11)) 13 15 (17 .18))))
|
|
(and (equal (cddr aa) '((5) 7 9 ((11)) 13 15 (17 .18)))
|
|
(equal (cddr (cddr aa)) '(9 ((11)) 13 15 (17 .18)))
|
|
(equal (cddr (cddr (cddr aa))) '(13 15 (17 .18)))
|
|
(equal (cddr (cddr (cddr (cddr aa)))) '((17 .18)))
|
|
)
|
|
)
|
|
)
|
|
|
|
|
|
(do-test "test cddr3"
|
|
(progn (setq aa '((a b) c d ))
|
|
(and
|
|
(setf (cddr aa) (make-list 2 :initial-element '(2 4)))
|
|
(equal aa `((a b) c (2 4)(2 4)))
|
|
(setf (cddr (cddr aa)) '((3 6) 9))
|
|
(equal aa `((a b ) c (2 4)(2 4) (3 6) 9))
|
|
(setf (cddr (cddr (cddr aa))) "magic kingdom")
|
|
(equal aa `((a b) c (2 4)(2 4) (3 6) 9 . "magic kingdom"))
|
|
)
|
|
)
|
|
)
|
|
;;
|
|
;;
|
|
STOP
|