+;;; Optimize common case of constant keyword arguments
+(define-compiler-macro write (&whole form object &rest keys)
+ (let (bind ignore)
+ (do ()
+ ((not (cdr keys))
+ ;; Odd number of keys, punt
+ (when keys
+ (return-from write form)))
+ (let* ((key (pop keys))
+ (value (pop keys))
+ (variable (or (getf *printer-keyword-variables* key)
+ (when (eq :stream key)
+ 'stream)
+ (return-from write form))))
+ (when (assoc variable bind)
+ ;; First key has precedence, but we still need to execute the
+ ;; argument, and in the right order.
+ (setf variable (gensym "IGNORE"))
+ (push variable ignore))
+ (push (list variable value) bind)))
+ (unless (assoc 'stream bind)
+ (push (list 'stream '*standard-output*) bind))
+ `(let ,(nreverse bind)
+ ,@(when ignore `((declare (ignore ,@ignore))))
+ (output-object ,object stream))))
+