commit 413119739dd91c6f5110ed0c2b42c1c2b893da43
parent 7e0f3cbdcac2221875d487133e1871a053a2f921
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 12 Jan 2007 22:56:21 +0000
Macro stepper preserves position when hiding policy changed, etc
svn: r5338
original commit: 0b35093018ef4666fde7b74b4a343456d7e38636
Diffstat:
5 files changed, 21 insertions(+), 11 deletions(-)
diff --git a/collects/macro-debugger/model/deriv-c.ss b/collects/macro-debugger/model/deriv-c.ss
@@ -17,7 +17,7 @@
;; - resolves is the list of identifiers resolved by the macro keyword
;; - me1 is the marked version of the input syntax
;; - me2 is the marked version of the output syntax
- (define-struct transformation (e1 e2 resolves me1 me2 locals) #f)
+ (define-struct transformation (e1 e2 resolves me1 me2 locals seq) #f)
;; A LocalAction is one of
;; - (make-local-expansion Syntax Syntax Syntax Syntax Derivation)
diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss
@@ -13,8 +13,18 @@
(error 'derivation-parser "bad token #~a" start)))
;; PARSER
+
+ (define (parse-derivation x)
+ (parameterize ((current-sequence-number 0))
+ (parse-derivation* x)))
+
+ (define current-sequence-number (make-parameter #f))
+ (define (new-sequence-number)
+ (let ([seq (current-sequence-number)])
+ (current-sequence-number (add1 seq))
+ seq))
- (define parse-derivation
+ (define parse-derivation*
(parser
(options (start Expansion)
(src-pos)
@@ -132,7 +142,7 @@
(! 'bad-transformer)
macro-pre-transform (? LocalActions 'locals) (! 'transform) macro-post-transform
exit-macro)
- (make-transformation $2 $8 $1 $4 $7 $5)])
+ (make-transformation $2 $8 $1 $4 $7 $5 (new-sequence-number))])
;; Local actions taken by macro
;; LocalAction Answer = (list-of LocalAction)
@@ -373,7 +383,7 @@
;; let*-values with bindings is "macro-like"
[(prim-let*-values ! (? EE))
(let ([next-e1 (lift/deriv-e1 $3)])
- (make-mrule e1 e2 (make-transformation e1 next-e1 rs e1 next-e1 null) $3))]
+ (make-mrule e1 e2 (make-transformation e1 next-e1 rs e1 next-e1 null (new-sequence-number)) $3))]
;; No bindings... model as "let"
[(prim-let*-values NoError renames-let (? NextEEs 'rhss) next-group (? EB 'body))
(make-p:let-values e1 e2 rs $3 $4 $6)])
diff --git a/collects/macro-debugger/model/deriv-util.ss b/collects/macro-debugger/model/deriv-util.ss
@@ -156,7 +156,7 @@
(join (loop tx) (loop next))]
[(AnyQ lift-deriv (_ _ first lift second))
(join (loop first) (loop lift) (loop second))]
- [(AnyQ transformation (_ _ _ _ _ locals))
+ [(AnyQ transformation (_ _ _ _ _ locals _))
(loops locals)]
[(struct local-expansion (_ _ _ _ deriv))
(loop deriv)]
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
@@ -284,14 +284,14 @@
;; reductions-transformation : Transformation -> ReductionSequence
(define (reductions-transformation tx)
(match tx
- [(struct transformation (e1 e2 rs me1 me2 locals))
+ [(struct transformation (e1 e2 rs me1 me2 locals seq))
(append (reductions-locals e1 locals)
(list (walk e1 e2 'macro-step)))]
- [(IntW transformation (e1 e2 rs me1 me2 locals) 'locals)
+ [(IntW transformation (e1 e2 rs me1 me2 locals seq) 'locals)
(reductions-locals e1 locals)]
- [(ErrW transformation (e1 e2 rs me1 me2 locals) 'bad-transformer exn)
+ [(ErrW transformation (e1 e2 rs me1 me2 locals seq) 'bad-transformer exn)
(list (stumble e1 exn))]
- [(ErrW transformation (e1 e2 rs me1 me2 locals) 'transform exn)
+ [(ErrW transformation (e1 e2 rs me1 me2 locals seq) 'transform exn)
(append (reductions-locals e1 locals)
(list (stumble e1 exn)))]))
diff --git a/collects/macro-debugger/view/hiding-panel.ss b/collects/macro-debugger/view/hiding-panel.ss
@@ -101,11 +101,11 @@
;; refresh
(define/public (refresh)
(when (send config get-macro-hiding?)
- (send stepper refresh/resynth)))
+ (send stepper refresh)))
;; force-refresh
(define/private (force-refresh)
- (send stepper refresh/resynth))
+ (send stepper refresh/resynth-prefix))
;; set-syntax : syntax/#f -> void
(define/public (set-syntax lstx)
