СЛОВАРИ ФОРТА В РЕАЛИЗАЦИИ КОНЕЧНОГО АВТОМАТА

chess

Код:

\ немного синтаксического сахара
M: avt{   s CASE ;
M: }avt   ENDCASE ;
M: s{     OF ;
M: a{     SWAP IF is s ;
M: }a     EXIT ELSE DROP THEN  ;
M: }s     ENDOF ;
M: ainit  sBeg) sEnd) sBeg s! ;

: INP-Q  ainit
  s-) sD.) s.) s.D)                              \ состояния

  0 c! c+1( c 1+ is c )                          \ действия
       c=0( 0 is c )
  0 k! 0 l! emit( k EMIT k is l )
           emit+( emit c+1 )

  k-( k '-' = )                                  \ события
  k.( k '.' = )
  k0( k '0' = )
  kent( k 13  = )
  k19( k '1' '9' 1+ WITHIN )

\ описание автомата
inp(
avt{  \ события                     состояния   действия
sBeg s{ k19                             sD.  a{ emit+    }a
        k-                              s-   a{ emit     }a }s
s-   s{ k19                             sD.  a{ emit+    }a }s
sD.  s{ k0 k19 OR c 9 < AND             s    a{ emit+    }a
        k.                              s.   a{ emit c=0 }a
        kent                            sEnd a{ emit     }a }s
s.   s{ k0 k19 OR                       s.D  a{ emit+    }a }s
s.D  s{ k0 c 8 < AND k19 c 9 < AND OR   s    a{ emit+    }a
        kent l '0' <> AND               sEnd a{          }a }s
}avt )

\ рабочий цикл
BEGIN KEY is k inp s sEnd = UNTIL ;
STARTLOG
SEE INP-Q

лог.

Код:

CODE INP-Q
5D00B7 C70570EE5B0060EE5B00     MOV     5BEE70  ( ldata+15  ) , # 5BEE60
5D00C1 C70594EE5B0000000000     MOV     5BEE94  ( ldata+39  ) , # 0
5D00CB C70598EE5B0000000000     MOV     5BEE98  ( ldata+3D  ) , # 0
5D00D5 C7059CEE5B0000000000     MOV     5BEE9C  ( ldata+41  ) , # 0
5D00DF 90               XCHG     EAX, EAX
5D00E0 E8E75EF8FF       CALL    555FCC  ( KEY )
5D00E5 890598EE5B00     MOV     5BEE98  ( ldata+3D  ) , EAX
5D00EB 8B4500           MOV     EAX , 0 [EBP]
5D00EE 8D6D04           LEA     EBP , 4 [EBP]
5D00F1 E8BEEEFDFF       CALL    5AEFB4  ( lcode+191  )
5D00F6 813D70EE5B0068EE5B00     CMP     5BEE70  ( ldata+15  ) , # 5BEE68
5D0100 75DE             JNE     5D00E0
5D0102 C3               RET     NEAR
END-CODE
( 76 bytes, 13 instructions )

 Ok

пс.
Собственно получилось близко к классике. Поддерживается автомат Мили.
Для каждого состояния проверяются все события для этого состояния ( скроллинг по событиям этого состояния),
затем устанавливается новое состояние и выполняются действия для этого нового состояния.
Почему так - потому, что все-таки дублирование кода минимально - вместо повторения самого кода только CALL addr.
Кроме того, довольно быстрый код автомата получается(это как правило важнее компактности).
Чтобы максимально ускорить код надо наиболее частые события ставить в тексте описания автомата раньше менее частых.

Alex

Вот реализация с использованием словаря,

Код:

S" order.f"     INCLUDED
\         evt  state prevt  cnt   key   delim
CREATE es 0 C,  0 C,  0 C,  0 C,  0 C, CHAR | C,

: #->  ( n -- ) [CHAR] 0 + es 1+ C! ;
: INP. es 4 + C@ EMIT es C@  es 2 + C! ;
: cnt+ es 3 + DUP C@ 1+ SWAP C! ;
: cnt0 [CHAR] 0 es 3 + C! ;
: err.  NOOP         ;
: es?  ( a u n --  f ) es SWAP SEARCH NIP NIP ;
: evt! ( a u -- ) OVER 13 SWAP C! es 4 + 2 SEARCH NIP IF 2+ C@ ELSE DROP 0 THEN es C! ;
: err! IF [CHAR] e es C! THEN ;
: IDENTIFY ( nfa -- nfa f )  DUP COUNT es 2 SEARCH NIP NIP ;
: FSEARCH ( wid -- ) @ BEGIN DUP WHILE IDENTIFY IF NAME> EXECUTE EXIT ELSE CDR THEN REPEAT DROP ;

