commit 1024013264e4d4ce43099f4e2a4de4670c8191fb
parent 6ca68a5be640af6151c30ee70628ce7403db40da
Author: binarycat <binarycat@envs.net>
Date: Thu, 30 Jun 2022 12:55:52 -0400
filter subsystem redux
Here's my second attempt at this patch. "with'" has become "with" and the old "with" has been removed.
I found the code was more readable if I just used "to'", that way all the arguments were on the same side
of with.
I have added some more comments trying to explain how to use the system, hopefully this is good enough
for now.
Diffstat:
6 files changed, 67 insertions(+), 0 deletions(-)
diff --git a/fs/lib/str.fs b/fs/lib/str.fs
@@ -8,6 +8,19 @@ $100 value STR_MAXSZ
\ "skip" str, that is, return the address following its last char
: s) ( str -- a ) c@+ + ;
+\\ append character to end of string
+: sappend ( c str -- ) tuck s) c! dup c@ 1+ swap c! ;
+
+\\ checks if str1 contains all of str2 (is str2 a substring?)
+: scontains ( str1 str2 -- f )
+ >r c@+ begin
+ dup r@ c@ >= while
+ over r@ c@+ []= if
+ r> drop 2drop 1 exit
+ then
+ 1- swap 1+ swap
+ repeat r> drop 2drop 0 ;
+
\ find active string in "list" and return its index, -1 if not found.
\ A list is a simple sequence of strings (length byte, then contents, then
\ another one...) ended by a 0 length
diff --git a/fs/lib/with.fs b/fs/lib/with.fs
@@ -0,0 +1,3 @@
+\\ helper word to save and restore a variable across a function call.
+: with ( w u addr -- ) dup >r dup @ >r ! execute r> r> ! ;
+
diff --git a/fs/sys/filter.fs b/fs/sys/filter.fs
@@ -0,0 +1,36 @@
+\ filter executes a word and filters its output based on a substring match.
+\ it parses first the word to execute, the the substring search to filter
+\ the output by.
+
+?f<< lib/str.fs
+?f<< lib/with.fs
+
+SPC value filter-delim
+
+\ internal state
+create filter-buf $100 allot
+0 value filter-str
+alias abort filter-out
+
+: filter-chunk
+ filter-buf filter-str scontains if
+ filter-buf ['] stype to' filter-out @ to' emit with
+ filter-delim filter-out
+ then
+ 0 filter-buf c! ;
+
+: filter-char ( c -- )
+ dup filter-delim = if drop
+ filter-chunk
+ else
+ filter-buf sappend
+ then ;
+
+: with-filter-str ( w str -- )
+ \ TODO: replace emit with stdout when it is added
+ to filter-str
+ 0 filter-buf c!
+ to' emit @ to filter-out
+ ['] filter-char to' emit with filter-chunk ;
+
+: filter ( "word" "query" -- ) ' word with-filter-str ;
diff --git a/fs/tests/lib/all.fs b/fs/tests/lib/all.fs
@@ -3,3 +3,4 @@ f<< tests/lib/core.fs
f<< tests/lib/str.fs
f<< tests/lib/xdict.fs
f<< tests/lib/struct.fs
+f<< tests/lib/with.fs
diff --git a/fs/tests/lib/str.fs b/fs/tests/lib/str.fs
@@ -15,4 +15,9 @@ S" baz" list sfind -1 #eq
'0' A-Za-z? not #
'z' alnum? #
'0' alnum? #
+
+S" foobar" S" foo" scontains #
+S" foobar" S" bar" scontains #
+S" foobar" S" oba" scontains #
+S" foobar" S" baz" scontains not #
testend
diff --git a/fs/tests/lib/with.fs b/fs/tests/lib/with.fs
@@ -0,0 +1,9 @@
+?f<< lib/with.fs
+?f<< tests/harness.fs
+testbegin
+\ testing lib/with
+create cell1 7 ,
+: foo cell1 @ 55 #eq ;
+: bar ['] foo 55 cell1 with ;
+bar cell1 @ 7 #eq
+testend
