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

finished updating the docs (again), implemented policies, moved nicely reusable files out of private, renamed load-annotator to load-sandbox

Browse Source 
svn: r590
This commit is contained in:
Guillaume Marceau 2005-08-14 05:27:58 +00:00
parent 9bb1db2104
commit 00b20bf708
19 changed files with 482 additions and 237 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/mztake/TODO.txt
View File

@ -61,7 +61,6 @@ DEMOS---------------------------------------------------------------------------
SCRIPT--------------------------------------------------------------------------------------
* document history-e; provide a variant of history which takes no n, and keeps a complete history
* process:time-per-event/milliseconds is broken
(printf-b "~a ms per event" (time-per-event/milliseconds p (changes (hold sin/x-trace))))

4
collects/mztake/annotator.ss
View File

@ -3,9 +3,9 @@
(require (prefix kernel: (lib "kerncase.ss" "syntax"))
(lib "class.ss")
(lib "list.ss")
(lib "marks.ss" "mztake" "private")
(lib "marks.ss" "mztake")
(lib "mred.ss" "mred")
(lib "load-annotator.ss" "mztake" "private")
(lib "load-sandbox.ss" "mztake")
(prefix srfi: (lib "search.ss" "srfi" "1"))
)
(provide annotate-stx annotate-for-single-stepping)

2
collects/mztake/debug-tool.ss
View File

@ -13,7 +13,7 @@
(lib "boundmap.ss" "syntax")
(lib "bitmap-label.ss" "mrlib")
(lib "annotator.ss" "mztake")
(lib "load-annotator.ss" "mztake" "private")
(lib "load-sandbox.ss" "mztake")
;(lib "framework.ss" "framework")
#;(lib "string-constant.ss" "string-constants")
)

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

@ -33,7 +33,7 @@
binary heap implementation without satisfying its (stronger) contract. |#
(require (lib "mztake.ss" "mztake")
(lib "useful-code.ss" "mztake" "private")
(lib "useful-code.ss" "mztake")
"dijkstra-solver.ss"
(lib "match.ss"))
@ -53,7 +53,7 @@
[(_ 'reset) false]
[(previous current) (> previous current)]
[else false])
(history-e 2 e)))
(history-e e 2)))
(define inserts-and-removes-e (merge-e (removes . ==> . node-weight)

2
collects/mztake/demos/dijkstra/graph.ss
View File

@ -1,6 +1,6 @@
;; -*- compile-command: "mzscheme -M errortrace -u graph.ss" -*-
(module graph mzscheme
(require (lib "more-useful-code.ss" "mztake" "private"))
(require (lib "more-useful-code.ss" "mztake"))
(provide make-graph
;; --- Constructors :

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

@ -1,5 +1,5 @@
(require (lib "mztake.ss" "mztake")
(lib "useful-code.ss" "mztake" "private"))
(lib "useful-code.ss" "mztake"))
(set-main! "exception.ss")

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

@ -1,6 +1,6 @@
(require (lib "mztake.ss" "mztake")
(lib "animation.ss" "frtime")
(lib "useful-code.ss" "mztake" "private"))
(lib "useful-code.ss" "mztake"))
(define/bind (loc "highway.ss" 3 ) speed)

5
collects/mztake/demos/random/random-mztake.ss
View File

@ -1,8 +1,7 @@
(require (lib "animation.ss" "frtime")
(lib "mztake.ss" "mztake")
(lib "useful-code.ss" "mztake" "private")
(as-is mzscheme
assoc))
(lib "useful-code.ss" "mztake")
(as-is mzscheme assoc))
(define/bind (loc "random.ss" 4 6) x)

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

@ -1,5 +1,5 @@
(require (lib "animation.ss" "frtime")
(lib "useful-code.ss" "mztake" "private"))
(lib "useful-code.ss" "mztake"))
(require (lib "mztake.ss" "mztake"))
(define/bind (loc "sine.ss" 5 ) x sin-x)
@ -20,7 +20,7 @@
(let ([x (+ 200 x)]
[sin-x (+ 200 (* 100 sin-x))])
(history-b 50 (changes (make-cute-circle x sin-x))))))
(history-b (changes (make-cute-circle x sin-x)) 50))))
(set-running! (even? seconds))

2
collects/mztake/demos/sprofiler/sprofiler.ss
View File

@ -1,6 +1,6 @@
(require (lib "mztake.ss" "mztake" )
(lib "match.ss")
(lib "more-useful-code.ss" "mztake" "private" ))
(lib "more-useful-code.ss" "mztake"))
(set-main! "picture.ss")

380
collects/mztake/doc.txt
View File

