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

expander: fix problems with cross-phase persistence

Browse Source
This commit is contained in:
Matthew Flatt 2018-02-26 20:29:22 -07:00
parent 9fec456335
commit 586feb6df0
6 changed files with 1598 additions and 1330 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1170,7 +1170,8 @@ and only if no module-level binding is @racket[set!]ed.
boolean
identifier
string
bytes]
bytes
()]
]
This grammar applies after @tech{expansion}, but because a @tech{cross-phase persistent}

11
pkgs/racket-test/tests/racket/cross-phase.rkt
View File

@ -53,6 +53,17 @@
(check-cross-phase #f '(define-values (x) (#%variable-reference)))
(check-cross-phase #f '(define-values (x) (lambda () (#%variable-reference))))
(check-cross-phase #f '(define-values (x) (lambda () (if #f (#%variable-reference) 10))))
(check-cross-phase #f '(define-values (x) (lambda () (if #f 10 (#%variable-reference)))))
(check-cross-phase #f '(define-values (x) (lambda () (if (#%variable-reference) #f 10))))
(check-cross-phase #f '(define-values (x) (lambda () (with-continuation-mark (set! x x) 1 2))))
(check-cross-phase #f '(define-values (x) (lambda () (with-continuation-mark 1 (set! x x) 2))))
(check-cross-phase #f '(define-values (x) (lambda () (with-continuation-mark 1 2 (set! x x)))))
(check-cross-phase #f '(define-values (x) (lambda () (begin 1 2 (set! x x)))))
(check-cross-phase #f '(define-values (x) (lambda () (begin0 1 2 (set! x x)))))
(check-cross-phase #f '(define-values (x) (lambda () (let-values ([q (set! x x)]) q))))
(check-cross-phase #f '(define-values (x) (lambda () (let-values ([q 'ok]) (set! x x)))))
(check-cross-phase #f '(define-values (x) (lambda () (letrec-values ([q (set! x x)]) q))))
(check-cross-phase #f '(define-values (x) (lambda () (letrec-values ([q 'ok]) (set! x x)))))
(check-cross-phase #f '(define-values (x) (#%variable-reference x)))
(check-cross-phase #f '(#%require racket/base))
(check-cross-phase #f '(define-values (x) (gensym 1)))

64
racket/src/expander/expand/cross-phase.rkt
View File

@ -15,8 +15,7 @@
(provide check-cross-phase-persistent-form)
(define (check-cross-phase-persistent-form bodys)
(check-body bodys))
(define (check-cross-phase-persistent-form bodys self-mpi)
(define (check-body bodys)
(for ([body (in-list bodys)])
@ -35,9 +34,12 @@
(define (check-expr e num-results enclosing)
(cond
[(or (parsed-lambda? e)
(parsed-case-lambda? e))
(check-count 1 num-results enclosing)]
[(parsed-lambda? e)
(check-count 1 num-results enclosing)
(check-no-disallowed-expr e)]
[(parsed-case-lambda? e)
(check-count 1 num-results enclosing)
(check-no-disallowed-expr e)]
[(parsed-quote? e)
(check-datum (parsed-quote-datum e) e)
(check-count 1 num-results enclosing)]
@ -61,7 +63,55 @@
(unless (and (= 1 (length rands))
(quoted-string? (car rands)))
(disallow e))]
[else (disallow e)])]))
[else (disallow e)])]
[else (check-no-disallowed-expr e)]))
(define (check-no-disallowed-expr e)
(cond
[(parsed-lambda? e)
(check-body-no-disallowed-expr (parsed-lambda-body e))]
[(parsed-case-lambda? e)
(for ([clause (in-list (parsed-case-lambda-clauses e))])
(check-body-no-disallowed-expr (cadr clause)))]
[(parsed-app? e)
(check-no-disallowed-expr (parsed-app-rator e))
(for ([e (in-list (parsed-app-rands e))])
(check-no-disallowed-expr e))]
[(parsed-if? e)
(check-no-disallowed-expr (parsed-if-tst e))
(check-no-disallowed-expr (parsed-if-thn e))
(check-no-disallowed-expr (parsed-if-els e))]
[(parsed-set!? e)
(define id (parsed-set!-id e))
(define normal-b (parsed-id-binding id))
(when (or (not normal-b)
(parsed-top-id? id)
(eq? (module-binding-module normal-b) self-mpi))
(disallow e))
(check-no-disallowed-expr (parsed-set!-rhs e))]
[(parsed-with-continuation-mark? e)
(check-no-disallowed-expr (parsed-with-continuation-mark-key e))
(check-no-disallowed-expr (parsed-with-continuation-mark-val e))
(check-no-disallowed-expr (parsed-with-continuation-mark-body e))]
[(parsed-begin? e)
(check-body-no-disallowed-expr (parsed-begin-body e))]
[(parsed-begin0? e)
(check-body-no-disallowed-expr (parsed-begin0-body e))]
[(parsed-let_-values? e)
(for ([clause (in-list (parsed-let_-values-clauses e))])
(check-no-disallowed-expr (cadr clause)))
(check-body-no-disallowed-expr (parsed-let_-values-body e))]
[(or (parsed-quote-syntax? e)
(parsed-#%variable-reference? e))
(disallow e)]
;; Other forms have no subexpressions
[else (void)]))
(define (check-body-no-disallowed-expr l)
(for ([e (in-list l)])
(check-no-disallowed-expr e)))
(check-body bodys))
(define (check-count is-num expected-num enclosing)
(unless (= is-num expected-num)
@ -69,7 +119,7 @@
(define (check-datum d e)
(cond
[(or (number? d) (boolean? d) (symbol? d) (string? d) (bytes? d))
[(or (number? d) (boolean? d) (symbol? d) (string? d) (bytes? d) (null? d))
(void)]
[else (disallow e)]))

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

@ -389,7 +389,7 @@
(raise-syntax-error #f "cannot be cross-phase persistent due to required modules"
rebuild-s
(hash-ref declared-keywords '#:cross-phase-persistent)))
(check-cross-phase-persistent-form fully-expanded-bodys-except-post-submodules))
(check-cross-phase-persistent-form fully-expanded-bodys-except-post-submodules self))
;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; Pass 4: expand `module*` submodules

3
racket/src/expander/namespace/attach.rkt
View File

@ -81,7 +81,8 @@
(define-values (m-ns already?)
(cond
[attach-this-instance?
[(or attach-this-instance?
(module-cross-phase-persistent? m))
(define m-ns (namespace->module-namespace src-namespace mod-name phase))
(unless m-ns
(raise-arguments-error who

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

File diff suppressed because it is too large Load Diff