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

more `raco exe' cycle repairs

Browse Source
This commit is contained in:
Matthew Flatt 2011-10-07 10:08:09 -06:00
parent f02ea92250
commit b6a9330bf1
4 changed files with 35 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
collects/compiler/embed-unit.rkt
View File

@ -358,8 +358,16 @@
;; First use of the module. Get code and then get code for imports.
(when verbose?
(fprintf (current-error-port) "Getting ~s\n" filename))
(let ([actual-filename filename]) ; `set!'ed below to adjust file suffix
(hash-set! working filename #t)
(let* ([actual-filename filename] ; `set!'ed below to adjust file suffix
[name (let-values ([(base name dir?) (split-path filename)])
(path->string (path-replace-suffix name #"")))]
[prefix (let ([a (assoc filename prefixes)])
(if a
(cdr a)
(generate-prefix)))]
[full-name (string->symbol
(format "~a~a" prefix name))])
(hash-set! working filename full-name)
(let ([code (get-module-code filename
"compiled"
compiler
@ -376,19 +384,13 @@
#:choose
;; Prefer extensions, if we're handling them:
(lambda (src zo so)
(set! actual-filename src) ; remember convert soure name
(set! actual-filename src) ; remember convert source name
(if on-extension
#f
(if (and (file-exists? so)
((file-date so) . >= . (file-date zo)))
'so
#f))))]
[name (let-values ([(base name dir?) (split-path filename)])
(path->string (path-replace-suffix name #"")))]
[prefix (let ([a (assoc filename prefixes)])
(if a
(cdr a)
(generate-prefix)))])
#f))))])
(cond
[(extension? code)
(when verbose?
@ -480,7 +482,13 @@
(unbox codes))))
;; Build up relative module resolutions, relative to this one,
;; that will be requested at run-time.
(let ([mappings (map (lambda (sub-i sub-filename sub-path)
(let* ([lookup-full-name (lambda (sub-filename)
(let ([m (assoc sub-filename (unbox codes))])
(if m
(mod-full-name m)
;; must have been a cycle...
(hash-ref working sub-filename))))]
[mappings (map (lambda (sub-i sub-filename sub-path)
(and (not (and collects-dest
(is-lib-path? sub-path)))
(let-values ([(path base) (module-path-index-split sub-i)])
@ -490,14 +498,12 @@
(let-values ([(path2 base2) (module-path-index-split base)])
(when (or path2 base2)
(error 'embed "unexpected nested module path index")))
(let ([m (assoc sub-filename (unbox codes))])
(cons path (mod-full-name m))))))))
all-file-imports sub-files sub-paths)])
(cons path (lookup-full-name sub-filename)))))))
all-file-imports sub-files sub-paths)])
;; Record the module
(set-box! codes
(cons (make-mod filename module-path code
name prefix (string->symbol
(format "~a~a" prefix name))
name prefix full-name
(filter (lambda (p)
(and p (cdr p)))
mappings)
@ -509,7 +515,7 @@
[(null? runtime-paths) null]
[(let ([p (car runtime-paths)])
(and (pair? p) (eq? (car p) 'module)))
(cons (mod-full-name (assoc (car extra-files) (unbox codes)))
(cons (lookup-full-name (car extra-files))
(loop (cdr runtime-paths) (cdr extra-files)))]
[else
(cons #f (loop (cdr runtime-paths) extra-files))]))

4
collects/tests/racket/embed-me13.rkt Normal file
View File

@ -0,0 +1,4 @@
#lang racket/base
(require racket/runtime-path)
(define-runtime-module-path-index _mod "embed-me14.rkt")
(dynamic-require _mod #f)

5
collects/tests/racket/embed-me14.rkt Normal file
View File

@ -0,0 +1,5 @@
#lang racket/base
(require "embed-me13.rkt")
(with-output-to-file "stdout"
(lambda () (printf "This is 14\n"))
#:exists 'append)

4
collects/tests/racket/embed.rktl
View File

@ -216,6 +216,8 @@
(one-mz-test "embed-me1d.rkt" "This is 1d\n" #f)
(one-mz-test "embed-me1e.rkt" "This is 1e\n" #f)
(one-mz-test "embed-me2.rkt" "This is 1\nThis is 2: #t\n" #t)
(one-mz-test "embed-me13.rkt" "This is 14\n" #f)
(one-mz-test "embed-me14.rkt" "This is 14\n" #f)
;; Try unicode expr and cmdline:
(prepare dest "unicode")
@ -304,7 +306,7 @@
(try-exe (mk-dest mred?) "This is 6\n#t\n" mred? void "cts") ; <- cts copied to distribution
(delete-directory/files "cts")
(test #f system* (mk-dest mred?))
(void)))
(define (try-mzc)