Forth и другие саморасширяющиеся системы программирования Locations of visitors to this page
Текущее время: Чт мар 28, 2024 15:51

...
Google Search
Forth-FAQ Spy Grafic

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




Начать новую тему Ответить на тему  [ Сообщений: 73 ]  На страницу Пред.  1, 2, 3, 4, 5  След.
Автор Сообщение
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Вт фев 18, 2020 11:06 
Не в сети

Зарегистрирован: Чт янв 07, 2016 19:14
Сообщения: 1288
Благодарил (а): 3 раз.
Поблагодарили: 18 раз.
Цитата:
Given two integers, A and B.

Their sum needs to be calculated.


Для Nova-forth
Код:
: CATCH: R> CATCH ;

: PLUS:
['] THROW >R
'CR' PARSE FROM ParseBuff.simb KEEP! FROM ParseBuff KEEP!
0 >IN KEEP!
CATCH:
0 BEGIN PARSE-NAME DUP WHILE STR>NUM THROW + REPEAT 2DROP
.
;

Интерпретация строки чисел с перехватом ошибок и восстановлением контекста ФС

_________________
Цель: сделать 64-битную Нову под Винду


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Вт фев 18, 2020 15:55 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 7960
Благодарил (а): 25 раз.
Поблагодарили: 144 раз.
Victor__v писал(а):
Интерпретация строки чисел с перехватом ошибок и восстановлением контекста ФС

Явно не хватает слова ReadInt.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Вт фев 18, 2020 16:48 
Не в сети

Зарегистрирован: Чт янв 07, 2016 19:14
Сообщения: 1288
Благодарил (а): 3 раз.
Поблагодарили: 18 раз.
Hishnik писал(а):
Victor__v писал(а):
Интерпретация строки чисел с перехватом ошибок и восстановлением контекста ФС

Явно не хватает слова ReadInt.

STR>NUM \ A U -- num err|0

Конечно, можно заморочиться и написать такое слово, только код сложнее будет у меня)

_________________
Цель: сделать 64-битную Нову под Винду


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Вт фев 18, 2020 23:06 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 7960
Благодарил (а): 25 раз.
Поблагодарили: 144 раз.
Вводить и складывать два числа через перехват исключений - это сильно. Для этого и нужны тесты вроде RosettaCode. Тут вообще можно ограничиться + . - это если оговорить, что числа вводятся с клавиатуры в консоль, а дальше как принято в Форте. У меня больше строк, да... но это GUI.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Вс май 24, 2020 01:20 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 7960
Благодарил (а): 25 раз.
Поблагодарили: 144 раз.
Rosetta Code оказался эффективным мотиватором для изменения нового Кварка :)
Вариант кода с чуть улучшенным взаимодействием виджетов.



Код:
0 LABEL.SHOW
20 40 100 40 0 LABEL.RECT
" A" 0 LABEL.TEXT

1 LABEL.SHOW
180 40 100 40 1 LABEL.RECT
" B" 1 LABEL.TEXT

2 LABEL.SHOW
300 40 100 40 2 LABEL.RECT

0 TEXTEDIT.SHOW
0 80 100 40 0 TEXTEDIT.RECT

1 TEXTEDIT.SHOW
120 80 100 40 1 TEXTEDIT.RECT

0 BUTTON.SHOW
320 80 100 50 0 BUTTON.RECT
" A+B" 0 BUTTON.TEXT

VARIABLE FLAG
FLAG OFF

: WAITGUI BEGIN FLAG @ UNTIL FLAG OFF ;

: EDIT.GETLINE
  FLAG SETFLAG
  TEXTEDIT.GETLINE WAITGUI
;

CREATE $BUF 256 ALLOT

: GETA
  $BUF 0 0 EDIT.GETLINE
  $BUF STR>
;

: GETB
  $BUF 0 1 EDIT.GETLINE
  $BUF STR>
;

: SHOWRESULT
  $BUF >STR
  $BUF 2 LABEL.TEXT
