Думаю, можно запостить моё "не совсем решение".
Правда, работает оно только под spf4wc.exe, т.к. предполагает, что строки, начатые S" никуда не деваются. Однако СПФ-консольнй вариант их "проглатывает".
Что и как подключать для сохранения строк, времени пока разбираться нету.
Всё же многое не учтено в задании, например - ! - отрицание в С - префиксный оператор. Как с ним быть?
Кроме того, не сказано, что делать с неправильной строкой (где скобки не так или что-то подобное)
Но если иметь ввиду строгий инфикс со скобками, то вот решение (по алгоритму Дейкстры)
Особенности решения:
делать такой алгоритм для "просто конкурса" неинтересно, потому - чуть более общий алгоритм, включающий в себя конкурсный как вариант
1 операторы могут быть любыми - они задаются строкой с названием вида priority_str_TYPE_OF_OPERATORS_STRING
где _TYPE_OF_OPERATORS_STRING - разновидность строки, например priority_str_PROBLEM_OPS - операторы для PROBLEM - задачи, кот. задал Олег.
priority_str_C_LIKE - С-подобные операторы, но не именно С а подобно,
строк может быть много
2 каждой такой строке операторов сопоставляется строка аналогов - т.е. алгоритм не сводится к переставлению местами операторов, а заменяет операторы на нужные аналоги (например, аналоги, которыми может пользоваться Форт)
3 каждой паре строк (исходных операторов и аналогов) сопоставляется несколько переменных, наподобие
priority_str_C_LIKE
analog_str_C_LIKE
analog_pointers_C_LIKE
analog_pointers указывает на массив , где хранятся смещения "аналогов" из analog_str
одновременно существуют непривязанные к конкретной строке переменные
priority_str
analog_str
analog_pointers
именно с ними работает
>postfix, предварительно, разумеется, туда нужно поместить соотв. значения переменных для конкретной строки. Т.о. можно в рамках одной программы задавать бесконечное
количество строк приоритета для наборов операторов : операторы имеют приоритет, соответствующий их положению в строке
Помещает значения "привязанных к строке" переменных в общие переменные функция, с названием вида _TYPE_OF_OPERATORS_STRING , т.е. в коде _C_LIKE или _PROBLEM_OPS , таковая должна быть вызвана перед
>postfix
4 соотношение priority_str и analog_str необходимо проинициализировать, для чего служит функция (слово) a_init , перед которой тоже нужно вызывать слова вида _TYPE_OF_OPERATORS_STRING, чтобы заполнить значениями
priority_str
analog_str
analog_pointers
если такое слово забыто, вызывается _BASE_POSTFIX_TYPE , забыто ли оно, видно из transformation_type_flag
4а поскольку одному оператору при преобразовании может соответствовать не один, принято в
строке аналогов выделять не оператор, а группу операторов, где отдельные элементы отделены табуляторами , например
= из С++ отображается
SWAP(tab)
! ; пробелы отделяют группы операторов
( чтобы посмотреть, нужно вызвать
_C_LIKE init_check после
_C_LIKE a_init )
5 для проверки инициализации служит слово init_check - вспомогательное, просто так его, конечно, вызвать не нужно
6 код производит простые проверки - на "инфиксность" - против двух операторов подряд, на парность скобок и их порядок - нельзя скобки без выражения внутри и т.п. ...
7 поскольку операторы могут быть любыми - в т.ч. содержащими алфавитные символы - необходимо всё - в т.ч. скобки - отделять пробелами (или табуляторами, таковые имеют специальное назначение только в строках аналогов).
Недостаток тот, что это именно инфикс, префиксные операторы не учитываются, скажем один и тот же оператор в качестве инфиксного и префиксного может иметь разный приоритет в С, тут этого нет, единственное место , где оператор может быть префиксным - начало строки, иначе ловится ошибка "два оператора подряд"
Недостаток ещё, что операторы, которые должны бы иметь равный приоритет, имеют различный вследствие расположения в строке
ну а дальше понятно...
ага, код слова
>postfix выглядит дисгармонично, т.к. из него изъяты пробовавшиеся куски синтакс. анализа (ещё пару слов), без вреда для функциональности, но с вредом для наглядности
код громоздкий ...
и, может С-подобный , в скобках то стековая нотация то просто комментарии ...
ИСПРАВЛЕНО 9.01.09 строки принимаются в постоянную память отдельным словом, тогда как ранее это автоматически делал изменённый SLITERAL из spf4wc.exe
ПРИМЕЧАНИЕ - движок форума (или виндоуз?) заменяет необходимые табуляторы в строке
S" * / MOD + - RSHIFT LSHIFT < > NOT > < NOT = <> AND XOR OR AND OR SWAP ! OVER @ * SWAP ! OVER @ SWAP / SWAP ! OVER @ SWAP MOD SWAP ! OVER @ + SWAP ! OVER @ SWAP - SWAP ! OVER @ SWAP LSHIFT SWAP ! OVER @ SWAP RSHIFT SWAP ! OVER @ AND SWAP ! OVER @ XOR SWAP ! OVER @ OR SWAP ! " pfx.str_accept
на пробелы, что делает невозможным запуск кода после копирования из форума, необходимо пользоваться кодом из файла
http://www.onlinedisk.ru/file/63157/
Код:
\ на самом деле алгоритм Дейкстры
0 WARNING !
: anykey? ." any KEY " ;
: NOT 0 = ;
\ сначала определим разделительные символы
: s_sym ( symbol -- flag )
DUP 32 =
SWAP 9 =
OR
;
\ также понадобятся символы скобок
: o_s C@ ( symbol_addr -- flag )
\ open symbol
40 = ;
: c_s C@ ( symbol_addr -- flag )
\ close symbol
41 = ;
\ 1-d array pointer
: 1dap ( array_begin offset -- real_addr )
CELL * +
;
\ ----------- auxiliary : prints found word before space -----------------
: typeto32 ( addr -- )
BEGIN
DUP C@ EMIT
1 +
DUP C@ 32 = OVER C@ 0 = OR
UNTIL
;
\ ----------------------------------------
0 VALUE transformation_type_flag
\ 1 переменнaя внутри строки источника
0 VALUE wordbegin
\ и 1 начала строки источника
0 VALUE sourcestringbegin
0 VALUE sourcestringpointer
0 VALUE sourcestringfinal
\ ---------------- строка - результат
0 VALUE result_begin
HERE 4096 ALLOT TO result_begin
0 VALUE result_pointer
\ теперь указатели
0 VALUE oper_stack_pointer
0 VALUE analog_stack_pointer
\ stacks self, 512 operations max
0 VALUE oper_stack
HERE TO oper_stack
512 CELL * ALLOT
\ на всякий случай
oper_stack 512 CELL * 0 FILL
0 VALUE priority_str \ начало строки приоритетов :)
0 VALUE priority_str_index \ указатель на символ
0 VALUE analog_str \ начало строки форт-аналогий (для опр. языка)
0 VALUE analog_str_index \ указатель на символ
0 VALUE analog_pointers \ начало массива указателей на аналоги
\ придётсz определить специальноен слово для внесения строчек в паmять
\ CMOVE не подходит, т.к. нужно прооверять наличие 0 и непонятно, в каком символе от конца строки
: pfx.str_accept ( asc # -- [new string] asc )
HERE >R DUP ALLOT
\ allot for string length
0 TO priority_str_index
BEGIN
DUP priority_str_index ( presently : asc # # index )
< NOT
>R
OVER priority_str_index + C@ DUP ( presently : asc # symbol symbol )
0 <>
R> AND \ symbol not is NULL and string not ended
WHILE
priority_str_index ( presently : asc # symbol index )
R@
+ C!
priority_str_index 1 + TO priority_str_index
REPEAT
\ the string was copied, this is needed: check the end of str - 32 0 to be
DROP DROP DROP ( presently : [empty] )
\ first if the end of string is HERE - 1
HERE
priority_str_index
R@ +
<>
IF
CR ." END OF COPIED STRING IS NOT THE END OF CURRENTLY ALLOCATED MEMORY ! "
anykey? KEY DROP BYE
THEN
priority_str_index R@ + C@ DUP ( presently : symbol symbol )
32 =
IF
HERE
1 ALLOT 0 SWAP C! DROP
ELSE
0 =
IF ( presently : [empty] )
priority_str_index R@ + 1 - C@ 32 <>
IF HERE 2 ALLOT DUP 1 - 32 SWAP C! 0 SWAP C! ELSE 1 ALLOT THEN
ELSE
HERE 1 ALLOT DUP 32 SWAP C! 1 + 0 SWAP C!
THEN
THEN
R> \ return begin of str
;
( end: pfx.str_accept )
\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\\ \\ \\ \\ \\ \\
\ ---------------- С_LIKE -------- С -подобные ператоры
0 VALUE priority_str_C_LIKE
S" * / % + - >> << < <= > >= == != & ^ | && || = *= /= %= += -= <<= >>= &= ^= |= " pfx.str_accept
TO priority_str_C_LIKE
\ строка оканчивается нулём и перед закрывающей кавычкой должно быть пару пробелов!
\ ---------------- аналоги форта для С_LIKE
0 VALUE analog_str_C_LIKE
S" * / MOD + - RSHIFT LSHIFT < > NOT > < NOT = <> AND XOR OR AND OR SWAP ! OVER @ * SWAP ! OVER @ SWAP / SWAP ! OVER @ SWAP MOD SWAP ! OVER @ + SWAP ! OVER @ SWAP - SWAP ! OVER @ SWAP LSHIFT SWAP ! OVER @ SWAP RSHIFT SWAP ! OVER @ AND SWAP ! OVER @ XOR SWAP ! OVER @ OR SWAP ! " pfx.str_accept
TO analog_str_C_LIKE
\ строка оканчивается нулём и перед закрывающей кавычкой должно быть пару пробелов!
0 VALUE analog_pointers_C_LIKE
HERE TO analog_pointers_C_LIKE
100 CELL * ALLOT
: _C_LIKE ( -- ) \ to set _C_LIKE as active
analog_str_C_LIKE TO analog_str
priority_str_C_LIKE TO priority_str
analog_pointers_C_LIKE TO analog_pointers
-1 TO transformation_type_flag
;
\ ---------------- аналоги форта для С_LIKE END ----------------
\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\\ \\ \\ \\ \\ \\
\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\\ \\ \\ \\ \\ \\
\ ---------------- problem_operators -------- предложенные в задаче операторы
0 VALUE priority_str_PROBLEM_OPS
0 VALUE analog_str_PROBLEM_OPS
0 VALUE analog_pointers_PROBLEM_OPS
HERE TO analog_pointers_PROBLEM_OPS
100 CELL * ALLOT
S" ! & | % ^ / * + - = " pfx.str_accept TO priority_str_PROBLEM_OPS
\ строка оканчивается нулём
\ ------------------------ forth analogies for problem_operators ----------------------------
S" ! & | % ^ / * + - = " pfx.str_accept TO analog_str_PROBLEM_OPS
\ строка оканчивается нулём и она та же самая, ради однообразия оставлено
\ деление на две строки, хотя можно было бы воспользоваться одною
: _PROBLEM_OPS ( -- ) \ to set _PROBLEM_OPS as active
analog_str_PROBLEM_OPS TO analog_str
priority_str_PROBLEM_OPS TO priority_str
analog_pointers_PROBLEM_OPS TO analog_pointers
-1 TO transformation_type_flag
;
\ ---------------- problem_operators ----- END---
\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\ \\\ \\ \\ \\ \\ \\
: _BASE_POSTFIX_TYPE ( -- )
_C_LIKE
;
\ ----------------------- values & words for initialization -------------------------------
0 VALUE a_init_analog
0 VALUE a_init_priority
( a_init ) : g_str_one_step ( -- TRUE | FALSE )
priority_str a_init_priority +
BEGIN DUP C@ s_sym NOT WHILE 1 + REPEAT
DUP C@ 0 <>
IF
BEGIN DUP C@ s_sym WHILE 1 + REPEAT
DUP C@ 0 <>
IF
priority_str - TO a_init_priority -1
ELSE
DROP 0
THEN
ELSE
DROP 0
THEN
;
( a_init ) : a_str_one_step ( -- TRUE | FALSE )
analog_str a_init_analog +
BEGIN DUP C@ 32 <> WHILE 1 + REPEAT DUP C@ 0 <>
IF
BEGIN DUP C@ 32 = WHILE 1 + REPEAT
DUP C@ 0 <>
IF
analog_str - TO a_init_analog -1
ELSE
DROP 0
THEN
ELSE
DROP 0
THEN
;
( a_init ) : a_init_assign ( --> ) a_init_analog
analog_pointers
a_init_priority CELL * + !
;
: a_init ( -- )
transformation_type_flag NOT IF _BASE_POSTFIX_TYPE THEN 0 TO transformation_type_flag
0 TO a_init_priority
0 TO a_init_analog
BEGIN
a_str_one_step
g_str_one_step
0 =
IF
0 = IF -1 ELSE ." unbalance in strings SAMPLES & FORTH analogies (1) " anykey? KEY DROP BYE THEN
ELSE
0 = IF ." unbalance in strings SAMPLES & FORTH analogies (2) " anykey? KEY DROP BYE ELSE
a_init_assign
0 THEN
THEN
UNTIL
;
\ =============== check ================
\ проверить инициализацию если нужно: check for strings initialization
0 VALUE init_check_a
0 VALUE init_check_pr
: init_check_NEXT_CHAR ( addr -- naddr )
DUP
32 <> priority_str init_check_pr <> AND
IF BEGIN 1 + DUP C@ 32 = UNTIL THEN
BEGIN 1 + DUP C@ 32 <> UNTIL
;
: init_check ( -- )
transformation_type_flag NOT IF _BASE_POSTFIX_TYPE THEN 0 TO transformation_type_flag
priority_str TO init_check_pr
BEGIN
init_check_pr DUP C@ 0 <>
WHILE
init_check_NEXT_CHAR DUP
TO init_check_pr
typeto32 DROP
init_check_pr
9 EMIT
priority_str - CELL *
analog_pointers +
@ DUP
TO init_check_a
analog_str +
typeto32 DROP
CR
REPEAT
DROP
;
\ =============== check end ================
\ 4 переменных состояния для конечного автомата
0 VALUE STRING_STATE \ собственно состояние ( всего 2 0 - nothing 1 - word continue; )
0 VALUE OPERATOR_STATE \ предупреждение появления 2 операторов подряд - не постфикс
0 VALUE OBRACKET_STATE \ предупреждение появления open скобок в ненадлежащем порядке
0 VALUE CBRACKET_STATE \ предупреждение появления close скобок в ненадлежащем порядке
-1 VALUE CONTINUITY \ непрерывность - до разделяющего символа
-1 VALUE is_operator_sbegin \ начало предполагаемого оператора в исходной строке
-1 VALUE is_operator_oplength \ длина оператора для пропуска оного
: is_operator_oplength++ is_operator_oplength 1 + TO is_operator_oplength ;
: priority_str_index++ priority_str_index 1 + TO priority_str_index ;
: priority_str_index_to_next
BEGIN priority_str_index DUP C@ 32 <> WHILE 1 + TO priority_str_index REPEAT DROP
BEGIN priority_str_index 1 + DUP TO priority_str_index C@ 32 <> UNTIL
;
: begin_of_operator_in_priority_str priority_str_index
is_operator_oplength - priority_str -
;
: (not_found)pryority_str_not_ended¬_found? ( not_found -- flag )
priority_str_index
C@ 0 <> AND
;
: is_operator_both_separator ( -- )
( found if CONTINUITY )
CONTINUITY -1 =
IF 1 + -1 ELSE DROP begin_of_operator_in_priority_str 0 THEN
;
: is_operator_symbols_equal ( pointer_to_symbol -- ... )
priority_str_index C@ 32 = ( ' ' consequently source also )
IF
is_operator_both_separator
ELSE
CONTINUITY -1 =
IF DUP TO CONTINUITY THEN 1 + -1
is_operator_oplength++ priority_str_index++
THEN
;
: is_operator_symbols_not_equal ( pointer_to_symbol -- ... )
DUP C@ 9 = IF priority_str_index C@ 32 = IF is_operator_both_separator THEN
ELSE
-1 TO CONTINUITY
DROP is_operator_sbegin
0 TO is_operator_oplength
-1 priority_str_index_to_next
THEN
;
: is_operator ( pointer_to_symbol -- flag )
DUP TO is_operator_sbegin
-1 TO CONTINUITY ( pointer to wordbegin is CONTINUITY -- "CONTINUITY from" )
priority_str TO priority_str_index
-1 \ not_found
BEGIN
(not_found)pryority_str_not_ended¬_found?
WHILE
priority_str_index
C@ OVER C@ = ( symbols equal )
IF
is_operator_symbols_equal
ELSE
is_operator_symbols_not_equal
THEN
REPEAT
CONTINUITY -1 = IF DROP -1 THEN
;
: check_elements_order ( type of element -- flag )
\ types of previous element: 1 - '(' , 2 - ')' , 3 - operator
DUP 1 =
IF
DROP
CBRACKET_STATE IF ." IMPROPER ORDER OF BRACKETS (1) " 0 ELSE -1 THEN
ELSE DUP 2 =
IF
DROP
OBRACKET_STATE IF ." IMPROPER ORDER OF BRACKETS (2) " 0 ELSE -1 THEN
OPERATOR_STATE IF ." IMPROPER COMBINATION of OPERATORS And BRACKETS (3) " 0 ELSE -1 THEN AND
ELSE 3 =
IF
OPERATOR_STATE IF ." IMPROPER COMBINATION OF OPERATORS (4) " 0 ELSE -1 THEN
OBRACKET_STATE IF ." IMPROPER COMBINATION OF OPERATORS AND BRACKETS (5) " 0 ELSE -1 THEN AND
ELSE
." ERROR OF PARAMETER OF WORD check_elements_order " anykey? KEY DROP BYE
THEN
THEN
THEN
;
: change_elements_order ( type of element -- )
\ types of previous element: 1 - '(' , 2 - ')' , 3 - operator , 4 - symple symbol
DUP 1 =
IF
DROP
-1 TO OBRACKET_STATE
ELSE DUP 2 =
IF
DROP
-1 TO CBRACKET_STATE
ELSE DUP 3 =
IF
DROP
-1 TO OPERATOR_STATE
0 TO CBRACKET_STATE
ELSE DUP 4 =
IF
DROP
0 TO OBRACKET_STATE
0 TO CBRACKET_STATE
0 TO OPERATOR_STATE
ELSE
." ERROR OF PARAMETER OF WORD change_elements_order " anykey? KEY DROP BYE
THEN
THEN
THEN
THEN
;
\ stack to result
: stack_sym_to_result ( symbol -- )
result_begin result_pointer + C!
result_pointer 1 + TO result_pointer
;
: space_to_result ( -- )
32 stack_sym_to_result
;
: word_to_res ( wordend -- )
BEGIN
wordbegin
OVER > NOT
WHILE
wordbegin C@ result_begin result_pointer + C!
result_pointer 1 + TO result_pointer
wordbegin 1 + TO wordbegin
REPEAT
DROP
space_to_result
;
\ помещение на стек операций
: >oper_stack ( operation_addr -- )
oper_stack_pointer 511 >
IF ." STACK OF OPERATIONS OVERFLOW " anykey? KEY DROP BYE THEN
oper_stack oper_stack_pointer 1dap !
oper_stack_pointer 1 + TO oper_stack_pointer
;
\ снятие со стека операций и размещение в результирующей строке: скобка - операция (-1)
\ хранить операции на стеке операций ...
\ в виде ссылок
: oper_stack> ( -- )
result_pointer ( check >> ) 4096 > IF ." STRING LENGTH OVERFLOW " anykey? KEY DROP BYE THEN
oper_stack oper_stack_pointer 1 - 1dap
( addr_of_last oper_stack )
@
( value_of_last_operstack=addr_of_pryority_stack_elem )
analog_pointers SWAP 1dap @
( value_of_analog_pointers_cell[vapc] )
analog_str +
( addr_of_analog_ )
DUP TO wordbegin
BEGIN
1 +
DUP C@
32 =
UNTIL ( [alrs] wordend )
word_to_res
oper_stack_pointer 1 - TO oper_stack_pointer
;
: oper_stack_see ( -- n )
oper_stack oper_stack_pointer 1 - 1dap
@
;
: (addr!)saved_priority_higher(flag) DUP
oper_stack_pointer 0 <> IF oper_stack_see -1 <> ELSE 0 THEN
IF
oper_stack_see ( value of operator on op_stack )
< NOT
ELSE
DROP 0
THEN
;
: brackets_match ( -- )
BEGIN
oper_stack>
space_to_result
oper_stack_see -1 =
UNTIL
oper_stack_pointer 1 - TO oper_stack_pointer
;
: operator_match ( addr_of_op_in_priority_str -- )
BEGIN
(addr!)saved_priority_higher(flag)
WHILE
oper_stack>
REPEAT
>oper_stack
;
: symbol_recognize ( symbol -- if_operator:addr ) \ recognizes and does
DUP o_s
IF
( check >> ) 1 check_elements_order NOT IF anykey? KEY DROP BYE THEN
DROP -1 >oper_stack
0 TO is_operator_oplength 1 change_elements_order
-1 ( return true for operator )
ELSE
DUP c_s
IF
( check >> ) 2 check_elements_order NOT IF anykey? KEY DROP BYE THEN
brackets_match
1 TO is_operator_oplength 2 change_elements_order
DROP -1 ( return true for operator )
ELSE
is_operator
DUP -1 <>
IF
( check >> ) 3 check_elements_order NOT IF anykey? KEY DROP BYE THEN
operator_match 3 change_elements_order
-1 ( return true for operator )
ELSE
DROP 4 change_elements_order
0 ( return false for operator )
THEN
\ end is_operator
THEN
THEN
;
: end_of_string_match ( -- )
BEGIN
oper_stack_pointer 0 <>
WHILE
oper_stack_see
-1 =
IF ." UNPAIRED BRACKETS " anykey? KEY DROP BYE THEN
oper_stack>
space_to_result
REPEAT
;
: skip_op_symbols ( -- )
is_operator_oplength sourcestringpointer + TO sourcestringpointer
;
: >postfix_variables_start
0 TO wordbegin 0 TO oper_stack_pointer
0 TO result_pointer 0 TO priority_str_index
0 TO STRING_STATE 0 TO OPERATOR_STATE
0 TO OBRACKET_STATE 0 TO CBRACKET_STATE
;
: >postfix ( asc # --> asc # )
transformation_type_flag NOT IF _BASE_POSTFIX_TYPE THEN 0 TO transformation_type_flag
SWAP DUP
TO sourcestringbegin
TO sourcestringpointer
sourcestringbegin + TO sourcestringfinal
>postfix_variables_start
BEGIN
sourcestringpointer sourcestringfinal > NOT
WHILE
sourcestringpointer
( symbol_addr )
STRING_STATE
IF
C@ s_sym
IF
\ naturally, end of word
0 TO STRING_STATE
sourcestringpointer 1 -
word_to_res
THEN
sourcestringpointer 1 + TO sourcestringpointer
ELSE \ ---------------------- NO word in process ----------------------
C@ s_sym NOT
IF
sourcestringpointer
symbol_recognize
IF
skip_op_symbols
ELSE
-1 TO STRING_STATE
sourcestringpointer TO wordbegin
THEN
THEN
sourcestringpointer 1 + TO sourcestringpointer
THEN
REPEAT
\ end of string - rest
OPERATOR_STATE OBRACKET_STATE OR IF ." UNEXPECTED END OF_ STRING " anykey? KEY DROP BYE THEN
end_of_string_match
result_begin ( asc )
result_pointer ( # )
;
: pfx_types_init
_C_LIKE a_init
_PROBLEM_OPS a_init
;
pfx_types_init
-1 WARNING !
\ примеры (раскомментировать)
\ _C_LIKE S" aa + bcd * c / d " >postfix CR TYPE
\ _C_LIKE S" +++A*A++ = ( a + a- ) != d | ( b + ss ) * c * ( s / d ) " >postfix CR TYPE
\ _C_LIKE S" a + b + c * d " >postfix CR TYPE
\ _PROBLEM_OPS S" x = ( a ^ ( b / c ) & d ) | f " >postfix CR TYPE
Вход
Регистрация
Благодарности
Forth-FAQ
не корректно:
чтобы это прочесть, нужно, на самом деле скопировать в редактор ( с подсветкой)