xexpr: micro-optimize xexpr-write

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

View File

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