diff --git a/collects/mztake/mztake.ss b/collects/mztake/mztake.ss index 0f9f628dcc..d809470486 100644 --- a/collects/mztake/mztake.ss +++ b/collects/mztake/mztake.ss @@ -1,4 +1,6 @@ #| TODO +I will want to be able to take "(lib ...)" as a path to the file being debugged + exceptions thrown in anonymous threads spawned by the target, are caught by the default drs handler, and not by frtime or mztake. they get printed out in the interaction window and there is nothing we can do about them for now -- if you want you can parameterize and rethrow the exceptions. just be aware of that. CAN I CATCH FRTIME EXCEPTIONS AND RETHROW THOSE TOO? @@ -77,7 +79,7 @@ What do we do about binding to a variable and following it EVERYWHERE it goes. Find a way to bind to the result of ananonymous expression: here->(add1 2) |# -(module mztake mzscheme +(module mztake mzscheme (require (lib "match.ss") (lib "contract.ss") (lib "unitsig.ss") diff --git a/collects/mztake/private/load-annotator.ss b/collects/mztake/private/load-annotator.ss new file mode 100644 index 0000000000..54b4db32a8 --- /dev/null +++ b/collects/mztake/private/load-annotator.ss @@ -0,0 +1,101 @@ +;catch oops exception +;catch the other two exceptions that my loaders throw +;detect if the source code for a certain module is missing and throw an error +;do I want to parameterize it over a given namespace? + +(module load-annotator mzscheme + + (require (lib "moddep.ss" "syntax") + (lib "class.ss" "mzlib") + (lib "mred.ss" "mred")) + + (provide load-with-annotations) + + #|load-with-annotations : + + >initial-module : (union (listof symbol?) string?) + 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 : (syntax? . -> . syntax?) +|# + (define (load-with-annotations initial-module annotate-module? annotator) + (parameterize + ([current-load/use-compiled + (let ([ocload/use-compiled (current-load/use-compiled)]) + (lambda (fn m) + (with-handlers + ([exn:module? + (lambda (exn) + (raise (format "mztake:not-a-module: file:`~a' module:`~a'" fn m)))]) + + (cond [(annotate-module? fn m) + (load/annotate annotator fn m)] + [else + (ocload/use-compiled fn m)]))))]) + (eval #`(require #,initial-module)))) + + (define (load/annotate annotator fn m) + (let-values ([(base _ __) (split-path fn)] + [(in-port src) (build-input-port fn)]) + (dynamic-wind + (lambda () (void)) + + (lambda () + (parameterize ([read-accept-compiled #f] + [current-load-relative-directory base]) + (unless m (raise 'oops)) + (with-module-reading-parameterization + (lambda () + (let* ([first (read-syntax src in-port)] + [module-ized-exp (annotator (check-module-form first m fn))] + [second (read in-port)]) + (unless (eof-object? second) + (raise-syntax-error + 'load/annotate + (format "expected only a `module' declaration for `~s', but found an extra expression" m) + second)) + (eval module-ized-exp)))))) + + (lambda () (close-input-port in-port))))) + + ; taken directly from mred.ss -- it's not exported... + (define (build-input-port filename) + (let ([p (open-input-file filename)]) + (port-count-lines! p) + (let ([p (cond + [(regexp-match-peek "^WXME01[0-9][0-9] ## " p) + (let ([t (make-object text%)]) + (send t insert-file p 'standard) + (close-input-port p) + (open-input-text-editor t))] + [else p])]) + (port-count-lines! p) + (let loop () + (when (with-handlers ([not-break-exn? (lambda (x) #f)]) + (regexp-match-peek "^#!" p)) + (let lloop ([prev #f]) + (let ([c (read-char-or-special p)]) + (if (or (eof-object? c) + (eq? c #\return) + (eq? c #\newline)) + (when (eq? prev #\\) + (loop)) + (lloop c)))))) + (values p filename)))) + + (define (test annotate-all?) + (load-with-annotations '(lib "mztake.ss" "mztake") + (lambda (fn m) + (printf "~a ~a~n" fn m) + annotate-all?) + (lambda (stx) stx))) + ;(test #t) ; slow + ;(test #f) ; fast + ) \ No newline at end of file