Macro stepper preserves position when hiding policy changed, etc

svn: r5338

original commit: 0b35093018ef4666fde7b74b4a343456d7e38636
This commit is contained in:
Ryan Culpepper 2007-01-12 22:56:21 +00:00
parent 7e0f3cbdca
commit 413119739d
5 changed files with 21 additions and 11 deletions

View File

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

View File

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

View File

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

View File

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

View File

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