Replaced the C1 special form for MEMBER with a compiler macro.

This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-13 22:34:04 +02:00
parent ebefa89d55
commit 34233787c6
6 changed files with 7 additions and 52 deletions

View file

@ -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)

View file

@ -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)

View file

@ -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
;;

View file

@ -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"

View file

@ -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#)

View file

@ -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"