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

fix module require-cycle detection

Browse Source 
svn: r5963
This commit is contained in:
Matthew Flatt 2007-04-17 11:34:11 +00:00
parent 7091496cd0
commit 4fe6bd19a4
3 changed files with 2547 additions and 2525 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5026
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

19
src/mzscheme/src/startup.inc
View File

@ -3226,6 +3226,7 @@
"(define -module-hash-table-table(make-hash-table 'weak)) " "(define -module-hash-table-table(make-hash-table 'weak)) "
"(define -path-cache(make-hash-table 'weak 'equal)) " "(define -path-cache(make-hash-table 'weak 'equal)) "
"(define -loading-filename(gensym))" "(define -loading-filename(gensym))"
"(define -loading-prompt-tag(make-continuation-prompt-tag 'module-loading))"
"(define -prev-relto #f)" "(define -prev-relto #f)"
"(define -prev-relto-dir #f)" "(define -prev-relto-dir #f)"
"(define(make-standard-module-name-resolver orig-namespace)" "(define(make-standard-module-name-resolver orig-namespace)"
@ -3380,9 +3381,13 @@
" (if (eq? #t suffix) \"\" suffix)" " (if (eq? #t suffix) \"\" suffix)"
" filename)))" " filename)))"
"(unless got" "(unless got"
"(let((l(continuation-mark-set->list" "(let((l(let((tag(if(continuation-prompt-available? -loading-prompt-tag)"
"(current-continuation-marks)" " -loading-prompt-tag"
" -loading-filename))" "(default-continuation-prompt-tag))))"
"(continuation-mark-set->list"
"(current-continuation-marks tag)"
" -loading-filename"
" tag)))"
"(ns(current-namespace)))" "(ns(current-namespace)))"
"(for-each" "(for-each"
"(lambda(s)" "(lambda(s)"
@ -3395,12 +3400,16 @@
"(map cdr(reverse(cons s l))))))" "(map cdr(reverse(cons s l))))))"
" l))" " l))"
"(let((prefix(string->symbol abase)))" "(let((prefix(string->symbol abase)))"
"((if(continuation-prompt-available? -loading-prompt-tag)"
"(lambda(f)(f))"
"(lambda(f)(call-with-continuation-prompt f -loading-prompt-tag)))"
"(lambda()"
"(with-continuation-mark -loading-filename(cons(current-namespace) normal-filename)" "(with-continuation-mark -loading-filename(cons(current-namespace) normal-filename)"
"(parameterize((current-module-name-prefix prefix))" "(parameterize((current-module-name-prefix prefix))"
"((current-load/use-compiled) " "((current-load/use-compiled) "
" filename " " filename "
"(string->symbol(bytes->string/latin-1(path->bytes no-sfx)))))))" "(string->symbol(bytes->string/latin-1(path->bytes no-sfx))))))))"
"(hash-table-put! ht modname suffix))))" "(hash-table-put! ht modname suffix)))))"
"(when(and(not(vector? s-parsed))" "(when(and(not(vector? s-parsed))"
"(or(string? s)" "(or(string? s)"
"(and(pair? s)" "(and(pair? s)"

19
src/mzscheme/src/startup.ss
View File

@ -3695,6 +3695,7 @@
(define -path-cache (make-hash-table 'weak 'equal)) ; weak map from `lib' path + corrent-library-paths to symbols (define -path-cache (make-hash-table 'weak 'equal)) ; weak map from `lib' path + corrent-library-paths to symbols
(define -loading-filename (gensym)) (define -loading-filename (gensym))
(define -loading-prompt-tag (make-continuation-prompt-tag 'module-loading))
(define -prev-relto #f) (define -prev-relto #f)
(define -prev-relto-dir #f) (define -prev-relto-dir #f)
@ -3860,9 +3861,13 @@
filename))) filename)))
(unless got (unless got
;; Currently loading? ;; Currently loading?
(let ([l (continuation-mark-set->list (let ([l (let ([tag (if (continuation-prompt-available? -loading-prompt-tag)
(current-continuation-marks) -loading-prompt-tag
-loading-filename)] (default-continuation-prompt-tag))])
(continuation-mark-set->list
(current-continuation-marks tag)
-loading-filename
tag))]
[ns (current-namespace)]) [ns (current-namespace)])
(for-each (for-each
(lambda (s) (lambda (s)
@ -3875,12 +3880,16 @@
(map cdr (reverse (cons s l)))))) (map cdr (reverse (cons s l))))))
l)) l))
(let ([prefix (string->symbol abase)]) (let ([prefix (string->symbol abase)])
((if (continuation-prompt-available? -loading-prompt-tag)
(lambda (f) (f))
(lambda (f) (call-with-continuation-prompt f -loading-prompt-tag)))
(lambda ()
(with-continuation-mark -loading-filename (cons (current-namespace) normal-filename) (with-continuation-mark -loading-filename (cons (current-namespace) normal-filename)
(parameterize ([current-module-name-prefix prefix]) (parameterize ([current-module-name-prefix prefix])
((current-load/use-compiled) ((current-load/use-compiled)
filename filename
(string->symbol (bytes->string/latin-1 (path->bytes no-sfx))))))) (string->symbol (bytes->string/latin-1 (path->bytes no-sfx))))))))
(hash-table-put! ht modname suffix)))) (hash-table-put! ht modname suffix)))))
;; If a `lib' path, cache pathname manipulations ;; If a `lib' path, cache pathname manipulations
(when (and (not (vector? s-parsed)) (when (and (not (vector? s-parsed))
(or (string? s) (or (string? s)