Macro stepper preserves position when hiding policy changed, etc
svn: r5338 original commit: 0b35093018ef4666fde7b74b4a343456d7e38636
This commit is contained in:
parent
7e0f3cbdca
commit
413119739d
|
@ -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)
|
||||
|
|
|
@ -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)])
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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)))]))
|
||||
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user