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 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 protobuf (delay (cdr (assoc "out" (nixpkgs "protobuf")))))
   (define magic (delay (cdr (assoc "out" (nixpkgs "file")))))
   (define openssl (delay (let ((data (nixpkgs "openssl"))) #~,(begin #$(cdr (assoc "out" data)) #$(cdr (assoc "dev" data))))))
   (define tvix-protos (delay (vfs-to-store (vfs-from-directory "/home/nix/store/dkjgsrg8knn406qh86c3mbxpbz2rjwfy-tvix-all-protos"))))

   (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"))))
      ((or (string=? crate-name "ring") (string=? crate-name "bzip2-sys") (string=? crate-name "zstd-sys") (string=? crate-name "lzma-sys") (string=? crate-name "libmimalloc-sys"))
       #~(("PATH" . ,(string-append #$(force gcc) "/bin"))))
      ((or (string=? crate-name "tvix-castore") (string=? crate-name "tvix-store") (string=? crate-name "tvix-build"))
       #~(("PATH" . ,(string-append #$(force protobuf) "/bin")) ("PROTO_ROOT" . #$(force tvix-protos))))
      ((or (string=? crate-name "prost-wkt-types") (string=? crate-name "nar-bridge"))
       #~(("PATH" . ,(string-append #$(force protobuf) "/bin"))))
      ((or (string=? crate-name "magic-sys"))
       #~(("NIX_LDFLAGS" . ,(string-append #$(force magic) "/lib"))))
      (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 build-script-out)
     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)
     (build-script-out resolved-package-build-data-build-script-out))
  
   (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 dir (force (cddr (mapping-ref (mapping-ref (resolver-locked-dependencies resolver) name) (version-str version)))))
     (define vfs (vfs-from-store dir))
     (define-values (parsed-cargo parsed-workspace) (parse-cargo-toml vfs (call-with-port (store-path-open (vfs-file-ref 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 (vfs-to-store (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 buildscript-out #f)
     (define crate-links '())
     (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, 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)
       ;; "build" here is a misnomer; it's handling the .drv:s.
       (unless (resolved-package-build-data (resolved-package-build-script resolved))
         (build-package (resolved-package-build-script resolved)))

       ; For each package dependency, check if it has "links" metadata.
       ; Crate that immediately depend on other crates that have this metadata have
       ; the cargo::metadata pairs passed to the build script.
       (mapping-for-each
         (lambda (key value)
           (unless (resolved-package-build-data value)
             (build-package value))
           (when (cargo-crate-links (resolved-package-crate value))
             ; Track (link-name . build-data) for each crate in immediate dependencies that applies
             (set! crate-links (cons (cons (cargo-crate-links (resolved-package-crate value)) (resolved-package-build-data value)) crate-links))))
         (resolved-package-dependencies resolved))

       ; Collect the necessary bits, and build the build script.
       (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-outdir runner-outpath)
           (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")
                ("_zilch_links" . ,(string-join #$(map (lambda (kv) #~,(string-append #$(resolved-package-build-data-build-script-out (cdr kv)) ":" (car kv))) crate-links) "!"))
                ,@(make-cfg-values-env cfg-values '())
                ,@dependency-metadata
                ,@rewritten-features
                #$@build-script-env
                ; TODO: OUT_DIR, NUM_JOBS, OPT_LEVEL/DEBUG/PROFILE
                ; RUSTC/RUSTDOC?, RUSTC_LINKER? and CARGO_ENCODED_RUSTFLAGS
                . #$rustc-env))))
         ; Pass the buildscript-out data to the next crate.
         (set! buildscript-out runner-outpath)

         ; Pass cargo::rustc-cfg and cargo::rustc-check-cfg to the crate this build script belongs to.
         ; Also set OUT_DIR for include! and include_str! reasons.
         (let ((old-rustc-env rustc-env))
           (set! rustc-env #~(("OUT_DIR" . #$runner-outdir) ("_zilch_proc" . #$runner-outpath) . #$old-rustc-env)))))

     (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 all-crate-features '())
     (for-each
       (lambda (feat)
         (set! all-crate-features
           (cons
             (string-append "\"" (car feat) "\"")
             all-crate-features)))
       (cargo-crate-features (resolved-package-crate resolved)))

     (set! params `(check-cfg: ,(string-append "cfg(feature, values(" (string-join all-crate-features ",") "))") . ,params))

     (define inherited-build-script-out '())
     (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))
         (when (resolved-package-build-data-build-script-out (resolved-package-build-data dep))
           (set! inherited-build-script-out (cons (resolved-package-build-data-build-script-out (resolved-package-build-data dep)) inherited-build-script-out))))
       transitive-dependencies)

     (unless (eq? crate-type 'rlib)
       (set! params `(codegen-flags: ("linker" . ,(force linker)) . ,params)))
     
     (define path #~,(string-append #$(vfs-to-store (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))
       (when (string=? crate-name "tvix_cli")
         (set! params `(search-path: ("native" . ,#~,(string-append #$(force magic) "/lib")) . ,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 buildscript-out))
     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 '< (first-incompatible parsed-version)))) ; TODO(puck): is this correct? how *should* "<= 3" be parsed.
       ((>) (list (cons '> parsed-version)))
       ((>=) (list (cons '>= parsed-version)))
       ((=) (list (cons '= parsed-version)))
       (else (error "unknown sigil" (cons type parsed-version)))))))