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

fix mistakes in augment corrections; fix runtime-path handling of lib paths

Browse Source 
svn: r11577

original commit: 1a8b6cb824f84323179757d0f95d39b9ffe2f7a6
This commit is contained in:
Matthew Flatt 2008-09-08 19:44:32 +00:00
parent bf474980dc
commit 462136e186
1 changed files with 23 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/mzlib/runtime-path.ss
View File

@ -1,22 +1,25 @@
(module runtime-path mzscheme (module runtime-path scheme/base
(require mzlib/etc (require mzlib/etc
syntax/modcollapse syntax/modcollapse
setup/dirs setup/dirs
(only "private/runtime-path-table.ss" table)) scheme/list
scheme/string
(only-in "private/runtime-path-table.ss" table)
(for-syntax scheme/base))
(provide define-runtime-path (provide define-runtime-path
define-runtime-paths define-runtime-paths
define-runtime-path-list define-runtime-path-list
runtime-paths) runtime-paths)
(define-for-syntax ext-file-table (make-hash-table)) (define-for-syntax ext-file-table (make-hasheq))
(define (lookup-in-table tag-stx p) (define (lookup-in-table tag-stx p)
;; This function is designed to cooperate with a table embedded ;; This function is designed to cooperate with a table embedded
;; in an executable by create-embedding-executable. ;; in an executable by create-embedding-executable.
(let ([mpi (syntax-source-module tag-stx)]) (let ([mpi (syntax-source-module tag-stx)])
(let ([p (hash-table-get (let ([p (hash-ref
table table
(cons (cond (cons (cond
[(module-path-index? mpi) [(module-path-index? mpi)
@ -71,10 +74,16 @@
((length p) . > . 1) ((length p) . > . 1)
(eq? 'lib (car p)) (eq? 'lib (car p))
(andmap string? (cdr p))) (andmap string? (cdr p)))
(let ([dir (if (null? (cddr p)) (let* ([strs (regexp-split #rx"/"
(collection-path "mzlib") (let ([s (cadr p)])
(apply collection-path (cddr p)))]) (if (regexp-match? #rx"[./]" s)
(build-path dir (cadr p)))] s
(string-append s "/main.ss"))))]
[dir (if (and (null? (cddr p))
(null? (cdr strs)))
(collection-path "mzlib")
(apply collection-path (append (cddr p) (drop-right strs 1))))])
(build-path dir (last strs)))]
[else (error 'runtime-path "unknown form: ~e" p)]))) [else (error 'runtime-path "unknown form: ~e" p)])))
paths))) paths)))
@ -85,8 +94,8 @@
[(symbol? mpi) mpi] [(symbol? mpi) mpi]
[else (error 'register-ext-files [else (error 'register-ext-files
"cannot determine source")])]) "cannot determine source")])])
(let ([files (hash-table-get ext-file-table modname null)]) (let ([files (hash-ref ext-file-table modname null)])
(hash-table-put! ext-file-table modname (append paths files)))))) (hash-set! ext-file-table modname (append paths files))))))
(define-syntax (-define-runtime-path stx) (define-syntax (-define-runtime-path stx)
(syntax-case stx () (syntax-case stx ()
@ -101,12 +110,12 @@
#'orig-stx #'orig-stx
id))) id)))
ids) ids)
(let ([tag (datum->syntax-object #'orig-stx 'tag #'orig-stx)]) (let ([tag (datum->syntax #'orig-stx 'tag #'orig-stx)])
#`(begin #`(begin
(define-values (id ...) (define-values (id ...)
(let-values ([(id ...) expr]) (let-values ([(id ...) expr])
(let ([get-dir (lambda () (let ([get-dir (lambda ()
#,(datum->syntax-object #,(datum->syntax
tag tag
`(,#'this-expression-source-directory) `(,#'this-expression-source-directory)
tag))]) tag))])
@ -135,10 +144,10 @@
(syntax-case stx () (syntax-case stx ()
[(_ mp) [(_ mp)
#`(quote #`(quote
#,(hash-table-get #,(hash-ref
ext-file-table ext-file-table
(module-path-index-resolve (module-path-index-join (module-path-index-resolve (module-path-index-join
(syntax-object->datum #'mp) (syntax->datum #'mp)
(syntax-source-module stx))) (syntax-source-module stx)))
null))])) null))]))