futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2015-01-09 01:07:57 +01:00
parent b2ad9d9b08
commit fb519bd831
1 changed files with 30 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
guix/records.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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)
(else
;; 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))
((regexp-exec %recutils-plus-rx line)
=>
(lambda (m)
((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"
(match:substring m 1)))
`((,field . ,(string-append value "\n" new-line))
,@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)))))
(error "unmatched line" line))))))))
;;; records.scm ends here