Подумал-подумал и наварганил простейшую либу для сравнения строки по маске.
На всё ушло в сухом остатке 2 часа.
Код:
\ полезные но не нужные в кодофайле штуки, spystile 8)
~ER\TMP\TMP-USE.F
S" ~ER\STRUCT\STRUCT-SUGAR.F" T-INCLUDED
S" ~ER\LAMBDA\SUBCALL.F" T-INCLUDED \ чтобы итераторы и пр. можно было вставлять в середине слова.
TMP-BACK
REQUIRE WITHIN ~ER\DATA-STACK\WITHIN.F
\ служебный словарь
VOCABULARY FLIKE-SERV
CURRENT @
ALSO FLIKE-SERV DEFINITIONS ' PREVIOUS >R
STRUCT: LIKE-D
4 CELLS -- ~serv \ не используется
CELL -- flag
CELL -- len
CELL -- addr
CELL -- ~xt \ куда пойти после сравнения
STRUCT;
1 CONSTANT any-f
2 CONSTANT yes
: GET-FALSE RDROP RDROP FALSE ; INLINE
\ вернуть на обратном ходу флаг
: like-back \ -- / flag <--
RP@ flag 2 CELLS - @
any-f =
IF TRUE
ELSE RP@ len 2 CELLS - @ 0=
THEN
;
\ вернуть на обратном ходу флаг
: not-back \ -- / flag <--
RP@ flag 2 CELLS - @ yes =
;
\ если строка закончилась, выходим
: len?
RP@ CELL+ len @ 0=
RP@ CELL+ len @ 0 <
OR
IF RDROP EXIT THEN
;
CURRENT !
\ начать сравнение строки с маской
: LIKE:
R>
ROT ROT
['] NOOP >R \ ~xt
2>R \ addr len
FALSE >R \ flag
RP@ 3 CELLS + >R RF^
['] like-back >R
>R
;
: >NOT \ xt --
RP@ flag @
RP@ addr @ RP@ len @
SUB: \ R: -- addr ,где SUB;
['] NOOP >R \ xt
2>R \ addr len
>R \ flag
RP@ 3 CELLS + >R RF^
['] not-back >R
EXECUTE
SUB;
TRUE = IF GET-FALSE THEN
;
\ для удобства
: NOT:
COMP?
' LIT,
['] >NOT COMPILE,
; IMMEDIATE
\ возможно, потенциально бажно
: LIKE; R@ RP@ ~xt ! RDROP ;
\ любые символы
: ANY any-f RP@ flag ! ;
: C= \ 'А' --
len?
RP@ flag @ any-f =
IF
SP@ 1
RP@ addr @ RP@ len @
2SWAP
SEARCH
IF
1- RP@ len !
1+ RP@ addr !
yes RP@ flag !
DROP
EXIT
ELSE
2DROP DROP
GET-FALSE
THEN
ELSE
RP@ addr @ C@
=
IF
RP@ addr 1+!
-1 RP@ len +!
yes RP@ flag !
ELSE GET-FALSE
THEN
THEN
;
: S= \ a u --
len?
RP@ flag @ any-f =
IF
RP@ addr @ RP@ len @
2SWAP SPLIT
IF
RP@ len !
RP@ addr !
yes RP@ flag !
2DROP
EXIT
ELSE 2DROP GET-FALSE
THEN
ELSE
RP@ addr @ OVER DUP >R
COMPARE
0= IF
R>
DUP RP@ addr +!
NEGATE RP@ len +!
yes RP@ flag !
ELSE RDROP GET-FALSE
THEN
THEN
;
\ пропустить несколько символов
: >PASS \ N
len?
DUP RP@ addr +!
NEGATE RP@ len +!
len?
;
: PASS COMP? 1 LIT, ['] >PASS COMPILE, ; IMMEDIATE
: N-N \ n n --
len?
1+ SWAP 1- SWAP \ для корректности WITHIN
RP@ flag @ any-f =
IF
BEGIN
2DUP
RP@ addr @ C@ WITHIN INVERT WHILE
RP@ len @ 0= IF 2DROP GET-FALSE EXIT THEN
RP@ addr 1+!
-1 RP@ len +!
REPEAT
THEN
RP@ addr @ RP@ len @
2>R
BEGIN
R@ WHILE
2DUP 1 RPICK C@ WITHIN
IF
-1 RP@ +!
RP@ CELL+ 1+!
ELSE
2DROP
2R>
DUP RP@ len @ =
IF 2DROP GET-FALSE \ нет совпадений:
ELSE RP@ len ! RP@ addr ! yes RP@ flag !
THEN
EXIT
THEN
REPEAT
2DROP
2R> RP@ len ! RP@ addr !
;
Примеры:
: T1 S" VERBA" LIKE:
PASS
'E' C=
ANY
'A' C=
;
: T2 S" 12345XREN"
LIKE:
'G' 'Z' NOT: N-N
'1' '5' N-N
ANY
'N' C=
;
Всё это приведено для иллюстрации идеи: на форте можно всё, самое главное подумать и спланировать. Дабы, естественно выглядело.
Код для Новы.