expander: restore datum-intern-literal
in datum->syntax
As the documentation says, `datum->syntax` should use `datum-intern-literal`. That helps avoid syntax-object mutability, and it increases sharing in compiled forms. The use of `datum-intern-literal` got lost when the expander was rewritten in Racket. Relevant to #3245
This commit is contained in:
parent
27fd176968
commit
5f5599d2e8
|
@ -53,6 +53,10 @@
|
|||
(test 'val syntax-property s 'key)
|
||||
(test #f syntax-property (syntax-property-remove s 'key) 'key))
|
||||
|
||||
(test #t immutable? (syntax-e (datum->syntax #f (string #\a))))
|
||||
(test #t immutable? (syntax-e (syntax-case (datum->syntax #f (list (string #\a))) ()
|
||||
[(a) #'a])))
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; some syntax-case patterns
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
|
@ -233,25 +233,26 @@
|
|||
[else
|
||||
(define insp (if (syntax? s) 'not-needed (current-module-code-inspector)))
|
||||
(define (wrap content)
|
||||
(syntax (if (and stx-c
|
||||
(syntax-tamper stx-c))
|
||||
(modified-content content
|
||||
(tamper-tainted-for-content content))
|
||||
content)
|
||||
(if stx-c
|
||||
(syntax-scopes stx-c)
|
||||
empty-scopes)
|
||||
(if stx-c
|
||||
(syntax-shifted-multi-scopes stx-c)
|
||||
empty-shifted-multi-scopes)
|
||||
(if stx-c
|
||||
(syntax-mpi-shifts stx-c)
|
||||
empty-mpi-shifts)
|
||||
(and stx-l (syntax-srcloc stx-l))
|
||||
empty-props
|
||||
(and insp
|
||||
stx-c
|
||||
(weaker-inspector insp (syntax-inspector stx-c)))))
|
||||
(let ([content (datum-intern-literal content)])
|
||||
(syntax (if (and stx-c
|
||||
(syntax-tamper stx-c))
|
||||
(modified-content content
|
||||
(tamper-tainted-for-content content))
|
||||
content)
|
||||
(if stx-c
|
||||
(syntax-scopes stx-c)
|
||||
empty-scopes)
|
||||
(if stx-c
|
||||
(syntax-shifted-multi-scopes stx-c)
|
||||
empty-shifted-multi-scopes)
|
||||
(if stx-c
|
||||
(syntax-mpi-shifts stx-c)
|
||||
empty-mpi-shifts)
|
||||
(and stx-l (syntax-srcloc stx-l))
|
||||
empty-props
|
||||
(and insp
|
||||
stx-c
|
||||
(weaker-inspector insp (syntax-inspector stx-c))))))
|
||||
(define result-s
|
||||
(non-syntax-map s
|
||||
(lambda (tail? x) (cond
|
||||
|
|
|
@ -6259,12 +6259,13 @@ static const char *startup_source =
|
|||
"(lambda(content_0)"
|
||||
"(begin"
|
||||
" 'wrap"
|
||||
"(let-values(((content_1)(datum-intern-literal content_0)))"
|
||||
"(syntax2.1"
|
||||
"(if(if stx-c_0(syntax-tamper stx-c_0) #f)"
|
||||
"(modified-content1.1"
|
||||
" content_0"
|
||||
"(tamper-tainted-for-content content_0))"
|
||||
" content_0)"
|
||||
" content_1"
|
||||
"(tamper-tainted-for-content content_1))"
|
||||
" content_1)"
|
||||
"(if stx-c_0(syntax-scopes stx-c_0) empty-scopes)"
|
||||
"(if stx-c_0"
|
||||
"(syntax-shifted-multi-scopes stx-c_0)"
|
||||
|
@ -6288,7 +6289,7 @@ static const char *startup_source =
|
|||
"(let-values() a_0)"
|
||||
"(let-values() #f)))))))"
|
||||
" #f)"
|
||||
" #f))))))"
|
||||
" #f)))))))"
|
||||
"(let-values(((result-s_0)"
|
||||
"(let-values(((s_1) s_0)"
|
||||
"((f_0)"
|
||||
|
|
Loading…
Reference in New Issue
Block a user