Macro stepper: added navigation methods

svn: r7335
This commit is contained in:
Ryan Culpepper 2007-09-14 18:45:14 +00:00
parent 5fb7a90786
commit d4e96a80cb
4 changed files with 79 additions and 11 deletions

View File

@ -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_
===========

View File

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

View File

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

View File

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