Macro stepper: fixed handling of #%expression

svn: r5848
This commit is contained in:
Ryan Culpepper 2007-03-30 18:15:17 +00:00
parent a31d421ede
commit a056844d33
6 changed files with 25 additions and 3 deletions

View File

@ -38,6 +38,7 @@
(define-struct (p:define-values prule) (rhs) #f)
;; Simple expressions
(define-struct (p:expression prule) (inner) #f)
(define-struct (p:if prule) (full? test then else) #f)
(define-struct (p:wcm prule) (key mark body) #f)
(define-struct (p:set! prule) (id-resolves rhs) #f)

View File

@ -205,6 +205,7 @@
[((? Prim#%ModuleBegin)) ($1 e1 e2 rs)]
[((? PrimDefineSyntaxes)) ($1 e1 e2 rs)]
[((? PrimDefineValues)) ($1 e1 e2 rs)]
[((? PrimExpression)) ($1 e1 e2 rs)]
[((? PrimIf)) ($1 e1 e2 rs)]
[((? PrimWCM)) ($1 e1 e2 rs)]
[((? PrimSet)) ($1 e1 e2 rs)]
@ -326,6 +327,11 @@
(make-p:define-values e1 e2 rs $3)])
;; Simple expressions
(PrimExpression
(#:args e1 e2 rs)
[(prim-expression ! (? EE 'inner))
(make-p:expression e1 e2 rs $3)])
(PrimIf
(#:args e1 e2 rs)
[(prim-if ! (? EE 'test) next (? EE 'then) next (? EE 'else))

View File

@ -40,6 +40,8 @@
local-post ; syntax
exit-local ; syntax
variable ; (cons identifier identifier)
IMPOSSIBLE ; useful for error-handling clauses that have no NoError counterpart
))
@ -50,7 +52,7 @@
renames-letrec-syntaxes ; (cons (listof syntax) (cons (listof syntax) syntax))
renames-block ; (cons syntax syntax) ... different, contains both pre+post
))
(define-tokens prim-tokens
(define-empty-tokens prim-tokens
(prim-module prim-#%module-begin
prim-define-syntaxes prim-define-values
prim-if prim-wcm prim-begin prim-begin0 prim-#%app prim-lambda
@ -59,8 +61,7 @@
prim-quote prim-quote-syntax prim-require prim-require-for-syntax
prim-require-for-template prim-provide
prim-set!
variable ; (cons identifier identifier)
prim-expression
))
;; ** Signals to tokens
@ -131,6 +132,7 @@
(135 . ,token-module-lift-end-loop)
(136 . ,token-lift/let-loop)
(137 . ,token-module-lift-loop)
(138 . prim-expression)
))
(define (tokenize sig-n val pos)

View File

@ -184,6 +184,8 @@
(loop rhs)]
[(AnyQ p:define-values (_ _ _ rhs))
(loop rhs)]
[(AnyQ p:expression (_ _ _ inner))
(loop inner)]
[(AnyQ p:if (_ _ _ _ test then else))
(join (loop test) (loop then) (loop else))]
[(AnyQ p:wcm (_ _ _ key value body))

View File

@ -197,6 +197,10 @@
(>>P d (make-p:define-values rhs)
(define-values variables RHS)
([for-deriv RHS rhs]))]
[(AnyQ p:expression (e1 e2 rs inner))
(>>P d (make-p:expression inner)
(#%expression INNER)
([for-deriv INNER inner]))]
[(AnyQ p:if (e1 e2 rs full? test then else))
(if full?
(>>P d (make-p:if full? test then else)
@ -603,6 +607,8 @@
(>>Seek (for-deriv rhs))]
[(AnyQ p:define-values (e1 e2 rs rhs))
(>>Seek (for-deriv rhs))]
[(AnyQ p:expression (e1 e2 rs inner))
(>>Seek (for-deriv inner))]
[(AnyQ p:if (e1 e2 rs full? test then else))
(>>Seek (for-deriv test)
(for-deriv then)

View File

@ -102,6 +102,11 @@
[#:frontier (list #'RHS)]
[#:if rhs
[Expr RHS rhs]])]
[(AnyQ p:expression (e1 e2 rs inner) exni)
(R e1
[! exni]
[#:pattern (?expr INNER)]
[Expr INNER inner])]
[(AnyQ p:if (e1 e2 rs full? test then else) exni)
(if full?
(R e1