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

add syntax-binding-set functions

Browse Source 
The `syntax-binding-set` functions enable explicit construction of
lexical information for a syntax objects.
This commit is contained in:
Matthew Flatt 2018-08-15 10:18:18 -06:00
parent 9658c723db
commit 9704cc4731
13 changed files with 794 additions and 211 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "7.0.0.11")
(define version "7.0.0.12")
(define deps `("racket-lib"
["racket" #:version ,version]))

35
pkgs/racket-doc/scribblings/reference/stx-ops.scrbl
View File

@ -279,6 +279,41 @@ then the @exnraise[exn:fail:contract].
The @racket[ignored] argument is allowed for backward compatibility
and has no effect on the returned syntax object.}
@deftogether[(
@defproc[(syntax-binding-set? [v any/c]) boolean?]
@defproc[(syntax-binding-set) syntax-binding-set?]
@defproc[(syntax-binding-set->syntax [binding-set syntax-binding-set?] [datum any/c]) syntax-binding-set?]
@defproc[(syntax-binding-set-extend [binding-set syntax-binding-set?]
[symbol symbol?]
[phase (or/c exact-integer? #f)]
[mpi module-path-index?]
[#:source-symbol source-symbol symbol? symbol]
[#:source-phase source-phase (or/c exact-integer? #f) phase]
[#:nominal-module nominal-mpi module-path-index? mpi]
[#:nominal-phase nominal-phase (or/c exact-integer? #f) source-phase]
[#:nominal-symbol nominal-symbol symbol? source-symbol]
[#:nominal-require-phase nominal-require-phase (or/c exact-integer? #f) 0]
[#:inspector inspector (or/c inspector? #f) #f])
syntax-binding-set?]
)]{
A @deftech{syntax binding set} supports explicit construction of
binding information for a syntax object. Start by creating an empty
binding set with @racket[syntax-binding-set], add bindings with
@racket[binding-set-extend], and create a syntax object that hash the
bindings as its @tech{lexical information} using
@racket[syntax-binding-set->syntax].
The first three arguments to @racket[syntax-binding-set-extend]
establish a binding of @racket[symbol] at @racket[phase] to an
identifier that is defined in the module referenced by @racket[mpi].
Supply @racket[source-symbol] to make the binding of @racket[symbol]
refer to a different provided variable from @racket[mpi], and so on;
the optional arguments correspond to the results of
@racket[identifier-binding].
@history[#:added "7.0.0.12"]}
@defproc[(datum-intern-literal [v any/c]) any/c]{

55
pkgs/racket-test-core/tests/racket/stx.rktl
View File

@ -1922,6 +1922,61 @@
(error-test #'(a-rule-pattern) no-match?)
(error-test #'(a-rule-pattern 1) no-match?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Explicit binding sets
(let ([bs (syntax-binding-set-extend
(syntax-binding-set-extend
(syntax-binding-set-extend
(syntax-binding-set)
'car 0 (module-path-index-join ''#%runtime #f))
'cdr 1 (module-path-index-join ''#%runtime #f)
#:source-phase 0
#:nominal-require-phase 1)
'items 0 (module-path-index-join ''#%runtime #f)
#:source-symbol 'list)])
(test #t free-identifier=?
(syntax-binding-set->syntax bs 'car)
#'car)
(test #f free-identifier=?
(syntax-binding-set->syntax bs 'cdr)
#'cdr)
(test #t free-identifier=?
(syntax-binding-set->syntax bs 'cdr)
#'cdr
1)
(test #f free-identifier=?
(syntax-binding-set->syntax bs 'list)
#'list)
(test #t free-identifier=?
(syntax-binding-set->syntax bs 'items)
#'list))
(module synthesizes-self-reference racket/base
(require (for-syntax racket/base))
(provide results)
(define x 5)
(define-syntax (f stx)
(define the-x
(syntax-binding-set->syntax
(syntax-binding-set-extend
(syntax-binding-set)
'x 0 (variable-reference->module-path-index
(#%variable-reference)))
'x))
#`(list #,the-x
x
(eval (quote-syntax #,the-x))
(eval (quote-syntax x))))
(define results (f)))
(dynamic-require ''synthesizes-self-reference 0)
(test '(5 5 5 5) dynamic-require ''synthesizes-self-reference 'results)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Extra taint tests

4
racket/collects/racket/private/base.rkt
View File

@ -12,7 +12,8 @@
"cert.rkt"
"submodule.rkt"
"generic-interfaces.rkt"
"kw-syntax-local.rkt" ; shadows local-expand and variants
"kw-syntax-local.rkt" ; shadows `local-expand` and variants
"kw-syntax-binding.rkt" ; shadows `syntax-binding-set-extend`
(for-syntax "stxcase-scheme.rkt"))
(#%provide (all-from-except "pre-base.rkt"
@ -40,6 +41,7 @@
(all-from "submodule.rkt")
(all-from "generic-interfaces.rkt")
(all-from "kw-syntax-local.rkt")
(all-from "kw-syntax-binding.rkt")
(for-syntax syntax-rules syntax-id-rules ... _)
(rename -open-input-file open-input-file)
(rename -open-output-file open-output-file)

18
racket/collects/racket/private/kw-syntax-binding.rkt Normal file
View File

@ -0,0 +1,18 @@
(module kw-syntax-local "pre-base.rkt"
(require (prefix-in k: '#%kernel))
(provide syntax-binding-set-extend)
(define (syntax-binding-set-extend bs as-sym as-phase mpi
#:source-symbol [sym as-sym]
#:source-phase [phase as-phase]
#:nominal-module [nominal-mpi mpi]
#:nominal-phase [nominal-phase phase]
#:nominal-symbol [nominal-sym sym]
#:nominal-require-phase [nominal-require-phase 0]
#:inspector [insp #f])
(k:syntax-binding-set-extend bs as-sym as-phase mpi
sym phase
nominal-mpi nominal-phase nominal-sym
nominal-require-phase
insp)))

7
racket/src/expander/boot/core-primitive.rkt
View File

@ -79,7 +79,12 @@
syntax-disarm
syntax-rearm
syntax-taint
syntax-binding-set
syntax-binding-set?
syntax-binding-set-extend
syntax-binding-set->syntax
raise-syntax-error
struct:exn:fail:syntax
exn:fail:syntax

14
racket/src/expander/demo.rkt
View File

@ -1407,3 +1407,17 @@
'kar)
(check-value (cadr (identifier-binding s-also-in-alt))
'car) ; because using combined scopes is ambiguous
;; ----------------------------------------
;; Explicitly constructed binding sets
(eval-expression
#:check '(#t #f)
'(let-values ([(bs) (syntax-binding-set-extend
(syntax-binding-set)
'car 0 (module-path-index-join ''#%runtime #f))])
(list
(free-identifier=? (syntax-binding-set->syntax bs 'car)
(quote-syntax car))
(free-identifier=? (syntax-binding-set->syntax bs 'cdr)
(quote-syntax cdr)))))

5
racket/src/expander/main.rkt
View File

@ -109,8 +109,9 @@
compile-keep-source-locations! ; to enable if the back end wants them
;; This functions are provided for basic testing
;; The remaining functions are provided for basic testing
;; (such as "demo.rkt")
syntax? syntax-e
identifier?
syntax-property
@ -118,7 +119,7 @@
module-compiled-exports
module-compiled-indirect-exports
read-accept-compiled
syntax-shift-phase-level
bound-identifier=?)

41
racket/src/expander/syntax/api.rkt
View File

@ -1,5 +1,6 @@
#lang racket/base
(require "../common/phase.rkt"
"../common/module-path.rkt"
(rename-in "syntax.rkt"
[syntax->datum raw:syntax->datum]
[datum->syntax raw:datum->syntax])
@ -17,6 +18,10 @@
[identifier-binding-symbol raw:identifier-binding-symbol])
(rename-in "track.rkt"
[syntax-track-origin raw:syntax-track-origin])
(rename-in "binding-set.rkt"
[syntax-binding-set raw:syntax-binding-set]
[syntax-binding-set-extend raw:syntax-binding-set-extend]
[syntax-binding-set->syntax raw:syntax-binding-set->syntax])
"../expand/syntax-local.rkt"
"srcloc.rkt"
"../common/contract.rkt"
@ -38,6 +43,10 @@
syntax->datum
maybe-syntax->datum
datum->syntax
syntax-binding-set?
syntax-binding-set
syntax-binding-set-extend
syntax-binding-set->syntax
syntax->list
identifier?
bound-identifier=?
@ -91,6 +100,38 @@
(raise-argument-error who "(or #f syntax?)" stx-p))
(raw:datum->syntax stx-c s (to-srcloc-stx stx-l) stx-p))
(define/who (syntax-binding-set)
(raw:syntax-binding-set null))
(define/who (syntax-binding-set-extend bs as-sym as-phase mpi
[sym as-sym]
[phase as-phase]
[nominal-mpi mpi]
[nominal-phase phase]
[nominal-sym sym]
[nominal-require-phase 0]
[insp #f])
(check who syntax-binding-set? bs)
(check who symbol? as-sym)
(check who phase? #:contract phase?-string as-phase)
(check who module-path-index? mpi)
(check who symbol? sym)
(check who phase? #:contract phase?-string phase)
(check who module-path-index? nominal-mpi)
(check who phase? #:contract phase?-string nominal-phase)
(check who symbol? nominal-sym)
(check who phase? #:contract phase?-string nominal-require-phase)
(check who inspector? #:or-false insp)
(raw:syntax-binding-set-extend bs as-sym as-phase mpi
sym phase
nominal-mpi nominal-phase nominal-sym
nominal-require-phase
insp))
(define/who (syntax-binding-set->syntax bs datum)
(check who syntax-binding-set? bs)
(raw:syntax-binding-set->syntax bs datum))
(define/who (syntax->list s)
(check who syntax? s)
(raw:syntax->list s))

38
racket/src/expander/syntax/binding-set.rkt Normal file
View File

@ -0,0 +1,38 @@
#lang racket/base
(require "syntax.rkt"
"scope.rkt"
"module-binding.rkt")
(provide syntax-binding-set
syntax-binding-set?
syntax-binding-set-extend
syntax-binding-set->syntax)
(struct syntax-binding-set (binds))
(struct bind (sym phase binding))
(define (syntax-binding-set-extend bs as-sym as-phase mpi
sym phase
nominal-mpi nominal-phase nominal-sym
nominal-require-phase
inspector)
(struct-copy syntax-binding-set bs
[binds
(cons (bind as-sym
as-phase
(make-module-binding mpi phase sym
#:extra-inspector inspector
#:nominal-module nominal-mpi
#:nominal-phase nominal-phase
#:nominal-sym nominal-sym
#:nominal-require-phase nominal-require-phase))
(syntax-binding-set-binds bs))]))
(define (syntax-binding-set->syntax bs datum)
(define s (add-scope (datum->syntax #f datum)
(new-multi-scope 'binding-set)))
(for ([bind (in-list (syntax-binding-set-binds bs))])
(add-binding-in-scopes! (syntax-scope-set s (bind-phase bind))
(bind-sym bind)
(bind-binding bind)))
s)

1
racket/src/expander/syntax/module-binding.rkt
View File

@ -22,7 +22,6 @@
;; ----------------------------------------
(define (make-module-binding module phase sym
#:wrt [wrt-sym sym]
#:nominal-module [nominal-module module]
#:nominal-phase [nominal-phase phase]
#:nominal-sym [nominal-sym sym]

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "7.0.0.11"
#define MZSCHEME_VERSION "7.0.0.12"
#define MZSCHEME_VERSION_X 7
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 11
#define MZSCHEME_VERSION_W 12
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

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

File diff suppressed because it is too large Load Diff