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

(zilch lang rust cargo): misc fixes

Browse source
This commit is contained in:
puck 2025-03-02 14:09:00 +00:00
parent 1a0fbbe7c7
commit 493f6712de
1 changed files with 53 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -36,6 +36,7 @@
<cargo-workspace> make-cargo-workspace cargo-workspace?
cargo-workspace-members cargo-workspace-exclude cargo-workspace-dependencies
cargo-workspace-version cargo-workspace-edition
cfg-values
@ -173,11 +174,13 @@
(cargo-crate-targets entry)))
(define-record-type <cargo-workspace>
(make-cargo-workspace members exclude dependencies)
(make-cargo-workspace members exclude dependencies edition version)
cargo-workspace?
(members cargo-workspace-members)
(exclude cargo-workspace-exclude)
(dependencies cargo-workspace-dependencies))
(dependencies cargo-workspace-dependencies set-cargo-workspace-dependencies!)
(edition cargo-workspace-edition)
(version cargo-workspace-version))
(define-record-printer (<cargo-workspace> entry out)
(fprintf out "#<cargo-workspace members:~S exclude:~S deps:~S>"
@ -225,10 +228,10 @@
((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)
(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 (assoc "default-features" object-internals) #t))
(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)))
@ -259,29 +262,34 @@
(define origin (cond
(workspace-dep (cargo-dependency-origin workspace-dep))
(path (make-cargo-dep-path path))
(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))
(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 object crate-name base-type base-edition)
(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) (string-append "src/bin/" name ".rs"))
((example) (string-append "examples/" name ".rs"))
((test) (string-append "tests/" name ".rs"))
((benchmark) (string-append "benches/" name ".rs")))))
((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))))
@ -305,9 +313,10 @@
; "foo/bar" resolves to (("foo" . #t) . "bar")
; "foo?/bar" resolves to (("foo" . #f) . "bar")
(define (parse-features feature-alist dependency-names)
(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)
@ -328,19 +337,34 @@
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 (cdr (assoc "version" package)))
(define package-links (and-cdr (assoc "links" package)))
(define package-edition (or (and-cdr (assoc "edition" package)) "2015"))
(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 (or (and-cdr (assoc "lib" internals)) #()) package-name 'lib package-edition)))
(set! lib-target (cargo-target-from-toml vfs (or (and-cdr (assoc "lib" internals)) #()) package-name 'lib package-edition)))
(define other-targets '())
(when (vfs-file-ref vfs "src" "main.rs")
(set! other-targets (cons (cargo-target-from-toml (vector (cons "name" package-name) (cons "path" "src/main.rs")) package-name 'bin package-edition) 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")
@ -352,15 +376,15 @@
(define dependencies
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace))
(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)) #()))))
;; TODO(puck): target.{matching cfg}.build-dependencies???
(define build-dependencies
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace))
(vector->list (or (and-cdr (assoc "build-dependencies" internals)) #()))))
(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
@ -376,12 +400,12 @@
(append
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) workspace))
(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))))
(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)))
(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))
(define (parse-cargo-workspace internals)
@ -389,13 +413,18 @@
(define workspace-members (or (and-cdr (assoc "members" workspace)) '()))
(define workspace-exclude (or (and-cdr (assoc "exclude" workspace)) '()))
(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))
(define dependencies
(map
(lambda (kv)
(cargo-dependency-from-toml (car kv) (if (string? (cdr kv)) (vector (cons "version" (cdr kv))) (cdr kv)) #f))
(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)) #()))))
(make-cargo-workspace workspace-members workspace-exclude dependencies))
(set-cargo-workspace-dependencies! workspace-record dependencies)
workspace-record)
(define (parse-cargo-toml vfs cargo-file workspace)
(define internals (vector->list (parse-toml cargo-file)))