application/octet-stream
•
6.15 KB
•
102 lines
;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; The port system for Nujel which provides an object oriented abstraction over
;;; low-level file streams
[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 [self buffer size]
[def buf [meta self :buffer]]
[when-not size [set! size [buffer/length buffer]]]
[when [> size
[- [buffer/length buf]
[meta self :position]]]
[buffer/length! buf
[+ #x80 [bit-and [+ [buffer/length buf] size] [bit-not #x7F]]]]]
[buffer/copy buf buffer [meta self :position] size]
[meta! self :position [+ [meta self :position] size]]]
:char-write [fn [self char]
[def buf [meta self :buffer]]
[when [< [- [buffer/length buf]
[meta self :position]]
1]
[buffer/length! buf
[+ #x80 [buffer/length buf]]]]
[buffer/set! buf [meta self :position] char]
[meta! self :position [+ [meta self :position] 1]]]
:write [fn [self . buffers]
[doseq [buf buffers self]
[self :block-write buf]]]
:close! [fn [self] self]
:return-string [fn [self]
[buffer->string [meta self :buffer]
[meta self :position]]]
:methods [fn [self] 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 self #nil]
[set! self [fn [method . args]
[apply [tree/ref string-out-methods method]
[cons self args]]]]
[meta! self :buffer [buffer/allocate #x80]]
[meta! self :position 0]]]
[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]]]]]]
[defmacro with-string-port [name . body]
`[let [[~name [make-string-output-port]]]
~@body
[~name 'return-string]]]
[defn cat l
"ConCATenates all arguments into a single string"
[def p [make-string-output-port]]
[doseq [c l [p 'return-string]]
[p 'block-write [string/display c]]]]