;

" GETA GETB + SHOWRESULT" 0 BUTTON.ACTION


Теперь чтение строки "обернуто" в еще одно слово. После некоторых позиционных войн с Qt выяснилось, что взаимодействие потоков не так просто, и заставить Qt "прокачивать" очередь сообщений не особенно удается, если Форт-машина при этом стоит. А она стоит, потому что ждет реакции на запрос (например, содержимого TextEdit). Скомпилировать серию вызовов на C++ в целом не получается, а вот слово EDIT.GETLINE работает.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 00:29 
Не в сети

Зарегистрирован: Пн янв 07, 2013 22:40
Сообщения: 2141
Благодарил (а): 8 раз.
Поблагодарили: 74 раз.
Нет решения такой несложной задачи на Форт. :)
Phrase_reversals
Самое простое схемное решение видится в создании слова Reverse ( addr n -- addr n )
- например считыванием всех символов строки в стэк, а потом из него их извлечением из стэка переписать строку символов.
а, остальные варианты из этой задачи применением слова Reverse и считывания отдельных слов из потока/строки.

P.S. Пока на Forth 543 решений задач на rosettacode.


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 10:44 
Не в сети
Аватара пользователя

Зарегистрирован: Ср июл 03, 2019 11:10
Сообщения: 463
Откуда: Москва
Благодарил (а): 57 раз.
Поблагодарили: 22 раз.
Ну да, там 3 подзадачи:
- инвертировать строку;
- инвертировать слова, не меняя порядок слов;
- поменять порядок слов;
Для первого случая, например, можно тупо запихать всю всю строку посимвольно в стек, а затем вывести содержимое... Во втором почти то же самое, но выводить и опустошать стек каждый раз, когда попался пробел... А для случая 3 можно запоминать в стеке адреса начала слов...
На esoteric forth, например, первая задача решается как-то так: :D
Код:
% c
% s
: p "rosetta code phrase reversal" ;
: r # , ( # , $ 1 + # , ) _ ;
: w # ( c # ) _ ;
0 p r w
> lasrever esarhp edoc attesor
или даже так: :D
Код:
%c%s0"rosetta code phrase reversal"#(#,$1+#,)(c#)_
> lasrever esarhp edoc attesor
На обычном Форте могло бы быть что-то вроде:
Код:
include "xxx" \ подключаем какие-то нужные библиотеки
: phrase "rosetta code phrase reversal" ;
: reverse begin dup c@ while dup c@ swap 1+ repeat drop ;
: write begin dup while emit repeat drop ;
0 phrase reverse write
Если бы не одно НО... У меня ж asciiz, поэтому за такое решение меня адепты секты ans94 на вилы поднимут, а переделывать под расово правильный Форт мне лень... :D
В принципе, для "правильных" строк еще проще может получиться, т.к. длину строки мы знаем, поэтому можем выводить строку посимвольно, начиная с strlen-1, но все равно лень... :D


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 15:23 
Не в сети

Зарегистрирован: Пн янв 07, 2013 22:40
Сообщения: 2141
Благодарил (а): 8 раз.
Поблагодарили: 74 раз.
Например один из вариантов решения по реверсу строки , при проверке в gForth Online может быть такой :)
Код:
create AXD S" rosetta code phrase reversal" S,
: reverse { addr len } addr len bounds  do  I c@ loop
                       addr len bounds  do  I c! loop ;
AXD count 2dup reverse  type

Тыц

P.S. Конечно gForth немного в "себе" Форт в сравнении с другими реализациями Forth и вроде бы такие простые вещи для него не так просты в реализации (может возможно более немногословное решение) :)



За это сообщение автора KPG поблагодарил: Total Vacuum
Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 15:57 
Не в сети
Аватара пользователя