@ -6,7 +6,7 @@
_MzTake_ is a _scripted debugger_ for PLT Scheme. It helps
programmers monitor the execution of a target program as it
unfolds (and optionally pause or resume its execution!). MzTake
unfolds (and optionally pause or resume its execution). MzTake
gives you the power to easily write real programs that debug real
programs. You are no longer limited to a tool chest of buttons
like "add breakpoint", "step-next", "step-into", and "step-over".
@ -16,17 +16,21 @@ language, which is bundled with DrScheme. FrTime supports the
implementation of reactive systems in a functional style.
The key abstraction it adds is a type of value called a 'signal',
which can change over time. FrTime infers dataflow dependencies
between signals and automatically recomputes them when necessary.
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 (implemented as "event streams" and "behaviors"),
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 MzTake collection:
(define/bind (loc "highway.ss" 3 ) speed)
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
MzTake collection:
(require (lib "mztake.ss" "mztake"))
(define/bind (loc "highway.ss" 3) speed)
(printf-b "current speed: ~a" speed)
(set-running! (< speed 55))
(set-running! true)
This code executes a target module in the file "highway.ss"
after installing a _trace point_ (also known as a _watch
@ -41,7 +45,8 @@ DrScheme's interaction pane. Whereas PRINTF accumulates
outdated text on the screen, PRINTF-B will replace old text
with updated text if any of the fill-values change. In this
invocation, it prints the current speed to screen, throughout
the execution of "highway.ss".
the execution of "highway.ss". The last line invokes SET-RUNNING!,
which lunches the execution of highway.ss
MzTake scripts are also powerful tools for building external
test suites. Whereas typical test cases may only assert that
@ -56,31 +61,45 @@ is already starting to fill up with information -- we are
only interested in the last ten speeds, after all.
One possible solution:
(printf-b "last ten speeds: ~a" (history-b 10 (changes speed)))
(printf-b "last ten speeds: ~a" (history-b (changes speed) 10))
HISTORY-B consumes a number and an event stream (CHANGES SPEED),
returning a FrTime behavior containing a FIFO ordered list of
the last ten values emitted on that event stream. In this case,
HISTORY-B maintains a list of the ten most recent SPEEDS seen
on SPEED. Though
this is is an improvement, we still can't *use* that list as
data to see what led to the exception. We might want to
puase the program when something goes awry.
HISTORY-B consumes an event stream (CHANGES SPEED) and an
optional number n, returning a FrTime behavior containing a
FIFO ordered list of the n values emitted on that event
stream. In this case, HISTORY-B maintains a list of the ten
most recent SPEEDS seen on SPEED.
(printf-b "last ten speeds: ~a" (history-b 10 (changes speed)))
We might want to pause the program when something goes awry. We do
this by exploiting the fact that SET-RUNNING! function consumes a
FrTime behavior. The value of a behavior can change over time, and
SET-RUNNING! monitor these changes. Whenever the behavior is true, the
target program runs, whenever it is false, the target program
pauses. We can indicate to MzTake to pause when the speed exceeds 55
as follow:
(printf-b "last ten speeds: ~a" (history-b (changes speed) 10))
(set-running! (< speed 55))
MzTake allows you to "pause" a target program anytime during
execution. Once paused, it becomes posssible to interactively
explore and compute with script variables. Once satisfied, you can easily resume
execution by typing "(set-running #t)", or end it
with "(kill)".
Once paused, it becomes possible to interactively explore the state of
the paused process. You can use the BIND function to reach into the
scope of the target process and read the value of the variable:
(bind (speed) (printf "the speed is ~a~n" speed))
This lines finds the variable named "speed" in the scope at the point
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
some other behavior, or end the execution altogether with "(kill)".
Finally, FrTime provides a rich animation library. Combined
with the MzTake debugger, it takes only a few lines to animate
your algorithms and see them in action, easily letting you
confirm (or refute!) that they are working correctly.
(require (lib "animation.ss" "frtime"))
(display-shapes (make-speed-gauge (hold speed)))
@ -98,6 +117,7 @@ the following two files: one is the program being debugged
(named after the directory), and the other is a file ending
in "...-mztake.ss" (the MzTake script).
The demos are (starting with the simplest one):
./highway/highway-mztake.ss - The program simulates a very simple
speedometer, and the MzTake script
@ -115,9 +135,6 @@ in "...-mztake.ss" (the MzTake script).
./djikstra/dijkstra-mztake.ss - Debugs a buggy implementation of
Dijkstra's algorithm
============================================================
Functions
The demos demonstrate many ways to debug with MzTake using
FrTime, even if you are not very familiar with the language.
@ -125,7 +142,7 @@ That said, in order to become more proficient in using MzTake,
you will want to learn more about the FrTime language.
You can refer to FrTime's own documentation by searching for
"frtime" in DrScheme's Help window. It explains how to use
"FrTime" in DrScheme's Help window. It explains how to use
time-varying behaviors and event streams in greater depth, and
also describes the many useful functions FrTime provides to work
with them.
@ -136,50 +153,226 @@ with them.
_Debugging with MzTake_
Conceptually, MzTake is a library for the FrTime languages
which provides
functions that execute a target program (or many), and
"connect" to points in its code. MzTake then provides the
running FrTime script with interesting information (such as
a variable's current value) which it derives from these
"connections". FrTime then handles the rest.
MzTake is a library for the FrTime languages which provides functions
that execute a target program (or many), and "connect" to points in
its code. MzTake then provides the running FrTime script with
interesting information (such as a variable's current value) which it
derives from these "connections". FrTime then handles the rest.
FrTime takes that information and lets the script author
compute with it, verify it, print it, make visualizations
with it, anything you would like to do.
MzTake itself defines the following functions:
MzTake defines the following functions and macros:
_Installing Trace Points_
Currently, MzTake offers two types of traces: ENTRY and BIND.
ENTRYs are event streams that get a "#t" event every time the
target program reaches the trace point. Binds are event streams that
ping the value of one or more variables when the trace point is reached.
> (loc require-spec line-number)
> (loc require-spec line-number column-number)
> (define-mztake-process process-name
[target-filename trace-clause ...] ...)
Creates a LOC structure containing the target file, the target line
number, and (optionally) the target column number. LOC structures
are consumed by TRACE and by DEFINE/BIND. The first argument to LOC
is a file specification suitable for require, provided as a
datum. For instance, to install a trace point on the tenth line of
the MzLib's list library, use:
(trace (loc '(lib "list.ss") 10) ...)
> (trace loc body ...)
Install a trace point at the location indicated by the LOC
value. The result is a FrTime event stream containing one value
each time the target reaches the location specified. To get the
value event, TRACE evaluates its body (once per event. During the
evaluation of the body, the target process is paused, and BIND is
available to inspect the state of the paused program.
The body is optional. If no body is provided, the value #t is used
by default.
Unless SET-MAIN! is used, the first call to trace sets the file
name that will be run when SET-RUNNING! is invoked the first time.
> (trace* process loc thunk)
Like TRACE, but takes an explicit process argument, and a thunk
rather than a body.
> (bind (name ...) body ...)
When the target process is paused (or during the execution of a
trace body), BIND reaches in the lexical context at the point of
the pause (or of the trace point) and find the values for the
variables whose names are given. These values are then bound in the
body (in the MzTake script) to variable of the same name.
It is an error to call BIND while the target process is running.
> (bind* process symbol)
In the given process, find the variable whose name has the given
symbol, and returns its value.
> (define/bind loc name ...)
Define the NAMEs the to behaviors reflecting the values of the
giving name in the target program, at the given
location. DEFINE/BIND is short for:
(define name (hold (trace loc (bind (name) name))))
> (define/bind-e loc name ...)
Same as DEFINE/BIND, but returns an event stream instead of a behavior.
> (exceptions)
> (exceptions process)
Returns an event stream containing one EXN structure for each
exception raised in the target process and not caught.
> (exited?)
> (exited? process)
Returns a behavior which starts as #f and take on the value #t when
the target process exits.
> (set-running! val)
> (set-running! val process)
> (set-running! event)
> (set-running! event process)
Lunches the execution of the target process. Execution continues as
long as the given behavior is true (aka, any value beside #f), or
until an event comes on the given event stream with the value
#f. When execution pauses, the target remains on the line where the
paused occured. You can then inspect the state of the program with
BIND, or resume execution with another call to SET-RUNNING!.
> (set-main! require-spec)
> (set-main! require-spec process)
Sets the file where execution begins when SET-RUNNING! is called
for the first time. When SET-MAIN! is not used explicitly,
execution begins with the file specified in the first call to
trace. It is an error to call SET-RUNNING! without first calling
either TRACE or SET-MAIN!.
> (where)
> (where process)
Returns an event stream that contains one event for each expression
evaluated in the target process. Combined with HISTORY-B, this let
you record entire execution traces for the target program.
> (kill)
Kills the process and releases all resources
it used -- you cannot start/resume after a KILL.
Kills the target process and releases all resources
it used -- you cannot resume after a KILL.
Closing a FrTime animation/graphics window will *not*
kill a running MzTake process. If it does not terminate
on its own, you may kill it with "(kill p-name)" or
"(kill-all)" in the Interactions window.
This will not stop of evaluation of the MzTake script, however. In
particular, if the script depends on input the varies independently
of the target process, FrTime will continue to update them. You can
use "Kill" command from DrScheme's "Scheme" menu to stop both the
MzTake script and its target process at once.
Also, note that closing a FrTime animation/graphics window does *not*
kill a running MzTake process.
> (kill-all)
kill-all kills all the processes currently running
under MzTake -- use this when it seems a process is
out of control and needs to be stopped immediately.
Has the same effect of calling KILL on each process
you defined and start/resume'd in the script.
When using more than one target process at a time, KILL-ALL invokes
KILL on all of them at once.
> (current-process)
> (current-process process)
The CURRENT-PROCESS parameter gets or sets the process manipulated
by the MzTake function when they are not provided with a process
argument. The CURRENT-PROCESS parameter is initialized with a blank
process, and you can create additional processes using the
CREATE-DEBUG-PROCESS function. Using more than one process at a
time lets your MzTake run multiple programs different at once and
compare their output using a single script.
> (create-debug-process)
Creates a fresh blank debug process. Each debug process has its own
set of trace points, its own run trigger (set via SET-RUNNING!),
its own exceptions stream, etc. Each debug process run
independently from the others, and they can be paused and killed
individually. All debug processes in a single MzTake script share
the same FrTime event space, and so it is possible to compare
output and traces between each of them.
> (current-policy)
> (current-policy policy)
Every file executed under MzTake can run either in fast mode or in
debuggable mode. The CURRENT-POLICY decides which.
- debuggable mode: the file is instrumented with MzTake debugging
information. It can be the target of trace point and it generate
events on the WHERE stream. Execution can also be paused in the middle
of code running in debuggable mode. The instrumentation overhead
is considerable, however, of the order of 10x-20x slowdown.
- fast mode: the file is not instrumented, and runs at its normal
speed, but cannot be debugged. Inserting trace points into fast
mode files after the beginning of the execution has no
effect. Also, pausing while executing a fast mode file will be
delayed until execution reaches a debuggable mode file.
MzTake uses the following rules, in order, to decide between fast
mode and debuggable mode:
1) Files that are compiled to .zo run in fast mode.
2) Files that are the target of a trace point when first lunching
the process run in debuggable mode, so is the main file set by SET-MAIN!
3) If none of the two previous rules apply, the current policy is
consulted to decide between fast and debuggable mode.
If the check reaches the third step and the policy does not decide,
MzTake raises an error.
Policies have the following contract:
(listof (list/c (symbols 'fast 'debuggable)
(union (symbols 'everything-else)
path?
string?
(listof (union path? string?)))))
A policy consist of a list of entries. Each entry is a pair
specifying either fast mode or debuggable mode, then a directory,
or a list of directories. Files in these directories, or their
subdirectories will run under the given mode. The special symbol
'everything-else can be used instead of a directory, and this will
match any file. The policy is checked in order, and the first entry
that applies to the given filename assign a mode the file.
The default policy run files of the directories specified by
CURRENT-LIBRARY-COLLECTIONS-PATHS in fast mode, and runs everything
else in debuggable mode. This poloicy is set as follow:
(current-policy `((fast ,(current-library-collection-paths))
(debuggable everything-else)))
You can change this policy by calling the
CURRENT-POLICY function with a new policy as an argument. The
policy is assigned to a process when the process lunches.
_Useful Functions for Time-Varying Values_
Note: FrTime uses a naming convention where functions which
@ -187,14 +380,15 @@ Note: FrTime uses a naming convention where functions which
functions that return event streams end in "-e".
Tips: When you have a behavior that you want to turn into
an event, use (changes behavior).
an event, use "(changes behavior)".
When you have an event that you want to be a
behavior, use (hold event)
behavior, use "(hold event)"
MzTake defines a few functions on time-varying values
that are particularly useful when debugging:
that are particularly useful when debugging. You can require these
functions with (require (lib "useful-code.ss" "mztake"))
> (history-e stream)
> (history-b stream)
@ -204,8 +398,8 @@ that are particularly useful when debugging:
Use with BINDs: (history-b x-trace)
> (history-e n stream)
> (history-b n stream)
> (history-e stream n)
> (history-b stream n)
Keeps a list of the last n values of a behavior
Returns a list of at most n elements, where the
@ -246,9 +440,8 @@ that are particularly useful when debugging:
Known Problems
* In general, you should not REQUIRE or use any functions on
acting on the structures of your target program in your
MzTake script.
* In general, you should not REQUIRE in your MzTake script any
functions that act on the structures of your target program.
ORIGINAL FILE:
(define-struct foo (a b))
@ -262,64 +455,39 @@ Known Problems
The target program and the MzTake will have different
instances of the struct, and the call to FOO-A will fail.
Instead, use BIND to bring the function from the target program to
the script:
(define/bind (loc "original-file.ss" 3) x foo-a)
(foo-a x) ;; this succeeds
* The break button will *not* kill runaway client processes.
You must type (kill) or (kill-all).
* Some legal syntax locations (used in setting trace points)
are unreachable during program execution (they do not get
triggered and produce empty eventstreams). So far, this only
shows up in LETs (the trace point being one line above,
and one character to the left of the carrot):
triggered and produce empty eventstreams). For instance,
the name clause of a LET is never the current point of execution:
(define x 12)
(let ([x (add1 x)]) x)
^ ^^^
^
Recommended syntax locations to use for trace points:
(define x 12)
(let ([x (add1 x)]) x)
^ ^^ ^ ^
* Don't rely entirely on MzTake to complain when you change
target code and your line/col locations in the script are out
of date. It can only raise an error if the locations are invalid.
* MzTake has not been tested for stability if the target is using
multiple threads. This only applies to threaded modules
*with* traces on them -- other REQUIRE'd modules will work
as expected.
* Watch out: when you change target code, your line/col locations in
the script will drift out of align.
* Error handling is not perfect -- e.g., the little "bug"
buttons on syntax errors don't reference the correct code.
However, the messages that are printed are as accurate as
possible.
* On particularly fast computers, when running scripts with a
very high trace point density (traces are hit constantly,
potentially hundreds in a second, like in the Monte Carlo,
random-xs, and sine demos), the FrTime animation window may
appear unresponsive because of how fast it is redrawing.
* Currently, if you are running traces on two modules with the
same name, IN the same process, though in different directories,
there will probably be some sort of name-clash and strange error.
This will be fixed.
============================================================
Tips and Tricks
* If output seems difficult to read in the script, e.g. you ever
see "struct:signal" and a lot of garbage, try (print-struct #f)
before you do any printing, or use (value-now behavior-name) to
get a more usable/printable version of a FrTime behavior (the
caveat is that it is no longer 'reactive' and it may be out of
date after the moment it is processed).
* You can add trace points to first-class functions, and they
will send trace update from anywhere they are passed to and
invoked.
* You can add trace points to the body first-class functions, and they
will send trace update from anywhere they are passed to and invoked.
============================================================

208
collects/mztake/engine.ss
View File

@ -1,16 +1,16 @@
(module engine mzscheme
(require (lib "marks.ss" "mztake" "private")
; (prefix frp: (lib "frp.ss" "frtime"))
(require "marks.ss"
(prefix frp: (lib "lang-ext.ss" "frtime"))
(rename (lib "frp-core.ss" "frtime")
frp:signal-thunk signal-thunk)
(lib "useful-code.ss" "mztake" "private")
(lib "more-useful-code.ss" "mztake" "private") ; mostly for hash- bindings
"useful-code.ss"
"more-useful-code.ss" ; mostly for hash- bindings
"mztake-structs.ss"
(lib "load-annotator.ss" "mztake" "private")
"load-sandbox.ss"
"annotator.ss")
(provide process:set-main!
current-policy
all-debug-processes
create-debug-process
process:->dead
@ -46,33 +46,34 @@
(cons (unwrap-syntax stx)
(loop (read-syntax filename port)))))
(close-input-port port)))))])
(lambda (line maybe-col)
(let loop ([lst pos-list]
[last-coord (first pos-list)])
(let loop ([lst pos-list])
(cond
; none is found
[(empty? lst)
(raise (format "No syntax found for trace at line/column ~a:~a in client `~a'" line maybe-col filename))]
; if first is correct line and correct column
[(and (= line (caar lst))
(error 'loc
"No syntax found for trace at line/column ~a:~a in client `~a'"
line maybe-col filename)]
[(and (<= line (first (first lst)))
(or (not maybe-col)
(= maybe-col (cadar lst))))
(<= maybe-col (second (first lst)))))
(third (first lst))]
[else (loop (rest lst)
(first lst))])))))
[else (loop (rest lst))])))))
(define (find-client process modpath)
(define (find-client process modpath)
(cond
[(memf (lambda (c) (equal? (debug-client-modpath c) modpath))
(debug-process-clients process)) => first]
[else false]))
(define (find-client/create process modpath)
(or (find-client process modpath)
(create-debug-client process modpath)))
(define (process:set-main! p reqspec)
(let* ([modpath (reqspec->modpath reqspec)]
[maybe-client (find-client p modpath)]
[client (or maybe-client (create-debug-client p modpath))])
[client (find-client/create p modpath)])
(set-debug-process-main-client! p client)))
@ -95,39 +96,46 @@
[no-traces? (empty? traces)]
[has-single-trace? (and (not no-traces?) (empty? (rest traces)))]
[no-where? (not (debug-process-where process))]
[no-events? (and no-traces? no-where?)])
[no-events? (and no-traces? no-where?
(not (debug-process-pause-requested? process)))])
(unless no-events?
(let* ([marks (cons top-mark (continuation-mark-set->list rest-marks debug-key))])
(set-debug-process-marks! process marks)
(if no-where?
(if has-single-trace?
;; fast-path
(let ([t (first traces)])
(frp:send-synchronous-event (trace-struct-evnt-rcvr t)
((trace-struct-thunk t))))
(frp:send-synchronous-events (traces->events traces)))
;; No where event to generate
(cond [has-single-trace?
;; fast-path
(let ([t (first traces)])
(frp:send-synchronous-event (trace-struct-evnt-rcvr t)
((trace-struct-thunk t))))]
[no-traces? void]
[else (frp:send-synchronous-events (traces->events traces))])
;; With a where event to generate
(let ([where-event ((frp:signal-thunk (debug-process-where process)) #t)]
[w (map (compose syntax-local-infer-name mark-source) marks)])
(if no-traces?
(frp:send-synchronous-event where-event w)
(let* ([where-event (list where-event w)]
[trace-events (traces->events traces)])
(frp:send-synchronous-events (cons where-event trace-events))))))))
(if no-traces?
(frp:send-synchronous-event where-event w)
(let* ([where-event (list where-event w)]
[trace-events (traces->events traces)])
(frp:send-synchronous-events (cons where-event trace-events))))))
;; Now that we processed the trace, do we want to pause or continue
(when (debug-process-pause-requested? process)
(let loop ()
(unless (debug-process-resume-requested? process)
(semaphore-wait (debug-process-run-semaphore process))
(loop)))
(set-debug-process-pause-requested?! process false)
(set-debug-process-resume-requested?! process false))
(set-debug-process-marks! process false)))))
; Now that we processed the trace, do we want to pause or continue
(when (debug-process-pause-requested? process)
(let loop ()
(unless (debug-process-resume-requested? process)
(semaphore-wait (debug-process-run-semaphore process))
(loop)))
(set-debug-process-pause-requested?! process false)
(set-debug-process-resume-requested?! process false))
(set-debug-process-marks! process false)))
(define ((break-after process client) top-mark marks . vals)
@ -138,37 +146,87 @@
(receive-result process client top-mark marks) ; TODO: allow substitute value
false)
(define (unbuild-path path)
(let-values ([(base name _) (split-path path)])
(if base
(append (unbuild-path base) (list name))
empty)))
(define (head lst n)
(if (= n 0)
empty
(cons (first lst) (head (rest lst) (sub1 n)))))
(define (dir-contains? dir filename)
(let ([dir-lst (unbuild-path dir)])
(equal? dir-lst (head (unbuild-path filename) (length dir-lst)))))
(define (map-policy-tag tag)
(cond [(eq? tag 'fast) false]
[(eq? tag 'debuggable) true]
[else (error 'map-policy-tag "unknown policy tag ~a" tag)]))
(define (policy-requests-annotatation? policy filename)
(if (empty? policy)
true
(let ([tag (first (first policy))]
[collect-paths (second (first policy))])
(map-policy-tag tag) ;; complains if the tag doesn't exists
(if (or (eq? collect-paths 'everything-else)
(ormap (lambda (dir) (dir-contains? dir filename))
(if (list? collect-paths)
collect-paths
(list collect-paths))))
(map-policy-tag tag)
(policy-requests-annotatation? (rest policy) filename)))))
(define (process-has-file? process filename)
(and
(memf (lambda (c) (equal? (debug-client-modpath c)
(path->string filename)));; TODO: harmonize path & string
(debug-process-clients process))
true))
(define (launch-sandbox process)
(require/sandbox+annotations
(debug-process-custodian process)
;; error-display-handler :
(let ([orig-err-disp (error-display-handler)])
(lambda (msg exn)
(frp:send-event (debug-process-exceptions process) exn)
(orig-err-disp msg exn)))
`(file ,(debug-client-modpath (debug-process-main-client process)))
(unless (debug-process-main-client process)
(error 'launch-sandbox
"No main file specified. Use TRACE or SET-MAIN! to indicate where to start execution"))
(parameterize ([current-inspector (make-inspector)])
(require/sandbox+annotations
(debug-process-custodian process)
;; error-display-handler :
(let ([orig-err-disp (error-display-handler)])
(lambda (msg exn)
(frp:send-event (debug-process-exceptions process) exn)
(orig-err-disp msg exn)))
;; target file
`(file ,(debug-client-modpath (debug-process-main-client process)))
;; annotate-module?
(lambda (filename module-name)
(memf (lambda (c) (equal? (debug-client-modpath c) (path->string filename)));; TODO: harmonize path & string
(debug-process-clients process)))
;; annotator
(lambda (stx)
(let ([client (and (syntax-source stx)
(find-client process (path->string (syntax-source stx))))])
(if (not client)
;; annotate-module?
(lambda (filename module-name)
(or (process-has-file? process filename)
(policy-requests-annotatation? (debug-process-policy process) filename)))
;; annotator
(lambda (stx)
(if (not (syntax-source stx))
stx
(let-values ([(annotated-stx pos-list)
(annotate-for-single-stepping
stx
(break? process client)
(break-before process client)
(break-after process client)
(lambda (kind bound binding) (void)))])
annotated-stx))))))
(let*-values ([(client) (find-client/create process (path->string (syntax-source stx)))]
[(annotated-stx pos-list)
(annotate-for-single-stepping
stx
(break? process client)
(break-before process client)
(break-after process client)
(lambda (kind bound binding) (void)))])
annotated-stx))))))
(define (process:new->running process)
(set-debug-process-run-semaphore! process (make-semaphore))
(set-debug-process-policy! process (current-policy))
(thread (lambda ()
(launch-sandbox process)
@ -203,6 +261,9 @@
(not (debug-process-resume-requested? process)))
(process:paused->running process)]))
(define current-policy (make-parameter `((fast ,(current-library-collection-paths))
(debuggable everything-else))))
(define (create-debug-process)
(letrec ([running-e (frp:new-cell frp:never-e)]
@ -215,6 +276,8 @@
run-manager ; run-manager
false ; pause-requested?
false ; resume-requested?
false ; policy
(frp:new-cell false) ; exited?
(frp:event-receiver) ; exceptions
false ; main-client
@ -263,12 +326,7 @@
(define (trace* p loc thunk)
(let* ([modpath (reqspec->modpath (loc-reqspec loc))]
[clients (filter (lambda (c)
(equal? modpath (debug-client-modpath c)))
(debug-process-clients p))]
[client (if (empty? clients)
(create-debug-client p modpath)
(first clients))]
[client (find-client/create p modpath)]
[trace-hash (debug-client-tracepoints client)]
[trace (make-trace-struct (frp:event-receiver) thunk)]
[pos ((debug-client-line-col->pos client) (loc-line loc) (loc-col loc))])

18
collects/mztake/private/load-annotator.ss → collects/mztake/load-sandbox.ss
View File

@ -1,4 +1,4 @@
(module load-annotator mzscheme
(module load-sandbox mzscheme
(require (lib "moddep.ss" "syntax")
(lib "class.ss" "mzlib")
@ -8,22 +8,6 @@
require/annotations
require/sandbox+annotations
load-module/annotate)
#|load-with-annotations :
>initial-module : (union (listof symbol?) string?)
Takes in a require spec -- "../file.ss", (file "complete-path.ss"), (lib ...), etc
In other words -
pass it a relative filename or a quoted lib to require
"mztake.ss" or '(lib "mztake.ss" "mztake")
>annotate-module? : (string? symbol? . -> . boolean)
(filename module-name)
If true, loads source file and annotates.
Else, tries to load compiled or source, no annotation.
>annotator : (string? symbol? syntax? . -> . syntax?)
|#
(define (require/sandbox+annotations custodian err-display-handler initial-module annotate-module? annotator)
(parameterize ([current-custodian custodian]

0
collects/mztake/private/marks.ss → collects/mztake/marks.ss
View File

17
collects/mztake/private/more-useful-code.ss → collects/mztake/more-useful-code.ss
View File

@ -3,10 +3,13 @@
(lib "pretty.ss")
(lib "etc.ss"))
(require-for-syntax (lib "list.ss"))
(provide assert
cons-to-end
assoc-get
debug
debug-x
make-to-string
make-debug
to-string
@ -204,6 +207,20 @@
(format "#~a=~a" my-id result)
result)))))))
(define-syntax (debug-x stx)
(syntax-case stx ()
[(_ rest ... expr)
#`(let ([result expr])
(printf "~a:~a ~a: ~a ~a~n"
#,(syntax-line stx)
#,(syntax-column stx)
'#,(if (syntax->list #'expr)
(syntax-e (first (syntax->list #'expr)))
(syntax-e #'expr))
result
(list rest ...))
result)]))
;; make-debug: usage example: (define debug-f (make-debug (make-to-string `([,is-type? ,type-to-string]))))
;; The printers have to take two arguments: the item to converts and the to-string function for subitems
(define (make-debug to-string-fn)

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

@ -1,5 +1,5 @@
(module mztake-structs mzscheme
(require (lib "more-useful-code.ss" "mztake" "private"))
(require (lib "more-useful-code.ss" "mztake"))
(provide (all-defined-except loc make-loc)
(rename loc loc$)
@ -31,6 +31,7 @@
run-manager ; saves behavior that actually pauses/resumes from GC
pause-requested?
resume-requested?
policy
exited? ; FrTime cell receives #t when the target exits
exceptions ; (an event stream) Exceptions thrown during the evaluation of the target

49
collects/mztake/mztake.ss
View File

@ -7,21 +7,42 @@
"mztake-structs.ss"
(lib "etc.ss")
(lib "list.ss")
(lib "marks.ss" "mztake" "private")
"marks.ss"
"engine.ss")
;; Turn struct printing on for MzTake users.
(print-struct true)
(define (require-spec? sexp)
(or string? list?))
(provide loc$ loc-reqspec loc-line loc-col
(provide loc$
trace
trace* bind define/bind define/bind-e where set-main!
bind
define/bind
define/bind-e
[rename #%top mztake-top])
(provide/contract [kill (() (debug-process?) . opt-> . void?)]
[kill-all (-> void?)]
[set-running-e! (frp:event? . -> . any)]
[set-running! (frp:value-nowable? . -> . any)]
(provide/contract [loc-reqspec (loc? . -> . require-spec?)]
[loc-line (loc? . -> . number?)]
[loc-col (loc? . -> . number?)]
[rename loc/opt-col loc
((any/c number?) (number?) . opt-> . loc?)]
[exceptions (() (debug-process?) . opt-> . frp:event?)]
[exited? (() (debug-process?) . opt-> . frp:behavior?)]
[rename loc/opt-col loc
((any/c number?) (number?) . opt-> . loc?)])
[kill (() (debug-process?) . opt-> . void?)]
[kill-all (-> void?)]
[set-running-e! ((frp:event?) (debug-process?) . opt-> . any)]
[set-running! ((frp:value-nowable?) (debug-process?) . opt-> . any)]
[where (() (debug-process?) . opt-> . frp:behavior?)]
[current-policy (case-> (-> any)
(any/c . -> . void?))]
[current-process (case-> (-> debug-process?)
(debug-process? . -> . void?))]
[create-debug-process (-> debug-process?)]
[set-main! ((require-spec?) (debug-process?) . opt-> . void?)]
[trace* (debug-process? loc? (-> any) . -> . frp:event?)]
[bind* (debug-process? symbol? . -> . any)])
(define loc/opt-col
(opt-lambda (reqspec line [col #f])
@ -67,9 +88,6 @@
(opt-lambda (reqspec [p (current-process)])
(process:set-main! p reqspec)))
(define (hold-b b)
(frp:hold (frp:filter-e (lambda (ev) (not (frp:undefined? ev))) (frp:changes b))))
(define-syntax trace
(syntax-rules ()
[(_ loc)
@ -82,13 +100,16 @@
(syntax-case stx ()
[(_ . name)
(begin
(printf "~a~n" 'name)
(printf "top ~a~n" 'name)
#'(with-handlers ([exn:fail?
(lambda (exn) (bind* (current-process) 'name))])
(printf "~a~n" 'name)
(printf "top ~a~n" '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))

BIN
collects/mztake/private/lab-where-mztake-was-born.jpg
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 585 KiB

16
collects/mztake/private/useful-code.ss → collects/mztake/useful-code.ss
View File

@ -6,23 +6,21 @@
(provide (all-defined))
; Everything is contracted to 'any' for speed benefits, though there is already a big performance hit
; Keeps a list of the last n values of a behavior
(define/contract history-e (case-> (number? event? . -> . any)
(event? . -> . any))
(define/contract history-e (case-> (event? . -> . any)
(event? number? . -> . any))
(case-lambda [(stream)
(define ((add-to-complete-hist x) hist) (append hist (list x)))
(accum-e (stream . ==> . add-to-complete-hist) empty)]
[(n stream)
[(stream n)
(define ((add-to-short-hist x) hist) (append (if (< (length hist) n) hist (rest hist)) (list x)))
(accum-e (stream . ==> . add-to-short-hist) empty)]))
(define/contract history-b (case-> (number? event? . -> . any)
(event? . -> . any))
(define/contract history-b (case-> (event? . -> . any)
(event? number? . -> . any))
(case-lambda [(stream) (hold (history-e stream) empty)]
[(n stream) (hold (history-e n stream) empty)]))
[(stream n) (hold (history-e stream n) empty)]))
; Counts number of events on an event stream
(define/contract count-b (event? . -> . any)
@ -52,7 +50,7 @@
; Matches a sequence of items in a list to event pings
(define/contract sequence-match? ((listof any/c) . -> . any)
(lambda (seq evs)
(equal? seq (history-b (length seq) evs))))
(equal? seq (history-b evs (length seq)))))
; Cheap printf for behaviors
(define printf-b format)