WORDLIST: FSM
: q0|q1|q2  RDROP RDROP RDROP ;
: e0|e1|e2  err.              ;
: d0|d1|01  INP. cnt+  1 #->  ;
: d2|02     INP. cnt+  2 #->  ;
: .1|       INP. cnt0  2 #->  ;
: -0|       INP.       1 #->  ;           
WORDLIST;   

: get-event  S" _|q -|- .|. 0|0 1|d 2|d 3|d 4|d 5|d 6|d 7|d 8|d 9|d" evt! ;   
: check-event  S" 01-0|.1-0|d1d9|d109|02d8|0208|d2d9|d209|q1-0|q2.0" 4 es? S" q20" 3 es? OR err! ;
: handle-event FSM FSEARCH ;

: INIT-FSM  0 es C! 0 es 2 + C! cnt0 0 #-> FSM >ORDER ;
: READ-KEY  KEY es 4 + C! ;
: AAA  INIT-FSM BEGIN READ-KEY get-event check-event handle-event AGAIN ;

нашел определение макросов M: в файле nf-name.f из библиотек chess-a и
в предпоследнем варианте handle-event можно записать более изящно

Код:

\         evt  state prevt  cnt   key   delim
CREATE es 0 C,  0 C,  0 C,  0 C,  0 C, CHAR | C,
: #->  ( n -- ) [CHAR] 0 + es 1+ C! ;
: INP. es 4 + C@ EMIT es C@  es 2 + C! ;
: cnt+ es 3 + DUP C@ 1+ SWAP C! ;
: cnt0 [CHAR] 0 es 3 + C! ;
: err.  NOOP         ;
: es?  ( a u n --  f ) es SWAP SEARCH NIP NIP ;
: evt! ( a u -- ) OVER 13 SWAP C! es 4 + 2 SEARCH NIP IF 2+ C@ ELSE DROP 0 THEN es C! ;
: err! IF [CHAR] e es C! THEN ;
M: [[  2 es?  IF  ;
M: ]]  EXIT THEN  ;
: get-event  S" _|q -|- .|. 0|0 1|d 2|d 3|d 4|d 5|d 6|d 7|d 8|d 9|d" evt! ;   
: check-event  S" 01-0|.1-0|d1d9|d109|02d8|0208|d2d9|d209|q1-0|q2.0"  4 es?  S" q20" 3 es? OR  err! ;
: handle-event
S" q0|q1|q2"   [[  RDROP             ]]
S" e0|e1|e2"   [[  err.              ]]
S" d0|d1|01"   [[  INP. cnt+  1 #->  ]]
S" d2|02"      [[  INP. cnt+  2 #->  ]]
S" .1"         [[  INP. cnt0  2 #->  ]]
S" -0"         [[  INP.       1 #->  ]] ;
: INIT-FSM  0 es C! 0 es 2 + C! cnt0 0 #-> ;
: READ-KEY  KEY es 4 + C! ;
: AAA  INIT-FSM BEGIN READ-KEY get-event check-event handle-event AGAIN ;

спасибо chess за сотворчество :wink:

chess

Можно еще усложнить задачу.

Предположим какую-то цифру( или несколько) ввели неправильно.
Исправить можно перемещением курсора и клавишами BS или Delete.
Точку тоже можно удалять. Все остальное остается.

in4

Может кто объяснить, чем числовое представление состояний в исходном тексте лучше символьного(названия состояния)? Вроде бы появление символьных меток упостило программирование (по сравнению с адресами)? Тогда почему большинство авторов предпочитают символы? Это дань традиции или что-то еще?

Где-нибудь изложенна практическая методика проектирования конечных автоматов (чтоб было много примеров с нарастающей сложностью, а не с одним-двумя простенькими, как в обычных книгах по дискретной математике)?

Что-то читабельность исходников не очень повысилась, это так и должно быть? А если изменить надо что-то, переписывать поновой? Или тоже методика есть (перекликается с предыдущей серией вопросов)?

chess

Код:

\ лексикон для произвольного автомата
M: avt{  s CASE ;  M: }avt  ENDCASE ;
M: s{  OF ;  M: }s  ENDOF ;
M: a{ SWAP IF is s ;  M: }a  EXIT ELSE DROP THEN ;
M: ainit  sBeg) sEnd) sBeg s! ;                  \ sBeg sEnd - идентификаторы начального и конечного состояний

Код:

: INP-Q  ainit
  s-) sD.) s.) s.D)                              \ состояния
  9 b.D]                                         \ буфер для хранения цифр после точки
  0 c!                                           \ счетчик цифр и позиция в буфере
  0 c.!                                          \ хранить число цифр до точки
  c+1( c 1+ is c )                               \ действия
  c-1( c 1- is c )
  c=0( 0 is c )
  0 k!                                           \ код вводимого символа
  emit( k EMIT  )                                \ вывести символ
  !k( k c b.D + C! )                             \ записать символ в текущую позицию буфера
  emit+( emit c+1 )
  k-( k '-' = )                                  \ события
  k.( k '.' = )
  k0( k '0' = )
  k19( k '1' '9' 1+ WITHIN )
  kbs( k 8 = )
  kent( k 13  = )
\ описание автомата
inp(  avt{
\ тек.состояния    события в тек. сост     нов.состояния   действия
sBeg             s{ k19                             sD.  a{ emit+ }a
                    k-                              s-   a{ emit }a                      }s
s-               s{ k19                             sD.  a{ emit+ }a
                    kbs                             sBeg a{ emit BL EMIT emit c=0 }a     }s
sD.              s{ k0 k19 OR c 9 < AND             s    a{ emit+ }a
                    k.                              s.   a{ emit c is c. c=0 }a
                    kbs c 1 = AND                   s-   a{ emit BL EMIT emit c=0 }a
                    kbs c 1 > AND                   s    a{ emit BL EMIT emit c-1 }a
                    kent                            sEnd a{ emit }a                      }s
s.               s{ k0 k19 OR                       s.D  a{ !k emit+ }a
                    kbs                             sD.  a{ emit BL EMIT emit c. is c }a }s
s.D              s{ k0 c 8 < AND k19 c 9 < AND OR   s    a{ !k emit+ }a
                    kbs c 1 = AND                   s.   a{ emit BL EMIT emit c=0 }a
                    kbs c 1 > AND                   s    a{ emit BL EMIT emit c-1 }a
                    kent c 1- b.D + C@ '0' <> AND   sEnd a{  }a                          }s  }avt )
BEGIN KEY is k inp s sEnd = UNTIL ; \ рабочий цикл

пс.
1. Упростил задачу использованием только клавиши BackSpace( лень разбираться со скан-кодами управляющих клавиш)
(чтобы заменить цифру - нужно все стереть до этой цифры и саму цифру).
Число состояний не изменил. Добавились буфер для запоминания цифр после точки
и ячейка для хранения количества введенных цифр до точки.
2. На самом деле программа получается не чистым автоматом, а
смесью автоматного и обычного кода, когда состояния определяются не только явно,
но еще и значащими комбинациями значений используемых в программе переменных.
Наиболее сложное в алгоритме выносится в явные состояния.
3. Чтобы код автомата сделать более компактным нужна рефакторизация - ограничений в этой модели на нее нет.
4. Программная модель автомата абсолютно не изменилась. Можно брать как основу для работы.
Правда тут только один автомат. Ну задача-то очень простая.

chess

in4 писал(а):

Может кто объяснить, чем числовое представление состояний в исходном тексте лучше символьного(названия состояния)? Вроде бы появление символьных меток упостило программирование (по сравнению с адресами)? Тогда почему большинство авторов предпочитают символы? Это дань традиции или что-то еще?

Символьное на мой взгляд удобнее. Человек все именует, а не нумерует.

in4 писал(а):

А если изменить надо что-то, переписывать поновой? Или тоже методика есть (перекликается с предыдущей серией вопросов)?

Не надо все переписывать. Надо только дополнять и добавлять.

Alex

in4 писал(а):

Что-то читабельность исходников не очень повысилась, это так и должно быть?

да, так как изменился автомат, сейчас он не тот простейший стартовый,
здесь присутствует контроль числа вводимых символов и ограничения при вводе
в зависимости от предыдущего ввода и особая работа с нулем.

Я пытаюсь продолжать разработку полагая, что не только состояние автомата, его
входные воздействия можно представить в виде строки но и логику работы автомата
описать как операции поиска по строке. Автомат может переходить в иное состояние
под воздействием различных условий, которые группируются (обрабатываются)
операциями AND и OR как явно так и неявно ( вложенные IF-ы и CASE неявно выполняют
операцию AND, а расположенные несколько IF-ов и CASE на одном уровне иерархии
неявно выполняют операцию OR). Так и со строками, если мы расположим два байта
или символа рядом, и будем рассматривать эти два байта как единую сущность,
мы "выполняем" операцию AND, если мы разместим два наших байта в строке большего
размера с такими же парами через разделитель, то мы "формируем" операцию OR.

например функции get-event1 и get-event2 практически эквивалентны

Код:

: get-event1     
  key [CHAR] - =                  IF [CHAR] - es C! EXIT THEN    
  key [CHAR] . =                  IF [CHAR] . es C! EXIT THEN
  key [CHAR] 0 =                  IF [CHAR] 0 es C! EXIT THEN
  key [CHAR] 0 [CHAR] 9 1+ WITHIN IF [CHAR] d es C! EXIT THEN
  0 es C! ;

: get-event2 S" -|- .|. 0|0 1|d 2|d 3|d 4|d 5|d 6|d 7|d 8|d 9|d" ev? es C! ;

где функция ev? ищет в заранее сформированной строке пару <key>| и если нашла
то отдает как выход байт со смещением 2 или 0.

расположив рядом байты текущего события, состояния, предудущего события и счетчика
введенных цифр нащего автомата мы можем затем сопоставлять такое "расширенное"
состояние с заранее сформированной строкой(таблицей) исключений. Это демонстрирует
функция check-event в последних примерах. Ну и наконец само сердце автомата
функция handle-event сейчас представляет собой совокупность строк с которыми
сопоставляется пара событие-состояние автомата и в случае успеха выполняются
указанные действия и смена состояния. Сами строки мы формируем, исходя из действий
и переходов автомата. Например строку из handle-event

Цитата:

S" d0|d1|01" [[ INP. cnt+ 1 #-> ]]

следует прочитать так:
ЕСЛИ
введена цифра 1..9 И состояние автомата 0 ИЛИ
введена цифра 1..9 И состояние автомата 1 ИЛИ
введена цифра 0 И состояние автомата 1
ТО
отпечатать ввод, увеличить счетчик цифр и перейти в состояние 1

Видим что одно и тоже действие может происходить в разных состояниях
автомата и мы спокойно записываем это в нащей строке, получается более
компактная запись. Обычно же или с целью эффективности или для уменьшения
уровня сложности автомат рассматривают по состояниям, прописывая необходимые
действия при входных воздействиях, смиряясь с возможным дублированием действий.

Ниже вариант автомата с обработкой Backspace,
чтобы не париться со счетчиками и состояниями автомата, сделано несколько иначе
каждое успешное действие автомата ( то что вызывает печать INP.)
пишет историю: сохраняется входное событие, состояние и счетчик цифр.
а при откате по bs затирается символ и восстанавливается наша четверка -
расширенное состояние. Введена строка qb с неотображаемыми символами
enter и backspace. cлова для работы с историей h+,h-,h!,h@ ,
состояний в автомате не поменялось, добавилось только событие b (Backspace)

Код:

\ выдрано из nf-name.f от chess-a 
\ Макросы многострочные допускают комментарии вида \ .....

: lex+ \ добавить очередную лексему в буфер
NextWord 2DUP >R >R NIP DUP 1 =
IF DROP R@ C@ [CHAR] ; =
   IF RDROP RDROP PAD 500 + HLD @ SLIT,
      POSTPONE EVALUATE POSTPONE ;  HLD 0! EXIT
   ELSE R@ C@ [CHAR] \ =
        IF R@ 0xD PARSE DROP R@ - 0 FILL THEN THEN
ELSE 0= IF REFILL DROP THEN THEN
R> PAD 500 + HLD @ + R@ CMOVE>  HLD @ R> + 1+ HLD ! ;

: M: : IMMEDIATE PAD 500 + 500 0 FILL HLD 0!  BEGIN lex+ HLD @ 0= UNTIL ;

\ ================================================================

CREATE eh  CHAR 0 C, 20 ALLOT eh 20 ERASE  \ event-history
CREATE sh  CHAR 0 C, 20 ALLOT sh 20 ERASE  \ state-history
CREATE ch  CHAR 0 C, 20 ALLOT ch 20 ERASE  \ count-history

\         evt  state prevt   cnt       key  delim     h#   
CREATE es 0 C,  0 C,  0 C,  CHAR 0 C,  0 C, CHAR | C, 0 C, 

: #->  ( n -- ) [CHAR] 0 + es 1+ C! ;
: cnt+  es 3 + DUP C@ 1+ [CHAR] 9 MIN SWAP C! ;
: cnt0  [CHAR] 0 es 3 + C! ;
: err.  NOOP         ;
: es?  ( a u n --  f ) es SWAP SEARCH NIP NIP ;
: ev? ( a u -- f ) es 4 + 2 SEARCH NIP IF 2+ C@ ELSE DROP 0 THEN ;

: h+ es 6 + DUP C@ 1+ 21 MIN SWAP C! ;
: h- es 6 + DUP C@ 1-  1 MAX SWAP C! ;
: h! h+ es 6 + C@ >R es C@ eh R@ + C! es 1+ C@ sh R@ + C! es 3 + C@ ch R> + C! ; 
: h@    es 6 + C@ >R eh R@ + C@ es C! sh R@ + C@ es 1+ C! ch R@ + C@ es 3 + C! eh R> 1- + C@ es 2 + C! h- ; 

: INP. es 4 + C@ EMIT es C@  es 2 + C! h! ;
: bs 8 EMIT BL EMIT 8 EMIT h@ ;
: err! IF [CHAR] e es C! THEN ;
M: [[  2 es?  IF  ;  M: ]]  EXIT THEN  ;

CREATE qb 13 C, CHAR | C, CHAR q C,  8 C, CHAR | C, CHAR b C,

: get-event qb 6 ev? S" -|- .|. 0|0 1|d 2|d 3|d 4|d 5|d 6|d 7|d 8|d 9|d" ev? OR es C! ;   
: check-event  S" 01-0|.1-0|d1d9|d109|0109|02d8|0208|d2d9|d209|q1-0|q2.0"  4 es?  S" q20" 3 es? OR  err! ;
: handle-event
S" q0|q1|q2"   [[  RDROP             ]]
S" e0|e1|e2"   [[  err.              ]]
S" d0|d1|01"   [[  INP. cnt+  1 #->  ]]
S" d2|02"      [[  INP. cnt+  2 #->  ]]
S" .1"         [[  INP. cnt0  2 #->  ]]
S" -0"         [[  INP.       1 #->  ]] 
S" b0|b1|b2"   [[  bs                ]]  ;
: INIT-FSM 0 es C! 0 es 2 + C! 0 es 6 + C!  cnt0 0 #-> ;
: READ-KEY  KEY es 4 + C! ;
: AAA  INIT-FSM BEGIN READ-KEY get-event check-event handle-event AGAIN ;

chess

Alex писал(а):

Я пытаюсь продолжать разработку полагая, что не только состояние автомата, его
входные воздействия можно представить в виде строки но и логику работы автомата
описать как операции поиска по строке.

Вычисления на строках - довольно перспективное направление. Вся арифметика может быть представлена как частный случай вычислений на строках особого вида. В форте с помощью вычислений на строках можно сделать оптимизатор.

Alex писал(а):

Видим что одно и тоже действие может происходить в разных состояниях
автомата и мы спокойно записываем это в нащей строке, получается более
компактная запись. Обычно же или с целью эффективности или для уменьшения
уровня сложности автомат рассматривают по состояниям, прописывая необходимые
действия при входных воздействиях, смиряясь с возможным дублированием действий.

Тут есть несколько нюансов:
1. В классически построенном автомате происходит скроллинг по состояниям, а после определения состояния
происходит скроллинг по событиям. После определения текущего события сразу осуществляется выполнение действия для
этого состояния и события, в том числе если надо, то меняется состояние. Эту схему можно ускорить поменяв порядок скроллинга
по состояниям и событиям, поставив наиболее частые состояния и события в начало их списков поиска. В случае когда состояния и события объединяются логически этого не сделать. Здесь еще возможно ускорить код выбирая адрес функции скроллинга по событиям из таблицы, подавая на ее вход номер текущего состояния. При лог. объединении состояний этот вариант ускорения невозможен.
2. Повтор имен действий в ветках состояний-событий на самом деле не дублирование кода действий, а ссылки на один код из разных мест памяти кода.
3. Описание автомата в тексте программы в стандартном виде близко к графу автомата - это плюс.

Alex писал(а):

\ выдрано из nf-name.f от chess-a

Сейчас я не использую для макросов и слов-строк буфер PAD:

Код:

\ Преобразователь выражений вида '?.?', где ?.? - ascii-символы - от 1-го до 4-х штук в одинарное число
: NOTFOUND ( a u -- n )
  2DUP OVER + 1- C@ 0x27 = SWAP C@ 0x27 = AND 0=
  IF NOTFOUND EXIT THEN 0 -ROT  2- SWAP 1+ SWAP OVER + 1-
  DO 8 LSHIFT I C@ + -1 +LOOP LIT, ;

: LOAD-LEX ( a u -- ) HERE SWAP DUP ALLOT MOVE 0 C, ;

: LOAD-TEXT
5 ALLOT HERE >R
BEGIN NextWord 2DUP 1 = IF C@ ';' = IF 2DROP 1 ELSE OVER C@ '\' =
      IF DROP 0xD PARSE DROP OVER - 0 FILL ELSE LOAD-LEX THEN 0 THEN
      ELSE DROP DUP 0= IF 2DROP REFILL DROP ELSE LOAD-LEX THEN 0 THEN
UNTIL HERE R@ 5 - DP ! 0xE9 C, DUP R@ - , DUP DP ! R@ SWAP R> - DLIT, ;

\ Слова-строки многострочные - допускают комментарии вида (  ) и \
: T: ( name "text" -- ) : LOAD-TEXT POSTPONE ; ;

\ Макросы многострочные - допускают комментарии вида (  ) и \
: M: ( name "text" -- ) : IMMEDIATE LOAD-TEXT POSTPONE EVALUATE POSTPONE ; ;

\ Отложенная компиляция имен вида "NAME," - вместо POSTPONE NAME
: NOTFOUND ( a u -- )
  2DUP + 1- C@ ',' <> IF NOTFOUND EXIT THEN 1- SLIT, POSTPONE EVALUATE ;

Кстати вместо записей S" -|- .|. 0|0 1|d 2|d 3|d 4|d 5|d 6|d 7|d 8|d 9|d"
можно писать например:

Код:

T: e|s 
-|- .|. 0|0 
1|d 2|d 3|d 4|d 5|d 6|d 7|d 8|d 9|d ;

Alex

chess писал(а):

1. В классически построенном автомате происходит скроллинг по состояниям, а после определения состояния происходит скроллинг по событиям.
После определения текущего события сразу осуществляется выполнение действия для этого состояния и события, в том числе если надо, то меняется состояние.

При табличной реализации ( как у J.V.Noble или в реализации в либе ~ygrek )
не надо сканировать состояния, вход анализируется и класифицируется, т.е.
определяется столбец таблицы, а текущее состояние и есть строка таблицы. Просто
вычесляем ячейку, исполняем слово и осуществляем переход.

Есть и другой способ избежать сканирования по состояниям, заметим что автомат
всегда находится в каком-то состоянии и выполняет цикл get-event и handle-event,
если каждое состояние автомата представить как такой цикл и оформить как
соответсвующее слово-процедуру, необходимо будет анализировать только входные
события обычным CASE. Конечно, нужно будет правильно организовать смену
состояния (цикла). Например если к последнему моему коду в конце добавить этот кусок

Код:

M: [s BEGIN  READ-KEY get-event check-event es C@ CASE ;  
M: s]  ENDCASE  AGAIN ;
M: [a OF ;
M: a] ENDOF ;
0 VALUE s0   
0 VALUE s1   
0 VALUE s2
: ->0  RDROP s0 >R  EXIT ;
: ->1  RDROP s1 >R  EXIT ;
: ->2  RDROP s2 >R  EXIT ;
: bss  bs  '0' es 1+ C@ = IF RDROP s0 >R  THEN
           '1' es 1+ C@ = IF RDROP s1 >R  THEN
           '2' es 1+ C@ = IF RDROP s2 >R  THEN  ;
: state0  0 #->  [s 'q'  [a  EXIT             a]
                    'e'  [a  err.             a]
                    'b'  [a  bss              a]
                    'd'  [a  INP. cnt+  ->1   a]  
                    '-'  [a  INP.       ->1   a] s] ;
: state1  1 #->  [s 'q'  [a  EXIT             a]
                    'e'  [a  err.             a]
                    'b'  [a  bss              a]
                    'd'  [a  INP. cnt+        a]  
                    '0'  [a  INP. cnt+        a]  
                    '.'  [a  INP. cnt0  ->2   a] s] ;
: state2  2 #->  [s 'q'  [a  EXIT             a]
                    'e'  [a  err.             a]
                    'b'  [a  bss              a]
                    'd'  [a  INP. cnt+        a]  
                    '0'  [a  INP. cnt+        a] s] ;
: BBB INIT-FSM  ['] state2 TO s2 ['] state1 TO s1 ['] state0 TO s0 ->0 ;

и запустив слово BBB мы получим наш автомат с backspace. Роль handle-event играют слова state0,state1,state2

chess

Вариант реализации автомата где вместо скроллинга по состояниям с помощью структуры case .. endcase
делается выборка из таблицы с выходом на процедуру скроллинга по событиям для текущего состояния.
Такой вариант имеет право на существование так как число состояний всегда обозримо.

Код:

\ лексикон произвольного автомата
: SPREV ( Q1 Q2 .. Qn n -- Qn .. Q2 Q1 ) \ реверс n параметров на стеке
  A-- D=P $ 2 #A<< A+D L1: B=@D C=@A @A=B @D=C $ 4 Da $ -4 Aa A=D? L1 J>= DROP ;
M: a{   SWAP IF is s ;
M: }a   EXIT ELSE DROP THEN ;
M: FSM{ DEPTH p! ;
M: }FSM DEPTH p - is p p SPREV p 0 DO Tse I CELLS  + ! LOOP
        BEGIN sens s sBeg - Tse + @ EXECUTE s sEnd = UNTIL ;

: INP-Q
  sBeg) s-) sD.) s.) s.D) sEnd) sBeg s!                    \ состояния
  20 Tse]                                                  \ таблица для 5-ти токенов
  9 b.D]  0 c.!                                            \ буфер для символов цифр после точки
  0 k! sens( KEY is k )                                    \ процедура 'обновить данные от сенсоров'
  0 c! c+1( c 1+ is c ) c-1( c 1- is c ) c=0( 0 is c )     \ действия
  emit( k EMIT ) emit+( emit c+1 )
  !k( k c b.D + C! )  bs( emit BL EMIT emit )
  k-( k '-' = ) k.( k '.' = ) k0( k '0' = ) kbs( k 8 = )   \ события
  kent( k 13  = ) k19( k '1' '9' 1+ WITHIN )
\ описание автомата
  eBeg( k19 sD. a{ emit+ }a
        k-  s-  a{ emit  }a )
    e-( k19 sD.  a{ emit+  }a
        kbs sBeg a{ bs c=0 }a )
   eD.( k0 k19 OR c 9 < AND s    a{ emit+            }a
        k.                  s.   a{ emit c is c. c=0 }a
        kbs c 1 = AND       s-   a{ bs c=0           }a
        kbs c 1 > AND       s    a{ bs c-1           }a
        kent                sEnd a{ CR               }a )
    e.( k0 k19 OR           s.D  a{ !k emit+         }a
        kbs                 sD.  a{ bs c. is c       }a )
   e.D( k0 c 8 < AND k19 c 9 < AND OR s    a{ !k emit+ }a
        kbs c 1 = AND                 s.   a{ bs c=0   }a
        kbs c 1 > AND                 s    a{ bs c-1   }a
        kent c 1- b.D + C@ '0' <> AND sEnd a{ CR       }a )
   FSM{ `eBeg `e- `eD. `e. `e.D }FSM ;  INP-Q

PS. описание автомата сводится к описанию для каждого состояния
процедур скроллинга по событиям и описанию действий для найденных событий.
Затем выписывается последовательность имен токенов процедур скроллинга по событиям для
каждого состояния и все.
Этот вариант достаточно универсален и по быстродействию близок к максимально-возможному.

dynamic-wind

А еще можно и Юникодный вариант написать... и чтоб римские цифры парсил! :mrgreen:

chess

dynamic-wind писал(а):

А еще можно и Юникодный вариант написать... и чтоб римские цифры парсил!

Азбуку Морзе забыли... а если поднапрячься можно еще вспомнить о кипу, иероглифах, СОК и клинописи.

chess

Предыдущий вариант, но ТАБЛИЦА ЗАПОЛНЯЕТСЯ ТОКЕНАМИ АВТОМАТИЧЕСКИ.
Для этого 'научил' локально-именованные слова отдавать токены на стек как :NONAME
только в режиме компиляции от ( TRUE get-xtl ! ) до ( FALSE get-xtl ! )
Но с точки зрения удобства надо сделать управление локальным,
что-то типа name(x ........ ).
Кстати имена в этом варианте необязательны, так как нужны только токены.

Код:

: SPREV ( Q1 Q2 .. Qn n -- Qn .. Q2 Q1 ) \ реверс n параметров на стеке
  A-- D=P $ 2 #A<< A+D L1: B=@D C=@A @A=B @D=C $ 4 Da $ -4 Aa A=D? L1 J>= DROP ;
M: a{   IF is s ;
M: }a   EXIT ELSE DROP THEN ;
M: FSM{ [ TRUE get-xtl ! ] DEPTH p!  ;
M: }FSM [ FALSE get-xtl ! ]  DEPTH p - is p   p SPREV p 0 DO Tse I CELLS  + ! LOOP
        BEGIN sens s sBeg - Tse + @ EXECUTE s sEnd = UNTIL ;

: INP-Q
  sBeg) s-) sD.) s.) s.D) sEnd) sBeg s!                    \ состояния
  20 Tse]                                                  \ таблица для 5-ти токенов
  9 b.D]  0 c.!                                            \ буфер для символов цифр после точки
  0 k! sens( KEY is k )                                    \ процедура 'обновить данные от сенсоров'
  0 c! c+1( c 1+ is c ) c-1( c 1- is c ) c=0( 0 is c )     \ действия
  emit( k EMIT ) emit+( emit c+1 )
  !k( k c b.D + C! )  bs( emit BL EMIT emit )
  k-( k '-' = ) k.( k '.' = ) k0( k '0' = ) kbs( k 8 = )   \ события
  kent( k 13  = ) k19( k '1' '9' 1+ WITHIN )
\ описание автомата
  FSM{  eBeg( sD. k19 a{ emit+ }a
              s- k- a{ emit }a )
          e-( sD. k19 a{ emit+ }a
              sBeg kbs a{ bs c=0 }a )
         eD.( s k0 k19 OR c 9 < AND a{ emit+ }a
              s. k. a{ emit c is c. c=0 }a
              s- kbs c 1 = AND a{ bs c=0 }a
              s kbs c 1 > AND a{ bs c-1 }a
              sEnd kent a{ CR }a )
          e.( s.D k0 k19 OR a{ !k emit+ }a
              sD. kbs a{ bs c. is c }a )
         e.D( s k0 c 8 < AND k19 c 9 < AND OR a{ !k emit+ }a
              s. kbs c 1 = AND a{ bs c=0 }a
              s kbs c 1 > AND a{ bs c-1 }a
              sEnd kent c 1- b.D + C@ '0' <> AND a{ CR }a )
  }FSM ; INP-Q

PS.
TODO: Размер таблицы тоже устанавливать автоматически.

chess

chess писал(а):

TODO: Размер таблицы тоже устанавливать автоматически.

Код:

\ лексикон произвольного автомата
: SPREV ( Q1 Q2 .. Qn n -- Qn .. Q2 Q1 ) \ реверс n параметров на стеке
  A-- D=P $ 2 #A<< A+D L1: B=@D C=@A @A=B @D=C $ 4 Da $ -4 Aa A=D? L1 J>= DROP ;
M: a{   IF is s ;
M: }a   EXIT ELSE DROP THEN ;
M: FSM{ [ TRUE get-xtl ! ] DEPTH p!  ;
M: }FSM [ FALSE get-xtl ! ]  DEPTH p - is p p SPREV p 0 DO sBeg I CELLS  + ! LOOP
        BEGIN sens s @ EXECUTE s sEnd = UNTIL ;

: INP-Q
  sBeg) s-) sD.) s.) s.D) sEnd) sBeg s!                                  \ состояния
  0 k! sens( KEY is k )  emit( k EMIT )                                  \ действия
  k-( k '-' = ) k.( k '.' = ) kent( k 13  = ) k09( k '0' '9' 1+ WITHIN ) \ события
  FSM{ eBeg( sD. k09 a{ emit }a k-
             s-   k-   a{ emit }a )
         e-( sD.  k09  a{ emit }a )
        eD.( s    k09  a{ emit }a
             s.   k.   a{ emit }a
             sEnd kent a{ CR   }a )
         e.( s.D  k09  a{ emit }a )
        e.D( s    k09  a{ emit }a
             sEnd kent a{ CR   }a )
  }FSM ;  INP-Q

ps.
это cамый первый автомат(чтобы покороче)
В качестве таблицы использованы поля данных идентификаторов состояний.
В эти поля(4 байта каждое) идентификаторов состояний( по сути это переменные типа variable)
помещаем токены связок (get-event handler-event) для соответствующих состояний. Идентификаторы состояний
идут друг за другом и по сути образуют таблицу как раз с нужным количеством ячеек.
Работа автомата заключается в циклическом извлечении из этой 'таблицы' по состояниям на ее входе
токенов связок (get-event handler-event) и выполнению их до выхода из цикла.
Быстродействие такого варианта близко к предельному.

chess

chess писал(а):

Но с точки зрения удобства надо сделать управление локальным,
что-то типа name(x ........ ).

Теперь если лок.именованное слово задается так:
name( ..... x), то это означает, что после компиляции этого слова
на стеке останется его токен.
Переход от глобального к локальному управлению поведением.

Код:

\ лексикон произвольного автомата
: SPREV ( Q1 Q2 .. Qn n -- Qn .. Q2 Q1 ) \ реверс n параметров на стеке
  A-- D=P $ 2 #A<< A+D L1: B=@D C=@A @A=B @D=C $ 4 Da $ -4 Aa A=D? L1 J>= DROP ;
M: a{   IF is s ;
M: }a   EXIT ELSE DROP THEN ;
M: FSM{ DEPTH p! ;
M: }FSM DEPTH p - is p p SPREV p 0 DO sBeg I CELLS + ! LOOP
        BEGIN sens s @ EXECUTE s sEnd = UNTIL ;

Код:

: INP-Q
  sBeg) s-) sD.) s.) s.D) sEnd) sBeg s!        \ состояния
  0 k! sens( KEY is k )  em( k EMIT )          \ действия
  k-( k '-' = ) k.( k '.' = ) ke( k 13 = )     \ события
  kd( k '0' '9' 1+ WITHIN )
  FSM{ eBeg( sD.  kd  a{ em }a                 \ автомат
             s-   k-  a{ em }a x)
         e-( sD.  kd  a{ em }a x)
        eD.( s    kd  a{ em }a
             s.   k.  a{ em }a
             sEnd ke  a{ CR }a x)
         e.( s.D  kd  a{ em }a x)
        e.D( s    kd  a{ em }a
             sEnd ke  a{ CR }a x)
  }FSM ;  INP-Q

СЛОВАРИ ФОРТА В РЕАЛИЗАЦИИ КОНЕЧНОГО АВТОМАТА

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