From b9bf3b613484e5e60d00929192a57c73cbb77751 Mon Sep 17 00:00:00 2001 From: Guillaume Marceau Date: Sun, 14 Aug 2005 07:27:27 +0000 Subject: [PATCH] #%top now works svn: r593 --- .../mztake/demos/dijkstra/dijkstra-mztake.ss | 4 +- .../mztake/demos/highway/highway-mztake.ss | 2 +- collects/mztake/doc.txt | 13 +- collects/mztake/mztake-lang.ss | 142 ------------------ collects/mztake/mztake-structs.ss | 3 + collects/mztake/mztake.ss | 31 ++-- 6 files changed, 32 insertions(+), 163 deletions(-) delete mode 100644 collects/mztake/mztake-lang.ss diff --git a/collects/mztake/demos/dijkstra/dijkstra-mztake.ss b/collects/mztake/demos/dijkstra/dijkstra-mztake.ss index aac3d7c4c3..176771ca05 100644 --- a/collects/mztake/demos/dijkstra/dijkstra-mztake.ss +++ b/collects/mztake/demos/dijkstra/dijkstra-mztake.ss @@ -37,8 +37,8 @@ "dijkstra-solver.ss" (lib "match.ss")) -(define inserts (trace (loc "heap.ss" 49 6) (bind (item) item))) -(define removes (trace (loc "heap.ss" 67 10) (bind (result) result))) +(define inserts (trace (loc "heap.ss" 49 6) item)) +(define removes (trace (loc "heap.ss" 67 10) result)) #| The following code merely observes the insertions and removals from the heap. We notice whether any of the removals are out diff --git a/collects/mztake/demos/highway/highway-mztake.ss b/collects/mztake/demos/highway/highway-mztake.ss index 6126039589..a537a799eb 100644 --- a/collects/mztake/demos/highway/highway-mztake.ss +++ b/collects/mztake/demos/highway/highway-mztake.ss @@ -2,7 +2,7 @@ (lib "animation.ss" "frtime") (lib "useful-code.ss" "mztake")) -(define/bind (loc "highway.ss" 3 ) speed) +(define/bind (loc "highway.ss" 3) speed) (printf-b "current speed: ~a" speed) diff --git a/collects/mztake/doc.txt b/collects/mztake/doc.txt index aaa958f2c2..233970daa0 100644 --- a/collects/mztake/doc.txt +++ b/collects/mztake/doc.txt @@ -20,8 +20,6 @@ between signals and automatically recomputes them when necessary. In order to use MzTake, you will need to familiarize yourself with the FrTime language by reading its own documentation. - - With signals it is possible to respond to outside events concisely, without using callbacks. Consider a MzTake script to monitor the behavior of the program "highway.ss", in the demos directory of the @@ -91,7 +89,16 @@ where the execution is paused, then binds its values to a variable named "speed" in the MzTake script, then executes its body. In this case, it print the value with PRINTF. -Once satisfied, you can resume execution with "(set-running #t)", or +Since MzTake defines a #%top syntax, you can also directly type the +name of a variable. MzTake will first look in the scope in the MzTake +script. If the variable is not found, it will then in the target +process. So, the example above can be written as: + + (printf "the speed is ~a~n" speed) + +so long as the script itself does not declare a SPEED variable. + +You can resume execution with "(set-running #t)", or some other behavior, or end the execution altogether with "(kill)". Finally, FrTime provides a rich animation library. Combined diff --git a/collects/mztake/mztake-lang.ss b/collects/mztake/mztake-lang.ss deleted file mode 100644 index 548c35bb88..0000000000 --- a/collects/mztake/mztake-lang.ss +++ /dev/null @@ -1,142 +0,0 @@ -; ; -; ;; ;; ;;;;;;;;; ; ; -; ;; ;; ; ; ; -; ; ; ; ; ; ; ; -; ; ; ; ; ;;;;;; ; ;;;; ; ; ;;; ; ;;;; ; ;;;; ;;;;;; -; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;; ; ; ; -; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; -; ; ; ; ; ; ; ;;;;; ; ; ; ; ; ;;;;; ; ; ; ; -; ; ; ; ; ; ; ; ; ;;; ;;;;;;; ; ; ; ; ; ; ; -; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; -; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; -; ; ; ; ; ; ;; ; ; ; ; ; ; ;; ; ; ; ;; -; ; ; ;;;;;; ; ;;;; ; ; ; ;;;; ;;;;;;; ;;;; ; ; ; ;;;; ; -; ; -; ; ; -; ;;;; - -(module mztake-lang mzscheme - (require "mztake.ss" - (lib "etc.ss") - (lib "list.ss") - (lib "class.ss") - (lib "unitsig.ss") - (lib "bitmap-label.ss" "mrlib") - (lib "contract.ss") - (lib "mred.ss" "mred") - (lib "tool.ss" "drscheme") - (lib "framework.ss" "framework") - (lib "string-constant.ss" "string-constants")) - - (provide tool@) - - (define tool@ - (unit/sig drscheme:tool-exports^ - (import drscheme:tool^) - - ;############################MZTAKE LANGUAGE RELATED FUNCTIONS############################################## - (define (phase1) (void)) - (define (phase2) - (drscheme:language-configuration:add-language - (make-object ((drscheme:language:get-default-mixin) (make-mztake-language mztake-language%))))) - - (define (make-mztake-language base) - (class (drscheme:language:module-based-language->language-mixin - (drscheme:language:simple-module-based-language->module-based-language-mixin - base)) - (field (watch-list empty)) - (inherit get-language-position) - (define/override (on-execute settings run-in-user-thread) - (let ([drs-eventspace (current-eventspace)]) - (super on-execute settings run-in-user-thread) - (run-in-user-thread - (lambda () - (let ([new-watch (namespace-variable-value 'render)] - [set-evspc (namespace-variable-value 'set-eventspace)]) - (set-evspc drs-eventspace) - (set! watch-list - ((if (weak-member new-watch watch-list) - identity - (lambda (r) (cons (make-weak-box new-watch) r))) - (filter weak-box-value watch-list)))))))) - - (define/override (render-value/format value settings port width) - (super render-value/format (watch watch-list value) - settings port width)) - (define/override (render-value value settings port) - (super render-value (watch watch-list value) - settings port)) - (define/override (use-namespace-require/copy?) #t) - (super-instantiate ()))) - - - (define mztake-language% - (class* object% (drscheme:language:simple-module-based-language<%>) - (define/public (get-language-numbers) - '(1000 -400)) - (define/public (get-language-position) - (list (string-constant experimental-languages) "MzTake")) - (define/public (get-module) - '(lib "mztake-syntax.ss" "mztake")) - (define/public (get-one-line-summary) - (format "MzTake Debugger")) - (define/public (get-language-url) #f) - (define/public (get-reader) - (lambda (name port offsets) - (let ([v (read-syntax name port offsets)]) - (if (eof-object? v) - v - (namespace-syntax-introduce v))))) - (super-instantiate ()))) - - ;;;;;;;;;;;;;FRTIME REPL STUFF;;;;;;;;;;;;;;;;;;;;;; - (define (weak-member obj lis) - (let ([cmp (lambda (v) (eq? v obj))]) - (let loop ([lis lis]) - (and (cons? lis) - (or - (cond - [(weak-box-value (first lis)) => cmp] - [else false]) - (loop (rest lis))))))) - - (define (watch watch-list value) - (foldl - (lambda (wb acc) - (cond - [(weak-box-value wb) - => (lambda (f) (f acc))] - [else acc])) - value - watch-list)) - ;########################################################################################################### - - - (define debugger-bitmap - (bitmap-label-maker - "Syntax Location" - (build-path (collection-path "mztake" "icons") "stock_macro-check-brackets-16.png"))) - - (define (debugger-unit-frame-mixin super%) - (class super% - - (inherit get-button-panel get-interactions-text get-definitions-text get-menu-bar) - - (super-instantiate ()) - - (define debugger-button - (make-object button% - (debugger-bitmap this) - (get-button-panel) - (lambda (button evt) - (let* ([pos (send (get-definitions-text) get-start-position)] - [line (send (get-definitions-text) position-paragraph pos)] - [column (- pos (send (get-definitions-text) line-start-position - (send (get-definitions-text) position-line pos)))]) - - (message-box "Syntax Location" - (format "Line: ~a~nColumn: ~a" (add1 line) column)))))) - (send (get-button-panel) change-children - (lambda (_) (cons debugger-button (remq debugger-button _)))))) - - (drscheme:get/extend:extend-unit-frame debugger-unit-frame-mixin)))) \ No newline at end of file diff --git a/collects/mztake/mztake-structs.ss b/collects/mztake/mztake-structs.ss index 0d0964b03d..3bdb8fae2b 100644 --- a/collects/mztake/mztake-structs.ss +++ b/collects/mztake/mztake-structs.ss @@ -5,6 +5,9 @@ (rename loc loc$) (rename make-loc loc)) + (define (require-spec? sexp) + (or string? list?)) + ; ;;;;; ; ; ; ; ; ; ; ; ; ; ; diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss index 47937b35ed..53425786df 100644 --- a/collects/mztake/mztake.ss +++ b/collects/mztake/mztake.ss @@ -13,15 +13,12 @@ ;; Turn struct printing on for MzTake users. (print-struct true) - (define (require-spec? sexp) - (or string? list?)) - (provide loc$ trace bind define/bind define/bind-e - [rename #%top mztake-top]) + [rename mztake-top #%top]) (provide/contract [loc-reqspec (loc? . -> . require-spec?)] [loc-line (loc? . -> . number?)] @@ -95,25 +92,29 @@ [(_ loc body ...) (trace* (current-process) loc (lambda () body ...))])) - ;; TODO this does not actually work (define-syntax (mztake-top stx) (syntax-case stx () [(_ . name) (begin - (printf "top ~a~n" 'name) - #'(with-handlers ([exn:fail? - (lambda (exn) (bind* (current-process) 'name))]) - (printf "top ~a~n" 'name) + #'(with-handlers + ([exn:fail? + (lambda (exn) + (with-handlers + ([exn:fail? (lambda (exn2) (raise exn))]) + (bind* (current-process) 'name)))]) (#%top . name)))])) (define (bind* p name) (unless (debug-process-marks p) - (error "Bind called while the target process is running")) - - (mark-binding-value - (first (lookup-all-bindings - (lambda (id) (eq? (syntax-e id) name)) - (debug-process-marks p))))) + (error "Bind called but the target process is not paused.")) + + (let ([bs (lookup-all-bindings + (lambda (id) (eq? (syntax-e id) name)) + (debug-process-marks p))]) + (when (empty? bs) + (error 'bind "variable `~a' not found in target at the current location" name)) + + (mark-binding-value (first bs)))) (define-syntax bind (syntax-rules ()