- ;; FIXME: Since none of these are supported in SBCL, the
- ;; declarations using them are just noise now that this is
- ;; not a portable package any more, and could be deleted.
- values ; I use this so that Zwei can remind
- ; me what values a function returns.
- arglist ; Tells me what the pretty arglist
- ; of something (which probably takes
- ; &REST args) is.
- indentation ; Tells ZWEI how to indent things
- ; like DEFCLASS.
- class
- variable-rebinding
- pcl-fast-call
- method-name
- method-lambda-list))
-
-;;; 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)))
-
-;;; 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)
-
-;;; 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 CMU CL, and there's one
-;;; in SB-EXT already (presently to go in SB-INT). 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))))
+ ;; These three nonstandard declarations seem to be used
+ ;; privately within PCL itself to pass information around,
+ ;; so we can't just delete them.
+ %class
+ %method-name
+ %method-lambda-list
+ ;; This declaration may also be used within PCL to pass
+ ;; information around, I'm not sure. -- WHN 2000-12-30
+ %variable-rebinding))
+
+(defmacro name-get-fdefinition (name)
+ (sb-int:once-only ((name name))
+ `(if (symbolp ,name) ; take care of "setf <fun>"'s
+ (symbol-function ,name)
+ (fdefinition ,name))))
+
+(defmacro name-set-fdefinition (name new-definition)
+ (sb-int:once-only ((name name))
+ `(if (symbolp ,name) ; take care of "setf <fun>"'s
+ (setf (symbol-function ,name) ,new-definition)
+ (setf (fdefinition ,name) ,new-definition))))
+
+;;; FIXME: CONSTANTLY-FOO should be boosted up to SB-INT too.
+(macrolet ((def-constantly-fun (name constant-expr)
+ `(setf (symbol-function ',name)
+ (constantly ,constant-expr))))
+ (def-constantly-fun constantly-t t)
+ (def-constantly-fun constantly-nil nil)
+ (def-constantly-fun constantly-0 0))