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

Macro stepper: changed rep/parsing of local-expand etc

Browse Source 
svn: r5849
This commit is contained in:
Ryan Culpepper 2007-03-30 20:09:44 +00:00
parent a056844d33
commit ea00e7a68b
6 changed files with 34 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -20,9 +20,11 @@
(define-struct transformation (e1 e2 resolves me1 me2 locals seq) #f) (define-struct transformation (e1 e2 resolves me1 me2 locals seq) #f)
;; A LocalAction is one of ;; A LocalAction is one of
;; - (make-local-expansion Syntax Syntax Syntax Syntax Derivation) ;; - (make-local-expansion Syntax Syntax Syntax Syntax boolean Derivation)
;; - (make-local-expansion/expr Syntax Syntax Syntax Syntax boolean Derivation)
;; - (make-local-lift Syntax Identifier) ;; - (make-local-lift Syntax Identifier)
(define-struct local-expansion (e1 e2 me1 me2 deriv) #f) (define-struct local-expansion (e1 e2 me1 me2 for-stx? deriv) #f)
(define-struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv) #f)
(define-struct local-lift (expr id) #f) (define-struct local-lift (expr id) #f)
(define-struct local-lift-end (decl) #f) (define-struct local-lift-end (decl) #f)
(define-struct local-bind (deriv) #f) (define-struct local-bind (deriv) #f)

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

@ -45,7 +45,7 @@
enter-block block->list block->letrec splice enter-block block->list block->letrec splice
enter-list exit-list enter-list exit-list
enter-check exit-check enter-check exit-check
local-post exit-local local-post exit-local exit-local/expr
phase-up module-body phase-up module-body
renames-lambda renames-lambda
renames-case-lambda renames-case-lambda
@ -155,7 +155,13 @@
(LocalAction (LocalAction
(#:no-wrap) (#:no-wrap)
[(enter-local local-pre (? EE) local-post exit-local) [(enter-local local-pre (? EE) local-post exit-local)
(make-local-expansion $1 $5 $2 $4 $3)] (make-local-expansion $1 $5 $2 $4 #f $3)]
[(enter-local phase-up local-pre (? EE) local-post exit-local)
(make-local-expansion $1 $6 $3 $5 #t $4)]
[(enter-local/expr local-pre (? EE) local-post exit-local/expr)
(make-local-expansion/expr $1 (car $5) $2 $4 #f (cdr $5) $3)]
[(enter-local/expr local-pre phase-up (? EE) local-post exit-local/expr)
(make-local-expansion/expr $1 (car $6) $3 $5 #t (cdr $6) $4)]
[(lift) [(lift)
(make-local-lift (cdr $1) (car $1))] (make-local-lift (cdr $1) (car $1))]
[(lift-statement) [(lift-statement)

5
collects/macro-debugger/model/deriv-tokens.ss
View File

@ -40,6 +40,9 @@
local-post ; syntax local-post ; syntax
exit-local ; syntax exit-local ; syntax
enter-local/expr ; syntax
exit-local/expr ; (cons syntax expanded-expression)
variable ; (cons identifier identifier) variable ; (cons identifier identifier)
IMPOSSIBLE ; useful for error-handling clauses that have no NoError counterpart IMPOSSIBLE ; useful for error-handling clauses that have no NoError counterpart
@ -133,6 +136,8 @@
(136 . ,token-lift/let-loop) (136 . ,token-lift/let-loop)
(137 . ,token-module-lift-loop) (137 . ,token-module-lift-loop)
(138 . prim-expression) (138 . prim-expression)
(139 . ,token-enter-local/expr)
(140 . ,token-exit-local/expr)
)) ))
(define (tokenize sig-n val pos) (define (tokenize sig-n val pos)

4
collects/macro-debugger/model/deriv-util.ss
View File

@ -176,7 +176,9 @@
(join (loop first) (loop second))] (join (loop first) (loop second))]
[(AnyQ transformation (_ _ _ _ _ locals _)) [(AnyQ transformation (_ _ _ _ _ locals _))
(loops locals)] (loops locals)]
[(struct local-expansion (_ _ _ _ deriv)) [(struct local-expansion (_ _ _ _ _ deriv))
(loop deriv)]
[(struct local-expansion/expr (_ _ _ _ _ _ deriv))
(loop deriv)] (loop deriv)]
[(struct local-bind (deriv)) [(struct local-bind (deriv))
(loop deriv)] (loop deriv)]

10
collects/macro-debugger/model/hide.ss
View File

@ -419,9 +419,11 @@
;; for-local-action : LocalAction -> LocalAction ;; for-local-action : LocalAction -> LocalAction
(define (for-local-action la) (define (for-local-action la)
(match la (match la
[(struct local-expansion (e1 e2 me1 me2 deriv)) [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
(let-values ([(deriv e2) (for-deriv deriv)]) (let-values ([(deriv e2) (for-deriv deriv)])
(make-local-expansion e1 e2 me1 me2 deriv))] (make-local-expansion e1 e2 me1 me2 for-stx? deriv))]
[(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
(error 'hide:for-local-action "not implemented for local-expand-expr")]
[(struct local-lift (expr id)) [(struct local-lift (expr id))
(add-unhidden-lift (extract/remove-unvisited-lift id)) (add-unhidden-lift (extract/remove-unvisited-lift id))
la] la]
@ -725,7 +727,9 @@
;; for-local-action : LocalAction -> (list-of Subterm) ;; for-local-action : LocalAction -> (list-of Subterm)
(define (for-local-action local) (define (for-local-action local)
(match local (match local
[(struct local-expansion (e1 e2 me1 me2 deriv)) [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
(raise (make-localactions))]
[(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
(raise (make-localactions))] (raise (make-localactions))]
[(struct local-lift (expr id)) [(struct local-lift (expr id))
;; FIXME: seek in the lifted deriv, transplant subterm expansions *here* ;; FIXME: seek in the lifted deriv, transplant subterm expansions *here*

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

@ -389,7 +389,11 @@
;; reductions-local : LocalAction -> ReductionSequence ;; reductions-local : LocalAction -> ReductionSequence
(define (reductions-local local) (define (reductions-local local)
(match/with-derivation local (match/with-derivation local
[(struct local-expansion (e1 e2 me1 me2 deriv)) [(struct local-expansion (e1 e2 me1 me2 for-stx? deriv))
(reductions* deriv)]
[(struct local-expansion/expr (e1 e2 me1 me2 for-stx? opaque deriv))
(fprintf (current-error-port)
"reductions: local-expand-expr not fully implemented")
(reductions* deriv)] (reductions* deriv)]
[(struct local-lift (expr id)) [(struct local-lift (expr id))
(list (walk expr id 'local-lift))] (list (walk expr id 'local-lift))]