1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
17 "If X is an atom, see whether it is present in *FEATURES*. Also
18 handle arbitrary combinations of atoms using NOT, AND, OR."
23 (error "too many subexpressions in feature expression: ~S" x)
24 (not (featurep (cadr x)))))
25 ((:and and) (every #'featurep (cdr x)))
26 ((:or or) (some #'featurep (cdr x)))
28 (error "unknown operator in feature expression: ~S." x)))
29 (not (null (memq x *features*)))))
31 ;;; KLUDGE: This is a wrapper around stale code for working with floating point
32 ;;; infinities. I believe that I will eventually eliminate floating point
33 ;;; infinities from the code, since they're a pain to cross-compile, since they
34 ;;; significantly increase the number of conditions which need to be tested in
35 ;;; numeric functions, and since the benefits which they provide (which are
36 ;;; admittedly significant) are unfortunately not portable. I haven't actually
37 ;;; done the dirty deed yet, though, and until then, I've wrapped various
38 ;;; infinity-returning forms in this macro. -- WHN 1999
39 (defmacro infinite (x)
40 (declare (ignorable x))
41 #!-sb-infinities '(error 'floating-point-overflow)
44 ;;; Given a list of keyword substitutions `(,OLD ,NEW), and a
45 ;;; keyword-argument-list-style list of alternating keywords and arbitrary
46 ;;; values, return a new keyword-argument-list-style list with all
47 ;;; substitutions applied to it.
49 ;;; Note: If efficiency mattered, we could do less consing. (But if efficiency
50 ;;; mattered, why would we be using keyword arguments at all, much less
51 ;;; renaming keyword arguments?)
53 ;;; KLUDGE: It would probably be good to get rid of this. -- WHN 19991201
54 (defun rename-keyword-args (rename-list keyword-args)
55 (declare (type list rename-list keyword-args))
56 ;; Walk through RENAME-LIST modifying RESULT as per each element in
58 (do ((result (copy-list keyword-args))) ; may be modified below
59 ((null rename-list) result)
60 (destructuring-bind (old new) (pop rename-list)
61 (declare (type keyword old new))
62 ;; Walk through RESULT renaming any OLD keyword argument to NEW.
63 (do ((in-result result (cddr in-result)))
65 (declare (type list in-result))
66 (when (eq (car in-result) old)
67 (setf (car in-result) new))))))
69 ;;; ANSI Common Lisp's READ-SEQUENCE function, unlike most of the
70 ;;; other ANSI input functions, is defined to communicate end of file
71 ;;; status with its return value, not by signalling. This is not the
72 ;;; behavior we usually want. This is a wrapper which give the
73 ;;; behavior we usually want, causing READ-SEQUENCE to communicate
74 ;;; end-of-file status by signalling.
75 (defun read-sequence-or-die (sequence stream &key start end)
76 ;; implementation using READ-SEQUENCE
77 #-no-ansi-read-sequence
78 (let ((read-end (read-sequence sequence
82 (unless (= read-end end)
83 (error 'end-of-file :stream stream))
85 ;; workaround for broken READ-SEQUENCE
86 #+no-ansi-read-sequence
88 (assert (<= start end))
89 (let ((etype (stream-element-type stream)))
90 (cond ((equal etype '(unsigned-byte 8))
91 (do ((i start (1+ i)))
94 (setf (aref sequence i)
96 (t (error "unsupported element type ~S" etype))))))