commit 3ad3f9a23c848e3eb567e0dd889773b6264b1b55
parent dfcbf8770432b42c9247aced5bb401418c2380b0
Author: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 12 Apr 2015 08:04:37 -0600
adapt observation of expander
There are two main changes:
* Expansion of internal-definition contexts uses a single
"rename" step (which is really an "add scope" step) at the
start of expansion, instead once for each body form.
Instead of changing the structures, the derivation parser just
pushes the single rename set down to all the body forms.
* Expansion of a `let`, `letrec`, or `letrec-syntaxes+values` form
parses its body as a sequence instead of (reundantly) as an
internal-defition block if the form was itself generated from
an `internal-detiniion` block.
The derivation parser handles this change by just allowing
block or sequence where only a block was allowed before.
Diffstat:
2 files changed, 48 insertions(+), 13 deletions(-)
diff --git a/macro-debugger-text-lib/macro-debugger/model/deriv-parser.rkt b/macro-debugger-text-lib/macro-debugger/model/deriv-parser.rkt
@@ -462,9 +462,10 @@
(PrimLetValues
(#:args e1 e2 rs)
- [(prim-let-values ! renames-let (? NextEEs) next-group (? EB))
+ [(prim-let-values ! renames-let (? NextEEs) next-group (? EB/EL))
(make p:let-values e1 e2 rs $2 $3 $4 $6)])
+ ;; There's no primitive `let*-values`, anymore
(PrimLet*Values
(#:args e1 e2 rs)
;; let*-values with bindings is "macro-like"
@@ -479,18 +480,18 @@
(PrimLetrecValues
(#:args e1 e2 rs)
- [(prim-letrec-values ! renames-let (? NextEEs) next-group (? EB))
+ [(prim-letrec-values ! renames-let (? NextEEs) next-group (? EB/EL))
(make p:letrec-values e1 e2 rs $2 $3 $4 $6)])
(PrimLetrecSyntaxes+Values
(#:args e1 e2 rs)
[(prim-letrec-syntaxes+values ! renames-letrec-syntaxes
- (? PrepareEnv) (? NextBindSyntaxess) next-group (? EB) OptTag)
+ (? PrepareEnv) (? NextBindSyntaxess) next-group (? EB/EL) OptTag)
(make p:letrec-syntaxes+values e1 e2 rs $2 $3 $4 $5 #f null $7 $8)]
[(prim-letrec-syntaxes+values renames-letrec-syntaxes
PrepareEnv NextBindSyntaxess next-group
prim-letrec-values
- renames-let (? NextEEs) next-group (? EB) OptTag)
+ renames-let (? NextEEs) next-group (? EB/EL) OptTag)
(make p:letrec-syntaxes+values e1 e2 rs #f $2 $3 $4 $7 $8 $10 $11)])
;; Atomic expressions
@@ -548,6 +549,13 @@
(make p:set! e1 e2 rs $2 (cons $3 $4) $5 $7)]
[(prim-set! Resolves (? MacroStep) (? EE))
(make p:set!-macro e1 e2 rs #f ($3 e1 $2 $4))])
+
+ ;; When an internal-definition context expands to `let`, `letrec`, etc.,
+ ;; then the body is processed as a list (since it has already been
+ ;; processed as a block)
+ (EB/EL
+ [(EB) $1]
+ [(EL) $1])
;; Blocks
;; EB Answer = BlockDerivation
@@ -561,24 +569,29 @@
;; BlockPass1 Answer = (list-of BRule)
(BlockPass1
+ [(renames-block (? BlockPass1*))
+ (map (install-renames-block $1) $2)])
+
+ ;; BlockPass1 Answer = (list-of BRule)
+ (BlockPass1*
(#:skipped null)
[() null]
- [((? BRule) (? BlockPass1))
+ [((? BRule) (? BlockPass1*))
(cons $1 $2)])
;; BRule Answer = BRule
(BRule
[(next !!)
(make b:error $2)]
- [(next renames-block (? CheckImmediateMacro))
- (make b:expr $2 $3)]
- [(next renames-block CheckImmediateMacro prim-begin ! splice !)
- (make b:splice $2 $3 $5 $6 $7)]
- [(next renames-block CheckImmediateMacro prim-define-values ! rename-one !)
- (make b:defvals $2 $3 $5 $6 $7)]
- [(next renames-block CheckImmediateMacro
+ [(next (? CheckImmediateMacro))
+ (make b:expr '... $2)]
+ [(next CheckImmediateMacro prim-begin ! splice !)
+ (make b:splice '... $2 $4 $5 $6)]
+ [(next CheckImmediateMacro prim-define-values ! rename-one !)
+ (make b:defvals '... $2 $4 $5 $6)]
+ [(next CheckImmediateMacro
prim-define-syntaxes ! rename-one ! (? PrepareEnv) (? BindSyntaxes))
- (make b:defstx $2 $3 $5 $6 $7 $8 $9)])
+ (make b:defstx '... $2 $4 $5 $6 $7 $8)])
;; BindSyntaxes Answer = Derivation
(BindSyntaxes
@@ -608,3 +621,18 @@
[(next (? EE) (? EL*)) (cons $2 $3)])
)))
+
+;; Used to move a `renames` block that is provided once into each of
+;; a list of brules, since the old expander provided the renames for
+;; each brule
+(define ((install-renames-block renames) b)
+ (cond
+ [(b:expr? b)
+ (struct-copy b:expr b [renames #:parent brule renames])]
+ [(b:splice? b)
+ (struct-copy b:splice b [renames #:parent brule renames])]
+ [(b:defvals? b)
+ (struct-copy b:defvals b [renames #:parent brule renames])]
+ [(b:defstx? b)
+ (struct-copy b:defstx b [renames #:parent brule renames])]
+ [else (error 'internal "unrecognized brule: ~e" b)]))
diff --git a/macro-debugger-text-lib/macro-debugger/model/reductions.rkt b/macro-debugger-text-lib/macro-debugger/model/reductions.rkt
@@ -557,6 +557,13 @@
([#:rename ?block (wlderiv-es1 pass2)]
[#:set-syntax (wlderiv-es1 pass2)]
[List ?block pass2])])]
+ ;; Alternatively, allow lists, since `let`, etc., bodies
+ ;; (generated form an internal definition context) are
+ ;; processed as a list.
+ [(Wrap lderiv (es1 es2 ?1 derivs))
+ (R [! ?1]
+ [#:pattern (?form ...)]
+ [Expr (?form ...) derivs])]
[#f
(R)]))
