puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

(zilch lang rust): document

Browse source 
Change-Id: I6a6a6964c8aaff8d5f3e18bc5c7486746b5a2952
This commit is contained in:
puck 2025-06-23 12:22:20 +00:00
parent ae774da043
commit 0340f6e830
10 changed files with 597 additions and 82 deletions
Download patch file Download diff file Expand all files Collapse all files

5
lang/rust/src/build-script.sld
View file

@ -1,3 +1,4 @@
;; Helper procedure to call a build script with the right working directory.
(define-library (zilch lang rust build-script)
(import
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
@ -26,7 +27,9 @@
#:crate-name "runner"
#:edition "2021"
#:emits '(#:link #t))))
;; Call a build script with specified current working directory (as string)
;; and environment (as alist).
(define (call-runner input-script cwd env)
(define output (store-path-for-ca-drv* "build.rs-run" "x86_64-linux"
`(,runner-runner)

142
lang/rust/src/cargo.sld
View file

@ -1,3 +1,4 @@
;; Procedures to parse Cargo files.
(define-library (zilch lang rust cargo)
(import
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
@ -13,21 +14,6 @@
(zilch vfs))
(export
<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
<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-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-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
@ -38,6 +24,21 @@
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)
@ -56,7 +57,22 @@
; (define-values (_ _ _) (process-wait pid))
parsed)
;; dependencies here is a list of (name . version-or-#f). if #f, use any version (should be unambiguous!)
;; 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?
@ -71,7 +87,7 @@
(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)
@ -85,7 +101,7 @@
(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)
@ -98,7 +114,10 @@
; - 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?
@ -111,7 +130,9 @@
(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?
@ -120,7 +141,8 @@
(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?
@ -129,6 +151,17 @@
(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?
@ -148,7 +181,39 @@
(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?
@ -175,6 +240,15 @@
(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?
@ -190,7 +264,7 @@
(cargo-workspace-members entry)
(cargo-workspace-exclude entry)
(cargo-workspace-dependencies entry)))
(foreign-declare "#include \"cfgfetch_source.h\"")
(define cfgfetch-bin
(cdar
@ -210,6 +284,8 @@
(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 '())))))
@ -224,7 +300,7 @@
(define (and-cdr-default val default)
(if val (cdr val) default))
(define (find-dependency-in-list l dep-name)
(cond
((null? l) #f)
@ -238,12 +314,12 @@
(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)))
@ -310,7 +386,7 @@
(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")
@ -343,7 +419,7 @@
(unless vfs (error "no vfs"))
(define package (vector->list (cdr (assoc "package" internals))))
(define package-name (cdr (assoc "name" package)))
(define package-version (cdr (assoc "version" 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"))
@ -363,7 +439,7 @@
(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)
@ -445,6 +521,14 @@
(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)

10
lang/rust/src/cfg.sld
View file

@ -1,3 +1,5 @@
;; Procedures to parse `cfg` attributes, as well as match them against
;; conditionals found in crate definitions.
(define-library (zilch lang rust cfg)
(import
(scheme base)
@ -35,6 +37,12 @@
(let ((end (or (string-skip strval is-ident-rest (+ index 1)) (string-length strval))))
(tokenize-cfg strval end (cons (cons 'ident (string-copy strval index end)) tail)))
(error "Unexpected character in cfg() string" strval))))))
;; Parses a configuration string or expression.
;;
;; - `key="value"` is represented as `('value . (key . value))`, where value can be `#f`.
;; - `all` and `any` are represented as `('all/'any . items)`, where `items` is a list of sub-expressions.
;; - `not(...)` is represented as `('not . value)`, where `value` is a sub-expression.
(define (cfg-parse str)
(define tokens (tokenize-cfg str 0 '()))
(define (expect token)
@ -100,6 +108,8 @@
(cons 'value (cons left right))))))
(parse-expr))
;; Checks whether the parsed expression `expr` matches against the list of
;; config value pairs in `cfgs`.
(define (cfg-matches expr cfgs)
(define (parse-any tail)
(cond

28
lang/rust/src/registry.sld
View file

@ -1,3 +1,4 @@
;; Procedures to parse lockfiles, and fetch crates from lockfile entries.
(define-library (zilch lang rust registry)
(import
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
@ -11,8 +12,10 @@
(export
parse-lockfile fetch-and-unpack-crate
lockfile-entry? lockfile-entry-name lockfile-entry-version lockfile-entry-source lockfile-entry-checksum lockfile-entry-dependencies)
<lockfile-entry> lockfile-entry? lockfile-entry-name
lockfile-entry-version lockfile-entry-source
lockfile-entry-checksum lockfile-entry-dependencies)
(begin
(define yj-path (foreign-value "YJ_PATH" nonnull-c-string))
@ -26,9 +29,19 @@
(close-input-port read-port)
; (define-values (_ _ _) (process-wait pid))
parsed)
;; TODO(puck): source here should probably be a record?
;; dependencies here is a list of (name . version-or-#f). if #f, use any version (should be unambiguous!)
;; The contents of a single lockfile entry.
;;
;; - `name`: The name of the crate
;; - `version`: The version of the crate.
;; - `source`: The source of the crate, as raw URL from the `Cargo.lock`.
;; - `checksum`: A bytevector containing the sha256 of the `.crate` file, if
;; one is available.
;; - `dependencies`: A list of dependencies for this crate. Each dependency
;; is a pair `(crate-name . crate-version)`, where `crate-version` is only
;; set if there is more than one version of the depended crate in the
;; lockfile.
(define-record-type <lockfile-entry>
(make-lockfile-entry name version source checksum dependencies)
lockfile-entry?
@ -37,7 +50,7 @@
(source lockfile-entry-source)
(checksum lockfile-entry-checksum)
(dependencies lockfile-entry-dependencies))
(define-record-printer (<lockfile-entry> entry out)
(fprintf out "#<lockfile-entry ~A ~A ~A csum:~A deps:~A>"
(lockfile-entry-name entry)
@ -152,6 +165,8 @@
(define git-dir (or (get-environment-variable "XDG_CACHE_HOME") (string-append (get-environment-variable "HOME") "/.cache/zilch/git")))
;; Fetch a crate from the internet. Supports the `crates.io` registry source,
;; as well as `git` dependencies. Returns a store path.
(define (fetch-and-unpack-crate lockfile-entry)
(define src (lockfile-entry-source lockfile-entry))
(cond
@ -162,6 +177,7 @@
((equal? src "registry+https://github.com/rust-lang/crates.io-index") (fetch-from-registry lockfile-entry))
(else (error "unknown source " lockfile-entry))))
;; Parse a `Cargo.lock`, returning a list of ``<lockfile-entry>``s.
(define (parse-lockfile file-contents)
(define inputs (vector->list (parse-toml file-contents)))
(define lockfile-version (assoc "version" inputs))

137
lang/rust/src/resolver.sld
View file

@ -1,3 +1,5 @@
;; Implements the resolver, which takes in a lockfile and other crates, and
;; allows resolving the dependencies for said crates.
(define-library (zilch lang rust resolver)
(import
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
@ -13,16 +15,17 @@
(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-pending-features
resolved-package-dependencies
resolved-package-crate resolved-package-build-data
<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-build-data-build-script-out
resolver-download
resolver-resolve-nonoptional
resolver-resolve-resolved-package
@ -49,28 +52,58 @@
#:crate-name "false"
#:edition "2021"
#:emits '(#:link #t)))))
; Used to select a set of crates plus their versions.
;; A helper record used to select a set of crates plus their versions.
;;
;; - `locked-dependencies`: An SRFI 146 mapping of package names to a mapping
;; of version to a pair of `(<lockfile-entry> . unpack-promise)`, where
;; `unpack-promise` is a promise that resolves to a store path containing
;; the crate.
;; - `selected-dependencies`: An SRFI 146 mapping of package names to a list
;; of `(version . <resolved-package>)` pairs, representing the versions of
;; this crate that have been activated.
(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)(?)
; pending-features is a mapping of (package-name . version) to a list of features
(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!))
;; A list of store paths for a `'<resolved-package>`''s build output build output.
;;
;; - `dep-info`: Equivalent to the rustc `dep-info` emit.
;; - `metadata`/`rlib`: A pair `(canonical-name . store-path)` for the
;; `metadata` and `obj` emits respectively.
;; - `transitive-dependencies`: A list of `<resolved-package>` for all
;; transitive dependencies of this resolved package.
;; - `build-script-out`: The store path output from the build script.
;; The format for this output is defined by the `buildscript-runner`.
(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)
(make-resolved-package-build-data dep-info metadata rlib transitive-dependencies 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))
;; A crate target that has been activated.
;;
;; - `name`, `version`: Equivalent to the name and version of the crate this
;; package is a part of.
;; - `cargo-target`: The `<cargo-target>` this `<resolved-package>` is part of.
;; - `target-dependencies': A list of `<cargo-dependency>` records for this
;; package.
;; - `crate`: The `<cargo-crate>` this `<resolved-package>` is part of.
;; - `enabled-features`: A list of feature names that have been activated on
;; this package.
;; - `pending-features`: an SRFI 146 mapping of dependency names to feature
;; names that are waiting for said optional dependency to be activated.
;; - `dependencies`: An SRFI 146 mapping of dependency name to `<resolved-package>`
;; record for said dependency.
;; - `build-data`: `<resolved-package-build-data>`, set once `build-package`
;; is called on it.
;; - `build-script`: The `<resolved-package>` for the build script for this
;; package, if a build script target exists.
(define-record-type <resolved-package>
(make-resolved-package name version fs cargo-target target-dependencies crate enabled-features pending-features dependencies build-data build-script)
resolved-package?
@ -85,8 +118,9 @@
(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.
;; Download and activate a dependency from the registry, in the context of `resolver`.
;; `name` and `version` are used to find the necessary dependency from the `resolver-locked-dependencies`.
(define (resolver-download resolver name version)
(unless version
(error "Resolver wanted non-versioned download" name))
@ -99,7 +133,7 @@
(define version (parse-version (cargo-crate-version parsed-cargo)))
(unless (cargo-crate-lib-target parsed-cargo)
(error "Crate does not have valid [lib] target" (list name)))
(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)) (mapping (make-default-comparator)) #f #f))
@ -113,16 +147,17 @@
(resolver-resolve-nonoptional resolver pkg)
pkg)
;; Preemptively resolve and activate all dependencies not marked optional.
;; Resolve and activate all dependencies not marked optional in `<resolved-package>` `pkg`.
(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.
;; Resolve a dependency of `<resolved-package>` `pkg` by name, activating it if requested.
;; Returns the resolved dependency.
(define (resolver-resolve-resolved-package resolver pkg name activate)
(define resolved-dep (mapping-ref/default (resolved-package-dependencies pkg) name #f))
(define cargo-dep
@ -141,9 +176,9 @@
(resolver-activate-features resolver resolved-dep pending-features))))
resolved-dep)
;; Activate a series of features on an existing <resolved-package>. This will resolve and activate optional dependencies
;; where needed.
;; Activate a list of features on `<resolved-package>` `resolved`,
;; resolving and activating optional dependencies where needed.
(define (resolver-activate-features resolver resolved to-activate)
(for-each
(lambda (feature)
@ -188,8 +223,11 @@
'())))))))
(cdr (or (assoc feature (cargo-crate-features (resolved-package-crate resolved))) (cons '() '()))))))
to-activate))
;; Register a non-registry crate+vfs with the resolver.
;; Register a non-registry `<cargo-crate>` and corresponding vfs with the
;; resolver. If `delayed` is `#t`, does not resolve any non-optional
;; dependency. This is used for loading multiple crates into the resolver in
;; arbitrary order.
(define (resolver-register resolver vfs crate delayed)
(define target (cargo-crate-lib-target crate))
(cond
@ -201,6 +239,7 @@
(map (lambda (target) (resolver-register-target resolver vfs crate target #f delayed)) (cargo-crate-targets crate)))))
;; Register a non-registry crate+vfs with the resolver.
;; If `delayed`, do not resolve the crate's (non-optional) dependencies yet.
(define (resolver-register-target resolver vfs crate target extra-dependencies delayed)
(define build-script #f)
(unless extra-dependencies
@ -216,8 +255,8 @@
(unless delayed
(resolver-resolve-nonoptional resolver pkg))
pkg)
;; Resolves a <cargo-dependency>, returning the <resolved-package>.
;; Resolves a `<cargo-dependency>` through the `resolver`, 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) '()))))
@ -243,7 +282,8 @@
(when (cargo-dependency-features dep)
(resolver-activate-features resolver resolved (cargo-dependency-features dep)))
resolved)))
;; Print the information of a `<resolved-package>` to `current-output-port`.
(define (resolver-print-pkg resolver pkg)
(printf " - version: ~S\n" (resolved-package-version pkg))
(printf " features: ~S\n" (resolved-package-enabled-features pkg))
@ -257,6 +297,7 @@
(printf "\n")))
(resolved-package-target-dependencies pkg)))
;; Print the information of this resolver to `current-output-port`.
(define (resolver-print resolver)
(mapping-for-each
(lambda (k v)
@ -272,6 +313,14 @@
v))
(resolver-selected-dependencies resolver)))
;; Resolve a single crate, using a `<resolver>` internally.
;;
;; - `vfs`: The VFS of the crate.
;; - `cargo-file`: The `<cargo-crate>` to process.
;; - `parsed-lockfile`: A list of ``<lockfile-entry>``s necessary to resolve the crate.
;; - `activated-features`: A list of features to activate on the targets in `<cargo-crate>`
;;
;; Returns a list of ``<resolved-package>``s for the targets in `cargo-file`.
(define (process-cargo-with-lockfile vfs cargo-file parsed-lockfile activated-features)
(define locked-dependencies (mapping (make-default-comparator)))
(for-each
@ -293,6 +342,8 @@
pkgs)
pkgs)
;; Resolve a list of `(<cargo-crate> . vfs)` pairs plus a list of ``<lockfile-entry>``,
;; returning a list of `<resolved-package>` for each target in the crates.
(define (process-many-with-lockfile vfs-cargo-map parsed-lockfile)
(define locked-dependencies (mapping (make-default-comparator)))
(for-each
@ -361,6 +412,14 @@
(reverse envs))
(mapping-map->list (lambda (k v) (cons k v)) final-env))
;; Builds a `<resolved-package>`, using specified build script and compiler overrides.
;;
;; - `build-script-env-overrides`: A procedure that takes two arguments `(proc crate-name is-dependency)`,
;; and returns `#f`, or a list of pairs to add to the environment of the build script, if any is executed.
;; - `compiler-env-overrides`: A procedure that takes two arguments `(proc crate-name is-dependency)`, and
;; returns `#f` or a list of pairs to add to the environment of `rustc` when compiling said crate.
;;
;; Returns the `rlib` (or linked output, for binaries) of this `<resolved-package>`.
(define (build-package resolved build-script-env-overrides compiler-env-overrides)
; Info we need to collect:
; - enabled features
@ -377,11 +436,9 @@
; 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))))
@ -524,7 +581,7 @@
(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))
@ -557,10 +614,8 @@
(for-each (lambda (check) (set! params `(check-cfg: ,check . ,params))) (cargo-crate-check-cfg-lint (resolved-package-crate resolved)))
(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)
@ -570,33 +625,31 @@
(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)))
; Rust is nitpicky about the filenames, fix them with copious symlinking.
(define rlib-file (cdar (apply call-rustc `(,path (("_zilch_inherit" . ,#~,(string-join #$inherited-build-script-out " ")) . ,rustc-env) search-path: ("dependency" . ,transitive-dependencies-rlib) emits: (link: #t) ,@bin-flags . ,params))))
(define rlib-file (cdar (apply call-rustc `(,path (("_zilch_inherit" . ,#~,(string-join #$inherited-build-script-out " ")) . ,rustc-env) search-path: ("dependency" . ,transitive-dependencies-rlib) emits: (link: #t) . ,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))
(set-resolved-package-build-data! resolved (make-resolved-package-build-data dep-info metadata rlib transitive-dependencies buildscript-out))
rlib-file)
(define (matches-requirements ver req)

35
lang/rust/src/rust.sld
View file

@ -1,3 +1,4 @@
;; Procedures to build code with `rustc`.
(define-library (zilch lang rust)
(import
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
@ -6,10 +7,12 @@
json
(chicken foreign) (chicken format)
(srfi 4))
(export rustc call-rustc)
(begin
;; Helper containing a store path for the `rustc` used by the rest of the
;; Zilch Rust support.
(define rustc (cdr (assoc "out" (nixpkgs "rustc"))))
(define gcc (delay (cdr (assoc "out" (nixpkgs "gcc")))))
(define linker (delay #~,(string-append #$(force gcc) "/bin/cc")))
@ -59,7 +62,7 @@
(check-one (rustc-emits-dep-info emits) "dep-info")
(check-one (rustc-emits-mir emits) "mir")
(values tail types))
(define (parse-rustc-emits out items)
(if (eq? items '())
out
@ -73,7 +76,7 @@
((#:dep-info) (set-rustc-emits-dep-info! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#:mir) (set-rustc-emits-mir! out (cadr items)) (parse-rustc-emits out (cddr items)))
(else (error "unknown rustc emits param" items)))))
(define (parse-rustc-params out items)
(if (eq? items '())
out
@ -91,11 +94,35 @@
((#:remap-path-prefix) (set-rustc-params-remap-path-prefix! out (cons (cadr items) (rustc-params-remap-path-prefix out))) (parse-rustc-params out (cddr items)))
((#:cap-lints) (set-rustc-params-cap-lints! out (cadr items)) (parse-rustc-params out (cddr items)))
(else (error "unknown rustc param" (car items))))))
(foreign-declare "#include \"rustc_wrap_source.h\"")
(define rustc_wrap-bin
#f)
;; Call rustc with a series of known parameters.
;; `input` represents the input file to call. `env` is an alist of environment
;; variables. The rest of the parameters are passed as two arguments, `foo: bar`,
;; similar to SRFI 89.
;;
;; - `crate-type: 'bin/'lib/etc`: Required. The crate type.
;; - `crate-name: "foo"`: Required. The crate name.
;; - `edition: "2021"/etc`: Required. The edition of Rust to use.
;; - `cfg: "val"`: equivalent to `--cfg val`
;; - `check-cfg: "val"`: equivalent to `--check-cfg val`
;; - `search-path: foo`: Adds `foo` to the library search path. If `foo` is a
;; pair, the `car` is the kind (`"dependency"`, `"crate"`, `"all"`, etc),
;; and the `cdr` is the value.
;; - `link: foo`: Links the generated output with `foo`. If `foo` is a pair,
;; the `car` represents the kind and the `cdr` is the value.
;; - `emits: (..emits data..)`: Set the outputs that `rustc` will generate.
;; Emits data is a list structured like this one. For example, `(asm: #t llvm-bc: "/foo")`
;; will output assembly to a derivation output called "asm", while
;; outputting LLVM bytecode to the path "/foo" in the derivation.
;; - `codegen-flags: ("foo" . "bar")`: Append `-C foo=bar` to the rustc
;; command line. the `cdr` of this pair may be a zexp.
;; - `remap-path-prefix: ("foo" . "bar")`: Remaps the path `foo` to the path
;; `bar` for all error traces. Both values can be a zexp.
;; - `cap-lints: "warn"`: Set the most restrictive lint level.
(define (call-rustc input env . params)
(call-rustc-internal input env (parse-rustc-params (make-rustc-params '() '() '() '() #f #f #f #f '() '() '() #f) params)))