nedoPC.org

Electronics hobbyists community established in 2002
Atom Feed | View unanswered posts | View active topics It is currently 28 Mar 2024 02:40



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

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
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 - он не учитывает порядок расположения вариантов - всегда подбирается самый подходящий - т.е. когда заканчиваются записи с известными аргументами - берётся запись с неизвестными, где бы она не стояла

_________________
:dj: https://mastodon.social/@Shaos


24 Apr 2010 20:08
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
Reply with quote
Post 
Shaos wrote:
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 для обсуждения функций, библиотек и т.д.?

_________________
:dj: https://mastodon.social/@Shaos


20 Nov 2010 12:39
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
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 выдаёт значение после символа равенства.

_________________
:dj: https://mastodon.social/@Shaos


20 Mar 2012 19:36
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
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

_________________
:dj: https://mastodon.social/@Shaos


21 Mar 2012 20:04
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
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";

_________________
:dj: https://mastodon.social/@Shaos


23 Mar 2012 07:07
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
Reply with quote
Post 
Выложил всё на GitHub:

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, однако что-то застопорилось - появились другие дела и т.д.

_________________
:dj: https://mastodon.social/@Shaos


24 Mar 2012 00:11
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
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

_________________
:dj: https://mastodon.social/@Shaos


30 Nov 2012 17:23
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
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/

_________________
:dj: https://mastodon.social/@Shaos


28 Nov 2014 12:01
Profile WWW
Banned
User avatar

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

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


29 Nov 2014 07:46
Profile
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
Reply with quote
Post 
типа того :roll:

_________________
:dj: https://mastodon.social/@Shaos


29 Nov 2014 17:10
Profile WWW
Admin
User avatar

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

_________________
:dj: https://mastodon.social/@Shaos


08 Feb 2015 16:55
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
Reply with quote
Исходники переехали на GitLab:

https://gitlab.com/shaos/hopeless

_________________
:dj: https://mastodon.social/@Shaos


06 Jun 2018 19:36
Profile WWW
Admin
User avatar

Joined: 08 Jan 2003 23:22
Posts: 22409
Location: Silicon Valley
Reply with quote
Shaos wrote:
Исходники переехали на GitLab:

https://gitlab.com/shaos/hopeless

и их там уже даже успели форкнуть :)
https://gitlab.com/dougcurrie/hopeless
человек подпилил их под совеременную макос:
https://gitlab.com/dougcurrie/hopeless/commit/f4b94971805983c6cd32bed9de2ed4a90f04e929

_________________
:dj: https://mastodon.social/@Shaos


16 Feb 2019 17:47
Profile WWW
Display posts from previous:  Sort by  
Reply to topic   [ 58 posts ]  Go to page Previous  1, 2, 3, 4

Who is online

Users browsing this forum: No registered users and 25 guests


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:  
Powered by phpBB® Forum Software © phpBB Group
Designed by ST Software.