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

added in a path rewriter

Browse Source
This commit is contained in:
Danny Yoo 2011-05-13 14:50:25 -04:00
parent cceec4ccd7
commit 2bb4666645
5 changed files with 44 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
compiler.rkt
View File

@ -2081,6 +2081,7 @@
[(Module? exp)
(make-Module (Module-name exp)
(Module-path exp)
(Module-prefix exp)
(Module-requires exp)
(Module-provides exp)

3
expression-structs.rkt
View File

@ -36,7 +36,8 @@
[src-name : Symbol])
#:transparent)
(define-struct: Module ([name : ModuleName]
(define-struct: Module ([name : Symbol]
[path : ModuleName]
[prefix : Prefix]
[requires : (Listof ModuleName)]
[provides : (Listof Provided)]

30
parse-bytecode-5.1.1.rkt
View File

@ -3,6 +3,7 @@
(require "expression-structs.rkt"
"lexical-structs.rkt"
"typed-module-path.rkt"
"path-rewriter.rkt"
syntax/modresolve)
@ -151,9 +152,8 @@
[(symbol? resolved-path-name)
(make-ModuleName resolved-path-name)]
[(path? resolved-path-name)
(make-ModuleName
(string->symbol
(path->string resolved-path-name)))]))
(make-ModuleName (rewrite-path resolved-path-name))]))
;; parse-form: form -> (U Expression)
@ -240,11 +240,25 @@
[(struct mod (name srcname self-modidx prefix provides requires
body syntax-body unexported max-let-depth dummy lang-info
internal-context))
(make-Module (make-ModuleName name)
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
(parse-mod-provides provides)
(parse-mod-body body))]))
(let ([self-path
((current-module-path-index-resolver)
self-modidx
(current-module-path))])
(cond
[(symbol? self-path)
(make-Module name
(make-ModuleName self-path)
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
(parse-mod-provides provides)
(parse-mod-body body))]
[else
(make-Module name
(make-ModuleName (rewrite-path self-path))
(parse-prefix prefix)
(parse-mod-requires self-modidx requires)
(parse-mod-provides provides)
(parse-mod-body body))]))]))
;; parse-mod-requires: module-path-index (listof (pair (U Integer #f) (listof module-path-index))) -> (listof ModuleName)

29
path-rewriter.rkt
View File

@ -21,21 +21,22 @@
;; Paths located within collects get remapped to collects/....
;; rewrite-path: complete-path -> (symbol #f)
;; rewrite-path: path -> (symbol #f)
(define (rewrite-path a-path)
(cond
[(within-collects? a-path)
(string->symbol
(string-append "collects/"
(path->string
(find-relative-path collects a-path))))]
[(within-root? a-path)
(string->symbol
(string-append "root/"
(path->string
(find-relative-path (current-root-path) a-path))))]
[else
#f]))
(let ([a-path (normalize-path a-path)])
(cond
[(within-collects? a-path)
(string->symbol
(string-append "collects/"
(path->string
(find-relative-path collects a-path))))]
[(within-root? a-path)
(string->symbol
(string-append "root/"
(path->string
(find-relative-path (current-root-path) a-path))))]
[else
#f])))
(define collects

6
test-parse-bytecode-5.1.1.rkt
View File

@ -331,7 +331,8 @@
(match (run-my-parse #'(module foo racket/base
42))
[(struct Top ((struct Prefix (list))
(struct Module ((? ModuleName?)
(struct Module ((? symbol?)
(? ModuleName?)
(? Prefix?) ;; the prefix will include a reference to print-values.
_ ;; requires
_ ;; provides
@ -345,7 +346,8 @@
(provide x)
(define x "x")))
[(struct Top ((struct Prefix ((? list?)))
(struct Module ((? ModuleName?)
(struct Module ((? symbol?)
(? ModuleName?)
(? Prefix?) ;; the prefix will include a reference to print-values.
_ ;; requires
(list (struct Provided ('x 'x))) ;; provides