494 lines
27 KiB
Text
494 lines
27 KiB
Text
|
(define-library (zilch lang rust resolver)
|
||
|
|
(import
|
||
|
|
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
|
||
|
|
(zilch file) (zilch magic) (zilch nix drv) (zilch nix path) (scheme char)
|
||
|
|
(zilch nixpkgs) (zilch zexpr) (zilch semver)
|
||
|
|
json
|
||
|
|
(chicken process)
|
||
|
|
(chicken base) (chicken format)
|
||
|
|
(chicken foreign)
|
||
|
|
(srfi 4) (srfi 128) (srfi 146) (srfi 152) (srfi 207)
|
||
|
|
(zilch lang rust registry) (zilch lang rust) (zilch lang rust cargo) (zilch lang rust build-script)
|
||
|
|
(zilch lang go vfs))
|
||
|
|
|
||
|
|
(export
|
||
|
|
<resolver> make-resolver resolver? resolver-locked-dependencies resolver-selected-dependencies
|
||
|
|
<resolved-package-build-data> make-resolved-package-build-data resolved-package-build-data?
|
||
|
|
resolved-package-build-data-dep-info resolved-package-build-data-metadata resolved-package-build-data-rlib
|
||
|
|
resolved-package-build-data-transitive-dependencies
|
||
|
|
|
||
|
|
<resolved-package> make-resolved-package resolved-package?
|
||
|
|
resolved-package-name resolved-package-version resolved-package-fs
|
||
|
|
resolved-package-cargo-target resolved-package-enabled-features resolved-package-dependencies
|
||
|
|
resolved-package-build-data
|
||
|
|
|
||
|
|
resolver-download
|
||
|
|
resolver-resolve-nonoptional
|
||
|
|
resolver-resolve-resolved-package
|
||
|
|
resolver-activate-features
|
||
|
|
resolver-register
|
||
|
|
resolver-resolve
|
||
|
|
resolver-print-pkg
|
||
|
|
resolver-print
|
||
|
|
process-cargo-with-lockfile
|
||
|
|
build-package)
|
||
|
|
|
||
|
|
(begin
|
||
|
|
(define gcc (delay (cdr (assoc "out" (nixpkgs "gcc")))))
|
||
|
|
(define linker (delay #~,(string-append #$(force gcc) "/bin/cc")))
|
||
|
|
|
||
|
|
(define pkgconfig (delay (cdr (assoc "out" (nixpkgs "pkg-config")))))
|
||
|
|
(define openssl (delay (let ((data (nixpkgs "openssl"))) #~,(begin #$(cdr (assoc "out" data)) #$(cdr (assoc "dev" data))))))
|
||
|
|
|
||
|
|
(define (build-script-env-overrides-for-crate crate-name)
|
||
|
|
(cond
|
||
|
|
((string=? crate-name "openssl-sys")
|
||
|
|
#~(("PATH" . ,(string-append #$(force pkgconfig) "/bin:" #$(force gcc) "/bin")) ("PKG_CONFIG_PATH" . ,(string-append #$(force openssl) "/lib/pkgconfig"))))
|
||
|
|
(else '())))
|
||
|
|
|
||
|
|
|
||
|
|
; Used to select a set of crates plus their versions.
|
||
|
|
(define-record-type <resolver>
|
||
|
|
; locked-dependencies is a mapping of package-name to a mapping of version to (version . (lockfile-entry . unpack-promise))
|
||
|
|
; selected-dependencies is a mapping of package-name to a list of (version . resolved-package)(?)
|
||
|
|
(make-resolver locked-dependencies selected-dependencies)
|
||
|
|
resolver?
|
||
|
|
(locked-dependencies resolver-locked-dependencies set-resolver-locked-dependencies!)
|
||
|
|
(selected-dependencies resolver-selected-dependencies set-resolver-selected-dependencies!))
|
||
|
|
|
||
|
|
(define-record-type <resolved-package-build-data>
|
||
|
|
(make-resolved-package-build-data dep-info metadata rlib transitive-dependencies build-script-metadata bin-flags)
|
||
|
|
resolved-package-build-data?
|
||
|
|
(dep-info resolved-package-build-data-dep-info set-resolved-package-build-data-dep-info!)
|
||
|
|
(metadata resolved-package-build-data-metadata set-resolved-package-build-data-metadata!)
|
||
|
|
(rlib resolved-package-build-data-rlib set-resolved-package-build-data-rlib!)
|
||
|
|
(transitive-dependencies resolved-package-build-data-transitive-dependencies set-resolved-package-build-data-transitive-dependencies!)
|
||
|
|
(build-script-metadata resolved-package-build-data-build-script-metadata)
|
||
|
|
(bin-flags resolved-package-build-data-bin-flags))
|
||
|
|
|
||
|
|
(define-record-type <resolved-package>
|
||
|
|
(make-resolved-package name version fs cargo-target target-dependencies crate enabled-features dependencies build-data build-script)
|
||
|
|
resolved-package?
|
||
|
|
(name resolved-package-name)
|
||
|
|
(version resolved-package-version)
|
||
|
|
(fs resolved-package-fs)
|
||
|
|
(cargo-target resolved-package-cargo-target)
|
||
|
|
(target-dependencies resolved-package-target-dependencies)
|
||
|
|
(crate resolved-package-crate)
|
||
|
|
(enabled-features resolved-package-enabled-features set-resolved-package-enabled-features!)
|
||
|
|
(dependencies resolved-package-dependencies set-resolved-package-dependencies!)
|
||
|
|
(build-data resolved-package-build-data set-resolved-package-build-data!)
|
||
|
|
(build-script resolved-package-build-script set-resolved-package-build-script!))
|
||
|
|
|
||
|
|
;; Download and activate a dependency from the registry.
|
||
|
|
(define (resolver-download resolver name version)
|
||
|
|
(define vfs (force (cddr (mapping-ref (mapping-ref (resolver-locked-dependencies resolver) name) (version-str version)))))
|
||
|
|
(define parsed-cargo (parse-cargo-toml vfs (call-with-port (store-path-open #~,(string-append #$vfs "/Cargo.toml")) (lambda (p) (read-string 99999999 p)))))
|
||
|
|
(unless (cargo-crate-lib-target parsed-cargo)
|
||
|
|
(error "Crate does not have valid [lib] target" (list name version)))
|
||
|
|
|
||
|
|
(define build-script #f)
|
||
|
|
(when (cargo-crate-build-script parsed-cargo)
|
||
|
|
(set! build-script (make-resolved-package (string-append name "_build") version vfs (cargo-crate-build-script parsed-cargo) (cargo-crate-build-dependencies parsed-cargo) parsed-cargo '() (mapping (make-default-comparator)) #f #f))
|
||
|
|
(resolver-resolve-nonoptional resolver build-script))
|
||
|
|
|
||
|
|
(define pkg (make-resolved-package (string-copy name) version vfs (cargo-crate-lib-target parsed-cargo) (cargo-crate-dependencies parsed-cargo) parsed-cargo '() (mapping (make-default-comparator)) #f build-script))
|
||
|
|
|
||
|
|
; Add package to the mapping.
|
||
|
|
(define existing-mapping (mapping-ref/default (resolver-selected-dependencies resolver) name '()))
|
||
|
|
(set-resolver-selected-dependencies! resolver (mapping-set (resolver-selected-dependencies resolver) name (cons (cons version pkg) existing-mapping)))
|
||
|
|
(resolver-resolve-nonoptional resolver pkg)
|
||
|
|
pkg)
|
||
|
|
|
||
|
|
;; Preemptively resolve and activate all dependencies not marked optional.
|
||
|
|
(define (resolver-resolve-nonoptional resolver pkg)
|
||
|
|
(for-each
|
||
|
|
(lambda (dep)
|
||
|
|
(unless (cargo-dependency-optional dep)
|
||
|
|
(resolver-resolve-resolved-package resolver pkg (cargo-dependency-name dep) #t)))
|
||
|
|
(resolved-package-target-dependencies pkg)))
|
||
|
|
|
||
|
|
|
||
|
|
;; Resolve a name of a dependency of a <resolved-package>, activating it if `activate` is #t.
|
||
|
|
(define (resolver-resolve-resolved-package resolver pkg name activate)
|
||
|
|
(define resolved-dep (mapping-ref/default (resolved-package-dependencies pkg) name #f))
|
||
|
|
(define cargo-dep
|
||
|
|
(do
|
||
|
|
((l (resolved-package-target-dependencies pkg) (cdr l)))
|
||
|
|
((or (eq? l '()) (string=? (cargo-dependency-name (car l)) name)) (and (pair? l) (car l)))))
|
||
|
|
; TODO(puck): Somehow this is okay? there might be more complex guarantees involved here? WAS: (error "Could not find dependency" (list (resolved-package-name pkg) (resolved-package-version pkg) name))))
|
||
|
|
(when (and activate cargo-dep (not resolved-dep))
|
||
|
|
(set! resolved-dep (resolver-resolve resolver cargo-dep))
|
||
|
|
(set-resolved-package-dependencies! pkg (mapping-set! (resolved-package-dependencies pkg) name resolved-dep))
|
||
|
|
(when (cargo-dependency-default-features cargo-dep) (resolver-activate-features resolver resolved-dep '("default")))
|
||
|
|
(when (cargo-dependency-features cargo-dep) (resolver-activate-features resolver resolved-dep (cargo-dependency-features cargo-dep))))
|
||
|
|
resolved-dep)
|
||
|
|
|
||
|
|
;; Activate a series of features on an existing <resolved-package>. This will resolve and activate optional dependencies
|
||
|
|
;; where needed.
|
||
|
|
(define (resolver-activate-features resolver resolved to-activate)
|
||
|
|
(for-each
|
||
|
|
(lambda (feature)
|
||
|
|
(unless (member feature (resolved-package-enabled-features resolved))
|
||
|
|
; Activate the feature.
|
||
|
|
(set-resolved-package-enabled-features! resolved (cons feature (resolved-package-enabled-features resolved)))
|
||
|
|
(when (resolved-package-build-script resolved)
|
||
|
|
(set-resolved-package-enabled-features! (resolved-package-build-script resolved) (cons feature (resolved-package-enabled-features (resolved-package-build-script resolved)))))
|
||
|
|
|
||
|
|
; Follow each activation of the feature.
|
||
|
|
(for-each
|
||
|
|
(lambda (activation)
|
||
|
|
; TODO: if dep isn't activated and has optional dep, track it!
|
||
|
|
(let ((involved-dep (and (car activation) (resolver-resolve-resolved-package resolver resolved (car activation) (cadr activation)))))
|
||
|
|
(when (and (cddr activation) involved-dep) (resolver-activate-features resolver involved-dep (list (cddr activation))))
|
||
|
|
(when (and (not (car activation)) (cddr activation)) (resolver-activate-features resolver resolved (list (cddr activation))))))
|
||
|
|
(cdr (or (assoc feature (cargo-crate-features (resolved-package-crate resolved))) (cons '() '()))))))
|
||
|
|
to-activate))
|
||
|
|
|
||
|
|
;; Register a non-registry crate+vfs with the resolver.
|
||
|
|
(define (resolver-register resolver vfs crate)
|
||
|
|
(define target (cargo-crate-lib-target crate))
|
||
|
|
(unless target
|
||
|
|
(set! target (car (cargo-crate-targets crate))))
|
||
|
|
(define build-script #f)
|
||
|
|
(when (cargo-crate-build-script crate)
|
||
|
|
(set! build-script (make-resolved-package (string-append (cargo-target-name target) "_build") (parse-version (cargo-crate-version crate)) vfs (cargo-crate-build-script crate) (cargo-crate-build-dependencies crate) crate '() (mapping (make-default-comparator)) #f #f))
|
||
|
|
(resolver-resolve-nonoptional resolver build-script))
|
||
|
|
(define pkg (make-resolved-package (cargo-target-name target) (parse-version (cargo-crate-version crate)) vfs target (cargo-crate-dependencies crate) crate '() (mapping (make-default-comparator)) #f build-script))
|
||
|
|
(define existing-mapping (mapping-ref/default (resolver-selected-dependencies resolver) (cargo-target-name target) '()))
|
||
|
|
(set-resolver-selected-dependencies! resolver (mapping-set (resolver-selected-dependencies resolver) (cargo-target-name target) (cons (cons (parse-version (cargo-crate-version crate)) pkg) existing-mapping)))
|
||
|
|
(resolver-resolve-nonoptional resolver pkg)
|
||
|
|
pkg)
|
||
|
|
|
||
|
|
;; Resolves a <cargo-dependency>, returning the <resolved-package>.
|
||
|
|
(define (resolver-resolve resolver dep)
|
||
|
|
(define package-name (cargo-dependency-package dep))
|
||
|
|
(define requirements (apply append (map parse-version-requirement (string-split (cargo-dependency-version dep) "," 'strict-infix))))
|
||
|
|
(define existing-mapping (mapping-ref/default (resolver-selected-dependencies resolver) package-name '()))
|
||
|
|
(define available-versions (mapping-ref (resolver-locked-dependencies resolver) package-name))
|
||
|
|
(define (find-matching-version l best-version)
|
||
|
|
(cond
|
||
|
|
((eq? l '()) best-version)
|
||
|
|
((matches-requirements (caar l) requirements)
|
||
|
|
(find-matching-version (cdr l) (if (and best-version (version<? (caar l) (car best-version))) best-version (car l))))
|
||
|
|
(else (find-matching-version (cdr l) best-version))))
|
||
|
|
(define matching-version (find-matching-version existing-mapping #f))
|
||
|
|
(if matching-version
|
||
|
|
(cdr matching-version)
|
||
|
|
(let* ((best-version (mapping-fold/reverse (lambda (k v acc) (if (or acc (not (matches-requirements (car v) requirements))) acc (car v))) #f available-versions))
|
||
|
|
(resolved (resolver-download resolver package-name best-version)))
|
||
|
|
(when (cargo-dependency-default-features dep)
|
||
|
|
(resolver-activate-features resolver resolved '("default")))
|
||
|
|
(when (cargo-dependency-features dep)
|
||
|
|
(resolver-activate-features resolver resolved (cargo-dependency-features dep)))
|
||
|
|
resolved)))
|
||
|
|
|
||
|
|
(define (resolver-print-pkg resolver pkg)
|
||
|
|
(printf " - version: ~S\n" (resolved-package-version pkg))
|
||
|
|
(printf " features: ~S\n" (resolved-package-enabled-features pkg))
|
||
|
|
(printf " dependencies:\n")
|
||
|
|
(for-each
|
||
|
|
(lambda (dep)
|
||
|
|
(define found-dep (mapping-ref/default (resolved-package-dependencies pkg) (cargo-dependency-name dep) #f))
|
||
|
|
(printf " - ~A: ~A ~A" (cargo-dependency-name dep) (cargo-dependency-package dep) (cargo-dependency-version dep))
|
||
|
|
(if found-dep
|
||
|
|
(printf " (activated! ~A)\n" (resolved-package-version found-dep))
|
||
|
|
(printf "\n")))
|
||
|
|
(resolved-package-target-dependencies pkg)))
|
||
|
|
|
||
|
|
(define (resolver-print resolver)
|
||
|
|
(mapping-for-each
|
||
|
|
(lambda (k v)
|
||
|
|
(printf "Package ~S:\n" k)
|
||
|
|
(for-each
|
||
|
|
(lambda (pair)
|
||
|
|
(resolver-print-pkg resolver (cdr pair)))
|
||
|
|
v))
|
||
|
|
(resolver-selected-dependencies resolver)))
|
||
|
|
|
||
|
|
(define (process-cargo-with-lockfile vfs cargo-file parsed-lockfile activated-features)
|
||
|
|
(define locked-dependencies (mapping (make-default-comparator)))
|
||
|
|
(for-each
|
||
|
|
(lambda (item)
|
||
|
|
(define name (lockfile-entry-name item))
|
||
|
|
(define inner (mapping-ref locked-dependencies name (lambda () (mapping (make-default-comparator)))))
|
||
|
|
(set! locked-dependencies
|
||
|
|
(mapping-set! locked-dependencies name
|
||
|
|
(mapping-set! inner
|
||
|
|
(lockfile-entry-version item)
|
||
|
|
(cons (parse-version (lockfile-entry-version item)) (cons item (delay (fetch-and-unpack-crate item))))))))
|
||
|
|
parsed-lockfile)
|
||
|
|
|
||
|
|
(define resolver (make-resolver locked-dependencies (mapping (make-default-comparator))))
|
||
|
|
(define pkg (resolver-register resolver vfs cargo-file))
|
||
|
|
(resolver-activate-features resolver pkg activated-features)
|
||
|
|
(resolver-print resolver)
|
||
|
|
pkg)
|
||
|
|
|
||
|
|
(define (cratify-name name)
|
||
|
|
; NOTE! string-map _has_ to return a char. non-chars are mistreated and cause memory corruption.
|
||
|
|
; TODO(puck): check this post-C6
|
||
|
|
(string-map (lambda (v) (if (char=? v #\-) #\_ v)) name))
|
||
|
|
|
||
|
|
(define (build-package resolved)
|
||
|
|
; Info we need to collect:
|
||
|
|
; - enabled features
|
||
|
|
; - dependencies
|
||
|
|
; - exact file dependencies (optional!)
|
||
|
|
; ..let's just give it a try, I guess?
|
||
|
|
; emits: (dep-info: #t)
|
||
|
|
(define crate-name (cargo-target-name (resolved-package-cargo-target resolved)))
|
||
|
|
(define crate-version (version-str (resolved-package-version resolved)))
|
||
|
|
(define crate-root (if (vfs? (resolved-package-fs resolved)) (vfs-to-store (resolved-package-fs resolved)) (resolved-package-fs resolved)))
|
||
|
|
(define crate-type (cargo-target-crate-type (resolved-package-cargo-target resolved)))
|
||
|
|
(define buildscript-metadata '())
|
||
|
|
(define dependency-metadata '())
|
||
|
|
(define bin-flags '())
|
||
|
|
|
||
|
|
(define params `(#:crate-type ,crate-type
|
||
|
|
#:remap-path-prefix (,crate-root . ,(string-append crate-name "-" (version-str (resolved-package-version resolved))))
|
||
|
|
#:codegen-flags ("metadata" . ,(string-append "zilch version=" (version-str (resolved-package-version resolved))))
|
||
|
|
#:codegen-flags ("extra-filename" . ,(string-append "v" crate-version))
|
||
|
|
#:edition ,(cargo-target-edition (resolved-package-cargo-target resolved))
|
||
|
|
#:crate-name ,crate-name))
|
||
|
|
(when (eq? crate-type 'proc-macro)
|
||
|
|
(set! params `(externs: "proc_macro" . ,params)))
|
||
|
|
(for-each
|
||
|
|
(lambda (feature)
|
||
|
|
(set! params (cons #:cfg (cons (string-append "feature=\"" feature "\"") params))))
|
||
|
|
(resolved-package-enabled-features resolved))
|
||
|
|
|
||
|
|
(define rustc-env
|
||
|
|
#~(
|
||
|
|
; ("CARGO" . "")
|
||
|
|
("CARGO_MANIFEST_DIR" . "")
|
||
|
|
("CARGO_PKG_VERSION" . ,(version-str (resolved-package-version resolved)))
|
||
|
|
("CARGO_PKG_VERSION_MAJOR" . ,(number->string (version-major (resolved-package-version resolved))))
|
||
|
|
("CARGO_PKG_VERSION_MINOR" . ,(number->string (version-minor (resolved-package-version resolved))))
|
||
|
|
("CARGO_PKG_VERSION_PATCH" . ,(number->string (version-patch (resolved-package-version resolved))))
|
||
|
|
("CARGO_PKG_VERSION_PRE" . ,(string-join (or (version-prerelease (resolved-package-version resolved)) '()) "."))
|
||
|
|
("CARGO_PKG_AUTHORS" . "")
|
||
|
|
("CARGO_PKG_NAME" . ,(cargo-crate-name (resolved-package-crate resolved)))
|
||
|
|
("CARGO_PKG_DESCRIPTION" . "")
|
||
|
|
("CARGO_PKG_HOMEPAGE" . "")
|
||
|
|
("CARGO_PKG_REPOSITORY" . "")
|
||
|
|
("CARGO_PKG_LICENSE" . "")
|
||
|
|
("CARGO_PKG_LICENSE_FILE" . "")
|
||
|
|
("CARGO_PKG_RUST_VERSION" . "")
|
||
|
|
("CARGO_PKG_README" . "")
|
||
|
|
("CARGO_CRATE_NAME" . ,crate-name)))
|
||
|
|
; CARGO_BIN_NAME, OUT_DIR, CARGO_BIN_EXE_*: skipping for now
|
||
|
|
; CARGO_PRIMARY_PACKAGE: not sensible here
|
||
|
|
; CARGO_TARGET_TMPDIR: integration/benchmark only
|
||
|
|
; CARGO_RUSTC_CURRENT_DIR: nightly only
|
||
|
|
|
||
|
|
(define (upcase-underscore ch)
|
||
|
|
(if (char=? ch #\-) #\_ (char-upcase ch)))
|
||
|
|
|
||
|
|
(when (resolved-package-build-script resolved)
|
||
|
|
(unless (resolved-package-build-data (resolved-package-build-script resolved))
|
||
|
|
(build-package (resolved-package-build-script resolved)))
|
||
|
|
(mapping-for-each
|
||
|
|
(lambda (key value)
|
||
|
|
(unless (resolved-package-build-data value)
|
||
|
|
(build-package value))
|
||
|
|
(for-each
|
||
|
|
(lambda (kv)
|
||
|
|
(set! dependency-metadata (cons (cons (string-map upcase-underscore (string-append "DEP_" (cargo-crate-links (resolved-package-crate value)) "_" (car kv))) (cdr kv)) dependency-metadata)))
|
||
|
|
(resolved-package-build-data-build-script-metadata (resolved-package-build-data value))))
|
||
|
|
(resolved-package-dependencies resolved))
|
||
|
|
(let*-values
|
||
|
|
(((build-script) (cdr (resolved-package-build-data-rlib (resolved-package-build-data (resolved-package-build-script resolved)))))
|
||
|
|
((build-script-env) (build-script-env-overrides-for-crate (cargo-crate-name (resolved-package-crate resolved))))
|
||
|
|
((runner-output runner-outdir)
|
||
|
|
(call-runner build-script crate-root
|
||
|
|
#~(
|
||
|
|
("RUSTC" . ,(string-append #$rustc "/bin/rustc"))
|
||
|
|
("HOST" . "x86_64-unknown-linux-gnu")
|
||
|
|
("TARGET" . "x86_64-unknown-linux-gnu")
|
||
|
|
("OPT_LEVEL" . "0")
|
||
|
|
("PROFILE" . "debug")
|
||
|
|
("DEBUG" . "true")
|
||
|
|
,@dependency-metadata
|
||
|
|
#$@build-script-env
|
||
|
|
; TODO: OUT_DIR, NUM_JOBS, OPT_LEVEL/DEBUG/PROFILE, DEP_*
|
||
|
|
; RUSTC/RUSTDOC?, RUSTC_LINKER? and CARGO_ENCODED_RUSTFLAGS
|
||
|
|
. #$rustc-env))))
|
||
|
|
(printf "runner output for ~S: ~S\n" (cargo-crate-name (resolved-package-crate resolved)) runner-output)
|
||
|
|
(map
|
||
|
|
(lambda (v)
|
||
|
|
(if (pair? v)
|
||
|
|
(set! params `(#:cfg ,(string-append (car v) "=\"" (cdr v) "\"") . ,params))
|
||
|
|
(set! params `(#:cfg ,v . ,params))))
|
||
|
|
(build-script-output-cfg runner-output))
|
||
|
|
(set! buildscript-metadata (build-script-output-metadata runner-output))
|
||
|
|
(let ((old-rustc-env rustc-env))
|
||
|
|
(set! rustc-env #~(("OUT_DIR" . #$runner-outdir) . #$old-rustc-env)))
|
||
|
|
; Reverse order for scheme reasons.
|
||
|
|
(for-each
|
||
|
|
(lambda (kv) (set! bin-flags `(#:link ,kv . ,bin-flags)))
|
||
|
|
(build-script-output-link-lib runner-output))
|
||
|
|
|
||
|
|
; TODO(puck): hack to workaround lack of store path passthrough
|
||
|
|
; This should be replaced with .... $something (a dir of all build script outputs?)
|
||
|
|
(unless (or (null? build-script-env) (null? bin-flags))
|
||
|
|
(let ((v (cadr bin-flags)))
|
||
|
|
(set-cdr! bin-flags (cons #~,(begin #$build-script-env v) (cddr bin-flags)))))
|
||
|
|
(for-each
|
||
|
|
(lambda (kv) (set! bin-flags `(#:search-path ,kv . ,bin-flags)))
|
||
|
|
(build-script-output-link-search runner-output))
|
||
|
|
(printf "~S bin flags: ~S\n" (cargo-crate-name (resolved-package-crate resolved)) bin-flags)))
|
||
|
|
; TODO(puck): check-cfg wants check-cfg everywhere
|
||
|
|
;(map
|
||
|
|
; (lambda (v)
|
||
|
|
; (set! params `(#:check-cfg ,v . ,params)))
|
||
|
|
; (build-script-output-check-cfg runner-output))))
|
||
|
|
|
||
|
|
(define params-meta params)
|
||
|
|
(define transitive-dependencies '())
|
||
|
|
(mapping-for-each
|
||
|
|
(lambda (key value)
|
||
|
|
(unless (resolved-package-build-data value)
|
||
|
|
(build-package value))
|
||
|
|
(for-each (lambda (dep) (unless (member dep transitive-dependencies) (set! transitive-dependencies (cons dep transitive-dependencies)))) (resolved-package-build-data-transitive-dependencies (resolved-package-build-data value)))
|
||
|
|
(unless (member value transitive-dependencies) (set! transitive-dependencies (cons value transitive-dependencies)))
|
||
|
|
(define data (resolved-package-build-data value))
|
||
|
|
(define meta-or-rlib (or (resolved-package-build-data-metadata data) (resolved-package-build-data-rlib data)))
|
||
|
|
(set! params-meta
|
||
|
|
`(#:externs (,(cratify-name key) . ,(cdr meta-or-rlib)) . ,params-meta))
|
||
|
|
(set! params
|
||
|
|
`(#:externs (,(cratify-name key) . ,(cdr (resolved-package-build-data-rlib data))) . ,params)))
|
||
|
|
(resolved-package-dependencies resolved))
|
||
|
|
|
||
|
|
(define transitive-dependencies-meta
|
||
|
|
(zdir (map (lambda (dep)
|
||
|
|
(define data (resolved-package-build-data dep))
|
||
|
|
(define meta-or-rlib (or (resolved-package-build-data-metadata data) (resolved-package-build-data-rlib data)))
|
||
|
|
(cons
|
||
|
|
(car meta-or-rlib)
|
||
|
|
(zsymlink (cdr meta-or-rlib)))) transitive-dependencies)))
|
||
|
|
(define transitive-dependencies-rlib
|
||
|
|
(zdir (map (lambda (dep)
|
||
|
|
(define data (resolved-package-build-data dep))
|
||
|
|
(define rlib (resolved-package-build-data-rlib data))
|
||
|
|
(cons
|
||
|
|
(car rlib)
|
||
|
|
(zsymlink (cdr rlib)))) transitive-dependencies)))
|
||
|
|
|
||
|
|
(define transitive-bin-flags '())
|
||
|
|
(for-each (lambda (dep) (set! transitive-bin-flags (append (resolved-package-build-data-bin-flags (resolved-package-build-data dep)) transitive-bin-flags))) transitive-dependencies)
|
||
|
|
|
||
|
|
(unless (eq? crate-type 'rlib)
|
||
|
|
(set! params `(codegen-flags: ("linker" . ,(force linker)) . ,params)))
|
||
|
|
|
||
|
|
(define path #~,(string-append #$(if (vfs? (resolved-package-fs resolved)) (vfs-to-store (resolved-package-fs resolved)) (resolved-package-fs resolved)) "/" (cargo-target-path (resolved-package-cargo-target resolved))))
|
||
|
|
(define dep-info (cdar (apply call-rustc `(,path ,rustc-env search-path: ("dependency" . ,transitive-dependencies-meta) emits: (dep-info: #t) . ,params-meta))))
|
||
|
|
|
||
|
|
(define rlib-name (string-append "lib" crate-name "-v" crate-version ".rlib"))
|
||
|
|
(define rmeta-name (string-append "lib" crate-name "-v" crate-version ".rmeta"))
|
||
|
|
|
||
|
|
(when (eq? crate-type 'proc-macro)
|
||
|
|
(set! rlib-name (string-append "lib" crate-name "-v" crate-version ".so")))
|
||
|
|
|
||
|
|
(when (or (eq? crate-type 'proc-macro) (eq? crate-type 'bin))
|
||
|
|
(set! params (append transitive-bin-flags params)))
|
||
|
|
(when (eq? crate-type 'bin)
|
||
|
|
(set! params `(#:codegen-flags ("rpath" . "no") . ,params)))
|
||
|
|
|
||
|
|
; Rust is nitpicky about the filenames, fix them with copious symlinking.
|
||
|
|
(define rlib-file (cdar (apply call-rustc `(,path ,rustc-env search-path: ("dependency" . ,transitive-dependencies-rlib) emits: (link: #t) ,@bin-flags . ,params))))
|
||
|
|
(define rlib (cons rlib-name #~,(string-append #$(zdir rlib-name (zsymlink rlib-file)) "/" rlib-name)))
|
||
|
|
(store-path-materialize rlib-file)
|
||
|
|
|
||
|
|
(define metadata #f)
|
||
|
|
(define metadata-file #f)
|
||
|
|
(unless (eq? crate-type 'proc-macro)
|
||
|
|
(set! metadata-file (cdar (apply call-rustc `(,path ,rustc-env search-path: ("dependency" . ,transitive-dependencies-meta) emits: (metadata: #t) . ,params-meta))))
|
||
|
|
(set! metadata (cons rmeta-name #~,(string-append #$(zdir rmeta-name (zsymlink metadata-file)) "/" rmeta-name)))
|
||
|
|
(store-path-materialize metadata-file))
|
||
|
|
|
||
|
|
(printf "-> crate ~S: ~S/~S/~S\n" crate-name dep-info metadata-file rlib-file)
|
||
|
|
(set-resolved-package-build-data! resolved (make-resolved-package-build-data dep-info metadata rlib transitive-dependencies buildscript-metadata bin-flags))
|
||
|
|
(list dep-info metadata rlib))
|
||
|
|
|
||
|
|
(define (matches-requirements ver req)
|
||
|
|
(if (eq? req '())
|
||
|
|
#t
|
||
|
|
(and
|
||
|
|
(case (caar req)
|
||
|
|
((<) (version<? ver (cdar req)))
|
||
|
|
((<=) (or (version=? ver (cdar req)) (version<? ver (cdar req))))
|
||
|
|
((>) (version<? (cdar req) ver))
|
||
|
|
((>=) (or (version=? ver (cdar req)) (version<? (cdar req) ver)))
|
||
|
|
((=) (version=? ver (cdar req))))
|
||
|
|
(matches-requirements ver (cdr req)))))
|
||
|
|
|
||
|
|
(define (parse-version-requirement str)
|
||
|
|
(set! str (string-drop-while str char-whitespace?))
|
||
|
|
(set! str (string-drop-while-right str char-whitespace?))
|
||
|
|
(define type '^)
|
||
|
|
(when (string-prefix? ">=" str)
|
||
|
|
(set! type '>=)
|
||
|
|
(set! str (string-copy str 2)))
|
||
|
|
(when (string-prefix? ">" str)
|
||
|
|
(set! type '>)
|
||
|
|
(set! str (string-copy str 1)))
|
||
|
|
(when (string-prefix? "~" str)
|
||
|
|
(set! type '~)
|
||
|
|
(set! str (string-copy str 1)))
|
||
|
|
(when (string-prefix? "<=" str)
|
||
|
|
(set! type '<=)
|
||
|
|
(set! str (string-copy str 2)))
|
||
|
|
(when (string-prefix? "<" str)
|
||
|
|
(set! type '<)
|
||
|
|
(set! str (string-copy str 1)))
|
||
|
|
(when (string-prefix? "=" str)
|
||
|
|
(set! type '=)
|
||
|
|
(set! str (string-copy str 1)))
|
||
|
|
(when (string-prefix? "^" str)
|
||
|
|
(set! type '^)
|
||
|
|
(set! str (string-copy str 1)))
|
||
|
|
(set! str (string-copy str (string-skip str char-whitespace?)))
|
||
|
|
(let ((suffix-len (string-suffix-length ".*" str)))
|
||
|
|
(when (> suffix-len 0)
|
||
|
|
(set! type '~)
|
||
|
|
(set! str (string-copy str 0 (- (string-length str) suffix-len)))))
|
||
|
|
(define-values (parsed-version part-count)
|
||
|
|
(let*
|
||
|
|
((first-period (string-index str (lambda (v) (char=? v #\.))))
|
||
|
|
(second-period (and first-period (string-index str (lambda (v) (char=? v #\.)) (+ first-period 1)))))
|
||
|
|
(cond
|
||
|
|
((and first-period second-period) (values (parse-version str) 3))
|
||
|
|
(first-period (values (parse-version (string-append str ".0")) 2))
|
||
|
|
((string=? str "") (values (parse-version "0.0.0") 0))
|
||
|
|
(else (values (parse-version (string-append str ".0.0")) 1)))))
|
||
|
|
(define (first-incompatible ver)
|
||
|
|
(if (= (version-major ver) 0)
|
||
|
|
(make-version 0 (+ (version-minor ver) 1) 0 '("0") #f)
|
||
|
|
(make-version (+ (version-major ver) 1) 0 0 '("0") #f)))
|
||
|
|
(define (next-major ver)
|
||
|
|
(make-version (+ (version-major ver) 1) 0 0 '("0") #f))
|
||
|
|
(define (next-minor ver)
|
||
|
|
(make-version (version-major ver) (+ (version-minor ver) 1) 0 '("0") #f))
|
||
|
|
(define (exclude-prerelease ver)
|
||
|
|
(if (version-prerelease ver)
|
||
|
|
ver
|
||
|
|
(make-version (version-major ver) (version-minor ver) (version-patch ver) '("0") #f)))
|
||
|
|
(case type
|
||
|
|
((^) (list (cons '>= parsed-version) (cons '< (first-incompatible parsed-version))))
|
||
|
|
((~) (if (= part-count 0)
|
||
|
|
(list
|
||
|
|
(cons '>= parsed-version))
|
||
|
|
(list
|
||
|
|
(cons '>= parsed-version)
|
||
|
|
(cons '< (case part-count
|
||
|
|
((2 3) (next-minor parsed-version))
|
||
|
|
((1) (next-major parsed-version)))))))
|
||
|
|
; TODO: this implements the RFC 3493-style implicit prerelease stuff, I _think_
|
||
|
|
((<) (list (cons '< (exclude-prerelease parsed-version))))
|
||
|
|
((<=) (list (cons '<= parsed-version)))
|
||
|
|
((>) (list (cons '> parsed-version)))
|
||
|
|
((>=) (list (cons '>= parsed-version)))
|
||
|
|
((=) (list (cons '= parsed-version)))
|
||
|
|
(else (error "unknown sigil" (cons type parsed-version)))))))
|