application/octet-stream
•
7.58 KB
•
165 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-string-output-port #nil]
[def make-input-port #nil]
[let*
[def temporary-buffer [buffer/allocate 1]]
[def temporary-buffer-view [buffer/u8* temporary-buffer]]
[def output-port-method-table @[ :flush-output [fn [handle]
[file/flush* handle]]
:block-write [fn [handle buffer size]
[file/write* handle buffer size]]
:char-write [fn [handle char]
[buffer/set! temporary-buffer-view 0 char]
[file/write* handle temporary-buffer-view]]
:close! [fn [handle]
[file/close* handle]]
:position [fn [handle]
[file/tell* handle]]
:position! [fn [handle new-position]
[file/seek* handle new-position 0]]
:file-handle [fn [handle] handle]
:methods [fn [handle] output-port-method-table]]]
[def string-out-methods @[ :block-write [fn [handle buffer size]
[def buf [tree/ref handle :buffer]]
[when-not size [set! size [buffer/length buffer]]]
[when [> size
[- [buffer/length buf]
[tree/ref handle :position]]]
[buffer/length! buf
[+ #x80 [bit-and [+ [buffer/length buf] size] [bit-not #x7F]]]]]
[buffer/copy buf buffer [tree/ref handle :position] size]
[tree/set! handle :position [+ [tree/ref handle :position] size]]]
:char-write [fn [handle char]
[buffer/set! temporary-buffer-view 0 char]
[file/write* handle temporary-buffer-view]]
:return-string [fn [handle]
[buffer->string [tree/ref handle :buffer]
[tree/ref handle :position]]]
:methods [fn [handle] string-out-methods]]]
[def input-port-method-table @[ :block-read [fn [handle buffer size]
[when [file/eof*? handle]
[return :end-of-file]]
[file/read* handle buffer size]]
:char-read [fn [handle char]
[when [file/eof*? handle]
[return :end-of-file]]
[when-not [file/read* handle temporary-buffer-view 1]
[return :end-of-file]]
[buffer/ref temporary-buffer-view 0 char]]
:close! [tree/ref output-port-method-table :close!]
:position [tree/ref output-port-method-table :position]
:position! [tree/ref output-port-method-table :position!]
:file-handle [tree/ref output-port-method-table :file-handle]
:methods [fn [handle] input-port-method-table]]]
[set! make-output-port [fn [handle]
"Create a new output port for HANDLE"
[fn [method . args]
[apply [tree/ref output-port-method-table method] [cons handle args]]]]]
[set! make-string-output-port [fn []
"Create a new string output port"
[def handle @[:buffer [buffer/allocate #x80] :position 0]]
[fn [method . args]
[apply [tree/ref string-out-methods method] [cons handle args]]]]]
[set! make-input-port [fn [handle]
"Create a new input port for 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 newline [port]
"Print a single line feed character"
[[or port stdout] 'block-write "\r\n"]
#nil]
[defn print [v port]
"Display V on the standard output port"
[write/raw v [or port stdout] #t]
[return v]]
[defn error [v port]
"Prints v on the standard error port"
[print v stderr]]
[defn read-line/raw [port buf]
"Reads in a line of user input and returns it"
[def i 0]
[def c 0]
[def view [buffer/u8* buf]]
[while #t
[while [>= i [buffer/length buf]]
[buffer/length! [+ 128 [buffer/length buf]]]]
[set! c [port 'char-read]]
[when [== c :end-of-file]
[return [if [zero? i] #nil i]]]
[when [== c #\lf]
[return i]]
[buffer/set! view i c]
[set! i [inc i]]]]
[defn read-line []
"Reads in a line of user input and returns it"
[def buf [buffer/allocate 128]]
[def len [read-line/raw stdin buf]]
[and len [buffer->string buf len]]]
[def input read-line]
[defn readline [prompt]
"Read a line of input in a user friendly way after writing PROMPT"
[stdout 'block-write [or prompt ""]]
[stdout 'flush-output]
[read-line]]
