suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix check-requires for submodules

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/macro-debugger/analysis/private/moduledb.rkt
View File

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

16
collects/macro-debugger/analysis/private/util.rkt
View File

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

3
collects/tests/macro-debugger/check-requires/src-a.rkt Normal file
View File

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

3
collects/tests/macro-debugger/check-requires/src-b.rkt Normal file
View File

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

8
collects/tests/macro-debugger/check-requires/src-c.rkt Normal file
View File

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

7
collects/tests/macro-debugger/check-requires/use-a.rkt Normal file
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)

7
collects/tests/macro-debugger/check-requires/use-cs.rkt Normal file
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)