mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-07 04:40:35 -08:00
Replaced the C1 special form for MEMBER with a compiler macro.
This commit is contained in:
parent
ebefa89d55
commit
34233787c6
6 changed files with 7 additions and 52 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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#)
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue