guix: build fixes.

* bin/builtin.in: Remove gratuitous quotes.
* configure (BUILTINS): Add bash and sh scripts.
* gash/builtins.scm (command-command): Add missing format parameter.
(type-command): Likewise.
* gash/guix-build-utils.scm: Use (ice-9 format).
* gash/guix-utils.scm: Likewise.
* gash/ustar.scm (write-ustar-port): Remove catch.
(read-ustar-port): Likewise.

bin/builtin.in

@@ -1,7 +1,8 @@
 #! @GUILE@ \
---no-auto-compile -e main -L "@GUILE_SITE_DIR@" -C "@GUILE_SITE_CCACHE_DIR@" -L . -C . -s
+--no-auto-compile -e main -L @GUILE_SITE_DIR@ -C @GUILE_SITE_CCACHE_DIR@ -L . -C . -s
 !#
 ;;; Gash --- Guile As SHell
+;;; Copyright © 2016,2017,2018 R.E.W. van Beusekom <rutger.van.beusekom@gmail.com>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Gash.

bin/gash.in

@@ -1,5 +1,5 @@
 #! @GUILE@ \
---no-auto-compile -e main -L "@GUILE_SITE_DIR@" -C "@GUILE_SITE_CCACHE_DIR@" -L . -C . -s
+--no-auto-compile -e main -L @GUILE_SITE_DIR@ -C @GUILE_SITE_CCACHE_DIR@ -L . -C . -s
 !#
 ;;; Gash --- Guile As SHell
 ;;; Copyright © 2016,2017,2018 R.E.W. van Beusekom <rutger.van.beusekom@gmail.com>

configure

@@ -35,6 +35,7 @@ sed \
     bin/gash.in > bin/gash
 chmod +x bin/gash
 BUILTINS="
+bash
 cat
 compress
 cp
@@ -42,6 +43,7 @@ find
 grep
 ls
 reboot
+sh
 tar
 wc 
 which

gash/builtins.scm

