suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

xexpr: micro-optimize xexpr-write

Browse Source 
This improves write performance by between 15% and 40% on large xexprs.
This commit is contained in:
Bogdan Popa 2021-02-09 15:00:01 +02:00 committed by Jay McCarthy
parent 9f6f988150
commit f3793bb4d7
1 changed files with 33 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
racket/collects/xml/private/xexpr.rkt
View File

@ -1,11 +1,11 @@
#lang racket/base #lang racket/base
(require racket/pretty (require racket/contract
racket/list racket/list
racket/contract racket/symbol
"xexpr-core.rkt"
"structures.rkt"
"reader.rkt" "reader.rkt"
"writer.rkt") "structures.rkt"
"writer.rkt"
"xexpr-core.rkt")
;; sorting is no longer necessary, since xt3d uses xml->zxexpr, which sorts. ;; sorting is no longer necessary, since xt3d uses xml->zxexpr, which sorts.
@ -122,45 +122,46 @@
(values (cadr x) (cddr x)) (values (cadr x) (cddr x))
(values null (cdr x)))) (values null (cdr x))))
; Write opening tag ; Write opening tag
(write-string "<" out) (write-bytes #"<" out)
(display name out) (write-string (symbol->immutable-string name) out)
; Write attributes ; Write attributes
(for ([att (in-list attrs)]) (for ([att (in-list attrs)])
(write-string " " out) (write-bytes #" " out)
(display (car att) out) (write-string (symbol->immutable-string (car att)) out)
(write-string "=\"" out) (write-bytes #"=\"" out)
(write-string/escape (cadr att) escape-attribute-table out) (write-string/escape (cadr att) escape-attribute-table out)
(write-string "\"" out)) (write-bytes #"\"" out))
(when insert-newlines? (when insert-newlines?
(newline out)) (newline out))
; Write end of opening tag ; Write end of opening tag
(if (and (null? content) (cond
(case short [(and (null? content)
[(always) #t] (case short
[(never) #f] [(always) #t]
[else (memq (lowercase-symbol name) short)])) [(never) #f]
(write-string "/>" out) [else (memq (lowercase-symbol name) short)]))
(begin (write-bytes #"/>" out)]
(write-string ">" out) [else
; Write body (write-bytes #">" out)
(for ([xe (in-list content)]) ; Write body
(loop xe)) (for ([xe (in-list content)])
; Write closing tag (loop xe))
(write-string "</" out) ; Write closing tag
(display name out) (write-bytes #"</" out)
(write-string ">" out)))] (write-string (symbol->immutable-string name) out)
(write-bytes #">" out)])]
; PCData ; PCData
[(string? x) [(string? x)
(write-string/escape x escape-table out)] (write-string/escape x escape-table out)]
; Entities ; Entities
[(symbol? x) [(symbol? x)
(write-string "&" out) (write-bytes #"&" out)
(display x out) (write-string (symbol->immutable-string x) out)
(write-string ";" out)] (write-bytes #";" out)]
[(valid-char? x) [(valid-char? x)
(write-string "&#" out) (write-bytes #"&#" out)
(display x out) (write-string (number->string x) out)
(write-string ";" out)] (write-bytes #";" out)]
; Embedded XML ; Embedded XML
[(cdata? x) [(cdata? x)
(write-xml-cdata x 0 void out)] (write-xml-cdata x 0 void out)]