(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 make-resolver resolver? resolver-locked-dependencies resolver-selected-dependencies 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 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 is-dependency) (cond ((and (string=? crate-name "pkg-config") is-dependency) #~(("PATH" . ,(string-append #$(force pkgconfig) "/bin")))) ((and (string=? crate-name "openssl-sys") (not is-dependency)) #~(("PATH" . ,(string-append #$(force gcc) "/bin")) ("PKG_CONFIG_PATH" . ,(string-append #$(force openssl) "/lib/pkgconfig")))) ((and (member crate-name '("ring" "bzip2-sys" "zstd-sys" "lzma-sys" "libmimalloc-sys") string=?) (not is-dependency)) #~(("PATH" . ,(string-append #$(force gcc) "/bin")))) ((and (member crate-name '("tvix-castore" "tvix-store" "tvix-build") string=?) (not is-dependency)) #~(("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 ; 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 (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 (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 , 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 . 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 , returning the . (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 (versionlist (lambda (k v) (cons k v)) final-env)) (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))) (define build-script-envs #f) (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))) (set! build-script-envs (list (build-script-env-overrides-for-crate (cargo-crate-name (resolved-package-crate resolved)) #f))) ; For each package dependency, check if it has "links" metadata, as well as build script env overrides. ; 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)) (let ((env-override (build-script-env-overrides-for-crate (cargo-crate-name (resolved-package-crate value)) #t))) (when env-override (set! build-script-envs (cons env-override build-script-envs)))) (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))))) ((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 ,@(rewrite-env #$build-script-envs) ; 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) (version=) (or (version=? ver (cdar req)) (version=" 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)))))))