(zilch lang rust): initial commit

This commit is contained in:
puck 2024-11-25 22:06:44 +00:00
parent d52a1e7796
commit 5380ac9307
12 changed files with 1392 additions and 3 deletions

View file

@ -0,0 +1,133 @@
(define-library (zilch lang rust build-script)
(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))
(export
<build-script-output>
make-build-script-output build-script-output?
build-script-output-rerun-if-changed build-script-output-rerun-if-env-changed
build-script-output-link-arg build-script-output-link-lib build-script-output-link-search
build-script-output-flags build-script-output-cfg build-script-output-check-cfg
build-script-output-env build-script-output-warning build-script-output-metadata
call-runner)
(begin
(define-record-type <build-script-output>
(make-build-script-output rerun-if-changed rerun-if-env-changed link-arg link-lib link-search flags cfg check-cfg env warning metadata)
build-script-output?
(rerun-if-changed build-script-output-rerun-if-changed set-build-script-output-rerun-if-changed!)
(rerun-if-env-changed build-script-output-rerun-if-env-changed set-build-script-output-rerun-if-env-changed!)
(link-arg build-script-output-link-arg set-build-script-output-link-arg!)
(link-lib build-script-output-link-lib set-build-script-output-link-lib!)
(link-search build-script-output-link-search set-build-script-output-link-search!)
(flags build-script-output-flags set-build-script-output-flags!)
(cfg build-script-output-cfg set-build-script-output-cfg!)
(check-cfg build-script-output-check-cfg set-build-script-output-check-cfg!)
(env build-script-output-env set-build-script-output-env!)
(warning build-script-output-warning set-build-script-output-warning!)
(metadata build-script-output-metadata set-build-script-output-metadata!))
(define-record-printer (<build-script-output> entry out)
(fprintf out "#<build-script-output changed:~S env-changed:~S flags:~S cfg:~S check-cfg:~S env:~S>"
(build-script-output-rerun-if-changed entry)
(build-script-output-rerun-if-env-changed entry)
(build-script-output-flags entry)
(build-script-output-cfg entry)
(build-script-output-check-cfg entry)
(build-script-output-env entry)))
(define linker (delay (let ((v (cdr (assoc "out" (nixpkgs "gcc"))))) #~,(string-append #$v "/bin/cc"))))
(foreign-declare "#include \"runner_source.h\"")
(define runner-runner
(cdar
(call-rustc
(zfile (foreign-value "runner_source" nonnull-c-string)) '()
#:codegen-flags (cons "linker" (force linker))
#:crate-type 'bin
#:crate-name "runner"
#:edition "2021"
#:emits '(#:link #t))))
(define (parse-build-script-line line out)
;; Rewrite cargo:foo -> cargo::foo
(when (and (string-prefix? "cargo:" line) (not (string-prefix? "cargo::" line)))
(set! line (string-append "cargo::" (string-copy line 6))))
(cond
((string-prefix? "cargo::rerun-if-changed=" line)
(set-build-script-output-rerun-if-changed! out (cons (string-copy line 24) (build-script-output-rerun-if-changed out))))
((string-prefix? "cargo::rerun-if-env-changed=" line)
(set-build-script-output-rerun-if-env-changed! out (cons (string-copy line 28) (build-script-output-rerun-if-env-changed out))))
((string-prefix? "cargo::rustc-flags=" line)
(set-build-script-output-flags! out (cons (string-copy line 19) (build-script-output-flags out))))
((string-prefix? "cargo::rustc-cfg=" line)
(let* ((kv (string-copy line 17))
(splat-start (and (string-suffix? "\"" kv) (string-contains kv "=\""))))
(set-build-script-output-cfg! out
(cons
(if splat-start
(cons (string-copy kv 0 splat-start) (string-copy kv (+ splat-start 2) (- (string-length kv) 1)))
kv)
(build-script-output-cfg out)))))
((string-prefix? "cargo::rustc-check-cfg=" line)
(set-build-script-output-check-cfg! out (cons (string-copy line 23) (build-script-output-check-cfg out))))
((string-prefix? "cargo::rustc-env=" line)
(let* ((kv (string-copy line 17))
(splat-start (string-contains kv "=")))
(set-build-script-output-env! out
(cons
(cons (string-copy kv 0 splat-start) (string-copy kv (+ splat-start 1)))
(build-script-output-env out)))))
((string-prefix? "cargo::metadata=" line)
(let* ((kv (string-copy line 16))
(splat-start (string-contains kv "=")))
(set-build-script-output-metadata! out
(cons
(cons (string-copy kv 0 splat-start) (string-copy kv (+ splat-start 1)))
(build-script-output-metadata out)))))
((string-prefix? "cargo::rustc-link-search=" line)
(let* ((kv (string-copy line 25))
(splat-start (string-contains kv "=")))
(set-build-script-output-link-search! out
(cons
(if splat-start (cons (string-copy kv 0 splat-start) (string-copy kv (+ splat-start 1)))
kv)
(build-script-output-link-search out)))))
((string-prefix? "cargo::rustc-link-lib=" line)
(set-build-script-output-link-lib! out
(cons
(string-copy line 22)
(build-script-output-link-lib out))))
; TODO(puck): bad
((string-prefix? "cargo::" line)
(let* ((kv (string-copy line 7))
(splat-start (string-contains kv "=")))
(set-build-script-output-metadata! out
(cons
(cons (string-copy kv 0 splat-start) (string-copy kv (+ splat-start 1)))
(build-script-output-metadata out)))))))
;; TODO: link-arg-*, warning, others?
(define (parse-build-script-output port)
(define out (make-build-script-output '() '() '() '() '() '() '() '() '() '() '()))
(define (tick)
(define line (read-line port))
(if (eof-object? line)
out
(begin (parse-build-script-line line out) (tick))))
(tick))
(define (call-runner input-script cwd env)
(define output (store-path-for-ca-drv* "build.rs-run" "x86_64-linux" #~(#$runner-runner) #~(("script" . #$input-script) ("cwd" . #$cwd) ("OUT_DIR" . ,(make-placeholder "outdir")) . #$env) '("out" "outdir")))
(printf "meow ~S\n" output)
(values (call-with-port (store-path-open (cdr (assoc "out" output))) parse-build-script-output) (cdr (assoc "outdir" output))))))