From d846d22b9ef04e7d6386ea262f6f248ea7ccad28 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 8 Jan 2010 21:32:49 +0000 Subject: [PATCH] macro-debugger: fixed local-expand not within macro transformation removed dead forms (eg require-for-syntax) fixed module-level begin-splicing highlighting svn: r17581 --- collects/macro-debugger/model/deriv-c.ss | 26 ++++----- collects/macro-debugger/model/deriv-parser.ss | 57 +++++-------------- collects/macro-debugger/model/reductions.ss | 22 ++++--- 3 files changed, 40 insertions(+), 65 deletions(-) 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]