X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fliece-clfns.el;h=baf5aceaf84e622c8632862130d56a777a7bf14b;hb=3078b2eb49bb36b0bbe92a82ec45fdf4e62e85e2;hp=a76ea7a25082a91cc6258ff8c6f07e4901ce155c;hpb=79bd78bd701bbc2d9b449d40d451c58987e4a607;p=elisp%2Fliece.git

diff --git a/lisp/liece-clfns.el b/lisp/liece-clfns.el
index a76ea7a..baf5ace 100644
--- a/lisp/liece-clfns.el
+++ b/lisp/liece-clfns.el
@@ -30,13 +30,19 @@
 
 ;;; 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))
@@ -53,9 +59,17 @@
 	     (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))
@@ -64,8 +78,7 @@
 	 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))
@@ -74,8 +87,7 @@
 	 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))))
@@ -83,8 +95,7 @@
 	 (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))))
@@ -92,8 +103,7 @@
 	 (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)))
@@ -101,8 +111,7 @@
 	 (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))))
@@ -110,8 +119,7 @@
 	 (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))))