@@ -167,7 +167,7 @@ Options:
                   (cond (builtin (format #t "~a is a shell builtin\n" command)
                                  0)
                         (else (let ((program (PATH-search-path command)))
-                                (if (string? program) (begin (format #t "~a hashed (~a)\n" command ) 0)
+                                (if (string? program) (begin (format #t "~a hashed (~a)\n" command program) 0)
                                     1))))))
                ((option-ref options 'show #f)
                 (let* ((command (car files))
@@ -217,7 +217,7 @@ Options:
                   (cond (builtin (format #t "~a is a shell builtin\n" command)
                                  0)
                         (else (let ((program (PATH-search-path command)))
-                                (if (string? program) (begin (format #t "~a hashed (~a)\n" command ) 0)
+                                (if (string? program) (begin (format #t "~a hashed (~a)\n" command program) 0)
                                     1))))))))))))
 
 (define test-command

gash/config.scm.in

@@ -37,7 +37,11 @@
   "@BZIP2@")
 
 (define %compress
-  "@COMPRESS@")
+  (let ((compress "@COMPRESS@")
+        (reloc (string-append (dirname (car (command-line))) "/compress")))
+    (cond ((getenv "COMPRESS"))
+          ((file-exists? compress) compress)
+          ((file-exists? reloc) reloc))))
 
 (define %gzip
   "@GZIP@")

gash/guix-build-utils.scm

@@ -32,6 +32,7 @@
   #:use-module (srfi srfi-26)
 
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 rdelim)

gash/guix-utils.scm

@@ -34,25 +34,11 @@
 
 (define-module (gash guix-utils)
   #:use-module (srfi srfi-1)
-  ;; #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
-  ;; #:use-module (srfi srfi-26)
-  ;; #:use-module (srfi srfi-35)
-  ;; #:use-module (srfi srfi-39)
-  ;; #:use-module (ice-9 binary-ports)
-  ;; #:autoload   (rnrs io ports) (make-custom-binary-input-port)
-  ;; #:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
-  ;; #:use-module (guix memoization)
-  ;; #:use-module ((guix build utils) #:select (dump-port mkdir-p))
-  ;; #:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
-  ;; #:use-module (ice-9 format)
+  #:use-module (ice-9 format)
   #:autoload   (ice-9 popen)  (open-pipe*)
-  ;; #:autoload   (ice-9 rdelim) (read-line)
-  ;; #:use-module (ice-9 regex)
+  #:use-module ((gash guix-build-utils) #:select (dump-port))
   #:use-module (ice-9 match)
-  ;; #:use-module (ice-9 format)
-  ;; #:use-module ((ice-9 iconv) #:prefix iconv:)
-  ;; #:use-module (system foreign)
   #:use-module (gash config)
   #:export (filtered-port
             compressed-port

gash/ustar.scm

@@ -497,18 +497,10 @@
     (newline)))
 
 (define* (write-ustar-port out files #:key group mtime numeric-owner? owner verbosity)
-  (catch #t
-    (lambda _
-      (for-each
-       (cut write-ustar-file out <>
-            #:group group #:mtime mtime #:numeric-owner? numeric-owner? #:owner owner #:verbosity verbosity)
-       files)
-      (write-ustar-footer out))
-    (lambda (key subr message args . rest)
-      (false-if-exception (delete-file file-name))
-      (format (current-error-port) "ERROR: ~a\n"
-              (apply format #f message args))
-      (exit 1))))
+  (for-each
+   (cut write-ustar-file out <>
+        #:group group #:mtime mtime #:numeric-owner? numeric-owner? #:owner owner #:verbosity verbosity)
+   files))
 
 (define* (write-ustar-archive file-name files #:key group mtime numeric-owner? owner verbosity)
   (catch #t
@@ -523,19 +515,13 @@
       (exit 1))))
 
 (define* (read-ustar-port in files #:key (extract? #t) verbosity)
-  (catch #t
-    (lambda _
-      (let loop ((header (read-ustar-header in)))
-        (when (and header
-                   (not (eof-object? header)))
-          (unless (zero? verbosity)
-            (display-header header #:verbose? (> verbosity 1)))
-          (read-ustar-file in header #:extract? extract?)
-          (loop (read-ustar-header in)))))
-    (lambda (key subr message args . rest)
-      (format (current-error-port) "ERROR: ~a\n"
-              (apply format #f message args))
-      (exit 1))))
+  (let loop ((header (read-ustar-header in)))
+    (when (and header
+               (not (eof-object? header)))
+      (unless (zero? verbosity)
+        (display-header header #:verbose? (> verbosity 1)))
+      (read-ustar-file in header #:extract? extract?)
+      (loop (read-ustar-header in)))))
 
 (define* (read-ustar-archive file-name files #:key (extract? #t) verbosity)
   (catch #t

stack.scm

@@ -1,59 +0,0 @@
-(use-modules (ice-9 match))
-
-(use-modules (system vm frame)
-             (system vm trace))
-
-(define (to-string o)
-  (match o
-    ((? string?) o)
-    ((? symbol?) (symbol->string o))
-    ((? number?) (number->string o))
-    ((? list?) (string-join (map to-string o) " "))
-    ((? pair?) (string-join (list (to-string (car o)) (to-string (cdr o))) " "))
-    (_ "???")))
-
-(define (location frame)
-  (let ((source (frame-source frame)))
-    (if source
-        (let* ((args (frame-arguments frame))
-               (args (if (null? args) "" (string-append " args: " (to-string args))))
-               (foo (format (current-output-port) "~a\n" (frame-procedure frame))))
-          (string-append (cadr source) ":"
-                              (number->string  (caddr source)) ":" args))
-        source)))
-
-(define (stack-trace)
-  (let ((skip-stack-capture-crap 0)
-        (stack (make-stack #t)))
-    (filter identity (let loop ((frame (stack-ref stack skip-stack-capture-crap)))
-       (if (not (frame? frame)) '()
-           (cons (location frame) (loop (frame-previous frame))))))))
-
-(define (main)
-  (catch #t
-    (lambda ()
-      (with-throw-handler
-          #t
-        foo
-        (lambda (key . args)
-          (stdout "error: " args)
-          (throw 'exception (stack-trace)))))
-    (lambda (key . args)
-      (map stdout (car args)))))
-
-(define (foo)
-  (bar '(a b))
-  (format (current-output-port) "foo\n"))
-
-(define (stdout . o)
-  (map (lambda (o) (display o (current-output-port))) o)
-  (newline)
-  o)
-
-(define (bar arg)
-  (match arg
-    ('a 'a)
-    ((? pair?) (map bar arg)))
-  (format (current-output-port) "bar\n"))
-
-(main)