37 |
|
|
38 |
(defvar *random-int-form-blocks* nil) |
(defvar *random-int-form-blocks* nil) |
39 |
|
|
40 |
|
(defvar *maximum-random-int-bits* 45) |
41 |
|
|
42 |
|
(declaim (special *vars*)) |
43 |
|
|
44 |
|
(defstruct var-desc |
45 |
|
(name nil :type symbol) |
46 |
|
(type t)) |
47 |
|
|
48 |
(defun test-random-integer-forms |
(defun test-random-integer-forms |
49 |
(size nvars n &optional (*random-state* (make-random-state t))) |
(size nvars n &optional (*random-state* (make-random-state t))) |
50 |
|
|
71 |
(defun test-random-integer-form |
(defun test-random-integer-form |
72 |
(size nvars &aux (vars (subseq '(a b c d e f g h i j k l m |
(size nvars &aux (vars (subseq '(a b c d e f g h i j k l m |
73 |
n o p q r s t u v w x y z) 0 nvars))) |
n o p q r s t u v w x y z) 0 nvars))) |
74 |
(let* ((form (make-random-integer-form size vars)) |
(let* ((var-ranges (mapcar #'make-random-integer-range vars)) |
|
(var-ranges (mapcar #'make-random-integer-range vars)) |
|
75 |
(var-types (mapcar #'(lambda (range) |
(var-types (mapcar #'(lambda (range) |
76 |
(let ((lo (car range)) |
(let ((lo (car range)) |
77 |
(hi (cadr range))) |
(hi (cadr range))) |
78 |
(assert (>= hi lo)) |
(assert (>= hi lo)) |
79 |
`(integer ,lo ,hi))) |
`(integer ,lo ,hi))) |
80 |
var-ranges)) |
var-ranges)) |
81 |
|
(form (let ((*vars* (loop for v in vars |
82 |
|
for tp in var-types |
83 |
|
collect (make-var-desc :name v |
84 |
|
:type tp)))) |
85 |
|
(make-random-integer-form size))) |
86 |
(vals-list |
(vals-list |
87 |
(loop repeat 20 |
(loop repeat 20 |
88 |
collect |
collect |
111 |
"Generate a list (LO HI) of integers, LO <= HI. This is used |
"Generate a list (LO HI) of integers, LO <= HI. This is used |
112 |
for generating integer types." |
for generating integer types." |
113 |
(declare (ignore var)) |
(declare (ignore var)) |
114 |
(flet ((%r () (let ((r (ash 1 (1+ (random 35))))) |
(flet ((%r () (let ((r (ash 1 (1+ (random *maximum-random-int-bits*))))) |
115 |
(- (random r) (floor (/ r 2)))))) |
(- (random r) (floor (/ r 2)))))) |
116 |
(let ((x (%r)) |
(let ((x (%r)) |
117 |
(y (%r))) |
(y (%r))) |
119 |
|
|
120 |
(defparameter *flet-names* nil) |
(defparameter *flet-names* nil) |
121 |
|
|
122 |
(defun make-random-integer-form (size vars) |
(defun make-random-integer-form (size) |
123 |
"Generate a random legal lisp form of size SIZE (roughly). VARS |
"Generate a random legal lisp form of size SIZE (roughly)." |
124 |
is a list of variable symbols that contain integers." |
|
125 |
(if (<= size 1) |
(if (<= size 1) |
126 |
;; Leaf node -- generate a variable, constant, or flet function call |
;; Leaf node -- generate a variable, constant, or flet function call |
127 |
(rcase |
(rcase |
128 |
(10 (let ((r (ash 1 (1+ (random 32))))) |
(10 (let ((r (ash 1 (1+ (random 32))))) |
129 |
(- (random r) (floor (/ r 2))))) |
(- (random r) (floor (/ r 2))))) |
130 |
(9 (random-from-seq vars)) |
(9 (var-desc-name (random-from-seq *vars*))) |
131 |
(1 (if *flet-names* (list (random-from-seq *flet-names*)) |
(1 (if *flet-names* (list (random-from-seq *flet-names*)) |
132 |
(random-from-seq vars)))) |
(var-desc-name (random-from-seq *vars*))))) |
133 |
;; (> size 1) |
;; (> size 1) |
134 |
(rcase |
(rcase |
135 |
;; Unary ops |
;; Unary ops |
137 |
(let ((op (random-from-seq '(- abs signum 1+ 1- identity progn floor |
(let ((op (random-from-seq '(- abs signum 1+ 1- identity progn floor |
138 |
ceiling truncate round realpart imagpart |
ceiling truncate round realpart imagpart |
139 |
integer-length logcount values)))) |
integer-length logcount values)))) |
140 |
`(,op ,(make-random-integer-form (1- size) vars)))) |
`(,op ,(make-random-integer-form (1- size))))) |
141 |
(2 `(isqrt (abs ,(make-random-integer-form (- size 2) vars)))) |
(2 `(isqrt (abs ,(make-random-integer-form (- size 2))))) |
142 |
(3 |
#| (3 |
143 |
(destructuring-bind (s1 s2) |
(destructuring-bind (s1 s2) |
144 |
(random-partition (- size 2) 2) |
(random-partition (- size 2) 2) |
145 |
`(ash ,(make-random-integer-form s1 vars) |
`(ash ,(make-random-integer-form s1) |
146 |
(min ,(random 100) |
(min ,(random 100) |
147 |
,(make-random-integer-form s2 vars))))) |
,(make-random-integer-form s2))))) |# |
148 |
|
|
149 |
;; binary floor, ceiling, truncate, round |
;; binary floor, ceiling, truncate, round |
150 |
(4 |
(4 |
152 |
(op2 (random-from-seq #(max min)))) |
(op2 (random-from-seq #(max min)))) |
153 |
(destructuring-bind (s1 s2) |
(destructuring-bind (s1 s2) |
154 |
(random-partition (- size 2) 2) |
(random-partition (- size 2) 2) |
155 |
`(,op ,(make-random-integer-form s1 vars) |
`(,op ,(make-random-integer-form s1) |
156 |
(,op2 ,(if (eq op2 'max) |
(,op2 ,(if (eq op2 'max) |
157 |
(1+ (random 100)) |
(1+ (random 100)) |
158 |
(- (1+ (random 100)))) |
(- (1+ (random 100)))) |
159 |
,(make-random-integer-form s2 vars)))))) |
,(make-random-integer-form s2)))))) |
160 |
|
|
161 |
;; Binary op |
;; Binary op |
162 |
(80 |
(80 |
170 |
logorc2 logxor)))) |
logorc2 logxor)))) |
171 |
(destructuring-bind (leftsize rightsize) |
(destructuring-bind (leftsize rightsize) |
172 |
(random-partition (1- size) 2) |
(random-partition (1- size) 2) |
173 |
(let ((e1 (make-random-integer-form leftsize vars)) |
(let ((e1 (make-random-integer-form leftsize)) |
174 |
(e2 (make-random-integer-form rightsize vars))) |
(e2 (make-random-integer-form rightsize))) |
175 |
`(,op ,e1 ,e2))))) |
`(,op ,e1 ,e2))))) |
176 |
;; conditionals |
;; conditionals |
177 |
(20 |
(20 |
178 |
(let* ((cond-size (random (max 1 (floor size 2)))) |
(let* ((cond-size (random (max 1 (floor size 2)))) |
179 |
(then-size (random (- size cond-size))) |
(then-size (random (- size cond-size))) |
180 |
(else-size (- size 1 cond-size then-size)) |
(else-size (- size 1 cond-size then-size)) |
181 |
(pred (make-random-pred-form cond-size vars)) |
(pred (make-random-pred-form cond-size)) |
182 |
(then-part (make-random-integer-form then-size vars)) |
(then-part (make-random-integer-form then-size)) |
183 |
(else-part (make-random-integer-form else-size vars))) |
(else-part (make-random-integer-form else-size))) |
184 |
`(if ,pred ,then-part ,else-part))) |
`(if ,pred ,then-part ,else-part))) |
185 |
(10 |
(10 |
186 |
(destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) |
(destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) |
187 |
`(,(random-from-seq '(deposit-field dpb)) |
`(,(random-from-seq '(deposit-field dpb)) |
188 |
,(make-random-integer-form s1 vars) |
,(make-random-integer-form s1) |
189 |
,(make-random-byte-spec-form s2 vars) |
,(make-random-byte-spec-form s2) |
190 |
,(make-random-integer-form s3 vars)))) |
,(make-random-integer-form s3)))) |
191 |
;; #-:allegro |
;; #-:allegro |
192 |
(10 |
(10 |
193 |
(destructuring-bind (s1 s2) (random-partition (1- size) 2) |
(destructuring-bind (s1 s2) (random-partition (1- size) 2) |
194 |
`(,(random-from-seq '(ldb mask-field)) |
`(,(random-from-seq '(ldb mask-field)) |
195 |
,(make-random-byte-spec-form s1 vars) |
,(make-random-byte-spec-form s1) |
196 |
,(make-random-integer-form s2 vars)))) |
,(make-random-integer-form s2)))) |
197 |
(20 |
(20 |
198 |
(destructuring-bind (s1 s2) (random-partition (1- size) 2) |
(destructuring-bind (s1 s2) (random-partition (1- size) 2) |
199 |
(let* ((var (random-from-seq #(v1 v2 v3 v4 v5 v6 v7 v8 v9 v10))) |
(let* ((var (random-from-seq #(v1 v2 v3 v4 v5 v6 v7 v8 v9 v10))) |
200 |
(e1 (make-random-integer-form s1 vars)) |
(e1 (make-random-integer-form s1)) |
201 |
(e2 (make-random-integer-form s2 (cons var vars)))) |
(e2 (let ((*vars* (cons (make-var-desc :name var |
202 |
|
:type '(integer * *)) |
203 |
|
*vars*))) |
204 |
|
(make-random-integer-form s2)))) |
205 |
;; for now, avoid shadowing |
;; for now, avoid shadowing |
206 |
(if (member var vars) |
(if (member var *vars* :key #'var-desc-name) |
207 |
(make-random-integer-form size vars) |
(make-random-integer-form size) |
208 |
`(let ((,var ,e1)) ,e2))))) |
`(let ((,var ,e1)) ,e2))))) |
209 |
(4 `(let () ,(make-random-integer-form (1- size) vars))) |
(4 `(let () ,(make-random-integer-form (1- size)))) |
210 |
(10 |
(10 |
211 |
(let* ((name (random-from-seq #(b1 b2 b3 b4 b5 b6 b7 b8))) |
(let* ((name (random-from-seq #(b1 b2 b3 b4 b5 b6 b7 b8))) |
212 |
(*random-int-form-blocks* (adjoin name *random-int-form-blocks*))) |
(*random-int-form-blocks* (adjoin name *random-int-form-blocks*))) |
213 |
`(block ,name ,(make-random-integer-form (1- size) vars)))) |
`(block ,name ,(make-random-integer-form (1- size))))) |
214 |
(3 (make-random-integer-case-form size vars)) |
(4 ;; setq |
215 |
|
(let* ((vdesc (random-from-seq *vars*)) |
216 |
|
(var (var-desc-name vdesc)) |
217 |
|
(type (var-desc-type vdesc))) |
218 |
|
(cond |
219 |
|
((equal type '(integer * *)) |
220 |
|
`(setq ,var ,(make-random-integer-form (1- size)))) |
221 |
|
((and (consp type) |
222 |
|
(eq (car type) 'integer) |
223 |
|
(integerp (second type)) |
224 |
|
(integerp (third type))) |
225 |
|
`(setq ,var ,(random-from-interval (1+ (third type)) (second type)))) |
226 |
|
(t (make-random-integer-form size))))) |
227 |
|
|
228 |
|
(3 (make-random-integer-case-form size)) |
229 |
(3 |
(3 |
230 |
(if *random-int-form-blocks* |
(if *random-int-form-blocks* |
231 |
(let ((name (random-from-seq *random-int-form-blocks*)) |
(let ((name (random-from-seq *random-int-form-blocks*)) |
232 |
(form (make-random-integer-form (1- size) vars))) |
(form (make-random-integer-form (1- size)))) |
233 |
`(return-from ,name ,form)) |
`(return-from ,name ,form)) |
234 |
;; No blocks -- try again |
;; No blocks -- try again |
235 |
(make-random-integer-form size vars))) |
(make-random-integer-form size))) |
236 |
|
|
237 |
(5 |
(5 |
238 |
(if *random-int-form-blocks* |
(if *random-int-form-blocks* |
239 |
(destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) |
(destructuring-bind (s1 s2 s3) (random-partition (1- size) 3) |
240 |
(let ((name (random-from-seq *random-int-form-blocks*)) |
(let ((name (random-from-seq *random-int-form-blocks*)) |
241 |
(pred (make-random-pred-form s1 vars)) |
(pred (make-random-pred-form s1)) |
242 |
(then (make-random-integer-form s2 vars)) |
(then (make-random-integer-form s2)) |
243 |
(else (make-random-integer-form s3 vars))) |
(else (make-random-integer-form s3))) |
244 |
`(if ,pred (return-from ,name ,then) ,else))) |
`(if ,pred (return-from ,name ,then) ,else))) |
245 |
;; No blocks -- try again |
;; No blocks -- try again |
246 |
(make-random-integer-form size vars))) |
(make-random-integer-form size))) |
247 |
|
|
248 |
(5 (make-random-flet-form size vars)) |
(5 (make-random-flet-form size)) |
249 |
|
|
250 |
))) |
))) |
251 |
|
|
252 |
(defun make-random-integer-case-form (size vars) |
(defun make-random-integer-case-form (size) |
253 |
(let ((ncases (1+ (random 10)))) |
(let ((ncases (1+ (random 10)))) |
254 |
(if (< (+ size size) (+ ncases 2)) |
(if (< (+ size size) (+ ncases 2)) |
255 |
;; Too small, give up |
;; Too small, give up |
256 |
(make-random-integer-form size vars) |
(make-random-integer-form size) |
257 |
(let* ((sizes (random-partition (1- size) (+ ncases 2))) |
(let* ((sizes (random-partition (1- size) (+ ncases 2))) |
258 |
(bound (ash 1 (+ 2 (random 16)))) |
(bound (ash 1 (+ 2 (random 16)))) |
259 |
(lower-bound (if (coin 3) 0 (- bound))) |
(lower-bound (if (coin 3) 0 (- bound))) |
266 |
for vals = (loop repeat (1+ (min (random 10) (random 10))) |
for vals = (loop repeat (1+ (min (random 10) (random 10))) |
267 |
collect (random-from-interval |
collect (random-from-interval |
268 |
upper-bound lower-bound)) |
upper-bound lower-bound)) |
269 |
for result = (make-random-integer-form case-size vars) |
for result = (make-random-integer-form case-size) |
270 |
repeat ncases |
repeat ncases |
271 |
collect `(,vals ,result))) |
collect `(,vals ,result))) |
272 |
(expr (make-random-integer-form (first sizes) vars))) |
(expr (make-random-integer-form (first sizes)))) |
273 |
`(case ,expr |
`(case ,expr |
274 |
,@cases |
,@cases |
275 |
(t ,(make-random-integer-form (second sizes) vars))))))) |
(t ,(make-random-integer-form (second sizes)))))))) |
276 |
|
|
277 |
(defun make-random-flet-form (size vars) |
(defun make-random-flet-form (size) |
278 |
"Generate random flet, labels forms, for now with no arguments |
"Generate random flet, labels forms, for now with no arguments |
279 |
and a single binding per form." |
and a single binding per form." |
280 |
(let ((fname (random-from-seq #(%f1 %f2 %f3 %f4 %f5 %f6 %f7 %f8 %f9 %f10 |
(let ((fname (random-from-seq #(%f1 %f2 %f3 %f4 %f5 %f6 %f7 %f8 %f9 %f10 |
281 |
%f11 %f12 %f13 %f14 %f15 %f16 %f17 %f18)))) |
%f11 %f12 %f13 %f14 %f15 %f16 %f17 %f18)))) |
282 |
(if (member fname *flet-names* :test #'eq) |
(if (member fname *flet-names* :test #'eq) |
283 |
(make-random-integer-form size vars) |
(make-random-integer-form size) |
284 |
(destructuring-bind (s1 s2) (random-partition (max 2 (1- size)) 2) |
(destructuring-bind (s1 s2) (random-partition (max 2 (1- size)) 2) |
285 |
(let ((op (random-from-seq #(flet labels))) |
(let ((op (random-from-seq #(flet labels))) |
286 |
(form1 |
(form1 |
287 |
;; Allow return-from of the flet/labels function |
;; Allow return-from of the flet/labels function |
288 |
(let ((*random-int-form-blocks* |
(let ((*random-int-form-blocks* |
289 |
(cons fname *random-int-form-blocks*))) |
(cons fname *random-int-form-blocks*))) |
290 |
(make-random-integer-form s1 vars))) |
(make-random-integer-form s1))) |
291 |
(form2 (let ((*flet-names* (cons fname *flet-names*))) |
(form2 (let ((*flet-names* (cons fname *flet-names*))) |
292 |
(make-random-integer-form s2 vars)))) |
(make-random-integer-form s2)))) |
293 |
`(,op ((,fname () ,form1)) ,form2)))))) |
`(,op ((,fname () ,form1)) ,form2)))))) |
294 |
|
|
295 |
(defun make-random-pred-form (size vars) |
(defun make-random-pred-form (size) |
296 |
"Make a random form whose value is to be used as a generalized boolean." |
"Make a random form whose value is to be used as a generalized boolean." |
297 |
(if (<= size 1) |
(if (<= size 1) |
298 |
(rcase |
(rcase |
299 |
(1 (if (coin) t nil)) |
(1 (if (coin) t nil)) |
300 |
(2 |
(2 |
301 |
`(,(random-from-seq '(< <= = > >= /= eql equal)) |
`(,(random-from-seq '(< <= = > >= /= eql equal)) |
302 |
,(make-random-integer-form size vars) |
,(make-random-integer-form size) |
303 |
,(make-random-integer-form size vars)))) |
,(make-random-integer-form size)))) |
304 |
(rcase |
(rcase |
305 |
(1 (if (coin) t nil)) |
(1 (if (coin) t nil)) |
306 |
(1 `(not ,(make-random-pred-form (1- size) vars))) |
(1 `(not ,(make-random-pred-form (1- size)))) |
307 |
(2 (destructuring-bind (leftsize rightsize) |
(2 (destructuring-bind (leftsize rightsize) |
308 |
(random-partition (1- size) 2) |
(random-partition (1- size) 2) |
309 |
`(,(random-from-seq '(and or)) |
`(,(random-from-seq '(and or)) |
310 |
,(make-random-pred-form leftsize vars) |
,(make-random-pred-form leftsize) |
311 |
,(make-random-pred-form rightsize vars)))) |
,(make-random-pred-form rightsize)))) |
312 |
(1 (destructuring-bind (leftsize rightsize) |
(1 (destructuring-bind (leftsize rightsize) |
313 |
(random-partition (1- size) 2) |
(random-partition (1- size) 2) |
314 |
`(,(random-from-seq '(< <= > >= = /= eql equal)) |
`(,(random-from-seq '(< <= > >= = /= eql equal)) |
315 |
,(make-random-integer-form leftsize vars) |
,(make-random-integer-form leftsize) |
316 |
,(make-random-integer-form rightsize vars)))) |
,(make-random-integer-form rightsize)))) |
317 |
(1 (let* ((cond-size (random (max 1 (floor size 2)))) |
(1 (let* ((cond-size (random (max 1 (floor size 2)))) |
318 |
(then-size (random (- size cond-size))) |
(then-size (random (- size cond-size))) |
319 |
(else-size (- size 1 cond-size then-size)) |
(else-size (- size 1 cond-size then-size)) |
320 |
(pred (make-random-pred-form cond-size vars)) |
(pred (make-random-pred-form cond-size)) |
321 |
(then-part (make-random-pred-form then-size vars)) |
(then-part (make-random-pred-form then-size)) |
322 |
(else-part (make-random-pred-form else-size vars))) |
(else-part (make-random-pred-form else-size))) |
323 |
`(if ,pred ,then-part ,else-part))) |
`(if ,pred ,then-part ,else-part))) |
324 |
(1 (destructuring-bind (s1 s2) |
(1 (destructuring-bind (s1 s2) |
325 |
(random-partition (1- size) 2) |
(random-partition (1- size) 2) |
326 |
`(ldb-test ,(make-random-byte-spec-form s1 vars) |
`(ldb-test ,(make-random-byte-spec-form s1) |
327 |
,(make-random-integer-form s2 vars)))) |
,(make-random-integer-form s2)))) |
328 |
(1 (let ((index (random (1+ (random 35)))) |
(1 (let ((index (random (1+ (random *maximum-random-int-bits*)))) |
329 |
(form (make-random-integer-form (1- size) vars))) |
(form (make-random-integer-form (1- size)))) |
330 |
`(logbitp ,index ,form))) |
`(logbitp ,index ,form))) |
331 |
))) |
))) |
332 |
|
|
333 |
(defun make-random-byte-spec-form (size vars) |
(defun make-random-byte-spec-form (size) |
334 |
(declare (ignore size vars)) |
(declare (ignore size)) |
335 |
(let* ((pform (random 33)) |
(let* ((pform (random 33)) |
336 |
(sform (1+ (random 33)))) |
(sform (1+ (random 33)))) |
337 |
`(byte ,sform ,pform))) |
`(byte ,sform ,pform))) |
355 |
(t hi))))) |
(t hi))))) |
356 |
(if (eq lo '*) |
(if (eq lo '*) |
357 |
(if (eq hi '*) |
(if (eq hi '*) |
358 |
(let ((x (ash 1 (random 35)))) |
(let ((x (ash 1 (random *maximum-random-int-bits*)))) |
359 |
(random-from-interval x (- x))) |
(random-from-interval x (- x))) |
360 |
(random-from-interval (1+ hi) |
(random-from-interval (1+ hi) |
361 |
(- hi (random (ash 1 35))))) |
(- hi (random (ash 1 *maximum-random-int-bits*))))) |
362 |
|
|
363 |
(if (eq hi '*) |
(if (eq hi '*) |
364 |
(random-from-interval (+ lo (random (ash 1 35)) 1) |
(random-from-interval (+ lo (random (ash 1 *maximum-random-int-bits*)) 1) |
365 |
lo) |
lo) |
366 |
;; May generalize the next case to increase odds |
;; May generalize the next case to increase odds |
367 |
;; of certain integers (near 0, near endpoints, near |
;; of certain integers (near 0, near endpoints, near |
380 |
(make-random-element-of-type '(integer 0 *)) |
(make-random-element-of-type '(integer 0 *)) |
381 |
(progn |
(progn |
382 |
(assert (and (integerp bits) (>= bits 1))) |
(assert (and (integerp bits) (>= bits 1))) |
383 |
(make-random-element-of-type `(integer 0 ,(1- (ash 1 bits))))))))) |
(make-random-element-of-type |
384 |
|
`(integer 0 ,(1- (ash 1 bits))))))))) |
385 |
))) |
))) |
386 |
(t |
(t |
387 |
(ecase type |
(ecase type |
388 |
(bit (random 2)) |
(bit (random 2)) |
389 |
(boolean (random-from-seq #(nil t))) |
(boolean (random-from-seq #(nil t))) |
390 |
(symbol (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| cl:car))) |
(symbol (random-from-seq #(nil t a b c :a :b :c |z| foo |foo| cl:car))) |
391 |
(unsigned-byte (random-from-interval (1+ (ash 1 (random 35))) 0)) |
(unsigned-byte (random-from-interval |
392 |
(integer (let ((x (ash 1 (random 35)))) |
(1+ (ash 1 (random *maximum-random-int-bits*))) 0)) |
393 |
|
(integer (let ((x (ash 1 (random *maximum-random-int-bits*)))) |
394 |
(random-from-interval (1+ x) (- x)))) |
(random-from-interval (1+ x) (- x)))) |
395 |
)))) |
)))) |
396 |
|
|
546 |
realpart imagpart) |
realpart imagpart) |
547 |
(mapc #'try args) |
(mapc #'try args) |
548 |
(try 0) |
(try 0) |
|
(try 1) |
|
549 |
(try -1) |
(try -1) |
550 |
(prune-fn form try-fn)) |
(prune-fn form try-fn)) |
551 |
|
|
552 |
((abs 1+ 1- identity values) |
((abs 1+ 1- identity values progn realpart imagpart) |
553 |
(mapc #'try args) |
(mapc #'try args) |
554 |
(prune-fn form try-fn)) |
(prune-fn form try-fn)) |
555 |
|
|
566 |
(else (third args))) |
(else (third args))) |
567 |
(try then) |
(try then) |
568 |
(try else) |
(try else) |
569 |
|
(when (every #'constantp args) |
570 |
|
(try (eval form))) |
571 |
(prune-fn form try-fn))) |
(prune-fn form try-fn))) |
572 |
|
|
573 |
|
((setq) |
574 |
|
;; Assumes only one assignment |
575 |
|
(assert (= (length form) 3)) |
576 |
|
(try (second args)) |
577 |
|
(prune (second args) |
578 |
|
#'(lambda (form) |
579 |
|
(try `(,op ,(first args) ,form))))) |
580 |
|
|
581 |
((byte) |
((byte) |
582 |
(prune-fn form try-fn)) |
(prune-fn form try-fn)) |
583 |
|
|
584 |
((deposit-field dpb) |
((deposit-field dpb) |
585 |
(try (first args)) |
(destructuring-bind (a1 a2 a3) |
586 |
(try (third args)) |
args |
587 |
|
(try a1) |
588 |
|
(try a3) |
589 |
|
(when (and (integerp a1) |
590 |
|
(integerp a3) |
591 |
|
(and (consp a2) |
592 |
|
(eq (first a2) 'byte) |
593 |
|
(integerp (second a2)) |
594 |
|
(integerp (third a2)))) |
595 |
|
(try (eval form)))) |
596 |
(prune-fn form try-fn)) |
(prune-fn form try-fn)) |
597 |
|
|
598 |
((ldb mask-field) |
((ldb mask-field) |