Зарегистрирован: Ср июл 03, 2019 11:10
Сообщения: 463
Откуда: Москва
Благодарил (а): 57 раз.
Поблагодарили: 22 раз.
ну или так: :D
Код:
: phrase s" rosetta code phrase reversal" ;
: reverse { addr len } addr len bounds do i c@ loop len 0 do emit loop ;
phrase reverse
или даже так: :D
Код:
: phrase s" rosetta code phrase reversal" ;
: reverse over + 1- do i c@ emit -1 +loop ;
phrase reverse

А для реализаций с asciiz, возможно, самым коротким будет вариант с рекурсией (у меня в таком виде работает, хотя в каких-то других системах надо будет использовать recurse):
Код:
: phrase "rosetta code phrase reversal" ;
: reverse dup 1+ c@ if dup 1+ reverse then c@ emit ;
phrase reverse


Последний раз редактировалось Total Vacuum Чт сен 16, 2021 13:44, всего редактировалось 1 раз.

Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 20:06 
Не в сети

Зарегистрирован: Чт янв 07, 2016 19:14
Сообщения: 1288
Благодарил (а): 3 раз.
Поблагодарили: 18 раз.
Total Vacuum писал(а):
Ну да, там 3 подзадачи:
- инвертировать строку;
- инвертировать слова, не меняя порядок слов;
- поменять порядок слов;


Код:
: REV-WORD \ a len --
DUP 2 < IF 2DROP EXIT THEN  \ ОТ ДУРАКА
OVER + 1- 2>R BEGIN
2R@ =
2R@ >
OR IF RDROP RDROP EXIT THEN
1 RPICK C@ R@ C@
1 RPICK C! R@ C!
R> 1- R> 1+ >R >R
AGAIN
;

S" HELLO WORD!" 2DUP REV-WORD TYPE CR

: REV-WORDS-IN-STR \ a u
FROM ParseBuff.simb KEEP!
FROM ParseBuff KEEP!
0 >IN KEEP!
BEGIN PARSE-NAME DUP WHILE REV-STR REPEAT 2DROP 
;

S" HELLO WORD!" 2DUP REV-WORDS-IN-STR TYPE CR

: REV-WORDS-ORDER \ xt a u -- xt: new-a new-u
FROM ParseBuff.simb KEEP!
FROM ParseBuff KEEP!
0 >IN KEEP!
>R
0 >R
BEGIN PARSE-NAME DUP WHILE RP@ 1+! REPEAT 2DROP 
BEGIN R@ WHILE 1 RPICK EXECUTE BL EMIT  R> 1- >R REPEAT
RDROP RDROP
;

' TYPE S" HELLO WORD!" REV-WORDS-ORDER

Последняя подзадача сделана квадратно-гнездовым способом, т. к. не учитывает пробельные символы. Заморачиваться для примера лень

_________________
Цель: сделать 64-битную Нову под Винду


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 21:57 
Не в сети

Зарегистрирован: Пн янв 07, 2013 22:40
Сообщения: 2141
Благодарил (а): 8 раз.
Поблагодарили: 74 раз.
Victor__v писал(а):
Total Vacuum писал(а):
Ну да, там 3 подзадачи:
- инвертировать строку;
- инвертировать слова, не меняя порядок слов;
- поменять порядок слов;


Последняя подзадача сделана квадратно-гнездовым способом, т. к. не учитывает пробельные символы. Заморачиваться для примера лень


Такое решение представлено на rosettacode

Код:
: not-empty?  dup 0 > ;
: (reverse)  parse-name not-empty? IF recurse THEN type space ;
: reverse  (reverse) cr ;

reverse ---------- Ice and Fire ------------
reverse
reverse fire, in end will world the say Some
reverse ice. in say Some
reverse desire of tasted I've what From
reverse fire. favor who those with hold I
reverse
reverse ... elided paragraph last ...
reverse
reverse Frost Robert -----------------------


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 23:14 
Не в сети
Аватара пользователя

