nedoPC.org

Community of electronics hobbyists established in 2002

...
Atom Feed | View unanswered posts | View active topics It is currently 19 Aug 2017 20:02



Reply to topic  [ 57 posts ]  Go to page Previous  1, 2, 3, 4
Hopeless - функциональное программирование на языке HOPE 
Author Message
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Немного попробовал поработать с локальным подобием базы данных в Hope:
Code:
#!/usr/local/bin/hopeless -f
uses string,lines,list;

dec base : string #  num -> string;

--- base(_,_) <= nil;

--- base("0",1) <= "500-igr.jpg";

--- base("a",1) <= "adaptatsia-programm-na-disk-v-sisteme-tr-dos.jpg";
--- base("a",2) <= "arhitektura-vichislitelnih-sistem.jpg";

--- base("b",1) <= "beta-disk-interface.jpg";

...........

--- base("ya",1) <= "ya-strou-kv-radiostantsiu.jpg";
--- base("ya",2) <= "yazik-assemblera-dla-ibm-pc.jpg";
--- base("ya",3) <= "yazik-programmirovania-el-76.jpg";
--- base("ya",4) <= "yazik-radioshem.jpg";

dec printone : string -> string;
--- printone(s) <= "<a href=\"../books/"<>s<>"\"><img border=0 width=200 src=\"../books/"<>s<>"\"></a>\n";

dec printall : string # num -> string;
--- printall(l,n) <= let s==base(l,n) in
               if s=nil then ""
                   else printone(s)<>printall(l,n+1);
            
write "Content-type: text/html\n\n";
write lines(printall(argv@0,1));


передаём в качестве аргумента букву (0,a,b,v,....,ya) и оно печатает весь список линков для этой буквы, например:

Code:
./books.hop ya
Content-type: text/html

<a href="../books/ya-strou-kv-radiostantsiu.jpg"><img border=0 width=200 src="../books/ya-strou-kv-radiostantsiu.jpg"></a>
<a href="../books/yazik-assemblera-dla-ibm-pc.jpg"><img border=0 width=200 src="../books/yazik-assemblera-dla-ibm-pc.jpg"></a>
<a href="../books/yazik-programmirovania-el-76.jpg"><img border=0 width=200 src="../books/yazik-programmirovania-el-76.jpg"></a>
<a href="../books/yazik-radioshem.jpg"><img border=0 width=200 src="../books/yazik-radioshem.jpg"></a>


как видно перебор номерв для буквы заканчивается на base(_,_) <= nil - это особенность языка Hope - он не учитывает порядок расположения вариантов - всегда подбирается самый подходящий - т.е. когда заканчиваются записи с известными аргументами - берётся запись с неизвестными, где бы она не стояла

_________________
:eugeek: https://twitter.com/Shaos1973


24 Apr 2010 23:08
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Вчера выложил сборку под MacOS X 10.4 PPC - см. www.hopelog.com

_________________
:eugeek: https://twitter.com/Shaos1973


06 Nov 2010 07:04
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Shaos wrote:
http://www.hopelog.com

04-Apr-2010 hopeless-v0.5.tar.bz2 (100K)

* added '\r' to function "isspace" in ctype.hop
* fixed function "dir" in system_win.hop
* path to libraries changed to /usr/local/share/hopeless
* created man file hopeless.1 (modified hope.1)
* fixed "make install" for Hopeless
* new library lib/db_sqlite.hop (database support with sqlite3)
* added functions "del" and "write_to" to lib/system.hop
* check for '\n' and '\r' before run commands ("!...")
* defined constant "stdin" instead of functions "getc" and "gets" (lib/system.hop)
* modified test _input.hop


Планирую вернуть обратно gets, но не как системную функцию, а как универсальную в составе модуля string.hop. Кроме того планирую вытащить функцию pipes из db_sqlite.hop в тот же string.hop (может быть даже сделав её более общей - с возможностью указывания символа по которому будем резать строки - типа split).
P.S. Не пора ли выделять отдельный форум по Hopeless для обсуждения функций, библиотек и т.д.?

_________________
:eugeek: https://twitter.com/Shaos1973


20 Nov 2010 15:39
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Написал несколько функций для работы с парами ключ=значение (например такие хранятся в списке env (переменные окружения) или приходят от веб-браузера из HTML-форм, правда в этом случае их ещё надо разбить по парам):

Code:
dec pairs1 : string # list(string) -> list(string);
--- pairs1(nil,l) <= reverse(l);
--- pairs1('&'::y,l) <= pairs1(y,nil::l);
--- pairs1(x::y,nil) <= pairs1(y,(x::nil)::nil);
--- pairs1(x::y,h::l) <= pairs1(y,(h<>(x::nil))::l);

dec pairs : string -> list(string);
--- pairs(x) <= pairs1(x,nil);

dec value_check : list(char) # list(char) -> truval;
--- value_check(nil,l) <= false;
--- value_check(x::y,nil) <= false;
--- value_check('='::y,nil) <= true;
--- value_check(x::y,z::l) <= if x=z
                              then value_check(y,l)
                              else false;

