Forth http://fforum.winglion.ru/ |
|
Форт и регулярки http://fforum.winglion.ru/viewtopic.php?f=4&t=3180 |
Страница 1 из 1 |
Автор: | Victor__v [ Пн июл 02, 2018 18:57 ] |
Заголовок сообщения: | Форт и регулярки |
Подумал-подумал и наварганил простейшую либу для сравнения строки по маске. На всё ушло в сухом остатке 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= ; Всё это приведено для иллюстрации идеи: на форте можно всё, самое главное подумать и спланировать. Дабы, естественно выглядело. Код для Новы. |
Страница 1 из 1 | Часовой пояс: UTC + 3 часа [ Летнее время ] |
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group http://www.phpbb.com/ |