Зарегистрирован: Ср июл 03, 2019 11:10
Сообщения: 463
Откуда: Москва
Благодарил (а): 57 раз.
Поблагодарили: 22 раз.
Симпатичное решение, но можно и проще:
Код:
: (reverse) parse-name dup IF recurse THEN type space ;
: reverse (reverse) cr ;
reverse ---------- Ice and Fire ------------
reverse
reverse fire, in end will world the say Some
reverse ice. in say Some
reverse desire of tasted I've what From
reverse fire. favor who those with hold I
reverse
reverse ... elided paragraph last ...
reverse
reverse Frost Robert -----------------------
Возможно, у автора решения какая-то диковинная версия parse-name... :)


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср сен 15, 2021 23:48 
Не в сети

Зарегистрирован: Пн янв 07, 2013 22:40
Сообщения: 2141
Благодарил (а): 8 раз.
Поблагодарили: 74 раз.
Total Vacuum писал(а):
Возможно, у автора решения какая-то диковинная версия parse-name... :)

:)
Решение 2-й подзадачи
Код:
: reverse { addr len } addr len bounds  do  I c@ loop
                       addr len bounds  do  I c! loop ;
: (reverse)  parse-name dup IF 2dup reverse type space recurse THEN  ;
: reverse  (reverse) cr ;

reverse rosetta code phrase reversal
s" reverse rosetta code phrase reversal" evaluate

Output:
Цитата:
attesor edoc esarhp lasrever
attesor edoc esarhp lasrever


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср июл 12, 2023 10:08 
Не в сети

Зарегистрирован: Пн янв 07, 2013 22:40
Сообщения: 2141
Благодарил (а): 8 раз.
Поблагодарили: 74 раз.
Задача разделения строк(и) текста на токены по разделителю "," (запятая)
Вход: ( addr len ) \ s" Hello,How,Are,You,Today"
Вывод тестовой печати: Hello.How.Are.You.Today
Решение: https://rosettacode.org/wiki/Tokenize_a_string#Forth

Код:
: split ( str len separator len -- tokens count )
  here >r 2swap
  begin
    2dup 2,             \ save this token ( addr len )
    2over search        \ find next separator
  while
    dup negate  here 2 cells -  +!  \ adjust last token length
    2over nip /string               \ start next search past separator
  repeat
  2drop 2drop
  r>  here over -   ( tokens length )
  dup negate allot           \ reclaim dictionary
  2 cells / ;                \ turn byte length into token count

: .tokens ( tokens count -- )
  1 ?do dup 2@ type ." ." cell+ cell+ loop 2@ type ;

s" Hello,How,Are,You,Today" s" ," split .tokens  \ Hello.How.Are.You.Today


В строке словом Search находятся токены по разделителю и адрес и длина найденных токенов в реализации слова split записывается по адресу Here (для временного сохранения в области памяти), а по завершению
сканирования строки слово Split оставляет после себя адрес Here и количество найденных токенов.
(токен представлен 2-я числами - addr len) а сам адрес Here востанавливается на момент вызова слова Split.

P.S. В gForth Online код выполняется.

Если просто вывести строку с заменой символа "," на "." без деления на токены при этом
то решение может быть таким.
Код:
: split> ( addr len -- )
  here >r  dup c, here swap cmove>
  r@ dup c@ 1+  bounds do
    i c@ dup [char] , = if drop
      [char] . emit
    else
      emit
    then
  loop 
   here r> -   
   negate allot
  ;
 
s" Hello,How,Are,You,Today" split>

Исходная строка, при этом сохранена по Here адресу до момента изменения этой области памяти.
Код:
here dup c@ type


Вернуться к началу
 Профиль Отправить личное сообщение  
Ответить с цитатой  
 Заголовок сообщения: Re: Список актуальных задач из Rosetta code
СообщениеДобавлено: Ср июл 12, 2023 16:07 
Не в сети
Administrator
Administrator
Аватара пользователя

Зарегистрирован: Вт май 02, 2006 22:48
Сообщения: 7960
Благодарил (а): 25 раз.
Поблагодарили: 144 раз.
Такую операцию можно вставить и в словарь.


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

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


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

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


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

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