223 |
for x in *universe* count |
for x in *universe* count |
224 |
(block failed |
(block failed |
225 |
(let ((p1 (handler-case |
(let ((p1 (handler-case |
226 |
(funcall (the function p) x) |
(normally (funcall (the function p) x)) |
227 |
(error () (format t "(FUNCALL ~S ~S) failed~%" |
(error () (format t "(FUNCALL ~S ~S) failed~%" |
228 |
P x) |
P x) |
229 |
(return-from failed t)))) |
(return-from failed t)))) |
230 |
(p2 (handler-case |
(p2 (handler-case |
231 |
(typep x TYPE) |
(normally (typep x TYPE)) |
232 |
(error () (format t "(TYPEP ~S '~S) failed~%" |
(error () (format t "(TYPEP ~S '~S) failed~%" |
233 |
x TYPE) |
x TYPE) |
234 |
(return-from failed t))))) |
(return-from failed t))))) |
273 |
If an error does occur, return type-error on TYPE-ERRORs, or the error |
If an error does occur, return type-error on TYPE-ERRORs, or the error |
274 |
condition itself on other errors." |
condition itself on other errors." |
275 |
`(locally (declare (optimize (safety 3))) |
`(locally (declare (optimize (safety 3))) |
276 |
(handler-case ,form |
(handler-case (normally ,form) |
277 |
(type-error () 'type-error) |
(type-error () 'type-error) |
278 |
(error (c) c)))) |
(error (c) c)))) |
279 |
|
|
282 |
If an error does occur, return a symbol classify the error, or allow |
If an error does occur, return a symbol classify the error, or allow |
283 |
the condition to go uncaught if it cannot be classified." |
the condition to go uncaught if it cannot be classified." |
284 |
`(locally (declare (optimize (safety 3))) |
`(locally (declare (optimize (safety 3))) |
285 |
(handler-case ,form |
(handler-case (normally ,form) |
286 |
(undefined-function () 'undefined-function) |
(undefined-function () 'undefined-function) |
287 |
(program-error () 'program-error) |
(program-error () 'program-error) |
288 |
(package-error () 'package-error) |
(package-error () 'package-error) |
386 |
;;; (defun complement (fn) |
;;; (defun complement (fn) |
387 |
;;; #'(lambda (&rest args) (not (apply fn args)))))) |
;;; #'(lambda (&rest args) (not (apply fn args)))))) |
388 |
|
|
389 |
|
|
390 |
|
(declaim (ftype (function (&rest function) (values function &optional)) |
391 |
|
compose)) |
392 |
|
|
393 |
(defun compose (&rest fns) |
(defun compose (&rest fns) |
394 |
(let ((rfns (reverse fns))) |
(let ((rfns (reverse fns))) |
395 |
#'(lambda (x) (loop for f |
#'(lambda (x) (loop for f |
438 |
" 'simple-base-string)) |
" 'simple-base-string)) |
439 |
|
|
440 |
(defparameter |
(defparameter |
441 |
+base-chars+ #.(concatenate 'simple-base-string |
+base-chars+ #.(coerce |
442 |
"abcdefghijklmnopqrstuvwxyz" |
(concatenate 'string |
443 |
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" |
"abcdefghijklmnopqrstuvwxyz" |
444 |
"0123456789" |
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" |
445 |
"<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|")) |
"0123456789" |
446 |
|
"<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|") |
447 |
|
'simple-base-string)) |
448 |
|
|
449 |
|
|
450 |
(declaim (type simple-base-string +base-chars+)) |
(declaim (type simple-base-string +base-chars+)) |
451 |
|
|
1284 |
`(eval-when #+gcl (load eval compile) |
`(eval-when #+gcl (load eval compile) |
1285 |
#-gcl (:load-toplevel :compile-toplevel :execute) |
#-gcl (:load-toplevel :compile-toplevel :execute) |
1286 |
(handler-case (eval '(defstruct ,@args)) |
(handler-case (eval '(defstruct ,@args)) |
1287 |
(serious-condition () nil)))) |
(serious-condition () nil)))) |
1288 |
|
|
1289 |
(defun sort-package-list (x) |
(defun sort-package-list (x) |
1290 |
(sort (copy-list x) |
(sort (copy-list x) |