Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт мар 28, 2024 17:44

...
Google Search
Forth-FAQ Spy Grafic

Часовой пояс: UTC + 3 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ 1 сообщение ] 
Автор Сообщение
 Заголовок сообщения: Форт и регулярки
СообщениеДобавлено: Пн июл 02, 2018 18:57 
Не в сети

Зарегистрирован: Чт янв 07, 2016 19:14
Сообщения: 1288
Благодарил (а): 3 раз.
Поблагодарили: 18 раз.
Подумал-подумал и наварганил простейшую либу для сравнения строки по маске.
На всё ушло в сухом остатке 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=
;

Всё это приведено для иллюстрации идеи: на форте можно всё, самое главное подумать и спланировать. Дабы, естественно выглядело.
Код для Новы.

_________________
Цель: сделать 64-битную Нову под Винду


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ 1 сообщение ] 

Часовой пояс: UTC + 3 часа [ Летнее время ]


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 10


Вы не можете начинать темы
Вы можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
phpBB сборка от FladeX // Русская поддержка phpBB