my-include.rkt (2074B)
1 #lang racket 2 (provide my-include) 3 (require version-case 4 (for-syntax mzlib/etc)) 5 6 (define-for-syntax (my-include1 esrcdir) 7 (lambda (filename) 8 (with-syntax ([esrcdir esrcdir] 9 [filename filename]) 10 #'(begin 11 (define-syntax (tmp _stx) 12 (my-include2 (this-expression-source-directory esrcdir) filename)) 13 (tmp))))) 14 15 (define-for-syntax (my-include2 dirname filename) 16 (let ([filename (build-path dirname 17 filename)]) 18 (define s 19 (parameterize ([read-accept-reader #t]) 20 (read-syntax filename (open-input-file filename)))) 21 (syntax-case s () 22 [(-module name . rest) 23 #'(begin (module name . rest) 24 (require 'name) 25 (provide (all-from-out 'name)))]))) 26 27 (define-syntax (my-include stx) 28 (syntax-case stx () 29 [(_ updir filename) 30 (and (string? (syntax-e #'updir)) 31 (string? (syntax-e #'filename))) 32 (let ([-updir (syntax-e #'updir)] 33 [-filename (syntax-e #'filename)] 34 [my-include1 (my-include1 #'filename)] 35 [loc (lambda (x) (quasisyntax/loc #'filename #,x))]) 36 #`(version-case 37 [(version< (version) "6.11.0.900") 38 #,(my-include1 (loc (string-append -updir "6-11" -filename)))] 39 [(version< (version) "6.90.0.29") 40 #,(my-include1 (loc (string-append -updir "6-12" -filename)))] 41 [(version< (version) "7.0.0.20") 42 #,(my-include1 (loc (string-append -updir "6-90-0-29" -filename)))] 43 [(version< (version) "7.3") 44 #,(my-include1 (loc (string-append -updir "7-0-0-20" -filename)))] 45 [(version< (version) "7.4") 46 #,(my-include1 (loc (string-append -updir "7-3-0-1" -filename)))] 47 ; #,(my-include1 (loc (string-append -updir "7-4" -filename)))] 48 [(version< (version) "7.5") 49 #,(my-include1 (loc (string-append -updir "7-4" -filename)))] 50 [else 51 #,(my-include1 (loc (string-append -updir "8-0" -filename)))]))]))