diff --git a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl index 86630017ae..c753fa23a8 100644 --- a/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl +++ b/pkgs/racket-doc/scribblings/reference/syntax-model.scrbl @@ -356,7 +356,8 @@ the @tech{syntax object} being expanded: @tech{binding}, that @tech{binding} is used to continue. If the @tech{identifier} is @tech{unbound}, a new @tech{syntax-object} symbol @racket['#%top] is created using the @tech{lexical information} - of the @tech{identifier}; if this @racketidfont{#%top} + of the @tech{identifier} with @tech{implicit-made-explicit properties}; + if this @racketidfont{#%top} @tech{identifier} has no @tech{binding}, then parsing fails with an @racket[exn:fail:syntax] exception. Otherwise, the new @tech{identifier} is combined with the original @@ -376,7 +377,8 @@ the @tech{syntax object} being expanded: @item{If it is a @tech{syntax-object} pair of any other form, then a new @tech{syntax-object} symbol @racket['#%app] is created - using the @tech{lexical information} of the pair. If the + using the @tech{lexical information} of the pair with + @tech{implicit-made-explicit properties}. If the resulting @racketidfont{#%app} @tech{identifier} has no binding, parsing fails with an @racket[exn:fail:syntax] exception. Otherwise, the new @tech{identifier} is combined @@ -388,7 +390,7 @@ the @tech{syntax object} being expanded: @item{If it is any other syntax object, then a new @tech{syntax-object} symbol @racket['#%datum] is created using the @tech{lexical information} of the original @tech{syntax - object}. If the resulting @racketidfont{#%datum} + object} with @tech{implicit-made-explicit properties}. If the resulting @racketidfont{#%datum} @tech{identifier} has no @tech{binding}, parsing fails with an @racket[exn:fail:syntax] exception. Otherwise, the new @tech{identifier} is combined with the original @tech{syntax @@ -436,6 +438,18 @@ things: ] +When a @racketidfont{#%top}, @racketidfont{#%app}, or +@racketidfont{#%datum} identifier is added by the expander, it is +given @deftech{implicit-made-explicit properties}: an +@racket['implicit-made-explicit] @tech{syntax property} whose value is +@racket[#t], and a hidden property to indicate that the implicit +identifier is original in the sense of @racket[syntax-original?] if +the syntax object that gives the identifier its @tech{lexical information} +has that property. + +@history[#:changed "7.9.0.13" @elem{Added @tech{implicit-made-explicit + properties}.}] + @;- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @subsection[#:tag "expand-context-model"]{Expansion Context} diff --git a/pkgs/racket-test-core/tests/racket/macro.rktl b/pkgs/racket-test-core/tests/racket/macro.rktl index 90dbb87ad6..07bfdd2625 100644 --- a/pkgs/racket-test-core/tests/racket/macro.rktl +++ b/pkgs/racket-test-core/tests/racket/macro.rktl @@ -1060,7 +1060,9 @@ [else #f])))]) ;; expecting `#%app` from `racket/base` to reqrite to core `#%app` (test #t syntax-original? (find (expand #'(+ 1 2)) '#%app)) - (test #f syntax-original? (find (expand (datum->syntax #'here '(+ 1 2))) '#%app))) + (test #t syntax-property (find (expand #'(+ 1 2)) '#%app) 'implicit-made-explicit) + (test #f syntax-original? (find (expand (datum->syntax #'here '(+ 1 2))) '#%app)) + (test #t syntax-property (find (expand (datum->syntax #'here '(+ 1 2))) '#%app) 'implicit-made-explicit)) ;; ---------------------------------------- diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index 405098e321..390b1765d5 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -7963,12 +7963,7 @@ static const char *startup_source = "(syntax-inspector the-struct_0)))" " (raise-argument-error 'struct-copy \"syntax?\" the-struct_0)))" " s_0)))))))" -"(define-values" -"(syntax-property-copy)" -"(lambda(from-s_0 key_0)" -"(begin" -"(let-values(((v_0)(hash-ref(syntax-props from-s_0) key_0 #f)))" -"(if v_0(hash-set empty-props key_0 v_0) empty-props)))))" +"(define-values(syntax-has-property?)(lambda(from-s_0 key_0)(begin(hash-ref(syntax-props from-s_0) key_0 #f))))" "(define-values" "(taint-content)" "(lambda(d_0)" @@ -44367,6 +44362,10 @@ static const char *startup_source = " for-loop_0)" " null" " lst_0)))))))" +"(define-values(implicit-made-explicit-properties)(hasheq 'implicit-made-explicit #t))" +"(define-values" +"(original-implicit-made-explicit-properties)" +"(hash-set implicit-made-explicit-properties original-property-sym #t))" "(define-values" "(expand.1)" "(lambda(alternate-id1_0 fail-non-transformer2_0 s5_0 ctx6_0)" @@ -44711,7 +44710,9 @@ static const char *startup_source = " disarmed-s_0" " sym_0" " s_0" -"(syntax-property-copy s_0 original-property-sym)" +"(if(syntax-has-property? s_0 original-property-sym)" +" original-implicit-made-explicit-properties" +" implicit-made-explicit-properties)" " insp_0)))" "(let-values(((new-s_0)" "(syntax-rearm$1" diff --git a/racket/src/cs/schemified/expander.scm b/racket/src/cs/schemified/expander.scm index d00070c3b8..27b6fe2869 100644 --- a/racket/src/cs/schemified/expander.scm +++ b/racket/src/cs/schemified/expander.scm @@ -9554,10 +9554,8 @@ (syntax-inspector s_0)))))))) (raise-argument-error 'struct-copy "syntax?" s_0)) s_0)))))) -(define syntax-property-copy - (lambda (from-s_0 key_0) - (let ((v_0 (hash-ref (syntax-props from-s_0) key_0 #f))) - (if v_0 (hash-set empty-props key_0 v_0) empty-props)))) +(define syntax-has-property? + (lambda (from-s_0 key_0) (hash-ref (syntax-props from-s_0) key_0 #f))) (define taint-content (letrec ((procz1 (|#%name| f (lambda (tail?_0 x_0) (begin x_0)))) (gf_0 @@ -50495,6 +50493,9 @@ (for-loop_0 fold-var_1 rest_0)))) fold-var_0)))))) (for-loop_0 null l_0)))))) +(define implicit-made-explicit-properties (hasheq 'implicit-made-explicit #t)) +(define original-implicit-made-explicit-properties + (hash-set implicit-made-explicit-properties original-property-sym #t)) (define expand.1 (|#%name| expand @@ -50963,7 +50964,10 @@ disarmed-s_0 sym_0 s_0 - (syntax-property-copy s_0 original-property-sym) + (if (begin-unsafe + (hash-ref (syntax-props s_0) original-property-sym #f)) + original-implicit-made-explicit-properties + implicit-made-explicit-properties) insp_0))) (let ((new-s_0 (syntax-rearm$1 diff --git a/racket/src/expander/expand/implicit-property.rkt b/racket/src/expander/expand/implicit-property.rkt new file mode 100644 index 0000000000..08311b4d7d --- /dev/null +++ b/racket/src/expander/expand/implicit-property.rkt @@ -0,0 +1,12 @@ +#lang racket/base +(require "../syntax/original.rkt") + +(provide implicit-made-explicit-properties + original-implicit-made-explicit-properties) + +(define implicit-made-explicit-properties + (hasheq 'implicit-made-explicit #t)) + +(define original-implicit-made-explicit-properties + (hash-set implicit-made-explicit-properties + original-property-sym #t)) diff --git a/racket/src/expander/expand/main.rkt b/racket/src/expander/expand/main.rkt index 38de243220..80b459c65a 100644 --- a/racket/src/expander/expand/main.rkt +++ b/racket/src/expander/expand/main.rkt @@ -39,7 +39,8 @@ "../common/performance.rkt" "rebuild.rkt" "parsed.rkt" - "expanded+parsed.rkt") + "expanded+parsed.rkt" + "implicit-property.rkt") (provide expand lookup @@ -243,7 +244,9 @@ (define (make-explicit ctx sym s disarmed-s) (define insp (current-module-code-inspector)) (define sym-s (immediate-datum->syntax disarmed-s sym s - (syntax-property-copy s original-property-sym) + (if (syntax-has-property? s original-property-sym) + original-implicit-made-explicit-properties + implicit-made-explicit-properties) insp)) (define new-s (syntax-rearm (immediate-datum->syntax disarmed-s (cons sym-s disarmed-s) s (syntax-props s) diff --git a/racket/src/expander/syntax/original.rkt b/racket/src/expander/syntax/original.rkt index 5feda7fa53..ef4c5f436a 100644 --- a/racket/src/expander/syntax/original.rkt +++ b/racket/src/expander/syntax/original.rkt @@ -4,4 +4,3 @@ (define original-property-sym (gensym 'original)) - diff --git a/racket/src/expander/syntax/property.rkt b/racket/src/expander/syntax/property.rkt index affeecd587..1bf106be66 100644 --- a/racket/src/expander/syntax/property.rkt +++ b/racket/src/expander/syntax/property.rkt @@ -7,7 +7,7 @@ syntax-property-preserved? syntax-property-symbol-keys syntax-property-remove - syntax-property-copy) + syntax-has-property?) ;; ---------------------------------------- @@ -59,8 +59,5 @@ s)) ;; internal use by expander: -(define (syntax-property-copy from-s key) - (define v (hash-ref (syntax-props from-s) key #f)) - (if v - (hash-set empty-props key v) - empty-props)) +(define (syntax-has-property? from-s key) + (hash-ref (syntax-props from-s) key #f))