-;;; FIXME: I still think (DOLIST (..) (DEFTRANSFORM ..)) is weird.
-;;; For that matter, it would be nice to use DEF-FROB for these
-;;; sorts of things, so folks looking for the definitions of
-;;; FOO can search for '\(def.*\<foo\>' and have a chance in hell..
-(dolist (name '(member memq))
- (deftransform name ((e l &key (test #'eql)) '* '* :node node :when :both
- :eval-name t)
- (unless (constant-continuation-p l)
- (give-up-ir1-transform))
-
- (let ((val (continuation-value l)))
- (unless (policy node
- (or (= speed 3)
- (and (>= speed space)
- (<= (length val) 5))))
- (give-up-ir1-transform))
-
- (labels ((frob (els)
- (if els
- `(if (funcall test e ',(car els))
- ',els
- ,(frob (cdr els)))
- nil)))
- (frob val)))))
-
-;;; FIXME: Rewrite this so that these definitions of DELETE, ASSOC, and MEMBER
-;;; are lexically findable:
-;;; (MACROLET ((DEF-FROB (X Y) ..))
-;;; (DEF-FROB DELETE DELQ)
-;;; (DEF-FROB ASSOC ASSQ)
-;;; (DEF-FROB MEMBER MEMQ))
-;;; And while I'm at it, I could save a few byte by implementing the
-;;; transform body as call to a shared function instead of duplicated
-;;; macroexpanded code.
-(dolist (x '((delete delq)
- (assoc assq)
- (member memq)))
- (destructuring-bind (fun eq-fun) x
- (deftransform fun ((item list &key test) '(t list &rest t) '*
- :eval-name t)
- "convert to EQ test"
- ;; FIXME: The scope of this transformation could be widened somewhat,
- ;; letting it work whenever the test is 'EQL and we know from the
- ;; type of ITEM that it #'EQ works like #'EQL on it. (E.g. types
- ;; FIXNUM, CHARACTER, and SYMBOL.)
- ;; If TEST is EQ, apply transform, else
- ;; if test is not EQL, then give up on transform, else
- ;; if ITEM is not a NUMBER or is a FIXNUM, apply transform, else
- ;; give up on transform.
- (cond (test
- (unless (continuation-function-is test '(eq))
- (give-up-ir1-transform)))
- ((types-equal-or-intersect (continuation-type item)
- (specifier-type 'number))
- (give-up-ir1-transform "Item might be a number.")))
- `(,eq-fun item list))))
+;;; FIXME: The MACROLET ... DEF-FROB ... DEFTRANSFORM idioms in this
+;;; file are literal translations of old CMU CL DOLIST ... DEFTRANSFORM,
+;;; and so use :EVAL-NAME for historical reasons. It'd be tidier to
+;;; just let macroexpansion substitution take care of everything,
+;;; and remove both :EVAL-NAME and the extra layer of quotes.
+
+(macrolet ((def-frob (name)
+ `(deftransform ',name ((e l &key (test #'eql)) '* '* :node node :when :both
+ :eval-name t)
+ (unless (constant-continuation-p l)
+ (give-up-ir1-transform))
+
+ (let ((val (continuation-value l)))
+ (unless (policy node
+ (or (= speed 3)
+ (and (>= speed space)
+ (<= (length val) 5))))
+ (give-up-ir1-transform))
+
+ (labels ((frob (els)
+ (if els
+ `(if (funcall test e ',(car els))
+ ',els
+ ,(frob (cdr els)))
+ nil)))
+ (frob val))))))
+ (def-frob member)
+ (def-frob memq))
+
+;;; FIXME: We have rewritten the original code that used DOLIST to this
+;;; more natural MACROLET. However, the original code suggested that when
+;;; this was done, a few bytes could be saved by a call to a shared
+;;; function. This remains to be done.
+(macrolet ((def-frob (fun eq-fun)
+ `(deftransform ',fun ((item list &key test) '(t list &rest t) '*
+ :eval-name t)
+ "convert to EQ test"
+ ;; FIXME: The scope of this transformation could be
+ ;; widened somewhat, letting it work whenever the test is
+ ;; 'EQL and we know from the type of ITEM that it #'EQ
+ ;; works like #'EQL on it. (E.g. types FIXNUM, CHARACTER,
+ ;; and SYMBOL.)
+ ;; If TEST is EQ, apply transform, else
+ ;; if test is not EQL, then give up on transform, else
+ ;; if ITEM is not a NUMBER or is a FIXNUM, apply
+ ;; transform, else give up on transform.
+ (cond (test
+ (unless (continuation-function-is test '(eq))
+ (give-up-ir1-transform)))
+ ((types-equal-or-intersect (continuation-type item)
+ (specifier-type 'number))
+ (give-up-ir1-transform "Item might be a number.")))
+ `(,',eq-fun item list))))
+ (def-frob delete delq)
+ (def-frob assoc assq)
+ (def-frob member memq))