From 34233787c6eac150887ffcd3efd8062476b2e9ec Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@users.sourceforge.net>
Date: Thu, 13 May 2010 22:34:04 +0200
Subject: [PATCH] Replaced the C1 special form for MEMBER with a compiler
 macro.

---
 src/cmp/cmpform.lsp     |  1 -
 src/cmp/cmpfun.lsp      | 28 ----------------------------
 src/cmp/cmppolicy.lsp   |  4 ++++
 src/cmp/load.lsp.in     |  1 +
 src/new-cmp/cmpfun.lsp  | 23 -----------------------
 src/new-cmp/load.lsp.in |  2 ++
 6 files changed, 7 insertions(+), 52 deletions(-)

diff --git a/src/cmp/cmpform.lsp b/src/cmp/cmpform.lsp
index 818be14dd..cffea05ea 100644
--- a/src/cmp/cmpform.lsp
+++ b/src/cmp/cmpform.lsp
@@ -64,7 +64,6 @@
     (C2PRINC		object-string-or-char stream-var stream-c1form :side-effects)
     (RPLACA		(dest-c1form value-c1form) :side-effects)
     (RPLACD		(dest-c1form value-c1form) :side-effects)
-    (MEMBER!2		fun-symbol args-c1form-list :pure)
     (ASSOC!2		fun-symbol args-c1form-list :pure)
 
     (SI:STRUCTURE-REF	struct-c1form type-name slot-index (:UNSAFE/NIL) :pure)
diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp
index dfed37f22..51f9b328a 100644
--- a/src/cmp/cmpfun.lsp
+++ b/src/cmp/cmpfun.lsp
@@ -121,32 +121,6 @@
     (unwind-exit x)
     (close-inline-blocks)))
 
-(defun c1member (args)
-  (check-args-number 'MEMBER args 2)
-  (cond ((endp (cddr args))
-	 (make-c1form* 'MEMBER!2 :args 'EQL (c1args* args)))
-	((and (eq (third args) :test)
-	      (= (length args) 4)       ; Beppe
-	      (member (fourth args) '('EQ #'EQ 'EQUAL #'EQUAL 'EQL #'EQL)
-		      :test #'EQUAL))	; arg4 = (QUOTE EQ)
-	 (make-c1form* 'MEMBER!2 :args (second (fourth args))
-		       (c1args* (list (car args) (second args)))))
-	(t
-	 (c1call-global 'MEMBER args))))
-
-(defun c2member!2 (fun args)
-  (let ((*inline-blocks* 0)
-        (*temp* *temp*))
-    (unwind-exit
-     (produce-inline-loc (inline-args args) '(T T) '(:object)
-                         (case fun
-                           (EQ "si_memq(#0,#1)")
-                           (EQL "ecl_memql(#0,#1)")
-                           (EQUAL "ecl_member(#0,#1)"))
-                         nil ; side effects?
-                         t)) ; one liner?
-    (close-inline-blocks)))
-
 (defun c1assoc (args)
   (check-args-number 'ASSOC args 2)
   (cond ((endp (cddr args))
@@ -310,8 +284,6 @@
 (put-sysprop 'rplacd 'C1 'c1rplacd)
 (put-sysprop 'rplacd 'C2 'c2rplacd)
 
-(put-sysprop 'member 'C1 'c1member)
-(put-sysprop 'member!2 'C2 'c2member!2)
 (put-sysprop 'assoc 'C1 'c1assoc)
 (put-sysprop 'assoc!2 'C2 'c2assoc!2)
 
diff --git a/src/cmp/cmppolicy.lsp b/src/cmp/cmppolicy.lsp
index c26794499..5a3e7b6c9 100644
--- a/src/cmp/cmppolicy.lsp
+++ b/src/cmp/cmppolicy.lsp
@@ -253,6 +253,10 @@
   "Expand TYPEP and similar forms in terms of simpler functions, such as FLOATP,
 INTGERP, STRINGP.")
 
+(define-policy inline-sequence-functions :off space 2
+  "Inline functions such as MAP, MEMBER, FIND, etc")
+
+
 ;;
 ;; DEBUG POLICY
 ;;
diff --git a/src/cmp/load.lsp.in b/src/cmp/load.lsp.in
index 6d98461d6..5055548eb 100644
--- a/src/cmp/load.lsp.in
+++ b/src/cmp/load.lsp.in
@@ -46,6 +46,7 @@
   "src:cmp;cmpname.lsp"
   "src:cmp;cmpopt.lsp"
   "src:cmp;cmpopt-cons.lsp"
+  "src:cmp;cmpopt-sequence.lsp"
   "src:cmp;cmpprop.lsp"
   "src:cmp;cmpclos.lsp"
   "src:cmp;cmpstructures.lsp"
diff --git a/src/new-cmp/cmpfun.lsp b/src/new-cmp/cmpfun.lsp
index a7acd1c50..d7b15a90f 100644
--- a/src/new-cmp/cmpfun.lsp
+++ b/src/new-cmp/cmpfun.lsp
@@ -132,29 +132,6 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
       (expand-rplaca/d (eq (first form) 'rplaca) cons value env)
       form))
 
-(defconstant +member-expansions+
-  '(('EQ . #1="si_memq(#0,#1)")
-    (#'EQ . #1#)
-    ('#'EQ . #1#)
-    ('EQL . #2="ecl_memql(#0,#1)")
-    (#'EQL . #2#)
-    ('#'EQL . #2#)
-    ('EQUAL . #3="ecl_member(#0,#1)")
-    (#'EQUAL . #3#)
-    ('#'EQUAL . #3#)))
-
-(define-compiler-macro member (&whole form value list &rest extra &environment env)
-  (unless extra
-    (setf extra '(:test 'EQL)))
-  (when (and (= (length extra) 2)
-             (eq (first extra) :test))
-    (let ((test (assoc (second extra)
-                       +member-expansions+ :test #'equal)))
-      (when test
-        (setf form `(C-INLINE (,value ,list) (:object :object) :object
-                              ,(cdr test) :one-liner t :side-effects nil)))))
-  form)
-
 (defconstant +assoc-expansions+
   '(('EQ . #1="ecl_assq(#0,#1)")
     (#'EQ . #1#)
diff --git a/src/new-cmp/load.lsp.in b/src/new-cmp/load.lsp.in
index d29860a82..0267d33c6 100644
--- a/src/new-cmp/load.lsp.in
+++ b/src/new-cmp/load.lsp.in
@@ -40,6 +40,8 @@
   "src:new-cmp;cmpnum.lsp"
   "src:cmp;cmpname.lsp"
   "src:cmp;cmpopt.lsp"
+  "src:cmp;cmpopt-cons.lsp"
+  "src:cmp;cmpopt-sequence.lsp"
   "src:new-cmp;cmpprop.lsp"
   "src:new-cmp;cmpclos.lsp"
   "src:new-cmp;cmpstructures.lsp"