diff --git a/gash/compat.scm b/gash/compat.scm index 3f77e3b..d86518a 100644 --- a/gash/compat.scm +++ b/gash/compat.scm @@ -103,11 +103,16 @@ file-port? input-port? output-port? + call-with-input-file call-with-input-string thunk? EXIT_SUCCESS EXIT_FAILURE + exact? exact-integer? + set-program-arguments + open-file + tmpfile sort) (define-macro (define-inlinable . rest) @@ -220,6 +225,13 @@ (define (input-port? port) #f) (define (output-port? port) #f) + (define (call-with-input-file file proc) + (let ((port (open-input-file file))) + (call-with-values (lambda () (proc port)) + (lambda results + (close-port port) + (apply values results))))) + (define (call-with-input-string str proc) (let ((port (open-input-string str))) (call-with-values (lambda () (proc port)) @@ -242,8 +254,55 @@ (define EXIT_FAILURE 1) ;; Mes only has exact integers. + (define exact? integer?) (define exact-integer? integer?) + (define (set-program-arguments args) + (set! %argv args)) + + (define (open-file filename mode) + (cond + ((string=? mode "r") (open-input-file filename)) + ((string=? mode "w") (open-output-file filename)) + (else (error "Unsupported file mode" mode)))) + + ;; Because Mes is not careful when resolving syntax, this will + ;; shadow its built-in 'false-if-exception' shim even though we + ;; don't export it (which would result in a warning). + (define-syntax-rule (false-if-exception body1 body2 ...) + (catch #t + (lambda () body1 body2 ...) + (lambda _ #f))) + + (define hex-digits "0123456789abcdef") + + (define (char->hex-string c) + (define b (char->integer c)) + (string (string-ref hex-digits (logand (ash b -4) #xf)) + (string-ref hex-digits (logand b #xf)))) + + (define (make-random-file-name) + (let* ((p (open-input-file "/dev/urandom")) + (dir (or (getenv "TMPDIR") "/tmp")) + (name (string-append dir "/mes-tmp-" + (char->hex-string (read-char p)) + (char->hex-string (read-char p)) + (char->hex-string (read-char p)) + (char->hex-string (read-char p))))) + (close-port p) + name)) + + (define (tmpfile) + (define flags (logior O_EXCL O_CREAT O_RDWR)) + ;; XXX: Mes provides no way to check for EEXIST, so we can't loop + ;; to ensure we get a fresh name. Hence, we cross our fingers and + ;; hope we don't crash because of a name collision. + (let* ((name (make-random-file-name)) + (port (open name flags))) + ;; Delete the file so that it's gone when we're done. + (delete-file name) + port)) + ;; A simple (slow!) sort procedure. It's needed for globbing. (define (sort items less) (define (split-reverse lst)