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

...
Google Search
Forth-FAQ Spy Grafic

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




Начать новую тему Ответить на тему  [ Сообщений: 148 ]  На страницу 1, 2, 3, 4, 5 ... 10  След.
Автор Сообщение
 Заголовок сообщения: *преобразование скобочной записи в постфикс
СообщениеДобавлено: Чт сен 18, 2008 23:45 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4954
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
Преобразовать выражение вида a=b*(c+d)/e в постфиксную запись вида c d + b * e / a =
Итак, на входе дана строка, представляемая своим адресом и длиной, в которой находится арифметическое выражение, записанное в инфиксной форме. Необходимо вернуть строку содержащую преобразованное в постфикс представление арифметического выражения:

как всегда задаем имя главного слова:
Код:

: >postfix ( asc # --> asc # )

               ;


преобразование должно производится согласно стандартным математическим правилам, то есть во-первых, более приоритетные операции находятся в скобках, во-вторых, порядок приоритетов операций следующий: ! & | % ^ / * + - = ( отрицание, логическое и, логическое или, исключающее или, возведение в степень, деление, умножение, сложение, вычитание, присвоение)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Чт сен 18, 2008 23:56 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Что будет делать =
?

_________________
понимаю некоторую бестолковость некоторых вопросов


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт сен 19, 2008 00:02 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4954
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
вопрос писал(а):
Что будет делать =
?

внимательно читаем ТЗ. Ответ в первой строке ТЗ в виде примера приведен

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт сен 19, 2008 00:05 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 6435
Благодарил (а): 14 раз.
Поблагодарили: 101 раз.
вопрос писал(а):
Что будет делать =
?

Видимо, SWAP !


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт сен 19, 2008 00:12 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4954
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
Хищник писал(а):
вопрос писал(а):
Что будет делать =
?

Видимо, SWAP !

ну, вроде как просто ! 8)
на самом деле ничего писать не надо! надо на выходе только строку получить

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт сен 19, 2008 00:16 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Это я понял, но для чего в фортовской строчке в конце сравнение, которое в сишной было присвоением - не уловил.

_________________
понимаю некоторую бестолковость некоторых вопросов


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пт сен 19, 2008 00:20 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4954
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
вопрос писал(а):
Это я понял, но для чего в фортовской строчке в конце сравнение, которое в сишной было присвоением - не уловил.

речь не о фортовой строке, а о постфиксе, прошу не путать

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: *преобразование скобочной записи в постфикс
СообщениеДобавлено: Пт дек 12, 2008 04:08 
Не в сети
Аватара пользователя

Зарегистрирован: Вт май 29, 2007 11:32
Сообщения: 1
Благодарил (а): 0 раз.
Поблагодарили: 0 раз.
Так писать :dmad; не корректно:
mOleg писал(а):
...
преобразование должно производится согласно стандартным математическим правилам, то есть во-первых, более приоритетные операции находятся в скобках, во-вторых, порядок приоритетов операций следующий: ! & | % ^ / * + - = ( отрицание, логическое и, логическое или, исключающее или, возведение в степень, деление, умножение, сложение, вычитание, присвоение)

У стандартных математических правила не такой порядок приоритетов! Сложение и вычитание имеют одинаковый приоритет; умножение и деление тоже. Про направление ассоциативности вообще тут слова не сказано... как считать "a/b/c"? Как "a/(b/c)" или как "(a/b)/c"?
Надо всё это уточнить. :?

_________________
Милость Божья - нам не дают что заслуживаем.
Благодать Божья - нам дают что не заслуживаем.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: *преобразование скобочной записи в постфикс
СообщениеДобавлено: Пт дек 12, 2008 06:45 
Не в сети

