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

expander: avoid format in common paths

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/expander/compile/header.rkt
View File

@ -212,7 +212,9 @@
(define (select-fresh sym header) (define (select-fresh sym header)
(if (symbol-conflicts? sym header) (if (symbol-conflicts? sym header)
(let loop ([pos 1]) (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) (if (symbol-conflicts? new-sym header)
(loop (add1 pos)) (loop (add1 pos))
new-sym)) new-sym))

2
racket/src/expander/expand/def-id.rkt
View File

@ -55,7 +55,7 @@
(symbol-interned? sym)) (symbol-interned? sym))
sym sym
(let loop ([pos 1]) (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) (if (defined-as-other? (hash-ref defined-syms-at-phase s #f) id phase top-level-bind-scope)
(loop (add1 pos)) (loop (add1 pos))
s)))) s))))

10
racket/src/expander/expand/env.rkt
View File

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

2
racket/src/expander/expand/provide.rkt
View File

@ -234,7 +234,7 @@
(define (add-prefix sym) (define (add-prefix sym)
(if 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)) sym))
(define found (make-hasheq)) (define found (make-hasheq))

3
racket/src/expander/expand/require+provide.rkt
View File

@ -183,7 +183,8 @@
[else [else
(define sym (cond (define sym (cond
[(not bulk-prefix) out-sym] [(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? (define already-defined?
(cond (cond
[(and check-and-remove? [(and check-and-remove?

6
racket/src/expander/expand/require.rkt
View File

@ -309,12 +309,14 @@
sym)] sym)]
[(adjust-prefix? adjust) [(adjust-prefix? adjust)
(string->symbol (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) [(adjust-all-except? adjust)
(and (not (and (set-member? (adjust-all-except-syms adjust) sym) (and (not (and (set-member? (adjust-all-except-syms adjust) sym)
(hash-set! done-syms sym #t))) (hash-set! done-syms sym #t)))
(string->symbol (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) [(adjust-rename? adjust)
(and (eq? sym (adjust-rename-from-sym adjust)) (and (eq? sym (adjust-rename-from-sym adjust))
(hash-set! done-syms sym #t) (hash-set! done-syms sym #t)

116
racket/src/racket/src/startup.inc
View File

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