From 35149c39d67eabce82c130b6819c0aa9d95d179a Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Wed, 21 Mar 2012 12:00:42 -0600 Subject: [PATCH] macro-debugger: updates for submodules original commit: f0c03ad921e63819901fd6c4658fa6735771eed5 --- .../analysis/private/get-references.rkt | 8 +++++-- collects/macro-debugger/model/deriv-c.rkt | 5 +++- .../macro-debugger/model/deriv-parser.rkt | 18 ++++++++++---- .../macro-debugger/model/deriv-tokens.rkt | 6 ++++- collects/macro-debugger/model/reductions.rkt | 24 +++++++++++++++++-- 5 files changed, 51 insertions(+), 10 deletions(-) diff --git a/collects/macro-debugger/analysis/private/get-references.rkt b/collects/macro-debugger/analysis/private/get-references.rkt index 544e945..48f6dae 100644 --- a/collects/macro-debugger/analysis/private/get-references.rkt +++ b/collects/macro-debugger/analysis/private/get-references.rkt @@ -123,8 +123,8 @@ (void)] [(p:module z1 z2 rs ?1 locals tag rename check tag2 ?3 body shift) (recur locals check body)] - [(p:#%module-begin z1 z2 rs ?1 me body ?2) - (recur body)] + [(p:#%module-begin z1 z2 rs ?1 me body ?2 subs) + (recur body subs)] [(p:define-syntaxes z1 z2 rs ?1 prep rhs locals) (recur prep locals) (recur/phase-up rhs)] @@ -164,6 +164,10 @@ (recur inners)] [(p:require _ _ _ _ locals) (recur locals)] + [(p:submodule _ _ _ _ exp) + (recur exp)] + [(p:submodule* _ _ _ _) + (void)] [(p:#%stratified-body _ _ _ _ bderiv) (recur bderiv)] [(p:stop _ _ _ _) (void)] diff --git a/collects/macro-debugger/model/deriv-c.rkt b/collects/macro-debugger/model/deriv-c.rkt index 3c2fe10..43dcc83 100644 --- a/collects/macro-debugger/model/deriv-c.rkt +++ b/collects/macro-debugger/model/deriv-c.rkt @@ -56,7 +56,7 @@ ;; (make-p:#%module-begin Stx ModuleBegin/Phase ?exn) (define-struct (p:module prule) (prep tag rename check tag2 ?3 body shift) #:transparent) -(define-struct (p:#%module-begin prule) (me body ?2) #:transparent) +(define-struct (p:#%module-begin prule) (me body ?2 subs) #:transparent) ;; (make-p:define-syntaxes (listof LocalAction) DerivLL (listof LocalAction)) ;; (make-p:define-values Deriv) @@ -101,6 +101,9 @@ ;; (make-p:require (listof LocalAction)) (define-struct (p:require prule) (locals) #:transparent) +(define-struct (p:submodule prule) (exp) #:transparent) +(define-struct (p:submodule* prule) () #:transparent) + ;; (make-p:#%stratified-body BDeriv) (define-struct (p:#%stratified-body prule) (bderiv) #:transparent) diff --git a/collects/macro-debugger/model/deriv-parser.rkt b/collects/macro-debugger/model/deriv-parser.rkt index 8b1325b..045f421 100644 --- a/collects/macro-debugger/model/deriv-parser.rkt +++ b/collects/macro-debugger/model/deriv-parser.rkt @@ -30,7 +30,7 @@ (src-pos) (tokens basic-empty-tokens basic-tokens prim-tokens renames-tokens) (end EOF) - #|(debug "/tmp/ryan/DEBUG-PARSER.txt")|# + #| (debug "/tmp/DEBUG-PARSER.txt") |# (error deriv-error)) ;; tokens @@ -292,17 +292,23 @@ ;; instead appear directly here (Prim#%ModuleBegin (#:args e1 e2 rs) - [(prim-#%module-begin ! rename-one (? ModuleBegin/Phase) (? Eval)) + [(prim-#%module-begin ! rename-one (? ModuleBegin/Phase) (? Eval) next (? ExpandSubmodules)) (make p:#%module-begin e1 e2 rs $2 $3 $4 (for/or ([la (in-list $5)]) - (and (local-exn? la) (local-exn-exn la))))]) + (and (local-exn? la) (local-exn-exn la))) + $7)]) #| ;; restore this version when expander fixed (Prim#%ModuleBegin-REAL (#:args e1 e2 rs) - [(prim-#%module-begin ! rename-one (? ModuleBegin/Phase) !) + [(prim-#%module-begin ! rename-one (? ModuleBegin/Phase) ! (? ExpandSubmodules)) (make p:#%module-begin e1 e2 rs $2 $3 $4 $5)]) |# + (ExpandSubmodules + (#:skipped null) + [(enter-prim (? PrimModule) exit-prim (? ExpandSubmodules)) + (cons ($2 $1 $3 null) $4)] + [() null]) (ModuleBegin/Phase [((? ModulePass1) next-group (? ModulePass2) next-group (? ModulePass3)) @@ -336,6 +342,10 @@ (make p:begin-for-syntax $1 $7 null $3 $4 $6 $7)] [(enter-prim prim-require (? Eval) exit-prim) (make p:require $1 $4 null #f $3)] + [(enter-prim prim-submodule ! (? ExpandSubmodules #|one|#) exit-prim) + (make p:submodule $1 $5 null $3 (car $4))] + [(enter-prim prim-submodule* ! exit-prim) + (make p:submodule* $1 $4 null $3)] [() (make p:stop e1 e1 null #f)]) diff --git a/collects/macro-debugger/model/deriv-tokens.rkt b/collects/macro-debugger/model/deriv-tokens.rkt index 9591336..25edb6d 100644 --- a/collects/macro-debugger/model/deriv-tokens.rkt +++ b/collects/macro-debugger/model/deriv-tokens.rkt @@ -97,6 +97,7 @@ prim-varref prim-#%stratified-body prim-begin-for-syntax + prim-submodule prim-submodule* )) ;; ** Signals to tokens @@ -194,7 +195,10 @@ (154 local-value-result ,token-local-value-result) (155 prim-#%stratified-body) (156 prim-begin-for-syntax) - (157 prepare-env))) + (157 prepare-env) + (158 prim-submodule) + (159 prim-submodule*) + )) (define (signal->symbol sig) (if (symbol? sig) diff --git a/collects/macro-debugger/model/reductions.rkt b/collects/macro-debugger/model/reductions.rkt index 0f54430..6757bdf 100644 --- a/collects/macro-debugger/model/reductions.rkt +++ b/collects/macro-debugger/model/reductions.rkt @@ -97,13 +97,14 @@ [Expr ?body body] [#:pattern ?form] [#:rename ?form shift])] - [(Wrap p:#%module-begin (e1 e2 rs ?1 me body ?2)) + [(Wrap p:#%module-begin (e1 e2 rs ?1 me body ?2 subs)) (R [! ?1] [#:pattern ?form] [#:rename ?form me] [#:pattern (?module-begin . ?forms)] [ModuleBegin/Phase ?forms body] - [! ?2])] + [! ?2] + [Submodules ?forms subs])] [(Wrap p:define-syntaxes (e1 e2 rs ?1 prep rhs locals)) (R [! ?1] [#:pattern ?form] @@ -252,6 +253,13 @@ [#:pattern ?form] [#:walk e2 'macro])] + [(Wrap p:submodule* (e1 e2 rs ?1)) + (R [! ?1])] + [(Wrap p:submodule (e1 e2 rs ?1 exp)) + (R [! ?1] + [#:pattern ?form] + [Expr ?form exp])] + [(Wrap p:stop (e1 e2 rs ?1)) (R [! ?1])] @@ -501,6 +509,18 @@ [#f (R)])) +(define (Submodules subs) + (match subs + ['() + (R)] + [(cons sub rest) + (R [#:pattern ?form] + [#:new-local-context + [#:pattern ?form] + [#:set-syntax (wderiv-e1 sub)] + [Expr ?form sub]] + [Submodules ?form rest])])) + ;; List : ListDerivation -> RST (define (List ld) (match ld