anchor.diff:                  ((nil) (with-output-to-string (s)
                            (call/stream s))))))))))
   
  -(defun compile-time-format (string)
  -  (let (writers)
  -    (labels ((parse (&key (start 0))
  -               (multiple-value-bind (ms me rs re)
  -                   (ppcre:scan *directive-regex* string :start start)
  -                 (if ms
  -                     (progn
  -                       (push
  -                        (writer (stream time)
  -                          (write-string string stream :start start :end ms))
  -                        writers)
  -                       (push (apply #'compile-directive
  -                                    (loop for s across rs
  -                                          for e across re
  -                                          collect (unless (= s e)
  -                                                    (subseq string s e))))
  -                             writers)
  -                       (parse :start me))
  -                     (push (writer (stream time)
  -                             (write-string string stream :start start))
  -                           writers)))))
  -      (parse))
  -    writers))
  +(defun make-time-formatter (format)
  +  (if (keywordp format)
  +      (ensure-gethash format
  +                      *compiled-time-formats*
  +                      (multiple-value-bind (f force-gmt)
  +                          (named-time-format format)
  +                        (make-time-formatter-1 f force-gmt)))
  +      (make-time-formatter-1 format nil)))
   
   (defparameter *directive-regex*
     (ppcre:create-scanner
  
positive.code: (in-package #:cl-strftime)
  
  (defun expand-tz (tz)
    (etypecase tz
  
negative.code:    :single-line-mode t
     :case-insensitive-mode nil))
  
  (defun compile-formatter (string)
    (declare (string string))
    (let (writers)
      (labels ((parse-from (start)
                 (declare (optimize speed) (index start))
                 (multiple-value-bind (ms me rs re)
                     (ppcre:scan *directive-regex* string :start start)
                   (if ms
                       ;; A directive.
                       (locally
                           (declare (index ms))
                         ;; Push a writer for the constant string before
                         ;; the directive.
                         (unless (= start ms)
                           (push
                            (lambda (stream time)
                              (declare (ignore time))
                              (write-string string stream :start start :end ms))
                            writers))
                         ;; Push a writer for the directive.
                         (push (apply #'compile-directive
                                      (loop for s of-type index across rs
                                            for e of-type index across re
                                            collect (unless (= s e)
                                                      (subseq string s e))))
                               writers)
                         (parse-from me))
                       ;; No more directives; push a writer for the
                       ;; constant remainder of the string.
                       (unless (= start (length string))
                         (push (lambda (stream time)
                                 (declare (ignore time))
                                 (write-string string stream :start start))
                               writers))))))
        (parse-from 0))
      ;; Don't reverse the writers yet; this might be a recursive call.
      writers))
  
  (defun compile-flag (flag width action)
    (declare (function action) (optimize speed))
    (if (not flag)
        (lambda (s ts)
          (declare (stream s))
          (princ (funcall action ts) s))
        (ecase (character flag)
          ;; Do not pad.
          (#\-
           (lambda (s ts)
             (declare (stream s))
             (princ (funcall action ts) s)))
          ;; Pad with spaces.
          (#\_
           (lambda (s ts)
             (declare (stream s))
             (format s
                     (formatter "~V,VD")
                     width #\Space
                     (funcall action ts))))
          ;; Pad with zeros.
          (#\0
           (lambda (s ts)
             (declare (stream s))
             (format s
                     (formatter "~V,VD")
                     width #\0
                     (funcall action ts))))
          ;; Toggle case.
          (#\#
           (lambda (s ts)
             (declare (stream s))
             (let ((value (funcall action ts)))
               (if (stringp value)
                   (loop for c across value
                         do (cond ((not (both-case-p c))
                                   (write-char c s))
                                  ((upper-case-p c)
                                   (write-char (char-downcase c) s))
                                  ((lower-case-p c)
                                   (write-char (char-upcase c) s))))
                   (princ value s)))))
          ;; Upcase.
          (#\^
           (lambda (s ts)
             (declare (stream s))
             (format s
                     (formatter "~:@(~A~)")
                     (funcall action ts)))))))
  
  (defun compile-directive (flag width directive)
    (multiple-value-bind (action default-width default-flag)
        (find-directive (character directive))
      (let ((flag (or flag default-flag))
            (width (or width default-width)))
  