application/octet-stream
•
4.99 KB
•
112 lines
[defn slurp/buffer [pathname]
"Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
[def fh [file/open* pathname "r"]]
[when-not fh [return #nil]]
[try [fn []
[file/close* fh]
[return #nil]]
[file/seek* fh 0 2]
[def size [file/tell* fh]]
[file/seek* fh 0 0]
[def buf [buffer/allocate size]]
[file/read* fh buf size]
[file/close* fh]
[return buf]]]
[def file/read/buffer slurp/buffer]
[defn slurp [pathname]
"Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
[buffer->string [slurp/buffer pathname]]]
[def file/read slurp]
[defn spit [pathname content]
"Read the entirety of PATHNAME and return it as a string if possible, otherwise return #nil."
[def fh [file/open* pathname "w"]]
[when-not fh [return #f]]
[try [fn []
[file/close* fh]
[return #f]]
[file/write* fh content]
[file/close* fh]]
[return #t]]
[defn file/write [content pathname]
"Writes CONTENT into PATHNAME"
[spit pathname content]]
[def make-output-port #nil]
[def make-input-port #nil]
[def make-input/output-port #nil]
[let*
[def output-port-method-table @[]]
[def input-port-method-table @[]]
[def temporary-buffer [buffer/allocate 1]]
[def temporary-buffer-view [buffer/view/u8* temporary-buffer]]
[tree/set! output-port-method-table :file-handle [fn [handle] handle]]
[tree/set! output-port-method-table :write-char [fn [handle char]
[buffer/view/set! output-port-temporary-buffer-view 0 char]
[file/write* handle output-port-temporary-buffer-view]]]
[tree/set! output-port-method-table :flush-output-port [fn [handle]
[file/flush* handle]]]
[tree/set! output-port-method-table :block-write [fn [handle buffer size]
[file/write* handle buffer size]]]
[tree/set! output-port-method-table :block-read [fn [handle buffer size]
[exception :type-error "Can't read from an output port" handle]]]
[tree/set! output-port-method-table :read-char [tree/ref output-port-method-table :block-read]]
[tree/set! output-port-method-table :close-port [fn [handle]
[file/close* handle]]]
[tree/set! output-port-method-table :file-position [fn [handle]
[file/tell* handle]]]
[tree/set! output-port-method-table :file-position! [fn [handle new-position]
[file/seek* handle new-position 0]]]
[tree/set! input-port-method-table :read-char [fn [handle char]
[file/read* handle temporary-buffer-view 1]
[buffer/view/ref temporary-buffer-view 0 char]]]
[tree/set! input-port-method-table :block-read [fn [handle buffer size]
[file/read* handle buffer size]]]
[tree/set! input-port-method-table :block-write [fn [handle buffer size]
[exception :type-error "Can't write to an input port" handle]]]
[tree/set! input-port-method-table :write-char [tree/ref output-port-method-table :block-write]]
[tree/set! input-port-method-table :close-port [tree/ref output-port-method-table :close-port]]
[tree/set! input-port-method-table :file-handle [tree/ref output-port-method-table :file-handle]]
[tree/set! input-port-method-table :file-position [tree/ref output-port-method-table :file-position]]
[tree/set! input-port-method-table :file-position! [tree/ref output-port-method-table :file-position!]]
[set! make-output-port [fn [handle]
""
[fn [method . args]
[apply [tree/ref output-port-method-table method] [cons handle args]]]]]
[set! make-input-port [fn [handle]
""
[fn [method . args]
[apply [tree/ref input-port-method-table method] [cons handle args]]]]]
]
[def stdin [make-input-port stdin*]]
[defn current-input-port [] stdin]
[defn current-input-port! [nport] [set! stdin nport]]
[def stdout [make-output-port stdout*]]
[defn current-output-port [] stdout]
[defn current-output-port! [nport] [set! stdout nport]]
[def stderr [make-output-port stderr*]]
[defn current-error-port [] stderr]
[defn current-error-port! [nport] [set! stderr nport]]
[defn print [v]
"Display V on the standard output port"
[stdout 'block-write [string v]]]
[defn error [v]
"Prints v on the standard error port"
[stderr 'block-write [string v]]]
