match.fs

\ Copyright 2020 Jan Bramkamp
\ 
\ Permission is hereby granted, free of charge, to any person obtaining a copy
\ of this software and associated documentation files (the "Software"), to deal
\ in the Software without restriction, including without limitation the rights
\ to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
\ copies of the Software, and to permit persons to whom the Software is
\ furnished to do so, subject to the following conditions:
\  
\ The above copyright notice and this permission notice shall be included in
\ all copies or substantial portions of the Software.
\ 
\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
\ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
\ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
\ AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
\ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
\ OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
\ SOFTWARE.

: 4dup ( a b c d -- a b c d a b c d ) 2over 2over inline 4-foldable ;
: 4drop ( a b c d -- ) 2drop 2drop inline 4-foldable ;

: prefix? ( str len prefix prefix-len -- ? )
	2over nip over < if
		4drop false exit
	then
	rot min tuck compare 0<> ;
	
: contains? ( str len key key-len -- ? )
	begin
		4dup prefix? if 4drop true exit then
		2over nip 0= if 4drop false exit then
		2swap 1- swap 1+ swap 2swap 
	again ;

6 constant name-offset
: >name ( addr -- name len ) name-offset + count inline ;

: (match) ( key key-len -- )
	cr ." Looking for words containing the substring: " 2dup type cr
	dictionarystart begin
		dup >r >name 2over
		contains? if r@ >name space space type cr then
		r> dictionarynext
	until drop 2drop ;

: match ( -- )
	token (match) ;