;;; Code:
+(defun liece-clfns-subr-fboundp (symbol)
+ "Return t if SYMBOL's function definition is a basic function."
+ (and (fboundp symbol)
+ (or (subrp (symbol-function symbol))
+ (and (fboundp 'symbol-file)
+ (string-equal (symbol-file symbol) "subr")))))
+
(if (featurep 'xemacs)
nil
(require 'cl)
(define-compiler-macro last (&whole form x &optional n)
- (if (and (fboundp 'last)
- (subrp (symbol-function 'last)))
+ (if (liece-clfns-subr-fboundp 'last)
form
(if n
`(let* ((x ,x) (n ,n) (m 0) (p x))
(pop x))
x))))
+ (define-compiler-macro remq (&whole form elt list)
+ (if (liece-clfns-subr-fboundp 'remq)
+ form
+ `(let ((elt ,elt)
+ (list ,list))
+ (if (memq elt list)
+ (delq elt (copy-sequence list))
+ list))))
+
(define-compiler-macro member-if (&whole form pred list)
- (if (and (fboundp 'member-if)
- (subrp (symbol-function 'member-if)))
+ (if (liece-clfns-subr-fboundp 'member-if)
form
`(let ((fn ,pred)
(seq ,list))
seq)))
(define-compiler-macro member-if-not (&whole form pred list)
- (if (and (fboundp 'member-if-not)
- (subrp (symbol-function 'member-if-not)))
+ (if (liece-clfns-subr-fboundp 'member-if-not)
form
`(let ((fn ,pred)
(seq ,list))
seq)))
(define-compiler-macro delete-if (&whole form pred list)
- (if (and (fboundp 'delete-if)
- (subrp (symbol-function 'delete-if)))
+ (if (liece-clfns-subr-fboundp 'delete-if)
form
`(let* ((fn ,pred) (seq ,list) (p seq))
(while (and p (not (funcall fn (car p))))
(if p (delq (car p) seq)))))
(define-compiler-macro remove-if (&whole form pred list)
- (if (and (fboundp 'remove-if)
- (subrp (symbol-function 'remove-if)))
+ (if (liece-clfns-subr-fboundp 'remove-if)
form
`(let* ((fn ,pred) (seq (copy-sequence ,list)) (p seq))
(while (and p (not (funcall fn (car p))))
(if p (delq (car p) seq) seq))))
(define-compiler-macro remove-if-not (&whole form pred list)
- (if (and (fboundp 'remove-if-not)
- (subrp (symbol-function 'remove-if-not)))
+ (if (liece-clfns-subr-fboundp 'remove-if-not)
form
`(let* ((fn ,pred) (seq (copy-sequence ,list)) (p seq))
(while (and p (funcall fn (car p)))
(if p (delq (car p) seq) seq))))
(define-compiler-macro assoc-if (&whole form pred list)
- (if (and (fboundp 'assoc-if)
- (subrp (symbol-function 'assoc-if)))
+ (if (liece-clfns-subr-fboundp 'assoc-if)
form
`(let ((fn ,pred) (seq ,list))
(while (and seq (not (funcall fn (caar seq))))
(car seq))))
(define-compiler-macro rassoc-if (&whole form pred list)
- (if (and (fboundp 'rassoc-if)
- (subrp (symbol-function 'rassoc-if)))
+ (if (liece-clfns-subr-fboundp 'rassoc-if)
form
`(let ((fn ,pred) (seq ,list))
(while (and seq (not (funcall fn (cdar seq))))