Changeset 32963 in project


Ignore:
Timestamp:
12/07/15 22:09:37 (5 years ago)
Author:
sjamaan
Message:

intarweb: Improve performance by forcing callers of parse-params to pre-compute the stop char-set instead of doing it in parse-params.

This uglifies the code a bit but is very much worthwhile.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/intarweb/trunk/header-parsers.scm

    r32591 r32963  
    180180        (values #f start-pos))))
    181181
    182 (define (parse-params string start-pos param-subparsers #!optional (stop-set (char-set #\;)))
     182(define (parse-params string start-pos param-subparsers #!optional (stop-set (char-set #\;)) (seperator-or-stop-set (char-set #\; #\=)))
    183183  (let loop ((start-pos start-pos)
    184184             (params '()))
    185185    (receive (attribute-name pos)
    186       (parse-token string start-pos (char-set-union stop-set (char-set #\=)))
     186        (parse-token string start-pos seperator-or-stop-set)
    187187      (if attribute-name
    188188          (let ((attribute (http-name->symbol attribute-name)))
     
    190190                     (char=? (string-ref string pos) #\=))
    191191                (receive (value pos)
    192                   (parse-token string (add1 pos) stop-set)
     192                    (parse-token string (add1 pos) stop-set)
    193193                  ;; In case of no value ("foo="), use the empty string as value
    194194                  (let ((value ((alist-ref attribute param-subparsers
     
    417417;; This parser is a full parser because parse-token cannot handle
    418418;; comments yet... (if a ; is in a comment, it breaks down)
    419 (define (software-parser contents)
    420   (let loop ((start-pos 0)
    421              (products '()))
    422     (let*-values (((product pos) (parse-token contents start-pos (char-set #\/ #\()))
    423                   ((version pos2) (parse-token contents pos ; (add1 pos)
    424                                                (char-set-union (char-set #\()
    425                                                                char-set:whitespace)))
    426                   ((comment pos3) (parse-comment contents pos2))
    427                   ;; Ugh
    428                   ((real-version) (and version (not (string-null? version)) (string-trim version #\/))))
    429       (if product
    430           (loop pos3 (cons (list product real-version comment) products))
    431           (list (vector (reverse products) '()))))))
     419(define software-parser
     420  (let ((char-set:space-or-paren (char-set-union (char-set #\()
     421                                                 char-set:whitespace))
     422        (char-set:slash-or-paren (char-set #\/ #\()))
     423   (lambda (contents)
     424     (let loop ((start-pos 0)
     425                (products '()))
     426       (let*-values (((product pos)
     427                      (parse-token contents start-pos
     428                                   char-set:slash-or-paren))
     429                     ((version pos2)
     430                      (parse-token contents pos ; (add1 pos)
     431                                   char-set:space-or-paren))
     432                     ((comment pos3) (parse-comment contents pos2))
     433                     ;; Ugh
     434                     ((real-version) (and version (not (string-null? version)) (string-trim version #\/))))
     435         (if product
     436             (loop pos3 (cons (list product real-version comment) products))
     437             (list (vector (reverse products) '()))))))))
    432438
    433439;;;; MAJOR TODOs
     
    532538                  (qop . ,symbol-subparser)
    533539                  (algorithm . ,symbol-subparser-ci))
    534                 (char-set #\,)))
     540                (char-set #\,) (char-set #\, #\=)))
    535541
    536542(define authorization-param-subparsers
     
    575581                                          (string-ci=? (string-trim s)
    576582                                                       "TRUE"))))
    577                                 (char-set #\,))
     583                            (char-set #\,) (char-set #\, #\=))
    578584              (loop (add1 pos) (cons (vector authtype params) result))))))))
    579585
Note: See TracChangeset for help on using the changeset viewer.