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

fix demod for submodules

Browse Source
This commit is contained in:
Matthew Flatt 2012-11-12 07:47:30 -07:00
parent 34f05a5190
commit 623265d1e8
2 changed files with 39 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/compiler/demodularizer/mpi.rkt
View File

@ -18,16 +18,24 @@
(lambda () (lambda ()
(define _pth (define _pth
(resolve-module-path-index mpi (current-module-path))) (resolve-module-path-index mpi (current-module-path)))
(if (path? _pth) (cond
(simplify-path _pth #t) [(path? _pth) (simplify-path _pth #t)]
_pth)))) [(and (pair? _pth)
(path? (cadr _pth)))
(list* 'submod (simplify-path (cadr _pth) #t) (cddr _pth))]
[else _pth]))))
(define (mpi->path* mpi) (define (mpi->path* mpi)
(hash-ref (MODULE-PATHS) mpi (hash-ref (MODULE-PATHS) mpi
(lambda () (lambda ()
(error 'mpi->path* "Cannot locate cache of path for ~S" mpi)))) (error 'mpi->path* "Cannot locate cache of path for ~S" mpi))))
(define submod-path/c
(cons/c 'submod
(cons/c (or/c symbol? path?)
(listof symbol?))))
(provide/contract (provide/contract
[MODULE-PATHS (parameter/c (or/c false/c hash?))] [MODULE-PATHS (parameter/c (or/c false/c hash?))]
[current-module-path (parameter/c path-string?)] [current-module-path (parameter/c (or/c path-string? submod-path/c))]
[mpi->path! (module-path-index? . -> . (or/c symbol? path?))] [mpi->path! (module-path-index? . -> . (or/c symbol? path? submod-path/c))]
[mpi->path* (module-path-index? . -> . (or/c symbol? path?))]) [mpi->path* (module-path-index? . -> . (or/c symbol? path? pair? submod-path/c))])

32
collects/compiler/demodularizer/nodep.rkt
View File

@ -28,13 +28,28 @@
[(struct @phase (_ (struct module-code (modvar-rewrite lang-info ctop)))) [(struct @phase (_ (struct module-code (modvar-rewrite lang-info ctop))))
(values ctop lang-info (modvar-rewrite-modidx modvar-rewrite) get-modvar-rewrite)]))) (values ctop lang-info (modvar-rewrite-modidx modvar-rewrite) get-modvar-rewrite)])))
(define (path->comp-top pth) (define (path->comp-top pth submod)
(hash-ref! (ZOS) pth (hash-ref! (ZOS) (cons pth submod)
(λ () (λ ()
(call-with-input-file pth zo-parse)))) (define zo (call-with-input-file pth zo-parse))
(if submod
(extract-submod zo submod)
zo))))
(define (extract-submod zo submod)
(define m (compilation-top-code zo))
(struct-copy compilation-top
zo
[code (let loop ([m m])
(if (and (pair? (mod-name m))
(equal? submod (cdr (mod-name m))))
m
(or (ormap loop (mod-pre-submodules m))
(ormap loop (mod-post-submodules m)))))]))
(define (excluded? pth) (define (excluded? pth)
(set-member? (current-excluded-modules) (path->string pth))) (and (path? pth)
(set-member? (current-excluded-modules) (path->string pth))))
(define (get-nodep-module-code/index mpi phase) (define (get-nodep-module-code/index mpi phase)
(define pth (mpi->path! mpi)) (define pth (mpi->path! mpi))
@ -61,7 +76,9 @@
(hash-ref! (hash-ref!
MODULE-CACHE pth MODULE-CACHE pth
(lambda () (lambda ()
(define-values (base file dir?) (split-path pth)) (define-values (base file dir?) (split-path (if (path-string? pth)
pth
(cadr pth))))
(define base-directory (define base-directory
(if (path? base) (if (path? base)
(path->complete-path base (current-directory)) (path->complete-path base (current-directory))
@ -73,8 +90,9 @@
(parameterize ([current-load-relative-directory base-directory]) (parameterize ([current-load-relative-directory base-directory])
(path->comp-top (path->comp-top
(build-compiled-path (build-compiled-path
base base
(path-add-suffix file #".zo")))) (path-add-suffix file #".zo"))
(and (pair? pth) (cddr pth))))
pth pth
phase))) phase)))
(when (and phase (zero? phase)) (when (and phase (zero? phase))