expander: avoid format in common paths

Use `string-append`, `symbol->string`, etc., instead of `format` for
constructing some symbols.
This commit is contained in:
Matthew Flatt 2018-11-27 19:26:59 -07:00
parent 432dfcdb4a
commit 8c6af1a234
7 changed files with 82 additions and 61 deletions

View File

@ -212,7 +212,9 @@
(define (select-fresh sym header)
(if (symbol-conflicts? sym header)
(let loop ([pos 1])
(define new-sym (string->symbol (format "~a/~a" pos sym)))
(define new-sym (string->symbol (string-append (number->string pos)
"/"
(symbol->string sym))))
(if (symbol-conflicts? new-sym header)
(loop (add1 pos))
new-sym))

View File

@ -55,7 +55,7 @@
(symbol-interned? sym))
sym
(let loop ([pos 1])
(define s (string->unreadable-symbol (format "~a.~a" sym pos)))
(define s (string->unreadable-symbol (string-append (symbol->string sym) "." (number->string pos))))
(if (defined-as-other? (hash-ref defined-syms-at-phase s #f) id phase top-level-bind-scope)
(loop (add1 pos))
s))))

View File

@ -98,9 +98,13 @@
;; Helper for registering a local binding in a set of scopes:
(define (add-local-binding! id phase counter #:frame-id [frame-id #f] #:in [in-s #f])
(check-id-taint id in-s)
(set-box! counter (add1 (unbox counter)))
(define key (string->uninterned-symbol (format "~a_~a" (syntax-e id) (unbox counter))))
(add-binding-in-scopes! (syntax-scope-set id phase) (syntax-e id) (make-local-binding key #:frame-id frame-id))
(define c (add1 (unbox counter)))
(set-box! counter c)
(define sym (syntax-content id))
(define key (string->uninterned-symbol (string-append (symbol->string sym)
"_"
(number->string c))))
(add-binding-in-scopes! (syntax-scope-set id phase) sym (make-local-binding key #:frame-id frame-id))
key)
(define (check-id-taint id in-s)

View File

@ -234,7 +234,7 @@
(define (add-prefix sym)
(if prefix-sym
(string->symbol (format "~a~a" prefix-sym sym))
(string->symbol (string-append (symbol->string prefix-sym) (symbol->string sym)))
sym))
(define found (make-hasheq))

View File

@ -183,7 +183,8 @@
[else
(define sym (cond
[(not bulk-prefix) out-sym]
[else (string->symbol (format "~a~a" bulk-prefix out-sym))]))
[else (string->symbol (string-append (symbol->string bulk-prefix)
(symbol->string out-sym)))]))
(define already-defined?
(cond
[(and check-and-remove?

View File

@ -309,12 +309,14 @@
sym)]
[(adjust-prefix? adjust)
(string->symbol
(format "~a~a" (adjust-prefix-sym adjust) sym))]
(string-append (symbol->string (adjust-prefix-sym adjust))
(symbol->string sym)))]
[(adjust-all-except? adjust)
(and (not (and (set-member? (adjust-all-except-syms adjust) sym)
(hash-set! done-syms sym #t)))
(string->symbol
(format "~a~a" (adjust-all-except-prefix-sym adjust) sym)))]
(string-append (symbol->string (adjust-all-except-prefix-sym adjust))
(symbol->string sym))))]
[(adjust-rename? adjust)
(and (eq? sym (adjust-rename-from-sym adjust))
(hash-set! done-syms sym #t)

View File

@ -15326,17 +15326,20 @@ static const char *startup_source =
"(let-values(((in-s_0) in31_0))"
"(let-values()"
"(let-values((()(begin(check-id-taint id_0 in-s_0)(values))))"
"(let-values((()(begin(set-box! counter_0(add1(unbox counter_0)))(values))))"
"(let-values(((c_0)(add1(unbox counter_0))))"
"(let-values((()(begin(set-box! counter_0 c_0)(values))))"
"(let-values(((sym_0)(syntax-content id_0)))"
"(let-values(((key_0)"
" (string->uninterned-symbol (format \"~a_~a\" (syntax-e$1 id_0) (unbox counter_0)))))"
"(string->uninterned-symbol"
" (string-append (symbol->string sym_0) \"_\" (number->string c_0)))))"
"(begin"
"(let-values(((temp62_0)(syntax-scope-set id_0 phase_0))"
"((temp63_0)(syntax-e$1 id_0))"
"((sym63_0) sym_0)"
"((temp64_0)"
"(let-values(((key65_0) key_0)((frame-id66_0) frame-id_0))"
"(make-local-binding7.1 frame-id66_0 #f key65_0))))"
"(add-binding-in-scopes!20.1 #f temp62_0 temp63_0 temp64_0))"
" key_0)))))))))))))"
"(add-binding-in-scopes!20.1 #f temp62_0 sym63_0 temp64_0))"
" key_0)))))))))))))))"
"(define-values"
"(check-id-taint)"
"(lambda(id_0 in-s_0)"
@ -20366,39 +20369,39 @@ static const char *startup_source =
"(let-values(((index_0)"
"(if(keyword? tmp_0)"
"(hash-ref"
" '#hasheq((#:scope+kind . 17)"
"(#:seteqv . 14)"
"(#:ref . 1)"
"(#:list . 12)"
"(#:vector . 12)"
"(#:module-binding . 24)"
"(#:set . 14)"
"(#:srcloc . 7)"
"(#:bulk-binding-at . 22)"
"(#:multi-scope . 19)"
"(#:hasheq . 13)"
"(#:simple-module-binding . 25)"
"(#:scope . 16)"
"(#:bulk-binding-registry . 3)"
"(#:hash . 13)"
"(#:shifted-multi-scope . 20)"
"(#:mpi . 9)"
"(#:quote . 8)"
"(#:prefab . 15)"
"(#:box . 10)"
"(#:local-binding . 26)"
" '#hasheq((#:box . 10)"
"(#:bulk-binding . 27)"
"(#:inspector . 2)"
"(#:table-with-bulk-bindings . 21)"
"(#:interned-scope . 18)"
"(#:seteq . 14)"
"(#:provided . 28)"
"(#:syntax . 4)"
"(#:bulk-binding-at . 22)"
"(#:bulk-binding-registry . 3)"
"(#:cons . 11)"
"(#:hasheqv . 13)"
"(#:datum->syntax . 5)"
"(#:hash . 13)"
"(#:hasheq . 13)"
"(#:hasheqv . 13)"
"(#:inspector . 2)"
"(#:interned-scope . 18)"
"(#:list . 12)"
"(#:local-binding . 26)"
"(#:module-binding . 24)"
"(#:mpi . 9)"
"(#:multi-scope . 19)"
"(#:prefab . 15)"
"(#:provided . 28)"
"(#:quote . 8)"
"(#:ref . 1)"
"(#:representative-scope . 23)"
"(#:scope . 16)"
"(#:scope+kind . 17)"
"(#:set . 14)"
"(#:seteq . 14)"
"(#:seteqv . 14)"
"(#:shifted-multi-scope . 20)"
"(#:simple-module-binding . 25)"
"(#:srcloc . 7)"
"(#:syntax . 4)"
"(#:syntax+props . 6)"
"(#:representative-scope . 23))"
"(#:table-with-bulk-bindings . 21)"
"(#:vector . 12))"
" tmp_0"
"(lambda() 0))"
" 0)))"
@ -22377,10 +22380,11 @@ static const char *startup_source =
" out-sym_0)"
"(let-values()"
"(string->symbol"
"(format"
" \"~a~a\""
" bulk-prefix_0"
" out-sym_0))))))"
"(string-append"
"(symbol->string"
" bulk-prefix_0)"
"(symbol->string"
" out-sym_0)))))))"
"(let-values(((already-defined?_0)"
"(if(if check-and-remove?_0"
"(let-values(((or-part_0)"
@ -25726,11 +25730,12 @@ static const char *startup_source =
" adjust_0)"
"(let-values()"
"(string->symbol"
"(format"
" \"~a~a\""
"(string-append"
"(symbol->string"
"(adjust-prefix-sym"
" adjust_0)"
" sym_0)))"
" adjust_0))"
"(symbol->string"
" sym_0))))"
"(if(adjust-all-except?"
" adjust_0)"
"(let-values()"
@ -25745,11 +25750,12 @@ static const char *startup_source =
" #t)"
" #f))"
"(string->symbol"
"(format"
" \"~a~a\""
"(string-append"
"(symbol->string"
"(adjust-all-except-prefix-sym"
" adjust_0)"
" sym_0))"
" adjust_0))"
"(symbol->string"
" sym_0)))"
" #f))"
"(if(adjust-rename?"
" adjust_0)"
@ -29826,7 +29832,9 @@ static const char *startup_source =
"(lambda(pos_0)"
"(begin"
" 'loop"
" (let-values (((new-sym_0) (string->symbol (format \"~a/~a\" pos_0 sym_0))))"
"(let-values(((new-sym_0)"
"(string->symbol"
" (string-append (number->string pos_0) \"/\" (symbol->string sym_0)))))"
"(if(symbol-conflicts? new-sym_0 header_0)(loop_0(add1 pos_0)) new-sym_0))))))"
" loop_0)"
" 1)"
@ -36559,10 +36567,12 @@ static const char *startup_source =
" 'loop"
"(let-values(((s_0)"
"(string->unreadable-symbol"
"(format"
" \"~a.~a\""
" sym_0"
" pos_0))))"
"(string-append"
"(symbol->string"
" sym_0)"
" \".\""
"(number->string"
" pos_0)))))"
"(if(defined-as-other?"
"(hash-ref"
" defined-syms-at-phase_0"
@ -74423,7 +74433,9 @@ static const char *startup_source =
"(lambda(sym_0)"
"(begin"
" 'add-prefix"
" (if prefix-sym_0 (string->symbol (format \"~a~a\" prefix-sym_0 sym_0)) sym_0)))))"
"(if prefix-sym_0"
"(string->symbol(string-append(symbol->string prefix-sym_0)(symbol->string sym_0)))"
" sym_0)))))"
"(let-values(((found_0)(make-hasheq)))"
"(begin"
"(let-values(((lst_0) requireds_0))"