diff --git a/collects/compiler/distribute.rkt b/collects/compiler/distribute.rkt index ed3f52b1eb..1e941045ae 100644 --- a/collects/compiler/distribute.rkt +++ b/collects/compiler/distribute.rkt @@ -162,24 +162,14 @@ (memq 'gracket3m types)) (map copy-dll (list - (versionize "libracket3m~a.dll")))) - (when (memq 'gracketcgc types) - (map copy-dll - (list - (versionize "libgracket~a.dll")))) - (when (memq 'gracket3m types) - (map copy-dll - (list - (versionize "libgracket3m~a.dll")))))] + (versionize "libracket3m~a.dll")))))] [(macosx) - (when (memq 'racketcgc types) + (when (or (memq 'racketcgc types) + (memq 'gracketcgc types)) (copy-framework "Racket" #f lib-dir)) - (when (memq 'racket3m types) - (copy-framework "Racket" #t lib-dir)) - (when (memq 'gracketcgc types) - (copy-framework "GRacket" #f lib-dir)) - (when (memq 'gracket3m types) - (copy-framework "GRacket" #t lib-dir))] + (when (or (memq 'racket3m types) + (memq 'gracket3m types)) + (copy-framework "Racket" #t lib-dir))] [(unix) (let ([lib-plt-dir (build-path lib-dir "plt")]) (unless (directory-exists? lib-plt-dir) @@ -205,11 +195,7 @@ (copy-shared-lib "mzgc" lib-dir)) (when (or (memq 'racket3m types) (memq 'gracket3m types)) - (copy-shared-lib "racket3m" lib-dir)) - (when (memq 'gracketcgc types) - (copy-shared-lib "gracket" lib-dir)) - (when (memq 'gracket3m types) - (copy-shared-lib "gracket3m" lib-dir))))])) + (copy-shared-lib "racket3m" lib-dir))))])) (define (search-dll dll-dir dll) (if dll-dir @@ -393,35 +379,40 @@ ;; Copy over the extensions for this binary, generating a separate path ;; for each executable (let loop ([exts exts][counter counter]) - (if (null? exts) - (values null counter) - (let* ([src (extract-src (car exts) (car orig-binaries))] - [dest (construct-dest src)] - [sub (format "e~a" counter)]) - (when (and src copy?) - ; Make dest and copy - (make-directory* (build-path exts-dir sub (or (path-only dest) 'same))) - (let ([f (build-path exts-dir sub dest)]) - (when (or (file-exists? f) - (directory-exists? f) - (link-exists? f)) - (delete-directory/files f)) - (copy-directory/files src f))) - ;; Generate the new extension entry for the table, and combine with - ;; recur result for the rest: - (let-values ([(rest-exts counter) - (loop (cdr exts) (inc-counter counter))]) - (values (if src - (cons (transform-entry - (path->bytes - (relative->binary-relative (car sub-dirs) - (car types) - (build-path relative-exts-dir sub dest))) - (car exts)) - rest-exts) - (cons (car exts) - rest-exts)) - counter)))))]) + (cond + [(null? exts) (values null counter)] + [(eq? 'module (cadar (car exts))) + (let-values ([(rest-exts counter) + (loop (cdr exts) counter)]) + (values (cons (car exts) rest-exts) counter))] + [else + (let* ([src (extract-src (car exts) (car orig-binaries))] + [dest (construct-dest src)] + [sub (format "e~a" counter)]) + (when (and src copy?) + ; Make dest and copy + (make-directory* (build-path exts-dir sub (or (path-only dest) 'same))) + (let ([f (build-path exts-dir sub dest)]) + (when (or (file-exists? f) + (directory-exists? f) + (link-exists? f)) + (delete-directory/files f)) + (copy-directory/files src f))) + ;; Generate the new extension entry for the table, and combine with + ;; recur result for the rest: + (let-values ([(rest-exts counter) + (loop (cdr exts) (inc-counter counter))]) + (values (if src + (cons (transform-entry + (path->bytes + (relative->binary-relative (car sub-dirs) + (car types) + (build-path relative-exts-dir sub dest))) + (car exts)) + rest-exts) + (cons (car exts) + rest-exts)) + counter)))]))]) (when copy? ;; Update the binary with the new paths (let* ([str (string->bytes/utf-8 (format "~s" new-exts))] @@ -477,6 +468,7 @@ ;; extract-src: (lambda (rt orig-binary) (and (cadr rt) + (bytes? (cadr rt)) (bytes->path (cadr rt)))) ;; construct-dest: (lambda (src) diff --git a/collects/compiler/embed-unit.rkt b/collects/compiler/embed-unit.rkt index 22f5f2ae76..fb327e833d 100644 --- a/collects/compiler/embed-unit.rkt +++ b/collects/compiler/embed-unit.rkt @@ -300,10 +300,12 @@ ;; Represent modules with lists starting with the filename, so we ;; can use assoc: (define (make-mod normal-file-path normal-module-path - code name prefix full-name relative-mappings runtime-paths + code name prefix full-name relative-mappings + runtime-paths runtime-module-syms actual-file-path) (list normal-file-path normal-module-path code - name prefix full-name relative-mappings runtime-paths + name prefix full-name relative-mappings + runtime-paths runtime-module-syms actual-file-path)) (define (mod-file m) (car m)) @@ -314,7 +316,8 @@ (define (mod-full-name m) (list-ref m 5)) (define (mod-mappings m) (list-ref m 6)) (define (mod-runtime-paths m) (list-ref m 7)) - (define (mod-actual-file m) (list-ref m 8)) + (define (mod-runtime-module-syms m) (list-ref m 8)) + (define (mod-actual-file m) (list-ref m 9)) (define (generate-prefix) (format "#%embedded:~a:" (gensym))) @@ -428,7 +431,7 @@ (cons (make-mod filename module-path code name prefix (string->symbol (format "~a~a" prefix name)) - null null + null null null actual-filename) (unbox codes)))] [code @@ -440,44 +443,54 @@ (apply append (map cdr importss)))] [extra-paths (map symbol-to-lib-form (get-extra-imports actual-filename code))]) - (let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename))) - all-file-imports)] - [sub-paths (map (lambda (i) (collapse-module-path-index i module-path)) - all-file-imports)] - [normalized-extra-paths (map (lambda (i) (collapse-module-path i module-path)) - extra-paths)] - [extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i #f) - filename))) - extra-paths)]) - ;; Get code for imports: - (for-each (lambda (sub-filename sub-path) - (get-code sub-filename - sub-path - codes - prefixes - verbose? - collects-dest - on-extension - compiler - expand-namespace - get-extra-imports)) - (append sub-files extra-files) - (append sub-paths normalized-extra-paths)) - (let ([runtime-paths - (parameterize ([current-namespace expand-namespace]) - (eval code) - (let ([module-path - (if (path? module-path) - (path->complete-path module-path) - module-path)]) - (syntax-case (expand `(,#'module m mzscheme - (require (only ,module-path) - mzlib/runtime-path) - (runtime-paths ,module-path))) (quote) - [(_ m mz (#%mb rfs req (quote (spec ...)))) - (syntax->datum #'(spec ...))] - [_else (error 'create-empbedding-executable - "expansion mismatch when getting external paths")])))]) + (let* ([runtime-paths + (parameterize ([current-namespace expand-namespace]) + (eval code) + (let ([module-path + (if (path? module-path) + (path->complete-path module-path) + module-path)]) + (syntax-case (expand `(,#'module m mzscheme + (require (only ,module-path) + mzlib/runtime-path) + (runtime-paths ,module-path))) (quote) + [(_ m mz (#%mb rfs req (quote (spec ...)))) + (syntax->datum #'(spec ...))] + [_else (error 'create-empbedding-executable + "expansion mismatch when getting external paths")])))] + + [extra-runtime-paths (filter + values + (map (lambda (p) + (and (pair? p) + (eq? (car p) 'module) + (cadr p))) + runtime-paths))]) + (let ([sub-files (map (lambda (i) (normalize (resolve-module-path-index i filename))) + all-file-imports)] + [sub-paths (map (lambda (i) (collapse-module-path-index i module-path)) + all-file-imports)] + [normalized-extra-paths (map (lambda (i) (collapse-module-path i module-path)) + (append extra-runtime-paths extra-paths))] + [extra-files (map (lambda (i) (normalize (resolve-module-path-index (module-path-index-join i #f) + filename))) + ;; getting runtime-module-path symbols below + ;; relies on extra-runtime-paths being first: + (append extra-runtime-paths extra-paths))]) + ;; Get code for imports: + (for-each (lambda (sub-filename sub-path) + (get-code sub-filename + sub-path + codes + prefixes + verbose? + collects-dest + on-extension + compiler + expand-namespace + get-extra-imports)) + (append sub-files extra-files) + (append sub-paths normalized-extra-paths)) (when verbose? (unless (null? runtime-paths) (fprintf (current-error-port) "Runtime paths for ~s: ~s\n" @@ -494,7 +507,8 @@ ;; Record module as copied (set-box! codes (cons (make-mod filename module-path #f - #f #f #f #f null + #f #f #f #f + null null actual-filename) (unbox codes)))) ;; Build up relative module resolutions, relative to this one, @@ -521,6 +535,17 @@ (and p (cdr p))) mappings) runtime-paths + ;; extract runtime-path module symbols: + (let loop ([runtime-paths runtime-paths] + [extra-files extra-files]) + (cond + [(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))) + (loop (cdr runtime-paths) (cdr extra-files)))] + [else + (cons #f (loop (cdr runtime-paths) extra-files))])) actual-filename) (unbox codes)))))))))] [else @@ -906,23 +931,31 @@ (let-values ([(rUnTiMe-paths) ; this is a magic name for exe->distribution process ',(apply append (map (lambda (nc) - (map (lambda (p) + (map (lambda (p sym) (list (cons (mod-full-name nc) (if (path? p) (path->bytes p) - p)) + (if (and (pair? p) + (eq? 'module (car p))) + (list 'module (cadr p)) + p))) (let ([p (cond [(bytes? p) (bytes->path p)] [(and (list? p) (= 2 (length p)) (eq? 'so (car p))) - (let ([f (path-replace-suffix (cadr p) - (system-type 'so-suffix))]) - (ormap (lambda (p) - (let ([p (build-path p f)]) - (and (file-exists? p) - p))) - (get-lib-search-dirs)))] + (let ([fs (list + (cadr p) + (path-replace-suffix (cadr p) + (system-type 'so-suffix)))]) + (ormap (lambda (f) + (ormap (lambda (p) + (let ([p (build-path p f)]) + (and (or (file-exists? p) + (directory-exists? p)) + p))) + (get-lib-search-dirs))) + fs))] [(and (list? p) (eq? 'lib (car p))) (let ([p (if (null? (cddr p)) @@ -940,16 +973,22 @@ (if (null? (cddr p)) (list "mzlib") (cddr p)))))] + [(and (list? p) + (eq? 'module (car p))) + sym] [else p])]) (and p - (path->bytes - (if (absolute-path? p) - p - (build-path (path-only (mod-file nc)) p))))) + (if (symbol? p) + p + (path->bytes + (if (absolute-path? p) + p + (build-path (path-only (mod-file nc)) p)))))) ;; As for the extension table, a placeholder to save ;; room likely needed by the distribution-mangler (bytes-append #"................." (path->bytes program-name)))) - (mod-runtime-paths nc))) + (mod-runtime-paths nc) + (mod-runtime-module-syms nc))) runtimes))]) rUnTiMe-paths)))) outp)) diff --git a/collects/mred/private/wx/cocoa/tab-panel.rkt b/collects/mred/private/wx/cocoa/tab-panel.rkt index 68e29eab04..dec99d7c88 100644 --- a/collects/mred/private/wx/cocoa/tab-panel.rkt +++ b/collects/mred/private/wx/cocoa/tab-panel.rkt @@ -1,21 +1,24 @@ -#lang scheme/base -(require scheme/class - scheme/foreign - ffi/objc - "../../syntax.rkt" - "types.rkt" - "utils.rkt" - "window.rkt" - "panel.rkt" - "../common/event.rkt" - "../common/procs.rkt") -(unsafe!) -(objc-unsafe!) +#lang racket/base +(require racket/class + ffi/unsafe + ffi/unsafe/objc + racket/runtime-path + "../../syntax.rkt" + "types.rkt" + "utils.rkt" + "window.rkt" + "panel.rkt" + "../common/event.rkt" + "../common/procs.rkt" + (for-syntax racket/base)) (provide tab-panel%) +(define-runtime-path psm-tab-bar-dir + '(so "PSMTabBarControl.framework")) + ;; Load PSMTabBarControl: -(void (ffi-lib "PSMTabBarControl.framework/PSMTabBarControl")) +(void (ffi-lib (build-path psm-tab-bar-dir "PSMTabBarControl"))) (define NSNoTabsNoBorder 6) (import-class NSView NSTabView NSTabViewItem PSMTabBarControl) diff --git a/collects/mred/private/wx/platform.rkt b/collects/mred/private/wx/platform.rkt index 448aa92c91..735172bdaf 100644 --- a/collects/mred/private/wx/platform.rkt +++ b/collects/mred/private/wx/platform.rkt @@ -2,7 +2,7 @@ (require scheme/runtime-path (for-syntax scheme/base)) (provide (all-defined-out)) -(define-runtime-path platform-lib +(define-runtime-module-path platform-lib (let ([gtk-lib '(lib "mred/private/wx/gtk/platform.rkt")]) (case (system-type) diff --git a/collects/mzlib/runtime-path.rkt b/collects/mzlib/runtime-path.rkt index a8c2891272..2be5f33fe6 100644 --- a/collects/mzlib/runtime-path.rkt +++ b/collects/mzlib/runtime-path.rkt @@ -11,24 +11,23 @@ (provide define-runtime-path define-runtime-paths define-runtime-path-list + define-runtime-module-path runtime-paths) (define-for-syntax ext-file-table (make-hasheq)) - (define (lookup-in-table tag-stx p) + (define (lookup-in-table var-ref p) ;; This function is designed to cooperate with a table embedded ;; in an executable by create-embedding-executable. - (let ([mpi (syntax-source-module tag-stx)]) + (let ([modname (variable-reference->resolved-module-path var-ref)]) (let ([p (hash-ref table - (cons (cond - [(module-path-index? mpi) - (resolved-module-path-name (module-path-index-resolve mpi))] - [(symbol? mpi) mpi] - [else #f]) + (cons (resolved-module-path-name modname) (if (path? p) (path->bytes p) - p)) + (if (and (pair? p) (eq? 'module (car p))) + (list 'module (cadr p)) + p))) #f)]) (and p (car p) @@ -36,11 +35,13 @@ [p (if (bytes? p) (bytes->path p) p)]) - (if (absolute-path? p) - p - (parameterize ([current-directory (find-system-path 'orig-dir)]) - (or (find-executable-path (find-system-path 'exec-file) p #t) - (build-path (current-directory) p))))))))) + (if (symbol? p) + (module-path-index-join (list 'quote p) #f) ; make it a module path index + (if (absolute-path? p) + p + (parameterize ([current-directory (find-system-path 'orig-dir)]) + (or (find-executable-path (find-system-path 'exec-file) p #t) + (build-path (current-directory) p)))))))))) (define (resolve-paths tag-stx get-base paths) (let ([base #f]) @@ -85,18 +86,24 @@ (null? (cdr strs))) (list "mzlib") (append (cddr p) (drop-right strs 1)))))] + [(and (list? p) + ((length p) . = . 3) + (eq? 'module (car p)) + (or (not (caddr p)) + (variable-reference? (caddr p)))) + (let ([p (cadr p)] + [vr (caddr p)]) + (unless (module-path? p) + (error 'runtime-path "not a module path: ~.s" p)) + (module-path-index-join p (and vr + (variable-reference->resolved-module-path vr))))] [else (error 'runtime-path "unknown form: ~.s" p)]))) paths))) - (define-for-syntax (register-ext-files tag-stx paths) - (let ([mpi (syntax-source-module tag-stx)]) - (let ([modname (cond - [(module-path-index? mpi) (module-path-index-resolve mpi)] - [(symbol? mpi) mpi] - [else (error 'register-ext-files - "cannot determine source")])]) - (let ([files (hash-ref ext-file-table modname null)]) - (hash-set! ext-file-table modname (append paths files)))))) + (define-for-syntax (register-ext-files var-ref paths) + (let ([modname (variable-reference->resolved-module-path var-ref)]) + (let ([files (hash-ref ext-file-table modname null)]) + (hash-set! ext-file-table modname (append paths files))))) (define-syntax (-define-runtime-path stx) (syntax-case stx () @@ -111,23 +118,22 @@ #'orig-stx id))) ids) - (let ([tag (datum->syntax #'orig-stx 'tag #'orig-stx)]) - #`(begin - (define-values (id ...) - (let-values ([(id ...) expr]) - (let ([get-dir (lambda () - #,(datum->syntax - tag - `(,#'this-expression-source-directory) - tag))]) - (apply to-values (resolve-paths (quote-syntax #,tag) - get-dir - (to-list id ...)))))) - (begin-for-syntax - (register-ext-files - (quote-syntax #,tag) - (let-values ([(id ...) expr]) - (to-list id ...)))))))])) + #`(begin + (define-values (id ...) + (let-values ([(id ...) expr]) + (let ([get-dir (lambda () + #,(datum->syntax + #'orig-stx + `(,#'this-expression-source-directory) + #'orig-stx))]) + (apply to-values (resolve-paths (#%variable-reference) + get-dir + (to-list id ...)))))) + (begin-for-syntax + (register-ext-files + (#%variable-reference) + (let-values ([(id ...) expr]) + (to-list id ...))))))])) (define-syntax (define-runtime-path stx) (syntax-case stx () @@ -141,6 +147,10 @@ (syntax-case stx () [(_ id expr) #`(-define-runtime-path #,stx (id) expr values list)])) + (define-syntax (define-runtime-module-path stx) + (syntax-case stx () + [(_ id expr) #`(-define-runtime-path #,stx (id) `(module ,expr ,(#%variable-reference)) list values)])) + (define-syntax (runtime-paths stx) (syntax-case stx () [(_ mp) diff --git a/collects/racket/draw/cairo.rkt b/collects/racket/draw/cairo.rkt index 3b0e7e4907..3a8f4116ce 100644 --- a/collects/racket/draw/cairo.rkt +++ b/collects/racket/draw/cairo.rkt @@ -3,19 +3,22 @@ ffi/unsafe/define ffi/unsafe/alloc setup/dirs + "libs.rkt" "utils.rkt") -(define cairo-lib - (case (system-type) - [(macosx) (ffi-lib "libcairo.2")] - [(unix) (ffi-lib "libcairo" '("2"))] - [(windows) - (ffi-lib "zlib1") - (ffi-lib "libpng14-14") - (ffi-lib "libexpat-1") - (ffi-lib "freetype6") - (ffi-lib "libfontconfig-1") - (ffi-lib "libcairo-2")])) +(define-runtime-lib cairo-lib + [(unix) (ffi-lib "libcairo" '("2"))] + [(macosx) + (ffi-lib "libpixman-1.0.dylib") + (ffi-lib "libpng14.14.dylib") + (ffi-lib "libcairo.2.dylib")] + [(windows) + (ffi-lib "zlib1") + (ffi-lib "libpng14-14") + (ffi-lib "libexpat-1") + (ffi-lib "freetype6") + (ffi-lib "libfontconfig-1") + (ffi-lib "libcairo-2")]) (define-ffi-definer define-cairo cairo-lib #:provide provide-protected) diff --git a/collects/racket/draw/gif.rkt b/collects/racket/draw/gif.rkt index c1b932f2b9..53213eafc0 100644 --- a/collects/racket/draw/gif.rkt +++ b/collects/racket/draw/gif.rkt @@ -1,4 +1,4 @@ -#lang scheme +#lang racket/base (require "lzw.rkt") ;; FIXME: still need to handle transparency diff --git a/collects/racket/draw/jpeg.rkt b/collects/racket/draw/jpeg.rkt index a5ad1eecf0..42d16b49a8 100644 --- a/collects/racket/draw/jpeg.rkt +++ b/collects/racket/draw/jpeg.rkt @@ -5,13 +5,13 @@ ffi/unsafe/atomic setup/dirs "bstr.rkt" - "utils.rkt") + "utils.rkt" + "libs.rkt") -(define jpeg-lib - (case (system-type) - [(macosx) (ffi-lib "libjpeg.62")] - [(unix) (ffi-lib "libjpeg" '("62" ""))] - [(windows) (ffi-lib "libjpeg-7.dll")])) +(define-runtime-lib jpeg-lib + [(unix) (ffi-lib "libjpeg" '("62" ""))] + [(macosx) (ffi-lib "libjpeg.62.dylib")] + [(windows) (ffi-lib "libjpeg-7.dll")]) (define JPEG_LIB_VERSION (case (system-type) diff --git a/collects/racket/draw/libs.rkt b/collects/racket/draw/libs.rkt new file mode 100644 index 0000000000..efb0b268a3 --- /dev/null +++ b/collects/racket/draw/libs.rkt @@ -0,0 +1,27 @@ +#lang scheme/base +(require ffi/unsafe + racket/runtime-path + (for-syntax racket/base)) + +(provide define-runtime-lib) + +(define-syntax define-runtime-lib + (syntax-rules (macosx unix windows ffi-lib) + [(_ lib-id + [(unix) unix-lib] + [(macosx) (ffi-lib mac-lib) ...] + [(windows) (ffi-lib windows-lib) ...]) + (begin + (define-runtime-path-list libs + (case (system-type) + [(macosx) '((so mac-lib) ...)] + [(unix) null] + [(windows) `((so windows-lib) ...)])) + + (define lib-id + (if (null? libs) + unix-lib + (for/fold ([v #f]) ([lib (in-list libs)]) + (ffi-lib lib)))))])) + + diff --git a/collects/racket/draw/pango.rkt b/collects/racket/draw/pango.rkt index 178613171b..454ca867b0 100644 --- a/collects/racket/draw/pango.rkt +++ b/collects/racket/draw/pango.rkt @@ -5,43 +5,45 @@ ffi/unsafe/atomic setup/dirs "cairo.rkt" - "utils.rkt") + "utils.rkt" + "libs.rkt") -(define pango-lib - (case (system-type) - [(macosx) - (ffi-lib "libpango-1.0.0")] - [(unix) (ffi-lib "libpango-1.0" '("0"))] - [(windows) - (ffi-lib "libglib-2.0-0") - (ffi-lib "libgmodule-2.0-0") - (ffi-lib "libgobject-2.0-0") - (ffi-lib "libpango-1.0-0")])) +(define-runtime-lib pango-lib + [(unix) (ffi-lib "libpango-1.0" '("0"))] + [(macosx) + (ffi-lib "libglib-2.0.0.dylib") + (ffi-lib "libgmodule-2.0.0.dylib") + (ffi-lib "libgobject-2.0.0.dylib") + (ffi-lib "libintl.8.dylib") + (ffi-lib "libpango-1.0.0.dylib")] + [(windows) + (ffi-lib "libglib-2.0-0") + (ffi-lib "libgmodule-2.0-0") + (ffi-lib "libgobject-2.0-0") + (ffi-lib "libpango-1.0-0")]) -(define pangowin32-lib - (case (system-type) - [(windows) - (ffi-lib "libpangowin32-1.0-0")] - [else #f])) +(define-runtime-lib pangowin32-lib + [(unix) #f] + [(macosx)] + [(windows) + (ffi-lib "libpangowin32-1.0-0")]) -(define pangocairo-lib - (case (system-type) - [(macosx) - (ffi-lib "libpangocairo-1.0.0")] - [(unix) (ffi-lib "libpangocairo-1.0" '("0"))] - [(windows) - (ffi-lib "libpangowin32-1.0-0") - (ffi-lib "libexpat-1") - (ffi-lib "freetype6") - (ffi-lib "libfontconfig-1") - (ffi-lib "libpangoft2-1.0-0") - (ffi-lib "libpangocairo-1.0-0")])) +(define-runtime-lib pangocairo-lib + [(unix) (ffi-lib "libpangocairo-1.0" '("0"))] + [(macosx) + (ffi-lib "libpangocairo-1.0.0.dylib")] + [(windows) + (ffi-lib "libpangowin32-1.0-0") + (ffi-lib "libexpat-1") + (ffi-lib "freetype6") + (ffi-lib "libfontconfig-1") + (ffi-lib "libpangoft2-1.0-0") + (ffi-lib "libpangocairo-1.0-0")]) -(define glib-lib - (case (system-type) - [(macosx) (ffi-lib "libgobject-2.0.0")] - [(unix) (ffi-lib "libgobject-2.0" '("0"))] - [else #f])) +(define-runtime-lib glib-lib + [(unix) (ffi-lib "libgobject-2.0" '("0"))] + [(macosx) (ffi-lib "libgobject-2.0.0")] + [(windows) (ffi-lib "libgobject-2.0-0")]) (define-ffi-definer define-pango pango-lib #:provide provide) diff --git a/collects/racket/draw/png.rkt b/collects/racket/draw/png.rkt index 2849867a31..eee5a03a04 100644 --- a/collects/racket/draw/png.rkt +++ b/collects/racket/draw/png.rkt @@ -5,19 +5,19 @@ ffi/unsafe/atomic setup/dirs "bstr.rkt" - "utils.rkt") + "utils.rkt" + "libs.rkt") -(define png-lib - (case (system-type) - [(macosx) (ffi-lib "libpng14" '("14" #f))] - [(unix) - (case (string->symbol (path->string (system-library-subpath #f))) - [(i386-freebsd) (ffi-lib "libpng")] - [else - (ffi-lib "libpng12" '("0" ""))])] - [(windows) - (ffi-lib "zlib1.dll") - (ffi-lib "libpng14-14.dll")])) +(define-runtime-lib png-lib + [(unix) + (case (string->symbol (path->string (system-library-subpath #f))) + [(i386-freebsd) (ffi-lib "libpng")] + [else + (ffi-lib "libpng12" '("0" ""))])] + [(macosx) (ffi-lib "libpng14.14.dylib")] + [(windows) + (ffi-lib "zlib1.dll") + (ffi-lib "libpng14-14.dll")]) (define-ffi-definer define-png png-lib #:provide provide) diff --git a/collects/racket/runtime-path.rkt b/collects/racket/runtime-path.rkt index 5142d32309..eeda4ffb62 100644 --- a/collects/racket/runtime-path.rkt +++ b/collects/racket/runtime-path.rkt @@ -3,32 +3,4 @@ (require mzlib/runtime-path) (provide (all-from-out mzlib/runtime-path) - (for-syntax #%datum) - define-runtime-module-path) - -(define-syntax (define-runtime-module-path stx) - (syntax-case stx () - [(_ id mod-path) - (begin - (unless (memq (syntax-local-context) '(top-level module module-begin)) - (raise-syntax-error #f - "allowed only in a module top-level or top-level context" - stx)) - (unless (identifier? #'id) - (raise-syntax-error #f - "expected an identifier to bind" - stx - #'id)) - (unless (module-path? (syntax->datum #'mod-path)) - (raise-syntax-error #f - "expected a literal module path" - stx - #'mod-path)) - #`(begin - (require (only-in (for-label mod-path))) - (define id (combine-module-path (#%variable-reference) 'mod-path))))])) - -(define (combine-module-path vr mod-path) - (module-path-index-resolve (module-path-index-join - mod-path - (variable-reference->resolved-module-path vr)))) + (for-syntax #%datum)) diff --git a/collects/scribblings/reference/filesystem.scrbl b/collects/scribblings/reference/filesystem.scrbl index 096fc7daf0..36622fa720 100644 --- a/collects/scribblings/reference/filesystem.scrbl +++ b/collects/scribblings/reference/filesystem.scrbl @@ -447,6 +447,15 @@ Racket-specific shared-object library directories (as determined by libraries that are installed specifically for Racket get carried along in distributions. +If @racket[expr] produces a list of the form @racket[(list 'module +_module-path _var-ref)], the value bound to @racket[id] is a +@tech{module path index}, where @racket[_module-path] is treated as +relative (if it is relative) to the module that is the home of the +@tech{variable reference} @racket[_var-ref], where @racket[_var-ref] +can be @racket[#f] if @racket[_module-path] is absolute. In an +executable, the corresponding module is carried along, including all +of its dependencies. + For compile-time, the @racket[expr] result is used by an executable creator---but not the result when the containing module is compiled. Instead, @racket[expr] is preserved in the module as a @@ -544,23 +553,13 @@ list of paths.} @defform[(define-runtime-module-path id module-path)]{ Similar to @racket[define-runtime-path], but @racket[id] is bound to a -@tech{resolved module path}. The @tech{resolved module path} for -@racket[id] corresponds to @racket[module-path] (with the same syntax -as a module path for @racket[require]), which can be relative to the -enclosing module. +@tech{module path index} that encapsulates @racket[module-path] +relative to the enclosing module. Use @racket[define-runtime-module-path] to bind a module path that is passed to a reflective function like @racket[dynamic-require] while also creating a module dependency for building and distributing -executables. - -The @racket[define-runtime-module-path] form creates a -@racket[for-label] dependency from an enclosing module to -@racket[module-path]. Since the dependency is merely -@racket[for-label], @racket[module-path] is not @tech{instantiate}d or -@tech{visit}ed when the enclosing module is @tech{instantiate}d or -@tech{visit}ed (unless such a dependency is created by other -@racket[require]s).} +executables.} @defform[(runtime-paths module-path)]{