dec value_skip : list(char) -> list(char);
--- value_skip(nil) <= nil;
--- value_skip(x::y) <= value_skip(y);
--- value_skip('='::y) <= y;

dec value : list(string) # string -> string;
--- value(nil,l) <= nil;
--- value(x::y,l) <= if value_check(x,l)
                     then value_skip(x)
                     else value(y,l);


Функция pairs разбивает последовательность вида "key1=value1&key2=value2" на части и выдаёт список строк, состоящий из разделённых пар: ["key1=value1","key2=value2"].

Функция value выдаёт значение ключа по имени (в первом аргументе даётся список пар ключ=значение, а во втором - имя искомого ключа). Вспомогательные функции: value_check проверяет что имя ключа в паре (первый аргумент) совпадает со вторым аргументом и value_skip выдаёт значение после символа равенства.

_________________
:eugeek: https://twitter.com/Shaos1973


20 Mar 2012 22:36
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Несколько причесал и расширил, добавив всё это в string.hop:
Code:
!! Library string.hop for Hopeless v0.6
!! Alexander A. Shabarshin <ashabarshin@gmail.com>

type string == list char;

type strings == list string;

dec explode : string # char -> strings;
--- explode([],c) <= [[]];
--- explode(h::t,c) <= if h=c then []::explode(t,c) else let x::y==explode(t,c) in (h::x)::y;

dec quote_end : string -> string;
--- quote_end(nil) <= '"'::nil;
--- quote_end(x::y) <= x::quote_end(y);

dec quote : string -> string;
--- quote(nil) <= nil;
--- quote(s) <= quote_end('"'::s);

dec equal : string # string -> truval;
--- equal(nil,nil) <= true;
--- equal(nil,l) <= false;
--- equal(l,nil) <= false;
--- equal(x::y,z::l) <= if x=z then equal(y,l) else false;

dec equal_until : string # string # char -> truval;
--- equal_until(nil,l,c) <= false;
--- equal_until(x::y,nil,c) <= if x=c then true else false;
--- equal_until(x::y,z::l,c) <= if x=z then equal_until(y,l,c) else false;

dec skip_until : string # char -> string;
--- skip_until(nil,c) <= nil;
--- skip_until(x::y,c) <= if x=c then y else skip_until(y,c);

dec ltrim : string -> string;
--- ltrim(l) <= l;
--- ltrim(' '::l) <= ltrim(l);
--- ltrim('\t'::l) <= ltrim(l);

dec strmap : strings # (string -> string) -> strings;
--- strmap(nil,f) <= nil;
--- strmap(h::l,f) <= f(h)::strmap(l,f);

dec strmap2 : strings # (string # alpha -> string) # alpha -> strings;
--- strmap2(nil,f,a) <= nil;
--- strmap2(h::l,f,a) <= f(h,a)::strmap2(l,f,a);

dec strmap3 : strings # (string # alpha # beta -> string) # alpha # beta -> strings;
--- strmap3(nil,f,a,b) <= nil;
--- strmap3(h::l,f,a,b) <= f(h,a,b)::strmap3(l,f,a,b);

dec envdel : strings # string -> strings;
--- envdel(nil,k) <= nil;
--- envdel(x::l,k) <= if equal_until(x,k,'=') then r else x::r where r==envdel(l,k);

dec envset : strings # string # string -> strings;
--- envset(l,k,v) <= (k<>"="<>v)::envdel(l,k);

dec envget : strings # string -> string;
--- envget(nil,l) <= nil;
--- envget(x::y,l) <= if equal_until(x,l,'=') then skip_until(x,'=') else envget(y,l);


Также вернул функции getc и gets в system.hop

_________________
:eugeek: https://twitter.com/Shaos1973


21 Mar 2012 23:04
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Shaos wrote:
Также вернул функции getc и gets в system.hop


Обновлённый вариант system.hop для Linux:
Code:
!! Library system_nix.hop (system.hop for Linux) for Hopeless v0.6
!! Alexander A. Shabarshin <ashabarshin@gmail.com>

uses lines,string;

dec stdin : string;
--- stdin <= "/dev/stdin";

dec getc : list char;
--- getc <= read(stdin);

dec gets : list string;
--- gets <= lines(getc);

dec dir : string -> strings;
--- dir(s) <= lines(read("!ls " <> s));

dec del : string -> string;
--- del(s) <= read("!rm -f " <> s);

dec write_to : string # string -> string;
--- write_to(s,f) <= read("!echo " <> s <> " | tee -a " <> f);

А вот модифицированный вариант db_sqlite.hop
Code:
!! Library db_sqlite.hop (interface to sqlite3 databases) for Hopeless v0.6
!! Alexander A. Shabarshin <ashabarshin@gmail.com>

uses string,lines,list;

dec pipes : strings -> list strings;
--- pipes(nil) <= nil;
--- pipes(x::y) <= explode(x,'|')::pipes(y);

dec sql : string # string -> list strings;
--- sql(file,statement) <=
    pipes(lines(read("!sqlite3 -noheader -list "<>file<>" '"<>statement<>"'")));