Зарегистрирован: Ср сен 13, 2006 10:06
Сообщения: 636
Откуда: Омск
Благодарил (а): 0 раз.
Поблагодарили: 3 раз.
Григорий писал(а):
У стандартных математических правила не такой порядок приоритетов! Сложение и вычитание имеют одинаковый приоритет; умножение и деление тоже. Про направление ассоциативности вообще тут слова не сказано... как считать "a/b/c"? Как "a/(b/c)" или как "(a/b)/c"?
Надо всё это уточнить. :?

К черту математику, кто первый тот и приоритет! Зачем все усложнять, оно что то даст? По моему заданьице против стереотипов форта направленно.

_________________
Меня нет, не будет и не было.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн янв 05, 2009 18:30 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Об индивидуальной непереносимости фортами одних другими ... теперь как выясняется, даже в рамках одной системы. Предположим, я сделал решение для этой задачки, даже, может, для группы таких задач ... Но под SPF4wc . 0днако работа со строками в простом СПФ и SPF4wc сильно разнится. Глюк, однако. Притом на выяснение, что именно и как подключено для отличия - полчаса мало :weep;
А решение громоздкое, переделывать его трудно.

_________________
понимаю некоторую бестолковость некоторых вопросов


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн янв 05, 2009 20:42 
Не в сети
Moderator
Moderator
Аватара пользователя

Зарегистрирован: Чт май 04, 2006 00:53
Сообщения: 4954
Откуда: был Крым, теперь Новосибирск
Благодарил (а): 18 раз.
Поблагодарили: 56 раз.
вопрос писал(а):
Об индивидуальной непереносимости фортами одних другими ... теперь как выясняется, даже в рамках одной системы.

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

_________________
Мне бы только мой крошечный вклад внести,
За короткую жизнь сплести
Хотя бы ниточку шёлка.
fleur


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн янв 05, 2009 23:32 
Не в сети

Зарегистрирован: Чт май 04, 2006 18:18
Сообщения: 456
Благодарил (а): 0 раз.
Поблагодарили: 1 раз.
вопрос писал(а):
0днако работа со строками в простом СПФ и SPF4wc сильно разнится.

Потому что это не одна система. spf4wc - это надстройка над spf. И отличия описана в readme.

_________________
http://forth.org.ru/~ygrek


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Пн янв 05, 2009 23:44 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Да, я читал
Цитата:
Переопределен SLITERAL - в режиме интерпретации строки, введенные через
S" text", копируются в динамическую память и остаются там навсегда.
Утечка памяти конечно, но зато никуда не пропадают.
вот где он переопределён - не сказано ...

_________________
понимаю некоторую бестолковость некоторых вопросов


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт янв 06, 2009 08:57 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
Думаю, можно запостить моё "не совсем решение".

Правда, работает оно только под 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, предварительно, разумеется, туда нужно поместить соотв. значения переменных для конкретной строки. Т.о. можно в рамках одной программы задавать бесконечное :D количество строк приоритета для наборов операторов : операторы имеют приоритет, соответствующий их положению в строке
Помещает значения "привязанных к строке" переменных в общие переменные функция, с названием вида _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


поскольку одному оператору при преобразовании может соответствовать не один, принято в строке аналогов выделять не оператор, а группу операторов, где отдельные элементы отделены табуляторами , например = из С++ отображается 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&not_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&not_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



_________________
понимаю некоторую бестолковость некоторых вопросов


Последний раз редактировалось вопрос Пт янв 09, 2009 21:19, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения:
СообщениеДобавлено: Вт янв 06, 2009 09:07 
Не в сети

Зарегистрирован: Вт май 09, 2006 12:31
Сообщения: 3438
Благодарил (а): 5 раз.
Поблагодарили: 16 раз.
посмотрел как выглядит код - перенос строк...
:shock: чтобы это прочесть, нужно, на самом деле скопировать в редактор ( с подсветкой)

_________________
понимаю некоторую бестолковость некоторых вопросов


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 148 ]  На страницу 1, 2, 3, 4, 5 ... 10  След.

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


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

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


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

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