zilch/lang/rust/src/resolver.sld

(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 process-many-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)
     (unless version
       (error "Resolver wanted non-versioned download" name))
     (define vfs (force (cddr (mapping-ref (mapping-ref (resolver-locked-dependencies resolver) name) (version-str version)))))
     (define-values (parsed-cargo parsed-workspace) (parse-cargo-toml vfs (call-with-port (store-path-open #~,(string-append #$vfs "/Cargo.toml")) (lambda (p) (read-string 99999999 p))) #f))
     (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 delayed)
     (define target (cargo-crate-lib-target crate))
     (unless target
       (when (null? (cargo-crate-targets crate))
         (error "Crate has _zero_ targets" crate))
       (set! target (car (cargo-crate-targets crate))))
     (resolver-register-target resolver vfs crate target #f delayed))

   ;; Register a non-registry crate+vfs with the resolver.
   (define (resolver-register-target resolver vfs crate target extra-dependencies delayed)
     (define build-script #f)
     (unless extra-dependencies
       (set! extra-dependencies (mapping (make-default-comparator))))
     (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 '() extra-dependencies #f build-script))
     (define existing-mapping (mapping-ref/default (resolver-selected-dependencies resolver) (cargo-crate-name crate) '()))
     (unless (equal? 'bin (cargo-target-crate-type target))
       (set-resolver-selected-dependencies! resolver (mapping-set (resolver-selected-dependencies resolver) (cargo-crate-name crate) (cons (cons (parse-version (cargo-crate-version crate)) pkg) existing-mapping))))
     (unless delayed
       (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 (if (cargo-dependency-version dep) (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/default (resolver-locked-dependencies resolver) package-name #f))
     (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))
     (unless (or matching-version available-versions)
       (error "Resolving ~S: could not find matching dep for reqs ~S in ~S\n" (list package-name requirements existing-mapping)))
     (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 #f))
     (resolver-activate-features resolver pkg activated-features)
     (resolver-print resolver)
     pkg)

   (define (process-many-with-lockfile vfs-cargo-map parsed-lockfile)
     (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)))))
         (when (lockfile-entry-source item)
           (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 pkgs '())
     (for-each
       (lambda (pkg-and-vfs)
         (when (cargo-crate-lib-target (car pkg-and-vfs))
           (set! pkgs (cons (resolver-register-target resolver (cdr pkg-and-vfs) (car pkg-and-vfs) (cargo-crate-lib-target (car pkg-and-vfs)) #f #t) pkgs)))
         (when (and (pair? (cargo-crate-targets (car pkg-and-vfs))) (equal? 'bin (cargo-target-crate-type (car (cargo-crate-targets (car pkg-and-vfs))))))
           (set! pkgs (cons (resolver-register-target resolver (cdr pkg-and-vfs) (car pkg-and-vfs) (car (cargo-crate-targets (car pkg-and-vfs)))
                              (if (cargo-crate-lib-target (car pkg-and-vfs)) (mapping (make-default-comparator) (cargo-target-name (cargo-crate-lib-target (car pkg-and-vfs))) (car pkgs)) (mapping (make-default-comparator))) #t) pkgs))))
       vfs-cargo-map)
     (for-each (lambda (p) (resolver-resolve-nonoptional resolver p)) pkgs)
     (for-each (lambda (p) (resolver-activate-features resolver p '("default"))) pkgs)
     (resolver-print resolver)
     pkgs)

   (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)))

     ; TODO(puck): workaround for multi-crate-type targets.
     ; These should probably be translated into distinct targets?
     (when (list? crate-type)
       (set! crate-type 'rlib))
     (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" . #$crate-root)
          ,@(if (cargo-crate-links (resolved-package-crate resolved)) (list (cons "CARGO_MANIFEST_LINKS" (cargo-crate-links (resolved-package-crate resolved)))) '())
          ("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)))

     (define (make-cfg-values-env l out)
       (cond
        ((pair? l)
         (let* ((env-name (string-map upcase-underscore (string-append "CARGO_CFG_" (caar l))))
                (existing (assoc env-name out)))
           (when (and existing (cdar l))
             (set-cdr! existing (string-append (cdr existing) "," (cdar l))))
           (if existing
             (make-cfg-values-env (cdr l) out)
             (make-cfg-values-env (cdr l) (cons (cons env-name (or (cdar l) "")) out)))))
        (else out)))

     (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))
           (when (cargo-crate-links (resolved-package-crate 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))))
          ((rewritten-features) (map (lambda (feature) (cons (string-map upcase-underscore (string-append "CARGO_FEATURE_" feature)) "")) (resolved-package-enabled-features 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")
                ,@(make-cfg-values-env cfg-values '())
                ,@dependency-metadata
                ,@rewritten-features
                #$@build-script-env
                ; TODO: OUT_DIR, NUM_JOBS, OPT_LEVEL/DEBUG/PROFILE, DEP_*
                ; RUSTC/RUSTDOC?, RUSTC_LINKER? and CARGO_ENCODED_RUSTFLAGS
                . #$rustc-env))))
         (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))
         (for-each (lambda (kv) (set! rustc-env (cons kv rustc-env))) (build-script-output-env runner-output))
         (let ((old-rustc-env rustc-env))
           (set! rustc-env #~(("OUT_DIR" . #$runner-outdir) . #$old-rustc-env)))
         (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 #$runner-outdir v) (cddr bin-flags)))))
         (for-each
           (lambda (kv) (set! bin-flags `(#:search-path ,kv . ,bin-flags)))
           (build-script-output-link-search runner-output))))
         ; 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)))
         (define name (cratify-name key))
         ; TODO(puck): what _is_ the logic here?
         (when (string=? key (cargo-crate-name (resolved-package-crate value)))
           (set! name (cratify-name (cargo-target-name (resolved-package-cargo-target value)))))
         (set! params-meta
           `(#:externs (,name . ,(cdr meta-or-rlib)) . ,params-meta))
         (set! params
           `(#:externs (,name . ,(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 (eq? crate-type 'bin)
       (set! rlib-name crate-name))

     (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))
       
     (set-resolved-package-build-data! resolved (make-resolved-package-build-data dep-info metadata rlib transitive-dependencies buildscript-metadata bin-flags))
     rlib-file)

   (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)))))))