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

macro-debugger:

Browse Source 
fixed local-expand not within macro transformation
  removed dead forms (eg require-for-syntax)
  fixed module-level begin-splicing highlighting

svn: r17581
This commit is contained in:
Ryan Culpepper 2010-01-08 21:32:49 +00:00
parent ab3dd78cb1
commit d846d22b9e
3 changed files with 40 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
collects/macro-debugger/model/deriv-c.ss
View File

@ -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 <Base> ?exn ?stx stx ?Deriv ?stx ?exn Deriv ?stx)
;; (make-p:module <Base> (listof LocalAction) ?stx stx ?Deriv ?stx ?exn Deriv ?stx)
;; (make-p:#%module-begin <Base> 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 <Base> DerivLL)
;; (make-p:define-syntaxes <Base> DerivLL (listof LocalAction))
;; (make-p:define-values <Base> 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 <Base> Deriv ?Stx)
@ -89,15 +90,15 @@
;; (make-p:provide <Base> (listof Deriv) ?exn)
(define-struct (p:provide prule) (inners ?2) #:transparent)
;; (make-p:require <Base> (listof LocalAction))
(define-struct (p:require prule) (locals) #:transparent)
;; (make-p:stop <Base>)
;; (make-p:unknown <Base>)
;; (make-p:#%top <Base> Stx)
;; (make-p:#%datum <Base> Stx)
;; (make-p:quote <Base>)
;; (make-p:quote-syntax <Base>)
;; (make-p:require <Base>)
;; (make-p:require-for-syntax <Base>)
;; (make-p:require-for-template <Base>)
;; (make-p:#%variable-reference <Base>)
(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 <Base> #:transparent)
;; (make-p:define-syntaxes <Base> Deriv)
;; (make-p:require <Base>)
;; (make-p:require-for-syntax <Base>)
;; (make-p:require-for-template <Base>)
;; (make-p:require <Base> (listof LocalAction))
;; (make-p:provide <Base>)
;; #f

57
collects/macro-debugger/model/deriv-parser.ss
View File

@ -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)

22
collects/macro-debugger/model/reductions.ss
View File

@ -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]