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

...
Google Search
Forth-FAQ Spy Grafic

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




Ответить
Имя пользователя:
Заголовок:
Текст сообщения:
Введите текст вашего сообщения. Длина сообщения в символах не более: 60000

Размер шрифта:
Цвет шрифта
Настройки:
BBCode ВКЛЮЧЕН
[img] ВЫКЛЮЧЕН
[flash] ВЫКЛЮЧЕН
[url] ВКЛЮЧЕН
Смайлики ВЫКЛЮЧЕНЫ
Отключить в этом сообщении BBCode
Не преобразовывать адреса URL в ссылки
Вопрос
Теперь гостю придется вводить здесь пароль. Не от своей учетной записи, а ПАРОЛЬ ДЛЯ ГОСТЯ, получить который можно после регистрации на форуме через ЛС.:
Этот вопрос предназначен для выявления и предотвращения автоматических регистраций.
   

Обзор темы - Форт и регулярки
Автор Сообщение
  Заголовок сообщения:  Форт и регулярки  Ответить с цитатой
Подумал-подумал и наварганил простейшую либу для сравнения строки по маске.
На всё ушло в сухом остатке 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=
;

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

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


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