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

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