1#lang mzscheme 2 3 (require syntax/moddep 4 mzlib/class 5 racket/private/namespace 6 mred) 7 8 (provide eval/annotations 9 require/annotations 10 require/sandbox+annotations 11 load-module/annotate) 12 13 ;; Like REQUIRE/ANNOTATIONS but the evaluation happens under the given 14 ;; custodian and the given error display handler. 15 (define (require/sandbox+annotations custodian err-display-handler initial-module annotate-module? annotator) 16 (parameterize ([current-custodian custodian] 17 [current-namespace (make-gui-namespace)] 18 [error-display-handler err-display-handler]) 19 (require/annotations initial-module annotate-module? annotator))) 20 21 22 ;; Like EVAL/ANNOTATION, but loads the required spec INITIAL-MODULE using EVAL. 23 (define (require/annotations initial-module annotate-module? annotator) 24 (eval/annotations #`(require #,initial-module) annotate-module? annotator)) 25 26 ;; Evaluates STX. For each module loaded during the evaluation, 27 ;; ANNOTATE-MODULE? is queried, if it returns true, ANNOTATOR is ran on the 28 ;; expanded module being loaded, and the return value is loaded instead. 29 (define (eval/annotations stx annotate-module? annotator) 30 (parameterize 31 ([current-load/use-compiled 32 (let ([ocload/use-compiled (current-load/use-compiled)]) 33 (lambda (fn m) 34 (cond [(annotate-module? fn m) 35 (load-module/annotate annotator fn m)] 36 [else 37 (ocload/use-compiled fn m)])))]) 38 (eval-syntax (annotator stx)))) 39 40 ;; Loads the file FN expecting a definition for a module called M. The 41 ;; code read from the file is expanded, then it is annotated using the 42 ;; ANNOTATOR function, then it is evaluated 43 (define (load-module/annotate annotator fn m) 44 (let-values ([(base _ __) (split-path fn)] 45 [(in-port src) (build-input-port fn)]) 46 (dynamic-wind 47 (lambda () (void)) 48 49 (lambda () 50 (parameterize ([read-accept-compiled #f] 51 [current-load-relative-directory base]) 52 (unless m (raise 'module-name-not-passed-to-load-module/annotate)) 53 (with-module-reading-parameterization 54 (lambda () 55 (let* ([first (parameterize ([current-namespace (make-base-namespace)]) 56 (expand (read-syntax src in-port)))] 57 [module-ized-exp (annotator (check-module-form first m fn))] 58 [second (read in-port)]) 59 (unless (eof-object? second) 60 (raise-syntax-error 61 'load-module/annotate 62 (format "expected only a `module' declaration for `~s', but found an extra expression" m) 63 second)) 64 (eval module-ized-exp)))))) 65 66 (lambda () (close-input-port in-port))))) 67 68 69 70 ; taken directly from mred.rkt -- it's not exported... 71 (define (build-input-port filename) 72 (let ([p (open-input-file filename)]) 73 (port-count-lines! p) 74 (let ([p (cond [(regexp-match-peek "^WXME01[0-9][0-9] ## " p) 75 (let ([t (make-object text%)]) 76 (send t insert-file p 'standard) 77 (close-input-port p) 78 (open-input-text-editor t))] 79 [else p])]) 80 (port-count-lines! p) 81 (values p filename)))) 82 83