diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss
index 09eea0eff0..2d71ee1433 100644
--- a/collects/macro-debugger/model/deriv-c.ss
+++ b/collects/macro-debugger/model/deriv-c.ss
@@ -32,6 +32,7 @@
(define-struct (mrule base) (me1 locals me2 ?2 etx next) #:transparent)
;; A LocalAction is one of:
+(define-struct local-exn (exn) #:transparent)
(define-struct (local-expansion node) (for-stx? me1 inner lifted me2 opaque)
#:transparent)
(define-struct local-lift (expr ids) #:transparent)
@@ -44,15 +45,15 @@
(define-struct (prule base) () #:transparent)
(define-struct (p:variable prule) () #:transparent)
-;; (make-p:module ?exn ?stx stx ?Deriv ?stx ?exn Deriv ?stx)
+;; (make-p:module (listof LocalAction) ?stx stx ?Deriv ?stx ?exn Deriv ?stx)
;; (make-p:#%module-begin Stx ModulePass1 ModulePass2 ?exn)
-(define-struct (p:module prule) (?2 tag rename check tag2 ?3 body shift)
+(define-struct (p:module prule) (locals tag rename check tag2 ?3 body shift)
#:transparent)
(define-struct (p:#%module-begin prule) (me pass1 pass2 ?2) #:transparent)
-;; (make-p:define-syntaxes DerivLL)
+;; (make-p:define-syntaxes DerivLL (listof LocalAction))
;; (make-p:define-values Deriv)
-(define-struct (p:define-syntaxes prule) (rhs ?2) #:transparent)
+(define-struct (p:define-syntaxes prule) (rhs locals) #:transparent)
(define-struct (p:define-values prule) (rhs) #:transparent)
;; (make-p:#%expression Deriv ?Stx)
@@ -89,15 +90,15 @@
;; (make-p:provide (listof Deriv) ?exn)
(define-struct (p:provide prule) (inners ?2) #:transparent)
+;; (make-p:require (listof LocalAction))
+(define-struct (p:require prule) (locals) #:transparent)
+
;; (make-p:stop )
;; (make-p:unknown )
;; (make-p:#%top Stx)
;; (make-p:#%datum Stx)
;; (make-p:quote )
;; (make-p:quote-syntax )
-;; (make-p:require )
-;; (make-p:require-for-syntax )
-;; (make-p:require-for-template )
;; (make-p:#%variable-reference )
(define-struct (p::STOP prule) () #:transparent)
(define-struct (p:stop p::STOP) () #:transparent)
@@ -106,9 +107,6 @@
(define-struct (p:#%datum p::STOP) () #:transparent)
(define-struct (p:quote p::STOP) () #:transparent)
(define-struct (p:quote-syntax p::STOP) () #:transparent)
-(define-struct (p:require p::STOP) () #:transparent)
-(define-struct (p:require-for-syntax p::STOP) () #:transparent)
-(define-struct (p:require-for-template p::STOP) () #:transparent)
(define-struct (p:#%variable-reference p::STOP) () #:transparent)
;; A LDeriv is
@@ -133,8 +131,8 @@
(define-struct (b:defstx brule) (head ?1 rename ?2 bindrhs) #:transparent)
;; A BindSyntaxes is
-;; (make-bind-syntaxes DerivLL ?exn)
-(define-struct bind-syntaxes (rhs ?1) #:transparent)
+;; (make-bind-syntaxes DerivLL (listof LocalAction))
+(define-struct bind-syntaxes (rhs locals) #:transparent)
;; A CaseLambdaClause is
;; (make-clc ?exn CaseLambdaRename BDeriv)
@@ -165,9 +163,7 @@
;; A ModPrim is a PRule in:
;; (make-p:define-values #:transparent)
;; (make-p:define-syntaxes Deriv)
-;; (make-p:require )
-;; (make-p:require-for-syntax )
-;; (make-p:require-for-template )
+;; (make-p:require (listof LocalAction))
;; (make-p:provide )
;; #f
diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss
index 7bb6d7b4f7..dbbae83914 100644
--- a/collects/macro-debugger/model/deriv-parser.ss
+++ b/collects/macro-debugger/model/deriv-parser.ss
@@ -18,14 +18,6 @@
;; PARSER
-(define-struct (exn:eval exn) (deriv))
-(define empty-cms
- (call-with-continuation-prompt (lambda () (current-continuation-marks))))
-(define (create-eval-exn deriv)
- (make-exn:eval "exception during evaluation"
- empty-cms
- deriv))
-
(define-production-splitter production/I values values)
(define-syntax (productions/I stx)
@@ -119,14 +111,9 @@
(make lift/let-deriv initial final $1 $2 $3))])
;; Evaluation
- ;; Answer = ?exn
+ ;; Answer = (listof LocalAction)
(Eval
- [() #f]
- [(!!) $1]
- [(start EE/Interrupted) (create-eval-exn $2)]
- [(start EE (? Eval)) $3]
- [(start CheckImmediateMacro/Interrupted) (create-eval-exn $2)]
- [(start CheckImmediateMacro (? Eval)) $3])
+ [((? LocalActions)) $1])
;; Expansion of an expression to primitive form
(CheckImmediateMacro
@@ -177,9 +164,9 @@
(MacroStep
(#:args e1 rs next)
[(enter-macro ! macro-pre-transform (? LocalActions)
- ! macro-post-transform ! exit-macro)
+ macro-post-transform ! exit-macro)
(make mrule e1 (and next (wderiv-e2 next)) rs $2
- $3 $4 $6 (or $5 $7) $8 next)])
+ $3 $4 $5 $6 $7 next)])
;; Keyword resolution
(Resolves
@@ -191,10 +178,10 @@
(LocalActions
(#:skipped null)
[() null]
- [((? LocalAction) (? LocalActions)) (cons $1 $2)]
- [((? NotReallyLocalAction) (? LocalActions)) $2])
+ [((? LocalAction) (? LocalActions)) (cons $1 $2)])
(LocalAction
+ [(!!) (make local-exn $1)]
[(enter-local OptPhaseUp
local-pre (? LocalExpand/Inner) OptLifted local-post
OptOpaqueExpr exit-local)
@@ -210,11 +197,16 @@
[(local-bind ! rename-list)
(make local-bind $1 $2 $3 #f)]
[(local-bind rename-list (? BindSyntaxes))
- (make local-bind $1 #f $2 $3)])
+ (make local-bind $1 #f $2 $3)]
+ ;; -- Not really local actions, but can occur during evaluation
+ ;; called 'expand' (not 'local-expand') within transformer
+ [(start (? EE)) #f]
+ [(start (? CheckImmediateMacro)) #f])
(LocalExpand/Inner
[(start (? EE)) $2]
[((? CheckImmediateMacro)) $1])
+
(OptLifted
[(lift-loop) $1]
[() #f])
@@ -225,11 +217,6 @@
[(phase-up) #t]
[() #f])
- (NotReallyLocalAction
- ;; called 'expand' (not 'local-expand') within transformer
- [(start (? EE)) #f]
- [(start (? CheckImmediateMacro)) #f])
-
(Prim
(#:args e1 e2 rs)
[((? PrimModule)) ($1 e1 e2 rs)]
@@ -255,8 +242,6 @@
[((? PrimQuote)) ($1 e1 e2 rs)]
[((? PrimQuoteSyntax)) ($1 e1 e2 rs)]
[((? PrimRequire)) ($1 e1 e2 rs)]
- [((? PrimRequireForSyntax)) ($1 e1 e2 rs)]
- [((? PrimRequireForTemplate)) ($1 e1 e2 rs)]
[((? PrimProvide)) ($1 e1 e2 rs)]
[((? PrimVarRef)) ($1 e1 e2 rs)])
@@ -303,11 +288,7 @@
phase-up (? EE/LetLifts) (? Eval) exit-prim)
(make p:define-syntaxes $1 $7 null $3 $5 $6)]
[(enter-prim prim-require (? Eval) exit-prim)
- (make p:require $1 $4 null $3)]
- [(enter-prim prim-require-for-syntax (? Eval) exit-prim)
- (make p:require-for-syntax $1 $4 null $3)]
- [(enter-prim prim-require-for-template (? Eval) exit-prim)
- (make p:require-for-template $1 $4 null $3)]
+ (make p:require $1 $4 null #f $3)]
[()
(make p:stop e1 e1 null #f)])
@@ -464,17 +445,7 @@
(PrimRequire
(#:args e1 e2 rs)
[(prim-require (? Eval))
- (make p:require e1 e2 rs $2)])
-
- (PrimRequireForSyntax
- (#:args e1 e2 rs)
- [(prim-require-for-syntax (? Eval))
- (make p:require-for-syntax e1 e2 rs $2)])
-
- (PrimRequireForTemplate
- (#:args e1 e2 rs)
- [(prim-require-for-template (? Eval))
- (make p:require-for-template e1 e2 rs $2)])
+ (make p:require e1 e2 rs #f $2)])
(PrimProvide
(#:args e1 e2 rs)
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index 6bdf409ec6..cd4cebb876 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -64,11 +64,11 @@
[#:when (or (not (identifier? e1))
(not (bound-identifier=? e1 e2)))
[#:walk e2 'resolve-variable]])]
- [(Wrap p:module (e1 e2 rs ?1 ?2 tag rename check tag2 ?3 body shift))
+ [(Wrap p:module (e1 e2 rs ?1 locals tag rename check tag2 ?3 body shift))
(R [#:hide-check rs]
[! ?1]
[#:pattern (?module ?name ?language . ?body-parts)]
- [! ?2]
+ [LocalActions ?body-parts locals]
[#:when tag
[#:in-hole ?body-parts
[#:walk (list tag) 'tag-module-begin]]]
@@ -96,12 +96,12 @@
[#:do (DEBUG (printf "** module begin pass 2\n"))]
[ModulePass ?forms pass2]
[! ?1])]
- [(Wrap p:define-syntaxes (e1 e2 rs ?1 rhs ?2))
+ [(Wrap p:define-syntaxes (e1 e2 rs ?1 rhs locals))
(R [! ?1]
[#:pattern (?define-syntaxes ?vars ?rhs)]
[#:binders #'?vars]
[Expr/PhaseUp ?rhs rhs]
- [! ?2])]
+ [LocalActions ?rhs locals])]
[(Wrap p:define-values (e1 e2 rs ?1 rhs))
(R [! ?1]
[#:pattern (?define-values ?vars ?rhs)]
@@ -224,6 +224,11 @@
[#:step 'provide]
[#:set-syntax e2]))]
+ [(Wrap p:require (e1 e2 rs ?1 locals))
+ (R [! ?1]
+ [#:pattern ?form]
+ [LocalActions ?form locals])]
+
[(Wrap p:stop (e1 e2 rs ?1))
(R [! ?1])]
@@ -367,6 +372,9 @@
(define (LocalAction local)
(match/count local
+ [(struct local-exn (exn))
+ (R [! exn])]
+
[(struct local-expansion (e1 e2 for-stx? me1 inner #f me2 opaque))
(R [#:parameterize ((phase (if for-stx? (add1 (phase)) (phase))))
[#:set-syntax e1]
@@ -544,11 +552,11 @@
;; BindSyntaxes : BindSyntaxes -> RST
(define (BindSyntaxes bindrhs)
(match bindrhs
- [(Wrap bind-syntaxes (rhs ?1))
+ [(Wrap bind-syntaxes (rhs locals))
(R [#:set-syntax (node-z1 rhs)] ;; set syntax; could be in local-bind
[#:pattern ?form]
[Expr/PhaseUp ?form rhs]
- [! ?1])]))
+ [LocalActions ?form locals])]))
;; ModulePass : (list-of MBRule) -> RST
(define (ModulePass mbrules)
@@ -574,8 +582,8 @@
[! ?1]
[#:let begin-form #'?firstB]
[#:let rest-forms #'?rest]
- [#:pattern ?forms]
[#:left-foot (list #'?firstB)]
+ [#:pattern ?forms]
[#:set-syntax (append (stx->list (stx-cdr begin-form)) rest-forms)]
[#:step 'splice-module (stx->list (stx-cdr begin-form))]
[#:rename ?forms tail]