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

(zilch lang rust): initial commit

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

140
lang/rust/src/rust.sld Normal file
View file

@ -0,0 +1,140 @@
(define-library (zilch lang rust)
(import
(scheme base) (scheme write) (scheme process-context) (scheme lazy)
(zilch file) (zilch magic) (zilch nix drv) (zilch nix path)
(zilch nixpkgs) (zilch zexpr)
json
(chicken foreign) (chicken format)
(srfi 4))
(export rustc call-rustc)
(begin
(define rustc (cdr (assoc "out" (nixpkgs "rustc"))))
(define-record-type <rustc-emits>
(make-rustc-emits asm llvm-bc llvm-ir obj metadata link dep-info mir)
rustc-emits?
(asm rustc-emits-asm set-rustc-emits-asm!)
(llvm-bc rustc-emits-llvm-bc set-rustc-emits-llvm-bc!)
(llvm-ir rustc-emits-llvm-ir set-rustc-emits-llvm-ir!)
(obj rustc-emits-obj set-rustc-emits-obj!)
(metadata rustc-emits-metadata set-rustc-emits-metadata!)
(link rustc-emits-link set-rustc-emits-link!)
(dep-info rustc-emits-dep-info set-rustc-emits-dep-info!)
(mir rustc-emits-mir set-rustc-emits-mir!))
(define-record-type <rustc-params>
(make-rustc-params cfg check-cfg search-path link crate-type crate-name edition emits externs codegen-flags remap-path-prefix)
rustc-params?
(cfg rustc-params-cfg set-rustc-params-cfg!)
(check-cfg rustc-params-check-cfg set-rustc-params-check-cfg!)
(search-path rustc-params-search-path set-rustc-params-search-path!)
(link rustc-params-link set-rustc-params-link!)
(crate-type rustc-params-crate-type set-rustc-params-crate-type!)
(crate-name rustc-params-crate-name set-rustc-params-crate-name!)
(edition rustc-params-edition set-rustc-params-edition!)
(emits rustc-params-emits set-rustc-params-emits!)
(externs rustc-params-externs set-rustc-params-externs!)
(codegen-flags rustc-params-codegen-flags set-rustc-params-codegen-flags!)
(remap-path-prefix rustc-params-remap-path-prefix set-rustc-params-remap-path-prefix!))
(define (rustc-emits-as-list emits tail types)
(define (check-one res name)
(when (and res (boolean? res))
(set! tail (cons "--emit" (cons (string-append name "=" (make-placeholder name)) tail)))
(set! types (cons name types)))
(when (and res (not (boolean? res)))
(set! tail (cons "--emit" (cons #~,(string-append name "=" #$name) tail)))
(set! types (cons name types))))
(check-one (rustc-emits-asm emits) "asm")
(check-one (rustc-emits-llvm-bc emits) "llvm-bc")
(check-one (rustc-emits-llvm-ir emits) "llvm-ir")
(check-one (rustc-emits-obj emits) "obj")
(check-one (rustc-emits-metadata emits) "metadata")
(check-one (rustc-emits-link emits) "link")
(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
(case (car items)
((#:asm) (set-rustc-emits-asm! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#:llvm-bc) (set-rustc-emits-llvm-bc! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#:llvm-ir) (set-rustc-emits-llvm-ir! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#:obj) (set-rustc-emits-obj! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#:metadata) (set-rustc-emits-metadata! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#:link) (set-rustc-emits-link! out (cadr items)) (parse-rustc-emits out (cddr items)))
((#: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
(case (car items)
((#:cfg) (set-rustc-params-cfg! out (cons (cadr items) (rustc-params-cfg out))) (parse-rustc-params out (cddr items)))
((#:check-cfg) (set-rustc-params-check-cfg! out (cons (cadr items) (rustc-params-check-cfg out))) (parse-rustc-params out (cddr items)))
((#:search-path) (set-rustc-params-search-path! out (cons (cadr items) (rustc-params-search-path out))) (parse-rustc-params out (cddr items)))
((#:link) (set-rustc-params-link! out (cons (cadr items) (rustc-params-link out))) (parse-rustc-params out (cddr items)))
((#:crate-type) (set-rustc-params-crate-type! out (cadr items)) (parse-rustc-params out (cddr items)))
((#:crate-name) (set-rustc-params-crate-name! out (cadr items)) (parse-rustc-params out (cddr items)))
((#:edition) (set-rustc-params-edition! out (cadr items)) (parse-rustc-params out (cddr items)))
((#:emits) (set-rustc-params-emits! out (parse-rustc-emits (make-rustc-emits #f #f #f #f #f #f #f #f) (cadr items))) (parse-rustc-params out (cddr items)))
((#:externs) (set-rustc-params-externs! out (cons (cadr items) (rustc-params-externs out))) (parse-rustc-params out (cddr items)))
((#:codegen-flags) (set-rustc-params-codegen-flags! out (cons (cadr items) (rustc-params-codegen-flags out))) (parse-rustc-params out (cddr items)))
((#: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)))
(else (error "unknown rustc param" (car items))))))
(define (call-rustc input env . params)
(call-rustc-internal input env (parse-rustc-params (make-rustc-params '() '() '() '() #f #f #f #f '() '() '()) params)))
(define (call-rustc-internal input-path env params)
(define args (list input-path))
(when (rustc-params-cfg params)
(for-each
(lambda (k) (set! args (cons "--cfg" (cons k args)))) (rustc-params-cfg params)))
(when (rustc-params-check-cfg params)
(for-each
(lambda (k) (set! args (cons "--check-cfg" (cons k args)))) (rustc-params-check-cfg params)))
(when (rustc-params-link params)
(for-each
(lambda (k)
(if (not (pair? k))
(set! args (cons "-l" (cons k args)))
(set! args (cons "-l" (cons #~,(string-append (car k) "=" #$(cdr k)) args)))))
(rustc-params-link params)))
(when (rustc-params-search-path params)
(for-each
(lambda (k)
(if (not (pair? k))
(set! args (cons "-L" (cons #~,(string-append "all=" #$k) args)))
(set! args (cons "-L" (cons #~,(string-append (car k) "=" #$(cdr k)) args)))))
(rustc-params-search-path params)))
(set! args (cons "--crate-type" (cons (symbol->string (rustc-params-crate-type params)) args)))
(set! args (cons "--crate-name" (cons (rustc-params-crate-name params) args)))
(set! args (cons "--edition" (cons (rustc-params-edition params) args)))
(define-values (new-args outputs) (rustc-emits-as-list (rustc-params-emits params) args '()))
(set! args new-args)
(when (rustc-params-externs params)
(for-each
(lambda (k)
(if (pair? k)
(set! args (cons "--extern" (cons #~,(string-append (car k) "=" #$(cdr k)) args)))
(set! args (cons "--extern" (cons k args)))))
(rustc-params-externs params)))
(when (rustc-params-codegen-flags params)
(for-each
(lambda (k)
(set! args (cons "-C" (cons #~,(string-append (car k) "=" #$(cdr k)) args))))
(rustc-params-codegen-flags params)))
(when (rustc-params-remap-path-prefix params)
(for-each
(lambda (k)
(set! args (cons "--remap-path-prefix" (cons #~,(string-append #$(car k) "=" #$(cdr k)) args))))
(rustc-params-remap-path-prefix params)))
(store-path-for-ca-drv* (string-append "rustc-" (symbol->string (rustc-params-crate-type params)) "-" (rustc-params-crate-name params)) "x86_64-linux" #~(,(string-append #$rustc "/bin/rustc") . #$args) env outputs))))