compat: More shims for Mes.
* gash/compat.scm [mes] (call-with-input-file): New procedure. [mes] (exact?): New procedure. [mes] (set-program-arguments): New procedure. [mes] (open-file): New procedure. [mes] (false-if-exception): New syntax. [mes] (hex-digits): New variable. [mes] (char->hex-string): New procedure. [mes] (make-random-file-name): New procedure. [mes] (tmpfile): New procedure.
This commit is contained in:
parent
4c04f1faa3
commit
6c67d7b23d
|
@ -103,11 +103,16 @@
|
||||||
file-port?
|
file-port?
|
||||||
input-port?
|
input-port?
|
||||||
output-port?
|
output-port?
|
||||||
|
call-with-input-file
|
||||||
call-with-input-string
|
call-with-input-string
|
||||||
thunk?
|
thunk?
|
||||||
EXIT_SUCCESS
|
EXIT_SUCCESS
|
||||||
EXIT_FAILURE
|
EXIT_FAILURE
|
||||||
|
exact?
|
||||||
exact-integer?
|
exact-integer?
|
||||||
|
set-program-arguments
|
||||||
|
open-file
|
||||||
|
tmpfile
|
||||||
sort)
|
sort)
|
||||||
|
|
||||||
(define-macro (define-inlinable . rest)
|
(define-macro (define-inlinable . rest)
|
||||||
|
@ -220,6 +225,13 @@
|
||||||
(define (input-port? port) #f)
|
(define (input-port? port) #f)
|
||||||
(define (output-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)
|
(define (call-with-input-string str proc)
|
||||||
(let ((port (open-input-string str)))
|
(let ((port (open-input-string str)))
|
||||||
(call-with-values (lambda () (proc port))
|
(call-with-values (lambda () (proc port))
|
||||||
|
@ -242,8 +254,55 @@
|
||||||
(define EXIT_FAILURE 1)
|
(define EXIT_FAILURE 1)
|
||||||
|
|
||||||
;; Mes only has exact integers.
|
;; Mes only has exact integers.
|
||||||
|
(define exact? integer?)
|
||||||
(define exact-integer? 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.
|
;; A simple (slow!) sort procedure. It's needed for globbing.
|
||||||
(define (sort items less)
|
(define (sort items less)
|
||||||
(define (split-reverse lst)
|
(define (split-reverse lst)
|
||||||
|
|
Loading…
Reference in New Issue