From d4e96a80cb7be97f5216a3482d1e49cea59c4d91 Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Fri, 14 Sep 2007 18:45:14 +0000 Subject: [PATCH] Macro stepper: added navigation methods svn: r7335 --- collects/macro-debugger/doc.txt | 22 +++++++++- collects/macro-debugger/view/cursor.ss | 6 +++ collects/macro-debugger/view/stepper.ss | 53 ++++++++++++++++++++++--- collects/macro-debugger/view/view.ss | 9 +++-- 4 files changed, 79 insertions(+), 11 deletions(-) diff --git a/collects/macro-debugger/doc.txt b/collects/macro-debugger/doc.txt index e0bfef024f..fbce16d04a 100644 --- a/collects/macro-debugger/doc.txt +++ b/collects/macro-debugger/doc.txt @@ -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_ =========== diff --git a/collects/macro-debugger/view/cursor.ss b/collects/macro-debugger/view/cursor.ss index 36b982b6eb..dd4b9f976b 100644 --- a/collects/macro-debugger/view/cursor.ss +++ b/collects/macro-debugger/view/cursor.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))) diff --git a/collects/macro-debugger/view/stepper.ss b/collects/macro-debugger/view/stepper.ss index 44fc278681..2ba628004b 100644 --- a/collects/macro-debugger/view/stepper.ss +++ b/collects/macro-debugger/view/stepper.ss @@ -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 ") diff --git a/collects/macro-debugger/view/view.ss b/collects/macro-debugger/view/view.ss index d0ea4f282f..bc33e2254f 100644 --- a/collects/macro-debugger/view/view.ss +++ b/collects/macro-debugger/view/view.ss @@ -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)])