-;;; comment from CMU CL PCL:
-;;; These are age-old functions which CommonLisp cleaned-up away. They
-;;; probably exist in other packages in all CommonLisp
-;;; implementations, but I will leave it to the compiler to optimize
-;;; into calls to them.
-;;;
-;;; FIXME: MEMQ, ASSQ, and DELQ are already defined in SBCL, and we should
-;;; use those. POSQ and NEQ aren't defined in SBCL, and are used too often
-;;; in PCL to make it appealing to hand expand all uses and then delete
-;;; the macros, so they should be boosted up to SBCL to stand by MEMQ,
-;;; ASSQ, and DELQ.
-(defmacro memq (item list) `(member ,item ,list :test #'eq))
-(defmacro assq (item list) `(assoc ,item ,list :test #'eq))
-(defmacro delq (item list) `(delete ,item ,list :test #'eq))
-(defmacro posq (item list) `(position ,item ,list :test #'eq))
-(defmacro neq (x y) `(not (eq ,x ,y)))
-
-;;; FIXME: Rename these to CONSTANTLY-T, CONSTANTLY-NIL, and
-;;; CONSTANTLY-0, and boost them up to SB-INT.
-(defun true (&rest ignore) (declare (ignore ignore)) t)
-(defun false (&rest ignore) (declare (ignore ignore)) nil)
-(defun zero (&rest ignore) (declare (ignore ignore)) 0)
-
-;;; comment from original CMU CL PCL: ONCE-ONLY does the same thing as
-;;; it does in zetalisp. I should have just lifted it from there but I
-;;; am honest. Not only that but this one is written in Common Lisp. I
-;;; feel a lot like bootstrapping, or maybe more like rebuilding Rome.
-;;;
-;;; FIXME: We should only need one ONCE-ONLY in SBCL, and there's one
-;;; in SB-INT already. Can we use only one of these in both places?
-(defmacro once-only (vars &body body)
- (let ((gensym-var (gensym))
- (run-time-vars (gensym))
- (run-time-vals (gensym))
- (expand-time-val-forms ()))
- (dolist (var vars)
- (push `(if (or (symbolp ,var)
- (numberp ,var)
- (and (listp ,var)
- (member (car ,var) '(quote function))))
- ,var
- (let ((,gensym-var (gensym)))
- (push ,gensym-var ,run-time-vars)
- (push ,var ,run-time-vals)
- ,gensym-var))
- expand-time-val-forms))
- `(let* (,run-time-vars
- ,run-time-vals
- (wrapped-body
- (let ,(mapcar #'list vars (reverse expand-time-val-forms))
- ,@body)))
- `(let ,(mapcar #'list (reverse ,run-time-vars)
- (reverse ,run-time-vals))
- ,wrapped-body))))
-