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.
10 (in-package "SB!IMPL")
14 "If X is an atom, see whether it is present in *FEATURES*. Also
15 handle arbitrary combinations of atoms using NOT, AND, OR."
20 (error "too many subexpressions in feature expression: ~S" x)
21 (not (featurep (cadr x)))))
22 ((:and and) (every #'featurep (cdr x)))
23 ((:or or) (some #'featurep (cdr x)))
25 (error "unknown operator in feature expression: ~S." x)))
26 (not (null (memq x *features*)))))
28 ;;; Given a list of keyword substitutions `(,OLD ,NEW), and a
29 ;;; &KEY-argument-list-style list of alternating keywords and
30 ;;; arbitrary values, return a new &KEY-argument-list-style list with
31 ;;; all substitutions applied to it.
33 ;;; Note: If efficiency mattered, we could do less consing. (But if
34 ;;; efficiency mattered, why would we be using &KEY arguments at
35 ;;; all, much less renaming &KEY arguments?)
37 ;;; KLUDGE: It would probably be good to get rid of this. -- WHN 19991201
38 (defun rename-key-args (rename-list key-args)
39 (declare (type list rename-list key-args))
40 ;; Walk through RENAME-LIST modifying RESULT as per each element in
42 (do ((result (copy-list key-args))) ; may be modified below
43 ((null rename-list) result)
44 (destructuring-bind (old new) (pop rename-list)
45 ;; ANSI says &KEY arg names aren't necessarily KEYWORDs.
46 (declare (type symbol old new))
47 ;; Walk through RESULT renaming any OLD key argument to NEW.
48 (do ((in-result result (cddr in-result)))
50 (declare (type list in-result))
51 (when (eq (car in-result) old)
52 (setf (car in-result) new))))))
54 ;;; ANSI Common Lisp's READ-SEQUENCE function, unlike most of the
55 ;;; other ANSI input functions, is defined to communicate end of file
56 ;;; status with its return value, not by signalling. This is not the
57 ;;; behavior we usually want. This is a wrapper which give the
58 ;;; behavior we usually want, causing READ-SEQUENCE to communicate
59 ;;; end-of-file status by signalling.
60 (defun read-sequence-or-die (sequence stream &key start end)
61 ;; implementation using READ-SEQUENCE
62 #-no-ansi-read-sequence
63 (let ((read-end (read-sequence sequence
67 (unless (= read-end end)
68 (error 'end-of-file :stream stream))
70 ;; workaround for broken READ-SEQUENCE
71 #+no-ansi-read-sequence
74 (let ((etype (stream-element-type stream)))
75 (cond ((equal etype '(unsigned-byte 8))
76 (do ((i start (1+ i)))
79 (setf (aref sequence i)
81 (t (error "unsupported element type ~S" etype))))))