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

expander: 'implicit-made-explicit property on introduced #%app, etc.

Browse Source
This commit is contained in:
Matthew Flatt 2020-12-12 11:02:58 -07:00
parent 79ccd514c3
commit 400f4fa4fb
8 changed files with 57 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
pkgs/racket-doc/scribblings/reference/syntax-model.scrbl
View File

@ -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}

4
pkgs/racket-test-core/tests/racket/macro.rktl
View File

@ -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))
;; ----------------------------------------

15
racket/src/bc/src/startup.inc
View File

@ -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"

14
racket/src/cs/schemified/expander.scm
View File

@ -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

12
racket/src/expander/expand/implicit-property.rkt Normal file
View File

@ -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))

7
racket/src/expander/expand/main.rkt
View File

@ -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)

1
racket/src/expander/syntax/original.rkt
View File

@ -4,4 +4,3 @@
(define original-property-sym
(gensym 'original))

9
racket/src/expander/syntax/property.rkt
View File

@ -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))