[racket-dev] [plt] Push #25660: master branch updated

How did you measure this performance increase? It would have been
better to commit a stress test too.

On Wed, Nov 7, 2012 at 4:10 PM,  <dyoo at racket-lang.org> wrote:
> dyoo has updated `master' from 741be85f07 to 5cb2f3eb58.
>   http://git.racket-lang.org/plt/741be85f07..5cb2f3eb58
>
> =====[ 4 Commits ]======================================================
> Directory summary:
>  100.0% collects/xml/private/
>
> ~~~~~~~~~~
>
> fb3a95f Danny Yoo <dyoo at racket-lang.org> 2012-11-07 15:32
> :
> | Replace fprintf with explicit display for performance.
> |
> | Replace fprintf with explicit display for performance.
> :
>   M collects/xml/private/xexpr.rkt | 16 ++++++++++++----
>
> ~~~~~~~~~~
>
> 6d18928 Danny Yoo <dyoo at racket-lang.org> 2012-11-07 15:39
> :
> | Add let loop for recursion and slight performance increase.
> :
>   M collects/xml/private/xexpr.rkt | 115 +++++++++++++++++++-------------------
>
> ~~~~~~~~~~
>
> 40116eb Danny Yoo <dyoo at racket-lang.org> 2012-11-07 15:42
> :
> | Lift out empty-tag-shorthand parameter lookup out of the hot spot.
> :
>   M collects/xml/private/xexpr.rkt | 6 +++---
>
> ~~~~~~~~~~
>
> 5cb2f3e Danny Yoo <dyoo at racket-lang.org> 2012-11-07 16:03
> :
> | Avoid regexp-replace* unless the string really contains escapable characters.
> :
>   M collects/xml/private/writer.rkt | 8 ++++++++
>   M collects/xml/private/xexpr.rkt  | 4 ++--
>
> =====[ Overall Diff ]===================================================
>
> collects/xml/private/writer.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/xml/private/writer.rkt
> +++ NEW/collects/xml/private/writer.rkt
> @@ -168,7 +168,15 @@
>  (define (escape x table)
>    (regexp-replace* table x replace-escaped))
>
> +(define (display/escape x table out)
> +  (cond [(regexp-match table x)
> +         (display (escape x table) out)]
> +        [else
> +         (display x out)]))
> +
> +
>  (provide escape
> +         display/escape
>           escape-table
>           escape-attribute-table
>           lowercase-symbol
>
> collects/xml/private/xexpr.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/xml/private/xexpr.rkt
> +++ NEW/collects/xml/private/xexpr.rkt
> @@ -120,52 +120,61 @@
>   [write-xexpr (->* (xexpr/c) (output-port?) void)] )
>
>  (define (write-xexpr x [out (current-output-port)])
> -  (cond
> -    ; Element
> -    [(cons? x)
> -     (define name (car x))
> -     (define-values (attrs content)
> -       (if (and (pair? (cdr x))
> -                (or (null? (cadr x))
> -                    (and (pair? (cadr x)) (pair? (caadr x)))))
> -           (values (cadr x) (cddr x))
> -           (values null (cdr x))))
> -     ; Write opening tag
> -     (display "<" out)
> -     (display name out)
> -     ; Write attributes
> -     (for ([att (in-list attrs)])
> -       (fprintf out " ~a=\"~a\"" (car att)
> -                (escape (cadr att) escape-attribute-table)))
> -     ; Write end of opening tag
> -     (if (and (null? content)
> -              (let ([short (empty-tag-shorthand)])
> +  (define short (empty-tag-shorthand))
> +  (let loop ([x x])
> +    (cond
> +      ; Element
> +      [(cons? x)
> +       (define name (car x))
> +       (define-values (attrs content)
> +         (if (and (pair? (cdr x))
> +                  (or (null? (cadr x))
> +                      (and (pair? (cadr x)) (pair? (caadr x)))))
> +             (values (cadr x) (cddr x))
> +             (values null (cdr x))))
> +       ; Write opening tag
> +       (display "<" out)
> +       (display name out)
> +       ; Write attributes
> +       (for ([att (in-list attrs)])
> +         (display " " out)
> +         (display (car att) out)
> +         (display "=" out)
> +         (display "\"" out)
> +         (display/escape (cadr att) escape-attribute-table out)
> +         (display "\"" out))
> +       ; Write end of opening tag
> +       (if (and (null? content)
>                  (case short
> -                  [(always) #t]
> -                  [(never) #f]
> -                  [else (memq (lowercase-symbol name) short)])))
> -         (display " />" out)
> -         (begin
> -           (display ">" out)
> -           ; Write body
> -           (for ([xe (in-list content)])
> -             (write-xexpr xe out))
> -           ; Write closing tag
> -           (display "</" out)
> -           (display name out)
> -           (display ">" out)))]
> -    ; PCData
> -    [(string? x)
> -     (display (escape x escape-table) out)]
> -    ; Entities
> -    [(symbol? x)
> -     (fprintf out "&~a;" x)]
> -    [(valid-char? x)
> -     (fprintf out "&#~a;" x)]
> -    ; Embedded XML
> -    [(cdata? x)
> -     (write-xml-cdata x 0 void out)]
> -    [(comment? x)
> -     (write-xml-comment x 0 void out)]
> -    [(p-i? x)
> -     (write-xml-p-i x 0 void out)]))
> +                    [(always) #t]
> +                    [(never) #f]
> +                    [else (memq (lowercase-symbol name) short)]))
> +           (display " />" out)
> +           (begin
> +             (display ">" out)
> +             ; Write body
> +             (for ([xe (in-list content)])
> +               (loop xe))
> +             ; Write closing tag
> +             (display "</" out)
> +             (display name out)
> +             (display ">" out)))]
> +      ; PCData
> +      [(string? x)
> +       (display/escape x escape-table out)]
> +      ; Entities
> +      [(symbol? x)
> +       (display "&" out)
> +       (display x out)
> +       (display ";" out)]
> +      [(valid-char? x)
> +       (display "&#" out)
> +       (display x out)
> +       (display ";" out)]
> +      ; Embedded XML
> +      [(cdata? x)
> +       (write-xml-cdata x 0 void out)]
> +      [(comment? x)
> +       (write-xml-comment x 0 void out)]
> +      [(p-i? x)
> +       (write-xml-p-i x 0 void out)])))



-- 
Jay McCarthy <jay at cs.byu.edu>
Assistant Professor / Brigham Young University
http://faculty.cs.byu.edu/~jay

"The glory of God is Intelligence" - D&C 93