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

(zilch lang rust resolver): misc fixes

Browse source
This commit is contained in:
puck 2024-11-27 14:25:49 +00:00
parent b55e725e2f
commit 8cc567a075
1 changed files with 34 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -309,7 +309,8 @@
(define rustc-env (define rustc-env
#~( #~(
; ("CARGO" . "") ; ("CARGO" . "")
("CARGO_MANIFEST_DIR" . "") ("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" . ,(version-str (resolved-package-version resolved)))
("CARGO_PKG_VERSION_MAJOR" . ,(number->string (version-major (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_MINOR" . ,(number->string (version-minor (resolved-package-version resolved))))
@ -333,6 +334,18 @@
(define (upcase-underscore ch) (define (upcase-underscore ch)
(if (char=? ch #\-) #\_ (char-upcase 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)))
(when (resolved-package-build-script resolved) (when (resolved-package-build-script resolved)
(unless (resolved-package-build-data (resolved-package-build-script resolved)) (unless (resolved-package-build-data (resolved-package-build-script resolved))
(build-package (resolved-package-build-script resolved))) (build-package (resolved-package-build-script resolved)))
@ -340,14 +353,16 @@
(lambda (key value) (lambda (key value)
(unless (resolved-package-build-data value) (unless (resolved-package-build-data value)
(build-package value)) (build-package value))
(when (cargo-crate-links (resolved-package-crate value))
(for-each (for-each
(lambda (kv) (lambda (kv)
(set! dependency-metadata (cons (cons (string-map upcase-underscore (string-append "DEP_" (cargo-crate-links (resolved-package-crate value)) "_" (car kv))) (cdr kv)) dependency-metadata))) (set! dependency-metadata (cons (cons (string-map upcase-underscore (string-append "DEP_" (cargo-crate-links (resolved-package-crate value)) "_" (car kv))) (cdr kv)) dependency-metadata)))
(resolved-package-build-data-build-script-metadata (resolved-package-build-data value)))) (resolved-package-build-data-build-script-metadata (resolved-package-build-data value)))))
(resolved-package-dependencies resolved)) (resolved-package-dependencies resolved))
(let*-values (let*-values
(((build-script) (cdr (resolved-package-build-data-rlib (resolved-package-build-data (resolved-package-build-script resolved))))) (((build-script) (cdr (resolved-package-build-data-rlib (resolved-package-build-data (resolved-package-build-script resolved)))))
((build-script-env) (build-script-env-overrides-for-crate (cargo-crate-name (resolved-package-crate resolved)))) ((build-script-env) (build-script-env-overrides-for-crate (cargo-crate-name (resolved-package-crate resolved))))
((rewritten-features) (map (lambda (feature) (cons (string-map upcase-underscore (string-append "CARGO_FEATURE_" feature)) "")) (resolved-package-enabled-features resolved)))
((runner-output runner-outdir) ((runner-output runner-outdir)
(call-runner build-script crate-root (call-runner build-script crate-root
#~( #~(
@ -357,12 +372,13 @@
("OPT_LEVEL" . "0") ("OPT_LEVEL" . "0")
("PROFILE" . "debug") ("PROFILE" . "debug")
("DEBUG" . "true") ("DEBUG" . "true")
,@(make-cfg-values-env cfg-values '())
,@dependency-metadata ,@dependency-metadata
,@rewritten-features
#$@build-script-env #$@build-script-env
; TODO: OUT_DIR, NUM_JOBS, OPT_LEVEL/DEBUG/PROFILE, DEP_* ; TODO: OUT_DIR, NUM_JOBS, OPT_LEVEL/DEBUG/PROFILE, DEP_*
; RUSTC/RUSTDOC?, RUSTC_LINKER? and CARGO_ENCODED_RUSTFLAGS ; RUSTC/RUSTDOC?, RUSTC_LINKER? and CARGO_ENCODED_RUSTFLAGS
. #$rustc-env)))) . #$rustc-env))))
(printf "runner output for ~S: ~S\n" (cargo-crate-name (resolved-package-crate resolved)) runner-output)
(map (map
(lambda (v) (lambda (v)
(if (pair? v) (if (pair? v)
@ -370,9 +386,9 @@
(set! params `(#:cfg ,v . ,params)))) (set! params `(#:cfg ,v . ,params))))
(build-script-output-cfg runner-output)) (build-script-output-cfg runner-output))
(set! buildscript-metadata (build-script-output-metadata runner-output)) (set! buildscript-metadata (build-script-output-metadata runner-output))
(for-each (lambda (kv) (set! rustc-env (cons kv rustc-env))) (build-script-output-env runner-output))
(let ((old-rustc-env rustc-env)) (let ((old-rustc-env rustc-env))
(set! rustc-env #~(("OUT_DIR" . #$runner-outdir) . #$old-rustc-env))) (set! rustc-env #~(("OUT_DIR" . #$runner-outdir) . #$old-rustc-env)))
; Reverse order for scheme reasons.
(for-each (for-each
(lambda (kv) (set! bin-flags `(#:link ,kv . ,bin-flags))) (lambda (kv) (set! bin-flags `(#:link ,kv . ,bin-flags)))
(build-script-output-link-lib runner-output)) (build-script-output-link-lib runner-output))
@ -381,11 +397,10 @@
; This should be replaced with .... $something (a dir of all build script outputs?) ; This should be replaced with .... $something (a dir of all build script outputs?)
(unless (or (null? build-script-env) (null? bin-flags)) (unless (or (null? build-script-env) (null? bin-flags))
(let ((v (cadr bin-flags))) (let ((v (cadr bin-flags)))
(set-cdr! bin-flags (cons #~,(begin #$build-script-env v) (cddr bin-flags))))) (set-cdr! bin-flags (cons #~,(begin #$build-script-env #$runner-outdir v) (cddr bin-flags)))))
(for-each (for-each
(lambda (kv) (set! bin-flags `(#:search-path ,kv . ,bin-flags))) (lambda (kv) (set! bin-flags `(#:search-path ,kv . ,bin-flags)))
(build-script-output-link-search runner-output)) (build-script-output-link-search runner-output))))
(printf "~S bin flags: ~S\n" (cargo-crate-name (resolved-package-crate resolved)) bin-flags)))
; TODO(puck): check-cfg wants check-cfg everywhere ; TODO(puck): check-cfg wants check-cfg everywhere
;(map ;(map
; (lambda (v) ; (lambda (v)
@ -402,10 +417,14 @@
(unless (member value transitive-dependencies) (set! transitive-dependencies (cons value transitive-dependencies))) (unless (member value transitive-dependencies) (set! transitive-dependencies (cons value transitive-dependencies)))
(define data (resolved-package-build-data value)) (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 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 (set! params-meta
`(#:externs (,(cratify-name key) . ,(cdr meta-or-rlib)) . ,params-meta)) `(#:externs (,name . ,(cdr meta-or-rlib)) . ,params-meta))
(set! params (set! params
`(#:externs (,(cratify-name key) . ,(cdr (resolved-package-build-data-rlib data))) . ,params))) `(#:externs (,name . ,(cdr (resolved-package-build-data-rlib data))) . ,params)))
(resolved-package-dependencies resolved)) (resolved-package-dependencies resolved))
(define transitive-dependencies-meta (define transitive-dependencies-meta
@ -437,6 +456,8 @@
(when (eq? crate-type 'proc-macro) (when (eq? crate-type 'proc-macro)
(set! rlib-name (string-append "lib" crate-name "-v" crate-version ".so"))) (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)) (when (or (eq? crate-type 'proc-macro) (eq? crate-type 'bin))
(set! params (append transitive-bin-flags params))) (set! params (append transitive-bin-flags params)))