diff --git a/core/default.nix b/core/default.nix index 9a9f68d..849e456 100644 --- a/core/default.nix +++ b/core/default.nix @@ -10,6 +10,7 @@ vector-lib srfi-18 srfi-60 + srfi-113 srfi-128 srfi-132 srfi-146 diff --git a/core/zilch.egg b/core/zilch.egg index 3f7334d..cf178b5 100644 --- a/core/zilch.egg +++ b/core/zilch.egg @@ -1,7 +1,7 @@ ((version "0.0.1") (synopsis "Nix. Noppes. Nada.") (author "puck") - (dependencies socket r7rs vector-lib srfi-60 srfi-128 srfi-132 srfi-146 srfi-151 srfi-152 srfi-180 trace) + (dependencies socket r7rs vector-lib srfi-60 srfi-113 srfi-128 srfi-132 srfi-146 srfi-151 srfi-152 srfi-180 trace) (component-options (csc-options "-X" "r7rs" "-R" "r7rs" "-optimize-level" "3")) (components @@ -39,5 +39,8 @@ (component-dependencies zilch.magic zilch.nix.daemon)) (extension zilch.semver (source "src/semver.sld")) + (extension zilch.vfs + (source "src/vfs.sld") + (component-dependencies zilch.magic zilch.file zilch.zexpr)) (extension zilch.lib.getopt (source "src/lib/getopt.sld")))) diff --git a/lang/go/src/mod.sld b/lang/go/src/mod.sld index 19ee86b..56a755c 100644 --- a/lang/go/src/mod.sld +++ b/lang/go/src/mod.sld @@ -5,6 +5,7 @@ (chicken file) (zilch magic) (zilch file) (zilch zexpr) (zilch nix drv) (zilch nix path) (zilch nixpkgs) + (zilch vfs) (json) (chicken base) (chicken format) (chicken foreign) (scheme char) diff --git a/lang/go/src/package.sld b/lang/go/src/package.sld index d649008..ef101f8 100644 --- a/lang/go/src/package.sld +++ b/lang/go/src/package.sld @@ -3,6 +3,7 @@ (scheme base) (zilch file) (zilch magic) (zilch nixpkgs) (zilch zexpr) + (zilch vfs) json (chicken foreign) (zilch lang go core) (zilch lang go) (zilch lang go vfs) (zilch lang go stdlib)) diff --git a/lang/go/src/vfs.sld b/lang/go/src/vfs.sld index d71166a..bfec072 100644 --- a/lang/go/src/vfs.sld +++ b/lang/go/src/vfs.sld @@ -1,73 +1,22 @@ -;; Contains procedures to work with a very simple virtual filesystem, -;; abstracting between local and in-store store paths. -;; -;; A VFS is defined as a vector containing pairs consisting of the directory's -;; name, with a forward slash prefixed and postfixed (e.g. `/` or `/foo/bar/`). -;; Each pair then contains another vector, mapping filename to any value that -;; can be used as a z-expression (e.g. `store-path-for-fod` or `zfile`). +;; Contains go-specific procedures to work with VFSes. (define-library (zilch lang go vfs) (import - (scheme base) (scheme write) (scheme read) (scheme file) (scheme process-context) (scheme lazy) (scheme case-lambda) + (scheme base) (scheme write) (scheme file) (scheme process-context) (scheme lazy) (chicken file) (zilch magic) (zilch file) (zilch zexpr) (zilch nix drv) (zilch nix path) (zilch nixpkgs) + (zilch vfs) (json) - (chicken base) (chicken format) (chicken foreign) + (chicken base) (chicken foreign) (scheme char) (srfi 4) (srfi 113) (srfi 128) (srfi 133) (srfi 146) (srfi 152) (srfi 207) (zilch lang go) (zilch lang go core) (zilch lang go stdlib) (zilch lang go sum) (zilch lang go fetch) - (chicken foreign)) + (chicken foreign) + (zilch vfs)) - (export vfs? vfs-dir-files vfs-file-ref vfs-dir-filter vfs-dir-filter-all vfs-from-dirhash vfs-from-directory vfs-filter-for-go-package vfs-to-store vfs-to-json) + (export vfs-from-dirhash vfs-filter-for-go-package vfs-to-json) (begin - ;; `contents` is a mapping whose keys are a pair (dir . filename) to file contents (e.g. zfile, or store path). - ;; The file contents may be the symbol 'directory to indicate there's a directory. - ;; - ;; The root directory is specified by `dir` being an empty string. There are no trailing or leading slashes. - (define-record-type - (make-vfs contents) - vfs? - (contents vfs-contents)) - - (define (vfs-dir-files vfs dir) - (mapping-map->list - (lambda (k v) (cons (cdr k) v)) - (mapping-filter - (lambda (key val) - (and (not (eq? val 'directory)) (string=? (car key) dir))) - (vfs-contents vfs)))) - - (define (vfs-file-ref vfs dirname filename) - (mapping-ref/default (vfs-contents vfs) (cons dirname filename) #f)) - - ;; Calls the filter with the dir, filename, and contents, for each file. - ;; If filter returns #f, the file in the vfs will be replaced by /dev/null. - (define (vfs-dir-filter vfs filter) - (make-vfs - (mapping-map/monotone - (lambda (key val) - (if (or (eq? val 'directory) (filter (car key) (cdr key) val)) (values key val) (values key "/dev/null"))) - (make-default-comparator) - (vfs-contents vfs)))) - - ;; Calls the filter for each directory. If the filter returns #f, the directory's files are replaced with `/dev/null`. - (define (vfs-dir-filter-all filter vfs) - (define to-filter-out (set (make-default-comparator))) - (mapping-for-each - (lambda (key val) - (when (and (eq? val 'directory) (not (filter (string-append (car key) "/" (cdr key))))) - (set! to-filter-out (set-adjoin! to-filter-out (string-append (car key) "/" (cdr key)))))) - (vfs-contents vfs)) - (define (is-filtered dirname) - (set-any? (lambda (v) (string=? v dirname)) to-filter-out)) - (make-vfs - (mapping-map/monotone - (lambda (key val) - (if (or (eq? val 'directory) (not (is-filtered (car key)))) (values key val) (values key "/dev/null"))) - (make-default-comparator) - (vfs-contents vfs)))) - (define (read-full-file port) (define buf (make-bytevector 2048 0)) (call-with-port (open-output-bytevector) @@ -76,47 +25,24 @@ (unless (eof-object? read-bytes) (write-bytevector buf outport 0 read-bytes)))))) (foreign-declare "#include \"dirhash_source.h\"") - (define dirhash-generator - (go-package-link - (go-package-compile "main" - (map go-stdlib-ref '("archive/zip" "crypto/sha256" "fmt" "io" "os" "sort")) - (list (cons "main.go" (zfile (foreign-value "dirhash_source" nonnull-c-string))))))) + (delay (go-package-link + (go-package-compile "main" + (map go-stdlib-ref '("archive/zip" "crypto/sha256" "fmt" "io" "os" "sort")) + (list (cons "main.go" (zfile (foreign-value "dirhash_source" nonnull-c-string)))))))) (foreign-declare "#include \"unzip_one_source.h\"") (define unpack-zip - (go-package-link - (go-package-compile "main" - (map go-stdlib-ref '("archive/zip" "io" "os")) - (list (cons "main.go" (zfile (foreign-value "unzip_one_source" nonnull-c-string))))))) + (delay (go-package-link + (go-package-compile "main" + (map go-stdlib-ref '("archive/zip" "io" "os")) + (list (cons "main.go" (zfile (foreign-value "unzip_one_source" nonnull-c-string)))))))) (define (rewrite-go-package-name-for-url name) (define out "") (string-for-each (lambda (ch) (if (char-upper-case? ch) (set! out (string-append out (string #\! (char-downcase ch)))) (set! out (string-append out (string ch))))) name) out) - - ;; Takes a VFS and writes its directory structure into the Nix store, - ;; returning a zdir describing the root directory. - (define (vfs-to-store vfs) - (define dirmap (mapping (make-default-comparator))) - (mapping-for-each - (lambda (k contents) - (define dir (car k)) - (define fname (cdr k)) - (if (eq? contents 'directory) - (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname 'directory) v)) '())) - (set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zsymlink contents)) v)) '())))) - (vfs-contents vfs)) - (define (read-dir dirname) - (define contents (mapping-ref/default dirmap dirname '())) - (for-each - (lambda (pair) - (when (eq? (cdr pair) 'directory) - (set-cdr! pair (read-dir (if (string=? dirname "") (car pair) (string-append dirname "/" (car pair))))))) - contents) - (zdir contents)) - (read-dir "")) ;; Reads a dirhash from a `go.sum` line. This prefetches the module from ;; the go module proxy, and then generates the dirhash without unpacking @@ -125,7 +51,7 @@ (when (go-sum-path sum-line) (error "go.sum line is invalid for fetch-dirhash-for-sum" sum-line)) (define url (string-append "https://proxy.golang.org/" (rewrite-go-package-name-for-url (go-sum-module sum-line)) "/@v/" (go-sum-version sum-line) ".zip")) (define known (fetch-with-known-url "module.zip" url)) - (store-path-for-fod "module" "x86_64-linux" #~(#$dirhash-generator) #~(("src" . #$known)) "sha256" (go-sum-hash sum-line) #f)) + (store-path-for-fod "module" "x86_64-linux" #~(#$(force dirhash-generator)) #~(("src" . #$known)) "sha256" (go-sum-hash sum-line) #f)) ;; Generates a full VFS structure from a module as described by a `go.sum` ;; line. @@ -163,7 +89,7 @@ (set! dirname (string-copy file-path 0 last-slash)) (set! filename (string-copy file-path (+ last-slash 1)))) - (define file (store-path-for-fod "file" "x86_64-linux" #~(#$unpack-zip #$zip ,(car pair)) '() "sha256" hash #f)) + (define file (store-path-for-fod "file" "x86_64-linux" #~(#$(force unpack-zip) #$zip ,(car pair)) '() "sha256" hash #f)) ; Skip files we know for sure won't be used. ; TODO(puck): this should be moved to vfs-filter-for-go-package? @@ -173,24 +99,6 @@ lines) (make-vfs output)) - ;; Generates a full VFS structure from an on-disk directory. - (define (vfs-from-directory osdir) - (define out (mapping (make-default-comparator))) - (define (iter-dir dirpath) - (define reldir (string-append osdir "/" dirpath)) - (define contents (directory reldir)) - (for-each - (lambda (name) - (unless (string=? (string-copy name 0 1) ".") - (if (directory-exists? (string-append reldir "/" name)) - (begin - (iter-dir (if (string=? dirpath "") name (string-append dirpath "/" name))) - (set! out (mapping-set! out (cons dirpath name) 'directory))) - (set! out (mapping-set! out (cons dirpath name) (zfile #~,(call-with-input-file (string-append reldir "/" name) read-full-file))))))) - contents)) - (iter-dir "") - (make-vfs out)) - ;; List extracted from go src/go/build/build.go. (define good-extensions '("go" "c" "cc" "cpp" "cxx" "m" "h" "hh" "hpp" "hxx" "f" "F" "for" "f90" "s" "S" "sx" "swig" "swigcxx" "syso")) (define (extract-extension name i) diff --git a/lang/rust/default.nix b/lang/rust/default.nix index abc038a..98fc73e 100644 --- a/lang/rust/default.nix +++ b/lang/rust/default.nix @@ -11,7 +11,8 @@ srfi-113 srfi-207 (callPackage ../../core {}) - (callPackage ../go {}) + + xxd ]; overrides.preBuild = '' (cat buildrs-runner.rs; printf '\0') | xxd -i -n runner_source > runner_source.h diff --git a/lang/rust/src/cargo.sld b/lang/rust/src/cargo.sld index 4ea566a..4abfc20 100644 --- a/lang/rust/src/cargo.sld +++ b/lang/rust/src/cargo.sld @@ -10,7 +10,7 @@ (srfi 4) (srfi 128) (srfi 146) (srfi 152) (srfi 207) (zilch lang rust registry) (zilch lang rust) (zilch lang rust cfg) (zilch lang rust cfg) - (zilch lang go vfs)) + (zilch vfs)) (export make-cargo-target cargo-target? diff --git a/lang/rust/src/resolver.sld b/lang/rust/src/resolver.sld index 60710fc..b45f313 100644 --- a/lang/rust/src/resolver.sld +++ b/lang/rust/src/resolver.sld @@ -9,7 +9,7 @@ (chicken foreign) (srfi 4) (srfi 128) (srfi 146) (srfi 152) (srfi 207) (zilch lang rust registry) (zilch lang rust) (zilch lang rust cargo) (zilch lang rust build-script) - (zilch lang go vfs)) + (zilch vfs)) (export make-resolver resolver? resolver-locked-dependencies resolver-selected-dependencies