fix check-requires for submodules

original commit: 0b8b0c36ef80c79f0f9e7762ce1c5383917fd19e
This commit is contained in:
Ryan Culpepper 2012-04-23 16:55:53 -06:00
parent 982cd95c6b
commit 12e710ab30
7 changed files with 58 additions and 21 deletions

View File

@ -32,10 +32,11 @@
(cond [(symbol? name) 'no-bypass]
[(hash-ref module-db name #f)
=> values]
[else
[(path? name)
(let ([str (path->relative-string/library name)])
(for/or ([rx (in-list no-bypass-rxs)])
(and (regexp-match? rx str) 'no-bypass)))])))
(and (regexp-match? rx str) 'no-bypass)))]
[else #f])))
;; module-db : ModuleDB
(define module-db

View File

@ -48,12 +48,17 @@
mpi-list->module-path)
;; get-module-derivation : module-path -> (values compiled Deriv)
(define (get-module-code/trace path)
(get-module-code (resolve-module-path path #f)
#:choose (lambda _ 'src)
#:compile (lambda (stx)
(let-values ([(stx deriv) (trace/result stx expand)])
(values (compile stx) deriv)))))
(define (get-module-code/trace modpath)
(let-values ([(path subs)
(match (resolve-module-path modpath #f)
[`(submod ,path . ,subs) (values path subs)]
[path (values path null)])])
(get-module-code path
#:submodule-path subs
#:choose (lambda _ 'src)
#:compile (lambda (stx)
(let-values ([(stx deriv) (trace/result stx expand)])
(values (compile stx) deriv))))))
;; here-mpi? : any -> boolean
(define (here-mpi? x)
@ -96,19 +101,22 @@
(collapse-module-path mod (lambda () (loop base)))]
[else (build-path 'same)]))]
[else (build-path 'same)]))])
(match collapsed
[(list 'lib str)
(cond [(regexp-match? #rx"\\.rkt$" str)
(let* ([no-suffix (path->string (path-replace-suffix str ""))]
[no-main
(cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
=> cadr]
[else no-suffix])])
(string->symbol no-main))]
[else collapsed])]
[(? path?)
(path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
[_ collapsed])))
(let simplify ([collapsed collapsed])
(match collapsed
[(list* 'submod base subs)
(list* 'submod (simplify base) subs)]
[(list 'lib str)
(cond [(regexp-match? #rx"\\.rkt$" str)
(let* ([no-suffix (path->string (path-replace-suffix str ""))]
[no-main
(cond [(regexp-match #rx"^([^/]+)/main$" no-suffix)
=> cadr]
[else no-suffix])])
(string->symbol no-main))]
[else collapsed])]
[(? path?)
(path->string (simplify-path collapsed #f))] ;; to get rid of "./" at beginning
[_ collapsed]))))
;; --------

View File

@ -0,0 +1,3 @@
#lang racket/base
(define a 1)
(provide a)

View File

@ -0,0 +1,3 @@
#lang racket/base
(define b 2)
(provide b)

View File

@ -0,0 +1,8 @@
#lang racket/base
(module s racket/base
(define cs 30)
(provide cs))
(define c 3)
(provide c)

View File

@ -0,0 +1,7 @@
#lang racket/base
(require "src-a.rkt"
"src-b.rkt"
"src-c.rkt"
(submod "src-c.rkt" s))
(void a)

View File

@ -0,0 +1,7 @@
#lang racket/base
(require "src-a.rkt"
"src-b.rkt"
"src-c.rkt"
(submod "src-c.rkt" s))
(void cs)