(zilch lang rust): various workspace fixes

This commit is contained in:
puck 2024-11-27 14:22:48 +00:00
parent a5a59ea9e8
commit afd268c46d
2 changed files with 53 additions and 11 deletions

View file

@ -45,7 +45,7 @@
(lockfile-entry-dependencies entry)))
(define (fetch-and-unpack-crate lockfile-entry)
(unless (string=? (lockfile-entry-source lockfile-entry) "registry+https://github.com/rust-lang/crates.io-index") (error "unknown source " (lockfile-entry-source lockfile-entry)))
(unless (equal? (lockfile-entry-source lockfile-entry) "registry+https://github.com/rust-lang/crates.io-index") (error "unknown source " lockfile-entry))
; TODO(puck): hardcoded
(define url (string-append "https://static.crates.io/crates/" (lockfile-entry-name lockfile-entry) "/" (lockfile-entry-version lockfile-entry) "/download"))

View file

@ -30,7 +30,7 @@
resolver-resolve
resolver-print-pkg
resolver-print
process-cargo-with-lockfile
process-cargo-with-lockfile process-many-with-lockfile
build-package)
(begin
@ -82,6 +82,8 @@
;; 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)
@ -146,26 +148,36 @@
to-activate))
;; Register a non-registry crate+vfs with the resolver.
(define (resolver-register resolver vfs crate)
(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 '() (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)
(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 (string-split (cargo-dependency-version dep) "," 'strict-infix))))
(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 (resolver-locked-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)
@ -173,6 +185,8 @@
(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))
@ -225,6 +239,35 @@
(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
@ -407,9 +450,8 @@
(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))
rlib-file)
(define (matches-requirements ver req)
(if (eq? req '())