В будущем сделаю встроенную поддержку SQLite3 (при этом даже можно будет организовать ленивую выдачу таблицы), а пока так - через вызов внешнего бинарника с передачей параметров через командную строку. Из неудобств - команды типа UPDATE или DELETE в данном варианте интерфейса не выдают ничего (точнее выдают nil - пустой список) - надо подумать как исправить. Возможно когда сделаю встроенный вариант, такие команды будут возвращать число, обозначающее кол-во задетых записей, типа [["1"]] (в двойных квадратных скобках, т.к. list(list(string))).

P.S. Вот CGI-программка на Hopeless, принимающая POST посылку (приходит через стандартный ввод stdin) с последовательностью ключей user=name&pass=password и если юзер не найден пишущей "unknown", если найден, но пароль не верен, пишущей "no", и если юзер и пароль найдены в БД, пишущей "yes" и далее e-mail юзера из БД:
Code:
#!/usr/local/bin/hopeless -f
uses db_sqlite,system,lists;

dec login : strings -> string # string;
--- login(l) <= (envget(l,"user"),envget(l,"pass"));

dec check : strings -> string;
--- check(l) <= let (u,p)==login(l)
                in let res==sql("/sqlite3/webit1.db","select usr_pass,usr_email from wt_users where usr_name="<>quote(u))
                   in if res=nil
                      then "unknown"
                      else if equal(p,head(head(res)))
                           then "yes "<>head(res)@1
                           else "no";

write "Content-type: text/html\n\n";
write "<html><head><title>Hopeless Server</title></head>\n";
write "<body>\n";
write check(explode(getc,'&'));
write "</body></html>\n";

_________________
:eugeek: https://twitter.com/Shaos1973


23 Mar 2012 10:07
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Выложил всё на GitHub:

https://github.com/shaos/hopeless

Там вся история изменений начиная с оригинальной версии (я модифицировал код с 2007 года, однако git-репозиторий создал только в 2010 - путём последовательного коммита оригинальной версии, затем v0.1, затем v0.2, затем v0.3, затем v0.4, затем v0.5 - чтобы было видно всю историю)

P.S. Я должен был выложить созданный git-репозиторий на github.com ещё два года назад (4 апреля 2010) - тогда же когда и создал аккаунт там и поимел локальный git, однако что-то застопорилось - появились другие дела и т.д.

_________________
:eugeek: https://twitter.com/Shaos1973


24 Mar 2012 03:11
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Переименовал envdel, envset и envget в pairs_del, pairs_set и pairs_get соответственно - понятнее будет:
Code:
dec pairs_del : strings # string -> strings;
--- pairs_del(nil,k) <= nil;
--- pairs_del(x::l,k) <= if equal_until(x,k,'=') then r else x::r where r==pairs_del(l,k);

dec pairs_set : strings # string # string -> strings;
--- pairs_set(l,k,v) <= (k<>"="<>v)::pairs_del(l,k);

dec pairs_get : strings # string -> string;
--- pairs_get(nil,l) <= nil;
--- pairs_get(x::y,l) <= if equal_until(x,l,'=') then skip_until(x,'=') else pairs_get(y,l);


Наверное пришла пора релизить Hopeless v0.6

_________________
:eugeek: https://twitter.com/Shaos1973


30 Nov 2012 20:23
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
Что-то мне стали писать письма с вопросами про Hope и благодарностями - точно пора релизить v0.6 :)

P.S. Вот появилась Windows версия, основанная на моей - http://hopelang.blogspot.com правда кроме блога у этого автора больше ничего в интернете не осталось - вот архивная версия его мёртвой странички https://web.archive.org/web/20130801064 ... ine.co.uk/ с которой кстати чего-то можно скачать...

P.P.S. Сайт оригинального автора помер и теперь доступен только из архивов:
https://web.archive.org/web/20051216124 ... ross/Hope/

_________________
:eugeek: https://twitter.com/Shaos1973


28 Nov 2014 15:01
Profile WWW
Banned
User avatar

Joined: 04 Jan 2013 13:09
Posts: 398
Location: 95.24.178.158
Reply with quote
Post 
Shaos wrote:
Что-то мне стали писать письма с вопросами про Hope и благодарностями - точно пора релизить v0.6 :)

Это из серии "к вам неожиданно нагрянули гости, пора и холодильник наполнять"? :)


29 Nov 2014 10:46
Profile
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
типа того :roll:

_________________
:eugeek: https://twitter.com/Shaos1973


29 Nov 2014 20:10
Profile WWW
Admin
User avatar

Joined: 09 Jan 2003 02:22
Posts: 15434
Location: New York
Reply with quote
Post 
вот так мне предложили добавить унарный минус:
Code:
! unary - using ~
dec ~ : num -> num;
--- ~ n <= 0 - n;

_________________
:eugeek: https://twitter.com/Shaos1973


08 Feb 2015 19:55
Profile WWW
Display posts from previous:  Sort by  
Reply to topic   [ 57 posts ]  Go to page Previous  1, 2, 3, 4

Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot post attachments in this forum

Search for:
Jump to:  
cron
Powered by phpBB® Forum Software © phpBB Group
Designed by ST Software.