49 |
"Return an instance of a type. Signal an error if |
"Return an instance of a type. Signal an error if |
50 |
it can't figure out a value for the type." |
it can't figure out a value for the type." |
51 |
(cond |
(cond |
52 |
((eq type t) ;; anything |
((eqt type t) ;; anything |
53 |
'a) |
'a) |
54 |
((eq type 'symbol) |
((eqt type 'symbol) |
55 |
'b) |
'b) |
56 |
((eq type 'null) nil) |
((eqt type 'null) nil) |
57 |
((eq type 'boolean) t) |
((eqt type 'boolean) t) |
58 |
((eq type 'keyword) :foo) |
((eqt type 'keyword) :foo) |
59 |
((eq type nil) (error "Cannot obtain element of type ~S~%" type)) |
((eqt type nil) (error "Cannot obtain element of type ~S~%" type)) |
60 |
((eq type 'cons) (cons 'a 'b)) |
((eqt type 'cons) (cons 'a 'b)) |
61 |
((eq type 'list) (list 1 2 3)) |
((eqt type 'list) (list 1 2 3)) |
62 |
((eq type 'fixnum) 17) |
((eqt type 'fixnum) 17) |
63 |
((eq type 'bignum) |
((eqt type 'bignum) |
64 |
(let ((x 1)) |
(let ((x 1)) |
65 |
(loop until (typep x 'bignum) |
(loop until (typep x 'bignum) |
66 |
do (setq x (* 2 x))) |
do (setq x (* 2 x))) |
71 |
(intern (concatenate 'string "MAKE-" (symbol-name type)) |
(intern (concatenate 'string "MAKE-" (symbol-name type)) |
72 |
(symbol-package type)))) |
(symbol-package type)))) |
73 |
(eval (list make-fn)))) |
(eval (list make-fn)))) |
74 |
((eq type 'character) #\w) |
((eqt type 'character) #\w) |
75 |
((eq type 'base-char) #\z) |
((eqt type 'base-char) #\z) |
76 |
((member type '(integer unsigned-byte signed-byte)) 35) |
((member type '(integer unsigned-byte signed-byte)) 35) |
77 |
((eq type 'bit) 1) |
((eqt type 'bit) 1) |
78 |
((and (consp type) |
((and (consp type) |
79 |
(consp (cdr type)) |
(consp (cdr type)) |
80 |
(consp (cddr type)) |
(consp (cddr type)) |
81 |
(null (cdddr type)) |
(null (cdddr type)) |
82 |
(eq (car type) 'integer) |
(eqt (car type) 'integer) |
83 |
(integerp (second type))) |
(integerp (second type))) |
84 |
(second type)) |
(second type)) |
85 |
((member type '(float single-float long-float double-float short-float)) |
((member type '(float single-float long-float double-float short-float)) |
86 |
0.0) |
0.0) |
87 |
((and (consp type) |
((and (consp type) |
88 |
(eq (car type) 'member) |
(eqt (car type) 'member) |
89 |
(consp (cdr type))) |
(consp (cdr type))) |
90 |
(second type)) |
(second type)) |
91 |
((and (consp type) |
((and (consp type) |
92 |
(eq (car type) 'or) |
(eqt (car type) 'or) |
93 |
(consp (second type))) |
(consp (second type))) |
94 |
(create-instance-of-type (second type))) |
(create-instance-of-type (second type))) |
95 |
(t (error "Cannot generate element for type ~S~%" type)))) |
(t (error "Cannot generate element for type ~S~%" type)))) |
191 |
;; Check that two invocations return different structures |
;; Check that two invocations return different structures |
192 |
(deftest ,(make-struct-test-name name 6) |
(deftest ,(make-struct-test-name name 6) |
193 |
,(let ((make-fn (make-struct-make-fn name))) |
,(let ((make-fn (make-struct-make-fn name))) |
194 |
`(eq (,make-fn) (,make-fn))) |
`(eqt (,make-fn) (,make-fn))) |
195 |
nil) |
nil) |
196 |
|
|
197 |
;; Check that we can setf the fields |
;; Check that we can setf the fields |