Macro stepper: added navigation methods
svn: r7335
This commit is contained in:
parent
5fb7a90786
commit
d4e96a80cb
|
@ -38,7 +38,27 @@ This module provides a single procedure:
|
|||
> (expand/step syntax-or-sexpr)
|
||||
|
||||
Expands the syntax (or S-expression) and opens a macro stepper frame
|
||||
for stepping through the expansion.
|
||||
for stepping through the expansion. Returns an object of
|
||||
macro-stepper<%> with the following methods:
|
||||
|
||||
> (send a-macro-stepper at-start?) -> boolean
|
||||
> (send a-macro-stepper at-end?) -> boolean
|
||||
> (send a-macro-stepper navigate-to-start) -> void
|
||||
> (send a-macro-stepper navigate-to-end) -> void
|
||||
> (send a-macro-stepper navigate-previous) -> void
|
||||
> (send a-macro-stepper navigate-next) -> void
|
||||
> (send a-macro-stepper navigate-forward/count n) -> void
|
||||
> (send a-macro-stepper navigate-forward/pred pred) -> void
|
||||
pred : syntax -> boolean
|
||||
Navigate forward to an expansion with redex (focus) matching pred.
|
||||
|
||||
> (send a-macro-stepper at-top?) -> boolean
|
||||
> (send a-macro-stepper at-bottom?) -> boolean
|
||||
> (send a-macro-stepper navigate-up) -> void
|
||||
> (send a-macro-stepper navigate-down) -> void
|
||||
> (send a-macro-stepper navigate-down/pred pred) -> void
|
||||
pred : syntax -> boolean
|
||||
Navigate down to an expansion with initial syntax satisfying pred.
|
||||
|
||||
_expand.ss_
|
||||
===========
|
||||
|
|
|
@ -18,6 +18,7 @@
|
|||
cursor:move-prev
|
||||
cursor:move-to-start
|
||||
cursor:move-to-end
|
||||
cursor:skip-to
|
||||
|
||||
cursor->list
|
||||
cursor:prefix->list
|
||||
|
@ -116,6 +117,11 @@
|
|||
(cursor:move-next c)
|
||||
(cursor:move-to-end c)))
|
||||
|
||||
(define (cursor:skip-to c i)
|
||||
(unless (or (eq? (cursor:next c) i) (cursor:at-end? c))
|
||||
(cursor:move-next c)
|
||||
(cursor:skip-to c i)))
|
||||
|
||||
(define (cursor->list c)
|
||||
(append (cursor:prefix->list c)
|
||||
(cursor:suffix->list c)))
|
||||
|
|
|
@ -216,26 +216,67 @@
|
|||
|
||||
;; Navigate
|
||||
|
||||
(define/private (navigate-to-start)
|
||||
(define/public-final (at-start?)
|
||||
(cursor:at-start? (focused-steps)))
|
||||
(define/public-final (at-end?)
|
||||
(cursor:at-end? (focused-steps)))
|
||||
|
||||
(define/public-final (navigate-to-start)
|
||||
(cursor:move-to-start (focused-steps))
|
||||
(update/save-position))
|
||||
(define/private (navigate-to-end)
|
||||
(define/public-final (navigate-to-end)
|
||||
(cursor:move-to-end (focused-steps))
|
||||
(update/save-position))
|
||||
(define/private (navigate-previous)
|
||||
(define/public-final (navigate-previous)
|
||||
(cursor:move-prev (focused-steps))
|
||||
(update/save-position))
|
||||
(define/private (navigate-next)
|
||||
(define/public-final (navigate-next)
|
||||
(cursor:move-next (focused-steps))
|
||||
(update/save-position))
|
||||
|
||||
(define/private (navigate-up)
|
||||
(define/public-final (navigate-forward/count n)
|
||||
(unless (integer? n)
|
||||
(raise-type-error 'navigate-forward/count "integer" n))
|
||||
(cond [(zero? n)
|
||||
(update/save-position)]
|
||||
[(positive? n)
|
||||
(cursor:move-next (focused-steps))
|
||||
(navigate-forward/count (sub1 n))]
|
||||
[(negative? n)
|
||||
(cursor:move-prev (focused-steps))
|
||||
(navigate-forward/count (add1 n))]))
|
||||
|
||||
(define/public-final (navigate-forward/pred p)
|
||||
(let* ([cursor (focused-steps)]
|
||||
[steps (and cursor (cursor:suffix->list cursor))]
|
||||
[pred (lambda (s)
|
||||
(and (rewrite-step? s)
|
||||
(ormap p (step-foci1 s))
|
||||
s))]
|
||||
[step (ormap pred steps)])
|
||||
(unless step
|
||||
(error 'navigate-forward/pred "no step matching predicate"))
|
||||
(cursor:skip-to cursor step)
|
||||
(update/save-position)))
|
||||
|
||||
(define/public-final (navigate-up)
|
||||
(cursor:move-prev terms)
|
||||
(refresh/move))
|
||||
(define/private (navigate-down)
|
||||
(define/public-final (navigate-down)
|
||||
(cursor:move-next terms)
|
||||
(refresh/move))
|
||||
|
||||
(define/public-final (navigate-down/pred p)
|
||||
(let* ([termlist (cursor:suffix->list terms)]
|
||||
[pred (lambda (trec)
|
||||
(and (p (lift/deriv-e1 (trec-deriv trec)))
|
||||
trec))]
|
||||
[term (ormap pred termlist)])
|
||||
(unless term
|
||||
(error 'navigate-down/pred "no term matching predicate"))
|
||||
(cursor:skip-to terms term)
|
||||
(refresh/move)))
|
||||
|
||||
;; insert-step-separator : string -> void
|
||||
(define/private (insert-step-separator text)
|
||||
(send sbview add-text "\n ")
|
||||
|
|
|
@ -13,9 +13,9 @@
|
|||
(macro-stepper-frame-mixin
|
||||
(frame:standard-menus-mixin
|
||||
(frame:basic-mixin frame%))))
|
||||
|
||||
|
||||
;; Main entry points
|
||||
|
||||
|
||||
(define (make-macro-stepper)
|
||||
(let ([f (new macro-stepper-frame%
|
||||
(config (new macro-stepper-config/prefs%)))])
|
||||
|
@ -24,8 +24,9 @@
|
|||
|
||||
(define (go stx)
|
||||
(let ([stepper (make-macro-stepper)])
|
||||
(send stepper add-deriv (trace stx))))
|
||||
|
||||
(send stepper add-deriv (trace stx))
|
||||
stepper))
|
||||
|
||||
(define (go/deriv deriv)
|
||||
(let* ([f (new macro-stepper-frame%)]
|
||||
[w (send f get-widget)])
|
||||
|
|
Loading…
Reference in New Issue
Block a user