(zilch lang go vfs): move to (zilch vfs)

It really wasn't that go-specific anymore.

core/default.nix

@@ -10,6 +10,7 @@
     vector-lib
     srfi-18
     srfi-60
+    srfi-113
     srfi-128
     srfi-132
     srfi-146

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"))))

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)

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))

lang/go/src/vfs.sld

@@ -1,73 +1,22 @@
-;; Contains procedures to work with a very simple virtual filesystem,
+;; Contains go-specific procedures to work with VFSes.
-;; 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`).
 (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 <vfs>
-      (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,19 +25,18 @@
               (unless (eof-object? read-bytes) (write-bytevector buf outport 0 read-bytes))))))
 
     (foreign-declare "#include \"dirhash_source.h\"")
-
     (define dirhash-generator
-      (go-package-link
+      (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)))))))
+                (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
+      (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)))))))
+                (list (cons "main.go" (zfile (foreign-value "unzip_one_source" nonnull-c-string))))))))
 
     (define (rewrite-go-package-name-for-url name)
       (define out "")
@@ -96,28 +44,6 @@
                            (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
     ;; said module file.
@@ -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)

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

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
   <cargo-target> make-cargo-target cargo-target?

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
   <resolver> make-resolver resolver? resolver-locked-dependencies resolver-selected-dependencies