commit 4d5ba051c004a16d9cf13d9649a8e7946d3070a3
parent d429218cdf7dd37d4f4a2343930d0f982cc821aa
Author: Virgil Dupras <hsoft@hardcoded.net>
Date: Thu, 12 Jan 2023 16:21:35 -0500
sys/io: add filters to Pipes
see doc/sys/io.
Diffstat:
3 files changed, 99 insertions(+), 1 deletion(-)
diff --git a/fs/doc/sys/io.txt b/fs/doc/sys/io.txt
@@ -98,6 +98,62 @@ between them. Pipes have separate references for read and write operations and
all IO methods are redirected to those references. In Pipes, :close is always a
noop.
+### Filters
+
+Filters can be applied to :readbuf and :writebuf through :addrfilter and
+:addwfilter. These take "word" arguments which have the same input arguments as
+:readbuf and :writebuf. For the output, it's funky. Read on.
+
+Filters are chained to :readbuf/:writebuf and previous filters through "chain"
+(see doc/dict). This means that when the word exits, the next word in the chain
+is called, until finally the :readbuf/:writebuf word is called.
+
+If all your filter only has to do stuff *before* the next word is called, but
+not after, then things are straightforward. Simply do your things and make sure
+that your output signature is the same as your input one.
+
+In some cases, however, to act on both "sides" of the read/write operation. For
+example, let's imagine that we apply a funky filter on :writebuf that results
+in writing only the first half of whatever is sent. You can't just do something
+like:
+
+ : half ( a n hdl -- written-n ) swap >> swap ;
+
+because if you do that, "written-n" will also be halved and whatever high-level
+method called :writebuf will call it again with the second half because that's
+how the IO API works.
+
+To do that, you also need to make written-n to falsely report all bytes as
+written, so you need some code to be applied *after* :writebuf has run.
+
+To do this, we'll rely on "chain" implementation details: unlike a regular word
+which can be called in any context, in this case, the context is always the
+same, that is, the word we return to will call another word with the ( a n hdl
+-- written-n ) signature, that's guaranteed. So let's do something that will
+make you feel dirty, let's "over-dig" in RS and call the word that was going to
+be called at the end of the present word:
+
+ : half ( a n hdl -- written-n )
+ swap dup >> tuck - ( a hdl n-diff reduced-n R:nextword )
+ swap r> swap >r ( a hdl reduced-n nextword R:n-diff )
+ >r swap r> execute ( written-n R:n-diff )
+ r> + ;
+
+See what we did there? We half the number, keep the diff around, call the next
+word (which is :writebuf, optionally with other filters applied), and then add
+back the diff to fool the caller into thinking that all its bytes have been
+written (unless the actual driver really couldn't write all bytes in one shot,
+in which case written-n will be lower). Then, because we've over-dug RS in our
+filter, we'll exit the :writebuf filter at the end of the word so it won't be
+called twice.
+
+Or, to have a simple example, let's imagine a "null" filter, something that eats
+up all arguments, pretend everything has been written, but do nothing:
+
+ : nullwrite ( a n hdl -- written-n ) rdrop drop nip ;
+
+### API
+
Fields:
readio a pointer to the IO for :readbuf
@@ -108,6 +164,17 @@ Words:
:new ( -- pipe )
Create a new Pipe
+:addrfilter ( w pipe -- )
+ Apply a new filter "w" on :readbuf. This new filter will be called before the
+ ones applied before.
+
+:addwfilter ( w pipe -- )
+ Apply a new filter "w" on :writebuf. This new filter will be called before the
+ ones applied before.
+
+:filters$ ( pipe -- )
+ Remove all filters.
+
## SumIO
The SumIO struct allows you to "spit" another IO into it and extract a result.
diff --git a/fs/tests/sys/io.fs b/fs/tests/sys/io.fs
@@ -13,4 +13,30 @@ mymem 7 + memio ptr #eq
mymem to memio ptr
memio :readline S" foobar" #s=
+\ Pipes
+mymem to memio ptr
+memio :self dup Pipe :new structbind Pipe pipe
+S" hello pipe\n" pipe :puts
+mymem to memio ptr
+pipe :readline S" hello pipe" #s=
+
+\ Pipe filters
+: encrypt ( n hdl -- a? read-n )
+ r> execute dup if ( a u )
+ 2dup >r begin dup c@ dup SPC > if 1+ then swap c!+ next drop then ;
+mymem to memio ptr
+' encrypt pipe :addrfilter
+pipe :readline S" ifmmp qjqf" #s=
+
+: half ( a n hdl -- written-n )
+ swap dup >> tuck - ( a hdl n-diff reduced-n R:nextword )
+ swap r> swap >r ( a hdl reduced-n nextword R:n-diff )
+ >r swap r> execute ( written-n R:n-diff )
+ r> + ;
+' half pipe :addwfilter
+mymem to memio ptr
+mymem 12 0 fill
+S" foobarbaz" pipe :puts
+mymem S" fooba\0" c@+ []= #
+
testend
diff --git a/fs/xcomp/bootlo.fs b/fs/xcomp/bootlo.fs
@@ -137,7 +137,7 @@ alias noop idle
?dup if begin [compile] then ?dup not until then [compile] rdrop ; immediate
\ Emitting
-$20 const SPC $0d const CR $0a const LF $08 const BS
+$20 const SPC $0d const CR $0a const LF $08 const BS $1b const ESC
alias drop emit
: nl> CR emit LF emit ; : spc> SPC emit ;
: rtype ( a u ) >r begin c@+ emit next drop ;
@@ -283,6 +283,11 @@ extends IO struct[ Pipe
: :new ( readio writeio -- pipe )
here 0 , ['] _readbuf , ['] _writebuf , ['] _flush , ['] drop ,
rot ( readio ) , swap ( writeio ) , ;
+ : _chain! ( w1 'w2 -- ) dup @ rot swap chain swap ! ;
+ : :addrfilter ( w self -- ) CELLSZ + _chain! ;
+ : :addwfilter ( w self -- ) CELLSZ << + _chain! ;
+ : :filters$ ( self -- )
+ ['] _readbuf swap CELLSZ + !+ ['] _writebuf swap ! ;
]struct
: _ioerr abort" Invalid I/O" ;
