added a load/annotation function in prep for annotating beyond requires.

svn: r110

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?

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