bug#14776: 24.3.50; [PATCH] parse-time-string performance

[Andreas Politz]

Lars Magne Ingebrigtsen <larsi@gnus.org> writes:

> Wow, that's a pretty impressive speed-up.  I do see one issue, though --
> it doesn't parse 2-digit years?  That's a requirement.

There is also a missing downcase and the zone is incorrect...

I only considered the strict version.  Of course 2-digit years could be
incorporated, but I don't see this as a replacement anyway, rather an
addition or alternative: Try the rfc2822 format and fallback on the
current code:

diff -wc --label /home/politza/src/emacs/trunk/lisp/calendar/parse-time.el 
--label \#\<buffer\ parse-time.el\<calendar\>\> 
/home/politza/src/emacs/trunk/lisp/calendar/parse-time.el 
/tmp/buffer-content-2968c1C
*** /home/politza/src/emacs/trunk/lisp/calendar/parse-time.el
--- #<buffer parse-time.el<calendar>>
***************
*** 176,186 ****
--- 176,240 ----
    "(slots predicate extractor...)")
  ;;;###autoload(put 'parse-time-rules 'risky-local-variable t)
  
+ (defconst parse-time-rfc2822-regex
+   (let* ((fws "[ \t\r\n]+")
+          (ofws "[ \t\r\n]*")
+          (day-of-week
+           (regexp-opt
+            (mapcar 'car parse-time-weekdays)))
+          (day "[0-9]\\{1,2\\}")
+          (month
+           (regexp-opt
+            (mapcar 'car parse-time-months)))
+          (year "[0-9]\\{4,\\}")
+          (hour "[0-9]\\{2\\}")
+          (minute hour)
+          (second hour)
+          (zone-hour (concat "[+-]" hour))
+          (zone-min hour)
+          ;; A rather non strict comment.
+          (cfws "(\\(?:.\\|\n\\)*)"))
+     (concat
+      (format "\\`%s\\(?:\\(%s\\),%s\\)?" ofws day-of-week ofws)
+      (format "\\(%s\\)%s\\(%s\\)%s\\(%s\\)%s"
+              day fws month fws year fws)
+      (format "\\(%s\\):\\(%s\\)\\(?::\\(%s\\)\\)?%s"
+              hour minute second fws)
+      (format "\\(%s\\)\\(%s\\)" zone-hour zone-min)
+      (format "%s\\(?:%s\\)?%s\\'" ofws cfws ofws)))
+   "A regex matching a strict rfc2822 date.")
+ 
+ (defun parse-time-string-rfc2822 (string)
+   "Parse the strict rfc2822 time-string STRING
+ 
+ Return either a list (SEC MIN HOUR DAY MON YEAR DOW DST TZ) or
+ nil, if STRING is not valid."
+   (setq string (downcase string))
+   (when (string-match parse-time-rfc2822-regex string)
+     (let ((dow (cdr (assoc (match-string 1 string)
+                            parse-time-weekdays)))
+           (day (string-to-number (match-string 2 string)))
+           (month (cdr (assoc (match-string 3 string)
+                              parse-time-months)))
+           (year (string-to-number (match-string 4 string)))
+           (hour (string-to-number (match-string 5 string)))
+           (min (string-to-number (match-string 6 string)))
+           (sec (string-to-number (or (match-string 7 string) "0")))
+           (zhour (string-to-number (match-string 8 string)))
+           (zmin (string-to-number (match-string 9 string))))
+       (let ((zone (+ (* (abs zhour) 3600)
+                      (* 60 zmin))))
+         (list sec min hour day month year dow
+               nil (if (>= zhour 0)
+                       zone
+                     (- zone)))))))
+ 
  ;;;###autoload
  (defun parse-time-string (string)
    "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
  The values are identical to those of `decode-time', but any values that are
  unknown are returned as nil."
+   (or (parse-time-string-rfc2822 string)
        (let ((time (list nil nil nil nil nil nil nil nil nil))
              (temp (parse-time-tokenize (downcase string))))
          (while temp
***************
*** 216,222 ****
                                       (funcall this)))
                                 parse-time-val)))
                  (rplaca (nthcdr (pop slots) time) new-val))))))))
!     time))
  
  (provide 'parse-time)
  
--- 270,276 ----
                                             (funcall this)))
                                       parse-time-val)))
                        (rplaca (nthcdr (pop slots) time) new-val))))))))
!         time)))
  
  (provide 'parse-time)
  

Diff finished.  Fri Jul  5 00:00:38 2013

> Could you collect a bunch of Date headers from the wild and see
> whether the old and new versions agree on them all?

These are 3000 dates from my inbox, all pretty standard:

parse-time.ert
Description: Binary data

-ap