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

(zilch lang go): introduce proper vfs record

Browse source 
This should hopefully make the code a bit clearer, and is preparation
for Rust support.
This commit is contained in:
puck 2024-11-01 00:12:04 +00:00
parent 0c575ca0e4
commit fc8aea8fb4
5 changed files with 228 additions and 162 deletions
Download patch file Download diff file Expand all files Collapse all files

1
lang/go/default.nix
View file

@ -8,6 +8,7 @@
r7rs
json
srfi-152
srfi-113
srfi-207
(callPackage ../../core {})

60
lang/go/src/mod.sld
View file

@ -55,7 +55,7 @@
(set-cdr! loc (cons (cons (go-sum-version line) (delay (vfs-from-dirhash line))) (cdr loc))))))
go-sum))
(define (add-modules-from-sum nvfs dir)
(define sumfile (vector-get-kv-value "go.sum" (vector-get-kv-value dir nvfs)))
(define sumfile (vfs-file-ref nvfs dir "go.sum"))
(when sumfile
(parse-sumfile (call-with-port (store-path-open sumfile) parse-go-sum-file))))
@ -63,7 +63,7 @@
(fprintf (current-error-port) "Collecting required modules\n")
(define (find-requires-from-mod vfs dir)
(define modfile (vector-get-kv-value "go.mod" (vector-get-kv-value dir vfs)))
(define modfile (vfs-file-ref vfs dir "go.mod"))
(define pathname #f)
(when modfile
(let*
@ -88,8 +88,8 @@
pathname)
(define root-path-name #f)
(define (handle-vfs nvfs)
(add-modules-from-sum nvfs "/")
(find-requires-from-mod nvfs "/"))
(add-modules-from-sum nvfs "")
(find-requires-from-mod nvfs ""))
(for-each
(lambda (vfs)
@ -145,27 +145,28 @@
(define go-files (cdr (assoc "goFiles" pairs)))
(define s-files (if (and (assoc "sFiles" pairs) (list? (cdr (assoc "sFiles" pairs)))) (cdr (assoc "sFiles" pairs)) '()))
(define imports (cdr (assoc "imports" pairs)))
; format: ((pattern . (fname file dir)))
; format: ((pattern . (file-name dir file)))
(define embed-vectors (cdr (assoc "embeds" pairs)))
(define embeds (if (vector? embed-vectors) (vector->list embed-vectors) '()))
(define embed-filenames '())
; Creates a list of (pattern-text . (filename-1 filename-2 ...)).
(define embed-patterns (map (lambda (pattern) (cons (car pattern) (if (list? (cdr pattern)) (map car (cdr pattern)) '()))) embeds))
(for-each
(lambda (pattern)
(when (list? pattern)
(for-each
(lambda (fname)
(define new-fname (cadr fname))
(if (string=? "//" new-fname) (set! new-fname "/"))
(define dir (vector-get-kv-value new-fname vfs))
(define file-obj (vector-get-kv-value (car (cddr fname)) dir))
(unless (assoc (car fname) embed-filenames) (set! embed-filenames (cons (cons (car fname) file-obj) embed-filenames))))
(lambda (entry)
(define target-file-name (list-ref entry 2))
(define target-directory (list-ref entry 1))
(define file-obj (vfs-file-ref vfs target-directory target-file-name))
(unless (assoc (car entry) embed-filenames) (set! embed-filenames (cons (cons (car entry) file-obj) embed-filenames))))
(cdr pattern))))
embeds)
(define vfsdir (vector-get-kv-value last-part vfs))
(let
((collected-files (map (lambda (name) (cons name (vector-get-kv-value name vfsdir))) go-files))
(collected-assembly-files (map (lambda (name) (cons name (vector-get-kv-value name vfsdir))) s-files))
((collected-files (map (lambda (name) (cons name (vfs-file-ref vfs last-part name))) go-files))
(collected-assembly-files (map (lambda (name) (cons name (vfs-file-ref vfs last-part name))) s-files))
(collected-assembly-includes (if (= (length s-files) 0) '() #~,(string-append #$(force headers) last-part)))
(collected-imports (map (lambda (name) (if (is-builtin name) (go-stdlib-ref name) (find-package name)))
(filter (lambda (name) (not (member name '("builtin" "unsafe")))) imports))))
@ -174,30 +175,27 @@
(define packages (mapping (make-default-comparator)))
(define (process-packages-for-module root-path vfs)
(define (dir-has-valid-contents contents)
(vector-any
(lambda (entry)
(or
(eq? (car entry) "go.mod")
(string-suffix? ".go" (car entry))))
contents))
(define (list-any filter entries)
(cond
((eq? entries '()) #f)
((filter (car entries)) #t)
(else (list-any filter (cdr entries)))))
(define module-packages
(find-packages-inside-vfs
(vector-map
(lambda (pair)
(cons
(car pair)
(if (dir-has-valid-contents (cdr pair))
(cdr pair)
(vector-map (lambda (pair) (cons (car pair) "/dev/null")) (cdr pair)))))
(vfs-dir-filter-all
(lambda (dirname)
(list-any
(lambda (entry)
(or (eq? (car entry) "go.mod")
(string-suffix? ".go" (car entry))))
(vfs-dir-files vfs dirname)))
vfs)))
(define headers (delay (vfs-to-store (filter-vfs vfs (lambda (dir fname) (string-suffix? ".h" fname))))))
(define headers (delay (vfs-to-store (vfs-dir-filter vfs (lambda (dir fname contents) (string-suffix? ".h" fname))))))
(vector-for-each
(lambda (pair)
(define full-path (string-append root-path (car pair)))
(set! full-path (string-copy full-path 0 (- (string-length full-path) 1)))
(define full-path (string-append root-path (if (string=? (car pair) "") "" "/") (car pair)))
(define pairs (vector->list (cdr pair)))
(set! packages (mapping-set! packages full-path (delay (process-package vfs (car pair) full-path pairs headers)))))
module-packages))

2
lang/go/src/package.sld
View file

@ -25,7 +25,7 @@
#~,(call-with-port
(open-output-bytevector)
(lambda (bv)
(json-write (vector (cons "GOARCH" (%goarch)) (cons "GOOS" "linux") (cons "files" #$(filter-vfs-for-package-reading vfs))) bv)
(json-write (vector (cons "GOARCH" (%goarch)) (cons "GOOS" "linux") (cons "files" #$(vfs-to-json (vfs-filter-for-go-package vfs)))) bv)
(get-output-bytevector bv))))
(define input-file (zfile input))
(define store-path (cdar (store-path-for-ca-drv* "find-packages" "x86_64-linux" #~(#$go-import-parser #$input-file) '() '("out"))))

186
lang/go/src/vfs.sld
View file

@ -14,13 +14,60 @@
(json)
(chicken base) (chicken format) (chicken foreign)
(scheme char)
(srfi 4) (srfi 128) (srfi 133) (srfi 146) (srfi 152) (srfi 207)
(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))
(export vfs-from-dirhash vfs-from-directory filter-vfs filter-vfs-for-package-reading vfs-to-store)
(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)
(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)
@ -43,7 +90,7 @@
(map go-stdlib-ref '("archive/zip" "io" "os"))
(list (cons "main.go" (zfile (foreign-value "unzip_one_source" nonnull-c-string)))))))
(define (rewrite-name name)
(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)
@ -53,30 +100,31 @@
;; returning a zdir describing the root directory.
(define (vfs-to-store vfs)
(define dirmap (mapping (make-default-comparator)))
(vector-for-each
(lambda (pair)
(define key (car pair))
(define separator (if (string=? key "/") 0 (string-index-right key (lambda (ch) (char=? ch #\/)) 0 (- (string-length key) 1))))
(unless (string=? key "/")
(let
((dirname (string-copy key 0 (+ 1 separator)))
(fname (string-copy key (+ 1 separator) (- (string-length key) 1))))
(set! dirmap (mapping-set! dirmap dirname (cons (cons fname key) (mapping-ref/default dirmap dirname '())))))))
vfs)
(define (translate-dir name)
(define files (vector-any (lambda (f) (and (string=? (car f) name) (cdr f))) vfs))
(define dirs (mapping-ref/default dirmap name '()))
(zdir (append
(map (lambda (kv) (cons (car kv) (zsymlink (cdr kv)))) (vector->list files))
(map (lambda (k) (cons (car k) (translate-dir (cdr k)))) dirs))))
(translate-dir "/"))
(mapping-for-each
(lambda (k contents)
(define dir (car k))
(define fname (cdr k))
(unless (eq? contents 'directory)
(set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zsymlink contents)) v)) '()))))
(vfs-contents vfs))
(mapping-for-each
(lambda (k contents)
(define dir (car k))
(define fname (cdr k))
(when (eq? contents 'directory)
(let*
((name (string-append dir "/" fname))
(dir (mapping-ref dirmap name)))
(set! dirmap (mapping-update!/default dirmap dir (lambda (v) (cons (cons fname (zdir dir)) v)) '())))))
(vfs-contents vfs))
(zdir (mapping-ref/default dirmap "" '())))
;; 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.
(define (fetch-dirhash-for-sum sum-line)
(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-name (go-sum-module sum-line)) "/@v/" (go-sum-version sum-line) ".zip"))
(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))
@ -84,7 +132,7 @@
;; line.
(define (vfs-from-dirhash sum-line)
(define dirhash-file (fetch-dirhash-for-sum sum-line))
(define url (string-append "https://proxy.golang.org/" (rewrite-name (go-sum-module sum-line)) "/@v/" (go-sum-version sum-line) ".zip"))
(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 zip (fetch-with-known-url "module.zip" url))
(define lines '())
(define prefix-length (string-length (string-append (go-sum-module sum-line) "@" (go-sum-version sum-line) "/")))
@ -96,62 +144,53 @@
(set! hash (hex-string->bytevector (string-copy line 0 64)))
(set! file (string-copy line 66))
(set! lines (cons (cons file hash) lines))))))
(define dirs '())
(define output (mapping (make-default-comparator)))
(for-each
; (path . hash)
(lambda (pair)
(define fpath (string-copy (car pair) prefix-length))
(define slashindex (string-index-right fpath (lambda (c) (char=? c #\/))))
(define dirname "/")
(define filename fpath)
(when slashindex
(set! dirname (string-append "/" (string-copy fpath 0 slashindex) "/"))
(set! filename (string-copy fpath (+ slashindex 1))))
(define file-path (string-copy (car pair) prefix-length))
(define hash (cdr pair))
(define dir (assoc dirname dirs))
(define file (store-path-for-fod "file" "x86_64-linux" #~(#$unpack-zip #$zip ,(car pair)) '() "sha256" (cdr pair) #f))
(unless dir
(set! dirs (cons (list dirname) dirs))
(set! dir (car dirs)))
(define last-slash (string-index-right file-path (lambda (c) (char=? c #\/))))
(define dirname "")
(define filename file-path)
(when last-slash
(set! dirname (string-copy file-path 0 last-slash))
(set! filename (string-copy file-path (+ last-slash 1))))
; Record directory name in the parent directory.
(unless last-slash
(let ((second-to-last-slash (string-index-right dirname (lambda (c) (char=? c #\/)))))
(if second-to-last-slash
(set! output (mapping-set! output (cons (string-copy dirname 0 second-to-last-slash) (string-copy dirname (+ second-to-last-slash 1))) 'directory))
(unless (string=? dirname "") (set! output (mapping-set! output (cons "" dirname) 'directory))))))
(define file (store-path-for-fod "file" "x86_64-linux" #~(#$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?
(unless (or (string-contains dirname "/_") (string-contains dirname "/.") (string-contains dirname "/testdata/") (char=? #\. (string-ref filename 0)) (char=? #\_ (string-ref filename 0)))
(set-cdr! dir (cons (cons filename file) (cdr dir)))))
(set! output (mapping-set! output (cons dirname filename) file))))
lines)
(list->vector (map (lambda (pair) (cons (car pair) (list->vector (cdr pair)))) dirs)))
(make-vfs output))
;; Generates a full VFS structure from an on-disk directory.
(define (vfs-from-directory osdir)
(define iter-dir #f)
(define output '())
(set! iter-dir
(lambda (dirpath)
(define reldir (string-append osdir "/" dirpath))
(define files '())
(define contents (directory (string-append osdir dirpath)))
(for-each
(lambda (name)
(unless (string=? (string-copy name 0 1) ".")
(if (directory-exists? (string-append reldir "/" name))
(iter-dir (string-append dirpath "/" name))
(set! files (cons (cons name (zfile #~,(call-with-input-file (string-append reldir "/" name) read-full-file))) files)))))
contents)
(set! output (cons (cons (string-append dirpath "/") (list->vector files)) output))))
(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 "")
(list->vector output))
;; Calls `filter` for each file in the virtual filesystem, replacing its
;; contents with an empty file if `filter` returns false.
(define (filter-vfs vfs filter)
(vector-map
(lambda (dir)
(cons (car dir)
(vector-map
(lambda (pair)
(if (filter (car dir) (car pair))
(cons (car pair) (cdr pair))
(cons (car pair) "/dev/null")))
(cdr dir))))
vfs))
(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"))
@ -162,8 +201,13 @@
;; Returns a VFS, filtered down to only contain the contents of files that
;; will be read during the processing of Go packages.
(define (filter-vfs-for-package-reading vfs)
(filter-vfs vfs
(lambda (dir fname)
(define (vfs-filter-for-go-package vfs)
(vfs-dir-filter vfs
(lambda (dir fname contents)
(define extension (extract-extension fname (- (string-length fname) 1)))
(member extension good-extensions))))))
(member extension good-extensions))))
(define (vfs-to-json vfs)
(mapping-map->list
(lambda (k v) (list (car k) (cdr k) (if (eq? v 'directory) "" v)))
(vfs-contents vfs)))))

141
lang/go/utils/parser/main.go
View file

@ -52,10 +52,10 @@ func (s *DirStat) Sys() any {
}
type Input struct {
// directory -> filename -> path
Files map[string]map[string]string `json:"files"`
GOARCH string `json:"GOARCH"`
GOOS string `json:"GOOS"`
// list of [directory, filename, target path] (target path is empty, if directory marker)
Files [][3]string `json:"files"`
GOARCH string `json:"GOARCH"`
GOOS string `json:"GOOS"`
}
type Output struct {
@ -66,6 +66,11 @@ type Output struct {
Embeds map[string][][]string `json:"embeds"`
}
type FileOrDir struct {
Directory []string
File string
}
func main() {
inputFile, err := os.Open(os.Args[1])
if err != nil {
@ -77,6 +82,37 @@ func main() {
if err != nil {
panic(err)
}
files := make(map[string]*FileOrDir)
for _, file := range input.Files {
directory := file[0]
filename := file[1]
contents := file[2]
dirslash := directory
if directory != "" {
dirslash = directory + "/"
}
if contents == "" {
_, ok := files[dirslash+filename]
if !ok {
files[dirslash+filename] = &FileOrDir{}
}
} else {
files[dirslash+filename] = &FileOrDir{File: contents}
}
parent, ok := files[directory]
if !ok {
parent = &FileOrDir{}
files[directory] = parent
}
parent.Directory = append(parent.Directory, dirslash+filename)
}
ctx := build.Context{
GOARCH: input.GOARCH,
GOOS: input.GOOS,
@ -89,40 +125,26 @@ func main() {
return nil, fs.ErrNotExist
}
dir = path.Clean(dir[5:])
if dir == "." {
dir = "/"
}
dir = path.Clean(dir[5:])[1:]
if !strings.HasSuffix(dir, "/") {
dir += "/"
}
contents, ok := files[dir]
dircontents, ok := input.Files[dir]
if !ok {
return nil, fs.ErrNotExist
}
infos := make([]fs.FileInfo, len(dircontents))
i := 0
for name, file := range dircontents {
stat, err := os.Stat(file)
if err != nil {
return nil, err
}
infos[i] = &WrappedStat{FileInfo: stat, newName: name}
i = i + 1
}
for key := range input.Files {
if path.Dir(key) == dir {
base := path.Base(key)
if strings.HasPrefix(base, ".") || strings.HasPrefix(base, "_") || base == "testdata" {
continue
infos := make([]fs.FileInfo, len(contents.Directory))
for i, filename := range contents.Directory {
file := files[filename]
if file.File != "" {
stat, err := os.Stat(file.File)
if err != nil {
return nil, err
}
infos = append(infos, &DirStat{base})
infos[i] = &WrappedStat{FileInfo: stat, newName: path.Base(filename)}
} else {
infos[i] = &DirStat{path.Base(filename)}
}
}
@ -136,16 +158,13 @@ func main() {
return nil, fs.ErrNotExist
}
pth = path.Clean(pth[5:])
dirname, fname := path.Split(pth)
if dirname == "." {
dirname = "/"
}
dir := input.Files[dirname]
pth = path.Clean(pth[5:])[1:]
fmt.Printf("-> OpenFile(%q)\n", pth)
fil := files[pth]
data, err := os.Open(dir[fname])
data, err := os.Open(fil.File)
if err != nil {
return data, fmt.Errorf("OpenFile(%q; %q[%q]; %q): %w", opth, dirname, fname, dir[fname], err)
return data, fmt.Errorf("OpenFile(%q; %q): %w", opth, pth, err)
}
return data, err
},
@ -156,18 +175,11 @@ func main() {
return false
}
dir = path.Clean(dir[5:])
if dir == "." {
dir = "/"
}
dir = path.Clean(dir[5:])[1:]
if !strings.HasSuffix(dir, "/") {
dir += "/"
}
_, ok := input.Files[dir]
fmt.Printf("IsDir -> %q, %v\n", dir, ok)
return ok
contents, ok := files[dir]
fmt.Printf("IsDir -> %q, %v, %v\n", dir, contents, ok)
return ok && contents.File == ""
},
HasSubdir: func(root, dir string) (rel string, ok bool) {
@ -179,17 +191,21 @@ func main() {
}
var filenames []string
for dirname, files := range input.Files {
for filename := range files {
filenames = append(filenames, filepath.Join(dirname, filename))
for _, filedata := range input.Files {
if filedata[2] != "" {
filenames = append(filenames, filepath.Join(filedata[0], filedata[1]))
}
}
files := make(map[string]Output)
outfiles := make(map[string]Output)
for dir, filelist := range files {
if filelist.File != "" {
continue
}
for dir, filelist := range input.Files {
isGo := false
for file := range filelist {
for _, file := range filelist.Directory {
if strings.HasSuffix(file, ".go") {
isGo = true
break
@ -203,13 +219,16 @@ func main() {
}
base := path.Base(dir)
if base == "." {
base = ""
}
if !isGo || strings.HasPrefix(base, "_") || strings.HasPrefix(base, ".") || base == "testdata" {
fmt.Printf(" skipping (not go)\n")
continue
}
pkg, err := ctx.Import(".", path.Clean("/code"+dir), 0)
pkg, err := ctx.Import(".", path.Clean("/code/"+dir), 0)
if err != nil {
if _, ok := err.(*build.NoGoError); ok {
continue
@ -267,13 +286,17 @@ func main() {
sort.Strings(matchedFiles)
var split [][]string
for _, match := range matchedFiles {
split = append(split, []string{match[len(dir):], filepath.Dir(match) + "/", filepath.Base(match)})
dirname := filepath.Dir(match)
if dirname == "." {
dirname = ""
}
split = append(split, []string{match[len(dir)+1:], dirname, filepath.Base(match)})
}
out.Embeds[pattern] = split
}
files[dir] = out
outfiles[dir] = out
}
out, err := os.OpenFile(os.Getenv("out"), os.O_CREATE|os.O_RDWR, 0666)
@ -281,7 +304,7 @@ func main() {
panic(err)
}
if err := json.NewEncoder(out).Encode(files); err != nil {
if err := json.NewEncoder(out).Encode(outfiles); err != nil {
panic(err)
}