zilch/lang/go/src/stdlib.sld

(define-library (zilch lang go stdlib)
  (import
    (scheme base) (scheme file) (scheme write) (scheme process-context) (scheme lazy)
    (chicken file) (chicken format)
    (zilch magic) (zilch file) (zilch zexpr)
    (zilch nix drv) (zilch nix path) (zilch nixpkgs)
    (json)
    (chicken foreign)
    (srfi-4)
    (zilch lang go core)
    (zilch lang go))
    
  (export
    go-stdlib-ref)

  (begin
    ;; Helper to read JSON objects until EOF.
    (define (read-all-objects port out)
      (if (eof-object? (peek-char port))
        out
        (read-all-objects port (cons (json-read port) out))))

    ;; Runs `++go list++` (thru `++/bin/sh++`) and reads (IFD) the output to fetch the metadata of the Go standard library and commands.
    (define stdlib-objects
      (map vector->list
        (call-with-port
          (store-path-open
            (cdar (store-path-for-ca-drv*
                    "stdenv"
                    "x86_64-linux"
                    #~("/bin/sh" "-c" ,(string-append "GOCACHE=$TMPDIR/go-cache " #$go-toolchain "/bin/go list -json -deps std cmd > $out"))
                    (env-for-goarch) '("out"))))
          (lambda (port) (read-all-objects port '())))))

    (define (assoc-or-empty name obj)
      (define res (assoc name obj))
      (if res (cdr res) '()))

    ;; Extract everything until the first space.
    ;; Space characters are illegal in Go package names, and `++go list -json std++`
    ;; uses it to disambiguate multiple versions of some internal packages.
    (define (strip-space-bits name)
      (do
        ((x 0 (+ 1 x)))
        ((or
           (>= x (string-length name))
           (char=? (string-ref name x) #\space))
         (if (>= x (string-length name))
           name
           (substring name 0 x)))))
  
    ;; Tail-recursively remove any packages that, if ignoring the postfixed origin
    ;; (e.g. `++unsafe [cmd/compile]++`), match either `++unsafe++` or `++builtin++`;
    ;; these have no source code and are compiler-internal.
    (define (remove-builtin-packages pkgs)
      (if (eq? pkgs '())
        '()
        (let ((stripped (strip-space-bits (car pkgs))))
          (if (or (string=? stripped "unsafe") (string=? stripped "builtin"))
            (remove-builtin-packages (cdr pkgs))
            (cons (car pkgs) (remove-builtin-packages (cdr pkgs)))))))
  
    (define (starts-with left right)
      (and
        (>= (string-length right) (string-length left))
        (string=? left (string-copy right 0 (string-length left)))))
   
    (define (filter condition lst)
      (if (eq? lst '())
        '()
        (if (condition (car lst))
          (cons (car lst) (filter condition (cdr lst)))
          (filter condition (cdr lst)))))
  
    ;; Helper that parses the JSON returned by `++go list -json -deps++` and builds a `++go-package++` record.
    ;; This is distinct from `go-package-compile` because of format differences,
    (define (make-stdlib-inner meta)
      (define files (assoc-or-empty "GoFiles" meta)) ; .go files
      (define sfiles (assoc-or-empty "SFiles" meta)) ; .s files
      (define imports (assoc-or-empty "Imports" meta)) ; imports (denormalised)
      (define importmap (assoc-or-empty "ImportMap" meta)) ; import map
      ; Rewrite the import map to be normalised; we use the normalised import path later on.
      (when (vector? importmap)
        (set! importmap (map (lambda (v) (cons (car v) (strip-space-bits (cdr v)))) (vector->list importmap))))
      (define import-path (cdr (assoc "ImportPath" meta)))
      (define package-name (cdr (assoc "Name" meta)))
      (define name (strip-space-bits import-path))
      ; Deal with commands properly. (Their package name is "main", but we track import path in other cases)
      (when (string=? package-name "main")
        (set! name package-name))
      (define dir (cdr (assoc "Dir" meta)))
       
      ; Fetch dependencies from the rest of the stdlib data.
      ; We only need the `++api++` at this point.
      (define resolved-imports (map (lambda (v) (cons (strip-space-bits v) (go-package-api (go-stdlib-ref v)))) (remove-builtin-packages imports)))

      ; The importcfg encodes the list of (direct) dependencies. Generate this from the "Imports" entry in the `go list -json` output.
      ; This uses a workaround for fetchurl behavior having been changed.
      (define importcfg (zfile #~,(build-importcfg #$resolved-imports importmap)))

      ; If this package uses embeds, process them.
      (define embed-patterns (assoc-or-empty "EmbedPatterns" meta))
      (define embed-files (assoc-or-empty "EmbedFiles" meta))
      ; alist of (<embed pattern>. values)
      (define embedprocessed (map (lambda (l) (cons (strip-space-bits l) (map strip-space-bits (filter (lambda (v) (starts-with l v)) embed-files)))) embed-patterns))

      (define embeds #f)
      (unless (eq? embed-files '())
        (set! embeds
          (zfile #~,(build-embedcfg embedprocessed (map (lambda (k) (cons k (string-append dir "/" k))) embed-files)))))

      ; When compiling assembly code, we first need to generate the symabi; then compile the Go code using that,
      ; and use the go_asm.h output from the Go compilation to compile the rest of the assembly.
      (define symabis #f)
      (unless (eq? sfiles '())
        (set! symabis (go-generate-symabi name dir (map (lambda (f) (string-append dir "/" f)) sfiles))))

      ; Compile the go code. Currently done in one single go, rather than per-file; this is a TODO.
      (define compiled-go (go-compile #t name importcfg symabis embeds (map (lambda (f) (cons f (string-append dir "/" f))) files)))
      (define asmhdrs (cdr (assoc "asmhdr" compiled-go)))

      ; Move the asmhdr output to the right path for the assembly.
      ; TODO: use zfile logic, once this works again.
      (define merged-asmhdr
        (zdir "go_asm.h" (zsymlink asmhdrs)))

      ; Now compile every assembly file, in order.
      (define compiled-assembly
        (map
          (lambda (f) (go-compile-assembly name dir merged-asmhdr (list (cons f (string-append dir "/" f)))))
          sfiles))

      ; Assembly code doesn't have an API, so use the Go code's API only.
      (define go-api (cdr (assoc "api" compiled-go)))

      ; Make a list of the "code" output from the Go with the compiled assembly files.
      ; NOTE: .go has to be compiled in one go; but .s is compiled one file at a time.
      (define all-code (cons (cdr (assoc "code" compiled-go)) compiled-assembly))

      ; Use `go tool pack` to merge the code together.
      (define merged-code
        (cdar
          (store-path-for-ca-drv*
            (string-append "go-" (rewrite-package-name name) "-code") "x86_64-linux"
            #~(,(string-append #$go-toolchain "/bin/go") "tool" "pack" "c" ,(make-placeholder "code") . #$all-code)
            (env-for-goarch)
            '("code"))))

      (make-go-package name import-path go-api merged-code (map go-stdlib-ref (remove-builtin-packages imports))))

    ; Each entry is a list (name metadata (api code)).
    ; Use `++delay++` to resolve the DAG lazily on use.
    (define stdlib-data (map (lambda (v) (list (cdr (assoc "ImportPath" v)) v (delay (make-stdlib-inner v)))) stdlib-objects))
  
    ;; Wrapper that forces evaluation of the promise fetching from a Go stdlib entry.
    (define (go-stdlib-ref name)
      (define entry (assoc name stdlib-data))
      (unless entry (error (string-append "Could not find package " name " in stdlib")))
      (force (list-ref entry 2)))))