Provide library lists out of "get-libs.rkt" and make it possible to require it

without doing anything, use this in the distribution specs to include them.
This commit is contained in:
Eli Barzilay 2010-11-10 20:57:38 -05:00
parent 6a997be578
commit d58395cd0b
3 changed files with 24 additions and 9 deletions

View File

@ -4,6 +4,7 @@
#lang racket/base
(require racket/cmdline racket/runtime-path racket/match racket/promise
racket/list ; for use in specs too
racket/file (only-in racket/system system)
(except-in racket/mpair mappend)
meta/checker (prefix-in dist: meta/dist-specs) meta/specs)

View File

@ -313,6 +313,18 @@ package: :=
(notes: ,p/) (man: ,p) (tests: ,p/)
,@(if (getkey '#:src?) `((src: ,p/ ,(concat "worksp/" p/))) '()))))
;; Utility for pulling out the names of libraries
get-libs: :=
(lambda (p)
(let* ([xs (parameterize ([current-command-line-arguments
'#("--no-op" "" "" "")])
(dynamic-require (build-path racket/ "src" "get-libs.rkt")
'all-files+sizes))]
[xs (or (assq p xs) (error 'get-libs "unknown package, ~s" p))]
[xs (append-map cdr (cdr xs))]
[xs (remove-duplicates (map car xs))])
`(lib: ,@xs)))
;; ============================================================================
;; Base distribution specs
@ -396,17 +408,16 @@ foreign-src := (src: "foreign/{Makefile.in|README}"
;; queries have no point elsewhere.)
mz-bins := (lib: "buildinfo" "**/mzdyn{|w}{|3[mM]|cgc|CGC}.{o|obj|exp|def}")
(get-libs: core)
(cond mac => (lib: "Racket*/")
win => (dll: "lib{mzgc|racket}" "UnicoWS" "iconv")
win => (dll: "lib{mzgc|racket}")
(lib: "gcc/{fixup|init}.o" "bcc/mzdynb.{obj|def}")
unix => (lib: "starter"))
extra-dynlibs
mr-bins := (cond mac => (lib: "GRacket*/")
mr-bins := (get-libs: gui)
(cond mac => (lib: "GRacket*/")
win => (dll: "libgracket"))
extra-dynlibs := (cond win => (dll: "{ssl|lib}eay32"))
;; ============================================================================
;; This filter is used on the full compiled trees to get the binary
;; (platform-dependent) portion out.

View File

@ -12,6 +12,7 @@
(define url-path "/libs/1/")
(define url-base (string-append "http://" url-host url-path))
(provide all-files+sizes)
(define all-files+sizes
`(;; Core Libraries
[core
@ -96,6 +97,7 @@
#:once-any
[("--download") "download mode (the default)" (set! mode 'download)]
[("--install") "install mode" (set! mode 'install)]
[("--no-op") "do nothing (for internal use)" (set! mode #f)]
#:once-each
[("--touch") file "touch `<file>' on download success" (set! touch file)]
#:args [package src-dir dest-dir]
@ -107,7 +109,7 @@
(string-append (unixize base) "/" (path->string name))
(path->string name))))
(define needed-files+sizes
(define (needed-files+sizes)
(let* ([files+sizes
(cdr (or (assq package all-files+sizes)
(error 'get-libs "bad package: ~s, expecting one of ~s"
@ -195,16 +197,17 @@
(subprocess-wait p)))
(case mode
[(#f) (void)]
[(download)
(unless (directory-exists? dest-dir) (make-directory dest-dir))
(for ([file+size (in-list needed-files+sizes)])
(for ([file+size (in-list (needed-files+sizes))])
(download-if-needed dest-dir (car file+size) (cadr file+size)))
(when touch
(define ok (build-path dest-dir touch))
(when (file-exists? ok) (delete-file ok))
(unless (file-exists? ok) (with-output-to-file ok void)))]
[(install)
(for ([file+size (in-list needed-files+sizes)])
(for ([file+size (in-list (needed-files+sizes))])
(define file (car file+size))
(install-file (build-path src-dir "libs" file)
(build-path dest-dir file)))])