zilch/lang/rust/src/cargo.sld

;; Procedures to parse Cargo files.
(define-library (zilch lang rust cargo)
 (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 cfg)
  (zilch lang rust cfg)
  (zilch vfs))

 (export
  <cargo-crate> make-cargo-crate cargo-crate?
  cargo-crate-name cargo-crate-version cargo-crate-edition cargo-crate-dependencies
  cargo-crate-features cargo-crate-lib-target cargo-crate-targets
  cargo-crate-build-dependencies cargo-crate-build-script
  cargo-crate-links cargo-crate-check-cfg-lint

  <cargo-workspace> make-cargo-workspace cargo-workspace?
  cargo-workspace-members cargo-workspace-exclude cargo-workspace-dependencies
  cargo-workspace-version cargo-workspace-edition

  <cargo-dependency> make-cargo-dependency cargo-dependency?
  cargo-dependency-name cargo-dependency-origin cargo-dependency-version
  cargo-dependency-default-features cargo-dependency-features cargo-dependency-package
  cargo-dependency-optional

  <cargo-dep-git> make-cargo-dep-git cargo-dep-git?
  cargo-dep-git-url cargo-dep-git-rev-type cargo-dep-git-rev
  <cargo-dep-path> make-cargo-dep-path cargo-dep-path? cargo-dep-path-path
  <cargo-dep-registry> make-cargo-dep-registry cargo-dep-registry? cargo-dep-registry-name

  <cargo-target> make-cargo-target cargo-target?
  cargo-target-name cargo-target-path cargo-target-test cargo-target-doctest
  cargo-target-bench cargo-target-doc cargo-target-proc-macro cargo-target-harness
  cargo-target-edition cargo-target-crate-type cargo-target-required-features

  cfg-values

  parse-cargo-toml)

 (begin
   (define linker (delay (let ((v (cdr (assoc "out" (nixpkgs "gcc"))))) #~,(string-append #$v "/bin/cc"))))
   (define yj-path (foreign-value "YJ_PATH" nonnull-c-string))

   ;; Shell out to a TOML-to-JSON parser. This will be replaced with a Nix-native solution later(tm).
   (define (parse-toml toml-to-parse)
     (define-values (read-port write-port pid) (process yj-path '("yj" "-tj")))
     (write-string toml-to-parse write-port)
     (close-output-port write-port)
     (define parsed (json-read read-port))
     (close-input-port read-port)
     ; (define-values (_ _ _) (process-wait pid))
     parsed)

   ;; A single target for a crate.
   ;;
   ;; Each crate consists of multiple targets; e.g. `lib`, ``bin``s, and things like test/doctest.
   ;;
   ;; The fields of this record closely match the Cargo.toml. For more information on these, see https://doc.rust-lang.org/cargo/reference/cargo-targets.html#configuring-a-target:[the Cargo documentation].
   ;;
   ;; - `name`: The name of this target. By default, the name of the binary or
   ;;   of the crate, if lib.
   ;; - `path`: The root source file for this target (e.g. `"src/lib.rs"`, `"src/bin/example.rs"`).
   ;;   Relative to the crate's root.
   ;; - `crate-type`: The type of crate, as a symbol (bin, lib, rlib, etc).
   ;; - `edition`: The target's edition
   ;; - `required-features`: A specifying which features on the `lib` have to be set.
   ;;   (non-lib targets implicitly depend on the lib target)
   ;;
   ;; Based on the `crate-type` the other fields may be valid; these closely match the `Cargo.toml`'s definitions as well.
   (define-record-type <cargo-target>
     (make-cargo-target name path test doctest bench doc proc-macro harness edition crate-type required-features)
     cargo-target?
     (name cargo-target-name) ; required other than for [lib]
     (path cargo-target-path) ; inferred
     (test cargo-target-test) ; true for [lib, bin, test]
     (doctest cargo-target-doctest) ; true for lib
     (bench cargo-target-bench) ; true for lib, bin, benchmark
     (doc cargo-target-doc) ; true for lib, bin
     (proc-macro cargo-target-proc-macro) ; only valid for lib
     (harness cargo-target-harness) ; defaults to true
     (edition cargo-target-edition) ; defaults to package's edition field
     (crate-type cargo-target-crate-type) ; [bin, lib, rlib, dylib, cdylib, staticlib, proc-macro]
     (required-features cargo-target-required-features)) ; list. has no effect on lib

   (define-record-printer (<cargo-target> entry out)
     (fprintf out "#<cargo-target ~S ~S test:~S doctest:~S bench:~S doc:~S proc-macro:~S harness:~S edition:~S ~S required-features:~S>"
       (cargo-target-name entry)
       (cargo-target-path entry)
       (cargo-target-test entry)
       (cargo-target-doctest entry)
       (cargo-target-bench entry)
       (cargo-target-doc entry)
       (cargo-target-proc-macro entry)
       (cargo-target-harness entry)
       (cargo-target-edition entry)
       (cargo-target-crate-type entry)
       (cargo-target-required-features entry)))

   ; either:
   ; - git + optionally tag/rev/branch (this supports looking at workspace.toml, as an exception)
   ; - path (relative)
   ; - no info (crates.io), or manual `registry` name (mapped using .cargo/config.toml)
   ;
   ; then also:
   ; - version (optional other than for registry uses)
   ; - default-features
   ; - features
   ; - package (used for resolving against the registry)
   ; - optional (only if feature is enabled!)
   ; or like, workspace (+ optional/features, whee)

   ;; A Git cargo dependency.
   ;; `rev-type` is either `'tag`, `'rev`, `'branch`, or `#f`, and specifies
   ;; how `rev` is interpreted.
   (define-record-type <cargo-dep-git>
     (make-cargo-dep-git url rev-type rev)
     cargo-dep-git?
     (url cargo-dep-git-url)
     (rev-type cargo-dep-git-rev-type)
     (rev cargo-dep-git-rev))

   (define-record-printer (<cargo-dep-git> entry out)
     (fprintf out "#<cargo-dep-git ~S ~S ~S>"
       (cargo-dep-git-url entry)
       (cargo-dep-git-rev-type entry)
       (cargo-dep-git-rev entry)))

   ;; A path cargo dependency.
   ;; The path is relative to the crate root.
   (define-record-type <cargo-dep-path>
     (make-cargo-dep-path path)
     cargo-dep-path?
     (path cargo-dep-path-path))

   (define-record-printer (<cargo-dep-path> entry out)
     (fprintf out "#<cargo-dep-path ~S>"
       (cargo-dep-path-path entry)))

   ;; A registry dependency.
   (define-record-type <cargo-dep-registry>
     (make-cargo-dep-registry name)
     cargo-dep-registry?
     (name cargo-dep-registry-name))
   (define-record-printer (<cargo-dep-registry> entry out)
     (fprintf out "#<cargo-dep-registry ~S>"
       (cargo-dep-registry-name entry)))

   ;; A crate's dependency.
   ;;
   ;; - `name`: the name this dependency has in the Rust code.
   ;; - `origin`: a `<cargo-dep-git>`, `<cargo-dep-path>`, or
   ;;   `<cargo-dep-registry>`, specifying the source of the dependency.
   ;; - `version`: The version requirements, as a string. Optional for
   ;;   non-registry depndencies.
   ;; - `default-features`: Whether default features are requested on this dependency.
   ;; - `features`: A list of features requested.
   ;; - `package`: The name of the crate being depended upon.
   ;; - `optional`: Whether this dependency is optional.
   (define-record-type <cargo-dependency>
     (make-cargo-dependency name origin version default-features features package optional)
     cargo-dependency?
     (name cargo-dependency-name)
     (origin cargo-dependency-origin)
     (version cargo-dependency-version)
     (default-features cargo-dependency-default-features)
     (features cargo-dependency-features)
     (package cargo-dependency-package)
     (optional cargo-dependency-optional))
   (define-record-printer (<cargo-dependency> entry out)
     (fprintf out "#<cargo-dependency ~S ~S v:~S default-features:~S features:~S package:~S optional:~S>"
       (cargo-dependency-name entry)
       (cargo-dependency-origin entry)
       (cargo-dependency-version entry)
       (cargo-dependency-default-features entry)
       (cargo-dependency-features entry)
       (cargo-dependency-package entry)
       (cargo-dependency-optional entry)))

   ;; A representation of a Cargo crate.
   ;;
   ;; - `name`: The name of the crate
   ;; - `version`: The version of the crate
   ;; - `edition`: The edition of Rust this crate uses. Can be overridden by
   ;;   individual targets.
   ;; - `workspace`: A reference to the workspace this crate is part of, or
   ;;   `#f` if none.
   ;; - `dependencies`: A list of `<cargo-dependency>` records.
   ;; - `build-dependencies`: A list of `<cargo-dependency>` records, used for
   ;;   the `build-script` only.
   ;; - `features`: An alist of feature names to any features it depends on.
   ;;    A feature dependency is represented as a triple `((crate-name . activates-crate) . crate-feature)`.
   ;;    `crate-name` and `activates-crate` govern the target crate. If
   ;;    `crate-name` is `#f`, the feature depends on another feature in the
   ;;    same crate. `activates-crate` specifies whether this is a required
   ;;    dependency, or whether the feature should be enabled when another
   ;;    feature requires the crate. `crate-feature` specifies the name of the
   ;;    feature in the target crate, or `#f` if this feature only depends on
   ;;    the crate itself. As examples:
   ;; +
   ;; ** "dep:foo" resolves to (("foo" . #t) . #f)
   ;; ** "foo/bar" resolves to (("foo" . #t) . "bar")
   ;; ** "foo?/bar" resolves to (("foo" . #f) . "bar")
   ;;
   ;; - `lib-target`: the `<cargo-target>` of the library of the crate, or `#f` if this crate
   ;;   has no library.
   ;; - `build-script`: the `<cargo-target>` of the build script, if any is present.
   ;; - `links`: the name of a native library being linked to, or `#f` if none.
   ;; - `check-cfg-lint`: A list of `--check-cfg` flags to be set on compiling
   ;;   this crate. These values are sourced from `lints.rust.unexpected_cfgs`
   ;;   in the `Cargo.toml`.
   (define-record-type <cargo-crate>
     (make-cargo-crate name version edition workspace dependencies build-dependencies features lib-target build-script targets links check-cfg-lint)
     cargo-crate?
     (name cargo-crate-name)
     (version cargo-crate-version)
     (edition cargo-crate-edition)
     (workspace cargo-crate-workspace)
     (dependencies cargo-crate-dependencies)
     (build-dependencies cargo-crate-build-dependencies)
     (features cargo-crate-features)
     (lib-target cargo-crate-lib-target)
     (build-script cargo-crate-build-script)
     (targets cargo-crate-targets)
     (links cargo-crate-links)
     (check-cfg-lint cargo-crate-check-cfg-lint))

   (define-record-printer (<cargo-crate> entry out)
     (fprintf out "#<cargo-crate ~S ~S edition:~S dependencies:~S features:~S lib-target:~S targets:~S>"
       (cargo-crate-name entry)
       (cargo-crate-version entry)
       (cargo-crate-edition entry)
       (cargo-crate-dependencies entry)
       (cargo-crate-features entry)
       (cargo-crate-lib-target entry)
       (cargo-crate-targets entry)))

   ;; A representation of a Cargo.toml's workspace.
   ;;
   ;; - `members`: A list of members of this workspace.
   ;; - `exclude`: A list of globs that should be excluded, even when mentioned
   ;;   in `members`.
   ;; - `dependencies`: A list of ``<cargo-dependency>``s that any crate part
   ;;   of this workspace can reference.
   ;; - `edition`, `version`, `check-cfg-lint`: Default values for the
   ;;   equivalent fields in this workspace's ``<cargo-crate>``s.
   (define-record-type <cargo-workspace>
     (make-cargo-workspace members exclude dependencies edition version check-cfg-lint)
     cargo-workspace?
     (members cargo-workspace-members)
     (exclude cargo-workspace-exclude)
     (dependencies cargo-workspace-dependencies set-cargo-workspace-dependencies!)
     (edition cargo-workspace-edition)
     (version cargo-workspace-version)
     (check-cfg-lint cargo-workspace-check-cfg-lint))

   (define-record-printer (<cargo-workspace> entry out)
     (fprintf out "#<cargo-workspace members:~S exclude:~S deps:~S>"
       (cargo-workspace-members entry)
       (cargo-workspace-exclude entry)
       (cargo-workspace-dependencies entry)))

   (foreign-declare "#include \"cfgfetch_source.h\"")
   (define cfgfetch-bin
     (cdar
       (call-rustc
         (zfile (foreign-value "cfgfetch_source" nonnull-c-string)) '()
         #:codegen-flags (cons "linker" (force linker))
         #:crate-type 'bin
         #:crate-name "cfgfetch"
         #:edition "2021"
         #:emits '(#:link #t))))

   (define cfg-target "x86_64-unknown-linux-gnu")
   (define (read-cfg-value port rest)
     (define line (read-line port))
     (if (eof-object? line)
       rest
       (let* ((line (cfg-parse line)))
         (read-cfg-value port (cons (cdr line) rest)))))

   ;; The list of config values that `rustc` sets by default, processed by xref:zilch.lang.rust.cfg.adoc#cfg-parse[`cfg-parse`].
   ;; These are used to parse `Cargo.toml` conditional dependencies.
   (define cfg-values
     (let ((vals (cdar (store-path-for-ca-drv* "cfg-values" "x86_64-linux" #~(#$cfgfetch-bin) #~(("rustc" . ,(string-append #$rustc "/bin/rustc"))) '("out")))))
       (call-with-port (store-path-open vals) (lambda (p) (read-cfg-value p '())))))

   (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 (and-cdr val)
      (and val (cdr val)))

   (define (and-cdr-default val default)
      (if val (cdr val) default))

   (define (find-dependency-in-list l dep-name)
     (cond
       ((null? l) #f)
       ((string=? dep-name (cargo-dependency-name (car l))) (car l))
       (else (find-dependency-in-list (cdr l) dep-name))))

   (define (cargo-dependency-from-toml name object workspace for-workspace)
     (define object-internals (vector->list object))
     (define version (and-cdr (assoc "version" object-internals)))
     (define default-features (and-cdr-default (or (assoc "default-features" object-internals) (assoc "default_features" object-internals)) #t))
     (define pkg-features (and-cdr-default (assoc "features" object-internals) '()))
     (define package (or (and-cdr (assoc "package" object-internals)) name))
     (define optional (and-cdr (assoc "optional" object-internals)))

     (define git-url (and-cdr (assoc "git" object-internals)))
     (define git-tag (and-cdr (assoc "tag" object-internals)))
     (define git-rev (and-cdr (assoc "rev" object-internals)))
     (define git-branch (and-cdr (assoc "branch" object-internals)))

     (define registry-name (and-cdr (assoc "registry" object-internals)))
     (define path (and-cdr (assoc "path" object-internals)))

     (define is-workspace (and-cdr (assoc "workspace" object-internals)))
     (when (and is-workspace (not workspace))
       (error "Dependency uses workspace=true, whilst not a workspace" (cons name object-internals)))

     (define workspace-dep
       (and is-workspace (find-dependency-in-list (cargo-workspace-dependencies workspace) name)))
     (when (and is-workspace (not workspace-dep))
       (error "Dependency could not be found in workspace" name))
     (when workspace-dep
       (set! version (cargo-dependency-version workspace-dep))
       (set! default-features (cargo-dependency-default-features workspace-dep))
       (for-each
         (lambda (feature) (unless (member feature pkg-features)) (set! pkg-features (cons feature pkg-features)))
         (cargo-dependency-features workspace-dep))
       (set! package (cargo-dependency-package workspace-dep)))

     (define origin (cond
                      (workspace-dep (cargo-dependency-origin workspace-dep))
                      (path (make-cargo-dep-path (if for-workspace (cons 'workspace path) path)))
                      (registry-name (make-cargo-dep-registry registry-name))
                      ((and git-url git-tag) (make-cargo-dep-git git-url 'tag git-tag))
                      ((and git-url git-rev) (make-cargo-dep-git git-url 'rev git-rev))
                      ((and git-url git-branch) (make-cargo-dep-git git-url 'branch git-branch))
                      (git-url (make-cargo-dep-git git-url #f #f))
                      (else (make-cargo-dep-registry #f))))
     (make-cargo-dependency name origin version default-features pkg-features package optional))

   ;; base-type is lib/bin/example/test/benchmark
   (define (cargo-target-from-toml vfs object crate-name base-type base-edition)
     (define object-internals (vector->list object))

     (define (multifile-if-available base name)
       (if (vfs-file-ref vfs (string-append base name) "main.rs")
          (string-append base name "/main.rs")
          (string-append base name ".rs")))

     (unless (or (eq? base-type 'lib) (assoc "name" object-internals)) (error "cargo target has no name"))
     (define name (cratify-name (or (and-cdr (assoc "name" object-internals)) crate-name)))
     (define path (or (and-cdr (assoc "path" object-internals))
                      (case base-type
                        ((lib) "src/lib.rs")
                        ;; TODO(puck): multi-file
                        ((bin) (multifile-if-available "src/bin/" name))
                        ((example) (multifile-if-available "examples/" name))
                        ((test) (multifile-if-available "tests/" name))
                        ((benchmark) (multifile-if-available "benches/" name)))))
     (define test (and-cdr-default (assoc "test" object-internals) (member base-type '(lib bin test))))
     (define doctest (and-cdr-default (assoc "doctest" object-internals) (eq? base-type 'lib)))
     (define bench (and-cdr-default (assoc "bench" object-internals) (member base-type '(lib bin benchmark))))
     (define doc (and-cdr-default (assoc "doc" object-internals) (member base-type '(lib bin))))
     (define proc-macro (and (eq? base-type 'lib) (and-cdr (assoc "proc-macro" object-internals))))
     (define harness (and-cdr-default (assoc "harness" object-internals) #t))
     (define edition (or (and-cdr (assoc "edition" object-internals)) base-edition))
     (define crate-type (if (assoc "crate-type" object-internals)
                            (map string->symbol (cdr (assoc "crate-type" object-internals)))
                            (cond
                              (proc-macro 'proc-macro)
                              ((eq? base-type 'lib) 'lib)
                              ((eq? base-type 'example) 'bin)
                              (else 'bin))))
     (define required-features (or (and-cdr (assoc "required-features" object-internals)) '()))

     (make-cargo-target name path test doctest bench doc proc-macro harness edition crate-type required-features))

   ; A feature is two parts: ((crate-name . activates-crate) package-feature)
   ; "dep:foo" resolves to (("foo" . #t) . #f)
   ; "foo/bar" resolves to (("foo" . #t) . "bar")
   ; "foo?/bar" resolves to (("foo" . #f) . "bar")

   (define (parse-features feature-alist dependency-names build-dependency-names)
    (define needs-implicit-dependency (mapping (make-default-comparator)))
    (for-each (lambda (name) (set! needs-implicit-dependency (mapping-set! needs-implicit-dependency name #t))) dependency-names)
    (for-each (lambda (name) (set! needs-implicit-dependency (mapping-set! needs-implicit-dependency name #t))) build-dependency-names)

    (define (parse-feature-string str)
      (if (string-prefix? "dep:" str)
        (let ((name (string-copy str 4)))
          (set! needs-implicit-dependency (mapping-set! needs-implicit-dependency name #f))
          (cons name (cons #t #f)))
        (let* ((index (string-contains str "/"))
               (first-half (if index (string-copy str 0 index) str))
               (second-half (and index (string-copy str (+ index 1))))
               (first-half-is-optional (string-suffix? "?" first-half))
               (first-half-not-optional (if first-half-is-optional (string-copy str 0 (- index 1)) first-half)))
          (if second-half
            (cons first-half-not-optional (cons (not first-half-is-optional) second-half))
            (cons #f (cons #t first-half))))))

    (define parsed (map (lambda (kv) (cons (car kv) (map parse-feature-string (cdr kv)))) feature-alist))
    (mapping-for-each (lambda (k v) (when v (set! parsed (cons (list k (cons k (cons #t #f))) parsed)))) needs-implicit-dependency)
    parsed)

   (define (parse-cargo-package vfs internals workspace)
     (unless vfs (error "no vfs"))
     (define package (vector->list (cdr (assoc "package" internals))))
     (define package-name (cdr (assoc "name" package)))
     (define package-version (or (and-cdr (assoc "version" package)) "0.0.0"))
     (define package-links (and-cdr (assoc "links" package)))
     (define package-edition (or (and-cdr (assoc "edition" package)) "2015"))

     (define lints (vector->list (or (and-cdr (assoc "lints" internals)) #())))
     (define lints-rust (vector->list (or (and-cdr (assoc "rust" lints)) #())))
     (define lints-rust-unexpected-cfgs (vector->list (or (and-cdr (assoc "unexpected_cfgs" lints-rust)) #())))
     (define check-cfg (or (and-cdr (assoc "check-cfg" lints-rust-unexpected-cfgs)) '()))

     (when (and (vector? package-edition) (and-cdr (assoc "workspace" (vector->list package-edition))))
       (unless workspace (error "Package used edition.workspace = true, but no workspace provided" package-name))
       (set! package-edition (cargo-workspace-edition workspace)))

     (when (and (vector? package-version) (and-cdr (assoc "workspace" (vector->list package-version))))
       (unless workspace (error "Package used version.workspace = true, but no workspace provided" package-name))
       (set! package-version (cargo-workspace-version workspace)))

     (define lib-target #f)
     (when (or (assoc "lib" internals) (vfs-file-ref vfs "src" "lib.rs"))
       (set! lib-target (cargo-target-from-toml vfs (or (and-cdr (assoc "lib" internals)) #()) package-name 'lib package-edition)))

     (define other-targets '())
     (cond
      ((assoc "bin" internals)
       (for-each
        (lambda (bindata)
         (set! other-targets (cons (cargo-target-from-toml vfs bindata package-name 'bin package-edition) other-targets)))
        (cdr (assoc "bin" internals))))
      ((vfs-file-ref vfs "src" "main.rs")
       (set! other-targets (cons (cargo-target-from-toml vfs (vector (cons "name" package-name) (cons "path" "src/main.rs")) package-name 'bin package-edition) other-targets))))

     (define build-file-path (and-cdr (assoc "build" package)))
     (when (vfs-file-ref vfs "" "build.rs")
       (set! build-file-path "build.rs"))
     (define build-script-target #f)
     (when build-file-path
       (set! build-script-target (make-cargo-target (cratify-name (string-append package-name "_buildscript")) build-file-path #f #f #f #f #f #f package-edition 'bin '("default"))))

     (define dependencies
       (map
         (lambda (kv)
           (cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace #f))
         (vector->list (or (and-cdr (assoc "dependencies" internals)) #()))))

     (define build-dependencies
       (map
         (lambda (kv)
           (cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace #f))
         (vector->list (or (and-cdr (or (assoc "build-dependencies" internals) (assoc "build_dependencies" internals))) #()))))

     ; Merge in dependencies in target.{matching cfg or target}.dependencies?
     (for-each
       (lambda (target-pair)
         (define target (car target-pair))
         (define contents (cdr target-pair))
         (define matches
           (if (and (string-prefix? "cfg(" target) (string-suffix? ")" target))
             (cfg-matches (cfg-parse (string-copy target 4 (- (string-length target) 1))) cfg-values)
             (string=? target cfg-target)))
         (when matches
           (set! dependencies
             (append
               (map
                 (lambda (kv)
                   (cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace #f))
                 (vector->list (or (and-cdr (assoc "dependencies" (vector->list contents))) #())))
               dependencies))
           (set! build-dependencies
             (append
               (map
                 (lambda (kv)
                   (cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace #f))
                 (vector->list (or (and-cdr (assoc "build-dependencies" (vector->list contents))) #())))
               build-dependencies))))
       (vector->list (or (and-cdr (assoc "target" internals)) #())))

     (define own-features (parse-features (vector->list (or (and-cdr (assoc "features" internals)) #())) (map cargo-dependency-name dependencies) (map cargo-dependency-name build-dependencies)))
     (make-cargo-crate package-name package-version package-edition workspace dependencies build-dependencies own-features lib-target build-script-target other-targets package-links (append check-cfg (if workspace (cargo-workspace-check-cfg-lint workspace) '()))))

   (define (parse-cargo-workspace internals)
     (define workspace (vector->list (cdr (assoc "workspace" internals))))
     (define workspace-members (or (and-cdr (assoc "members" workspace)) '()))
     (define workspace-exclude (or (and-cdr (assoc "exclude" workspace)) '()))

     (define lints (vector->list (or (and-cdr (assoc "lints" internals)) #())))
     (define lints-rust (vector->list (or (and-cdr (assoc "rust" lints)) #())))
     (define lints-rust-unexpected-cfgs (vector->list (or (and-cdr (assoc "unexpected_cfgs" lints-rust)) #())))
     (define check-cfg (or (and-cdr (assoc "check-cfg" lints-rust-unexpected-cfgs)) '()))

     (define package (vector->list (or (and-cdr (assoc "package" workspace)) #())))
     (define package-edition (and-cdr (assoc "edition" package)))
     (define package-version (and-cdr (assoc "version" package)))

     (define workspace-record (make-cargo-workspace workspace-members workspace-exclude #f package-edition package-version check-cfg))
     (define dependencies
       (map
         (lambda (kv)
           (cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) #f #t))
         (vector->list (or (and-cdr (assoc "dependencies" workspace)) #()))))
     (set-cargo-workspace-dependencies! workspace-record dependencies)
     workspace-record)

   ;; Parse the contents of a `Cargo.toml`. Returns two values: A `<cargo-crate>`
   ;; representing the crate (or `#f` if this is purely a workspace), and a
   ;; `<cargo-workspace>` the `Cargo.toml` defined (or the workspace passed in,
   ;; if any).
   ;;
   ;; - `vfs`: The VFS to use to automatically detect `bin` and `lib` targets.
   ;; - `cargo-file`: A string representing the contents of the `Cargo.toml` to use.
   ;; - `workspace`: A workspace that this rcate is part of, or `#f` if none.
   (define (parse-cargo-toml vfs cargo-file workspace)
     (define internals (vector->list (parse-toml cargo-file)))
     (define crate #f)
     (when (assoc "workspace" internals)
       (when workspace
         (error "Crate already is in a workspace." cargo-file))
       (set! workspace (parse-cargo-workspace internals)))
     (when (assoc "package" internals)
       (set! crate (parse-cargo-package vfs internals workspace)))
     (values crate workspace))))