03/04: records: Optimize 'recutils->alist' by avoiding regexps.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit fb519bd8313e192d6eca2e51f9f33c87e5ee883e
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 9 01:07:57 2015 +0100

    records: Optimize 'recutils->alist' by avoiding regexps.
    
    * guix/records.scm (%recutils-field-rx, %recutils-comment-rx,
      %recutils-plus-rx): Remove.
      (%recutils-field-charset): New variable.
      (recutils->alist): Adjust to use tests (string-ref line 0) instead of
      regexps.
---
 guix/records.scm |   59 +++++++++++++++++++++++++++--------------------------
 1 files changed, 30 insertions(+), 29 deletions(-)

diff --git a/guix/records.scm b/guix/records.scm
index 93c52f0..e7b86af 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <address@hidden>
+;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -267,15 +267,12 @@ PORT, according to FIELDS.  FIELDS must be a list of 
field name/getter pairs."
        (format port "~a: ~a~%" field (get object))
        (loop rest)))))
 
-(define %recutils-field-rx
-  (make-regexp "^([[:graph:]]+): (.*)$"))
-
-(define %recutils-comment-rx
-  ;; info "(recutils) Comments"
-  (make-regexp "^#"))
-
-(define %recutils-plus-rx
-  (make-regexp "^\\+ ?(.*)$"))
+(define %recutils-field-charset
+  ;; Valid characters starting a recutils field.
+  ;; info "(recutils) Fields"
+  (char-set-union char-set:upper-case
+                  char-set:lower-case
+                  (char-set #\%)))
 
 (define (recutils->alist port)
   "Read a recutils-style record from PORT and return it as a list of key/value
@@ -288,25 +285,29 @@ pairs.  Stop upon an empty line (after consuming it) or 
EOF."
            (if (null? result)
                (loop (read-line port) result)     ; leading space: ignore it
                (reverse result)))                 ; end-of-record marker
-          ((regexp-exec %recutils-comment-rx line)
-           (loop (read-line port) result))
-          ((regexp-exec %recutils-plus-rx line)
-           =>
-           (lambda (m)
-             (match result
-               (((field . value) rest ...)
-                (loop (read-line port)
-                      `((,field . ,(string-append value "\n"
-                                                  (match:substring m 1)))
-                        ,@rest))))))
-          ((regexp-exec %recutils-field-rx line)
-           =>
-           (lambda (match)
-             (loop (read-line port)
-                   (alist-cons (match:substring match 1)
-                               (match:substring match 2)
-                               result))))
           (else
-           (error "unmatched line" line)))))
+           ;; Now check the first character of LINE, since that's what the
+           ;; recutils manual says is enough.
+           (let ((first (string-ref line 0)))
+             (cond
+              ((char-set-contains? %recutils-field-charset first)
+               (let* ((colon (string-index line #\:))
+                      (field (string-take line colon))
+                      (value (string-trim (string-drop line (+ 1 colon)))))
+                 (loop (read-line port)
+                       (alist-cons field value result))))
+              ((eqv? first #\#)                   ;info "(recutils) Comments"
+               (loop (read-line port) result))
+              ((eqv? first #\+)                   ;info "(recutils) Fields"
+               (let ((new-line (if (string-prefix? "+ " line)
+                                   (string-drop line 2)
+                                   (string-drop line 1))))
+                (match result
+                  (((field . value) rest ...)
+                   (loop (read-line port)
+                         `((,field . ,(string-append value "\n" new-line))
+                           ,@rest))))))
+              (else
+               (error "unmatched line" line))))))))
 
 ;;; records.scm ends here