suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

#%top now works

Browse Source 
svn: r593
This commit is contained in:
Guillaume Marceau 2005-08-14 07:27:27 +00:00
parent d3e8815e46
commit b9bf3b6134
6 changed files with 32 additions and 163 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mztake/demos/dijkstra/dijkstra-mztake.ss
View File

@ -37,8 +37,8 @@
"dijkstra-solver.ss" "dijkstra-solver.ss"
(lib "match.ss")) (lib "match.ss"))
(define inserts (trace (loc "heap.ss" 49 6) (bind (item) item))) (define inserts (trace (loc "heap.ss" 49 6) item))
(define removes (trace (loc "heap.ss" 67 10) (bind (result) result))) (define removes (trace (loc "heap.ss" 67 10) result))
#| The following code merely observes the insertions and removals #| The following code merely observes the insertions and removals
from the heap. We notice whether any of the removals are out from the heap. We notice whether any of the removals are out

2
collects/mztake/demos/highway/highway-mztake.ss
View File

@ -2,7 +2,7 @@
(lib "animation.ss" "frtime") (lib "animation.ss" "frtime")
(lib "useful-code.ss" "mztake")) (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) (printf-b "current speed: ~a" speed)

13
collects/mztake/doc.txt
View File

@ -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 order to use MzTake, you will need to familiarize yourself with the
FrTime language by reading its own documentation. FrTime language by reading its own documentation.
With signals it is possible to respond to outside events concisely, With signals it is possible to respond to outside events concisely,
without using callbacks. Consider a MzTake script to monitor the without using callbacks. Consider a MzTake script to monitor the
behavior of the program "highway.ss", in the demos directory of 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 named "speed" in the MzTake script, then executes its body. In this
case, it print the value with PRINTF. 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)". some other behavior, or end the execution altogether with "(kill)".
Finally, FrTime provides a rich animation library. Combined Finally, FrTime provides a rich animation library. Combined

142
collects/mztake/mztake-lang.ss
View File

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

3
collects/mztake/mztake-structs.ss
View File

@ -5,6 +5,9 @@
(rename loc loc$) (rename loc loc$)
(rename make-loc loc)) (rename make-loc loc))
(define (require-spec? sexp)
(or string? list?))
; ;;;;; ; ; ; ;;;;; ; ;
; ; ; ; ; ; ; ; ; ;
; ; ; ; ; ; ; ;

29
collects/mztake/mztake.ss
View File

@ -13,15 +13,12 @@
;; Turn struct printing on for MzTake users. ;; Turn struct printing on for MzTake users.
(print-struct true) (print-struct true)
(define (require-spec? sexp)
(or string? list?))
(provide loc$ (provide loc$
trace trace
bind bind
define/bind define/bind
define/bind-e define/bind-e
[rename #%top mztake-top]) [rename mztake-top #%top])
(provide/contract [loc-reqspec (loc? . -> . require-spec?)] (provide/contract [loc-reqspec (loc? . -> . require-spec?)]
[loc-line (loc? . -> . number?)] [loc-line (loc? . -> . number?)]
@ -95,25 +92,29 @@
[(_ loc body ...) [(_ loc body ...)
(trace* (current-process) loc (lambda () body ...))])) (trace* (current-process) loc (lambda () body ...))]))
;; TODO this does not actually work
(define-syntax (mztake-top stx) (define-syntax (mztake-top stx)
(syntax-case stx () (syntax-case stx ()
[(_ . name) [(_ . name)
(begin (begin
(printf "top ~a~n" 'name) #'(with-handlers
#'(with-handlers ([exn:fail? ([exn:fail?
(lambda (exn) (bind* (current-process) 'name))]) (lambda (exn)
(printf "top ~a~n" 'name) (with-handlers
([exn:fail? (lambda (exn2) (raise exn))])
(bind* (current-process) 'name)))])
(#%top . name)))])) (#%top . name)))]))
(define (bind* p name) (define (bind* p name)
(unless (debug-process-marks p) (unless (debug-process-marks p)
(error "Bind called while the target process is running")) (error "Bind called but the target process is not paused."))
(mark-binding-value (let ([bs (lookup-all-bindings
(first (lookup-all-bindings (lambda (id) (eq? (syntax-e id) name))
(lambda (id) (eq? (syntax-e id) name)) (debug-process-marks p))])
(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 (define-syntax bind
(syntax-rules () (syntax-rules ()