Re: Subscribe
Hi Alex, I just discovered picolisp and must say how impressed and excited I am about it;-) What is the recommended way of deploying picolisp web apps? I was thinking having it behind nginx but I see that there are some utilities in picolisp dealing with deployment and ssl, e.g. httpGate, replica, watchdog... Is there any description on how to use these utilities? What are the rules/heuristics for splitting entities and relations into database files? Thank you, Tomas Alexander Burger [EMAIL PROTECTED] writes: Hi Tomas, can I subscribe to the picolisp mailing list? Sure. It already happened (automatically). Welcome! Cheers, Alex -- Software Lab. Alexander Burger Bahnhofstr. 24a, D-86462 Langweid [EMAIL PROTECTED], www.software-lab.de, +49 8230 5060
Re: problem reading XML
Hi Alex, (in file (pipe (while (and (echo !--) (from --))) (xml) ) ) I fact, I would like to remove that half-hearted comment feature from lib/xml.l. Does anybody have objections? since the XML declaration is optional, I would need to write: (or (in F (pipe (while (and (echo !--) (from --))) (and (xml?) (xml (in F (pipe (while (and (echo !--) (from --))) (xml to load xml data. Would not it be better if the xml function simply handled it all, the xml declaration, comments and xml elements? It looks like the current code is not far from it. The following code handles optional declarations and comments (both inside and outside the root element): (de xml2 (Lst N) (if Lst (let Tag (pop 'Lst) (space (default N 0)) (prin Tag) (for X (pop 'Lst) (prin (car X) =\) (escXml (cdr X)) (prin \) ) (nond (Lst (prinl /)) ((or (cdr Lst) (pair (car Lst))) (prin ) (escXml (car Lst)) (prinl / Tag ) ) (NIL (prinl ) (for X Lst (if (pair X) (xml X (+ 3 N)) (space (+ 3 N)) (escXml X) (prinl) ) ) (space N) (prinl / Tag ) ) ) ) (_xml2) ) ) (de _xml2 (Tok Decl In) #(println Tok) (cond ((not Tok) (skip) (unless (= (char)) (quit Bad XML start) ) (_xml2 (till /))) ((head '(? x m l) Tok) (if Decl (quit XML declaration too late) # TODO check decl validity (from ?) (skip) (unless (= (char)) (quit Bad XML element start) ) (_xml2 (till /) T))) ((head '(! - -) Tok) (from --) (unless In (skip) (unless (= (char)) (quit Bad XML element start) ) (_xml2 (till /) T))) (T (use X (make (link (intern (pack Tok))) (let L (make (loop (NIL (skip) (quit XML parse error 1)) (T (member @ '(/ ))) (NIL (setq X (intern (till = T (char) (unless (= \ (char)) (quit XML parse error 2 X) ) (link (cons X (pack (xmlEsc (till \) (char) ) ) (if (= / (char)) (prog (char) (and L (link L))) (link L) (loop (NIL (skip) (quit XML parse error 3 (pack Tok))) (T (and (= (setq X (char))) (= / (peek))) (char) (unless (= Tok (till /)) (quit Unbalanced XML (pack Tok) )) (char) ) (if (= X) (and (_xml2 (till /) T T) (link @)) (link (pack (xmlEsc (trim (cons X (till ^J))) It can parse the following file: ?xml version=1.0?!--*- xml -*-- !-- comment 1 -- hi !-- another comment -- bye123/bye /hi !-- comment 2 -- !-- last comment -- Is this mailing list the right place to decide such changes? How does current decision making work? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
pipes redirection
Hi Alex, is it possible in picolisp to create pipes from external programs, e.g. like in bash? I.e. create a pipe, write to it on one end and read from it on the other end? E.g. `base64 | wc -l`? Also, is it possible in the following code to suppress the two prompts Encryption key: Again: shown by bcrypt? Maybe read the two lines in or redirect bcrypt stdout to /dev/null? : (de bcrypt (Data Salt) (default Salt (fmt64 (in '/dev/random (rd 42 # 56*3/4=42 (unless (= 8 (length (pipe (prin Salt) (line T))) 56) (quit Length of Salt must be from 8 to 56 Salt)) (let (F (pipe (call 'mktemp) (line T)) G (pack F .bfe)) (out F (print Data)) (out (list 'bcrypt F) (prinl Salt) (prinl Salt)) (prog1 (cons Salt (pipe (call 'base64 '-w 0 G) (line T))) (call 'rm '-f G - bcrypt : (bcrypt hello) Encryption key: Again: - (e07OZN8X;IWgm8bXjNgKrWG9Ib4c11hqEcRhol8DNHd1Mru2VqfhNRS . VAE/tAC/bQUOifdyG6SPS89pgd8ceWsaUHPDvCFKXSyHs358BUMR32qkfQEtwB/AIWEU9tTIXsW6+sC+VxbAg5b6x/HhRP8ie04H) : Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: problem reading XML
Hi Alex, So please take your time, and send it to me when ready. here is the XML parser: # expects well formed XML # encoding by picolisp (utf8 only, no utf16 etc.) # trim whitespace except in cdata # ignore ? !-- !DOCTYPE # non-builtin entities as normal text: ent; = ent (de _xml (In Char) (unless Char (skip) (unless (= (char)) (quit Bad XML) ) ) (case (peek) (? (from ?) (unless In (_xml2 In))) (! (char) (case (peek) (- (ifn (= '`(chop --) (list (char) (char))) (quit XML comment expected) (from --) (unless In (_xml2 In (D (ifn (= '`(chop DOCTYPE) (list (char) (char) (char) (char) (char) (char) (char))) (quit XML DOCTYPE expected) (when (= [ (from [ )) (use X (loop (T (= ] (setq X (from ] \ ' !-- (case X (\ (from \)) (' (from ')) (!-- (from --) (from )) (unless In (_xml2 In ([ (ifn (= '`(chop [CDATA[) (list (char) (char) (char) (char) (char) (char) (char))) (quit XML CDATA expected) (prog1 # ??? echo to string? (pipe (echo ]]) (till NIL T)) (from ]] (T (quit Unhandled XML tag (T (let Tok (till ^I^M^J/ T) (use X (make (link (intern (pack Tok))) (let L (make (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (member @ '(/ ))) (NIL (setq X (intern (pack (trim (till =)) (char) (skip) (let C (char) (unless (member C '(\ ')) (quit XML attribute quote expected X) ) (link (cons X (pack (xmlEsc (till C)) (char) ) ) (if (= / (char)) (prog (char) (and L (link L))) (link L) (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (and (= (setq X (char))) (= / (peek))) (char) (unless (= Tok (till ^I^M^J/ T)) (quit Unbalanced XML Tok) ) (skip) (char) ) (if (= X) (when (_xml2 T ) (link @)) (link (pack (xmlEsc (trim (cons X (till ^M^J _xml should be called from xml function as (_xml), like the previous _xml2 code. I found a few XML files where the above code fails but this is due to: 1) utf-8 byte order mark is not understood. The UTF-8 representation of the BOM is the byte sequence EF BB BF. I am not sure how others handle this but it should not be part of the parser probably. 2) some unusual utf-8 characters. Not sure why I get these failures. However, this is quite minor problem and might be a bug in picolisp utf-8 fandling code? Example file: : 3c64 6f63 3ef0 9080 80f4 8fbf bd3c 2f64 doc/d 0010: 6f63 3e oc Any ideas? Also, I think that a better way of checking whether a file is an XML file is: (de xml! (F) (call sh -c (pack xmlstarlet val -w -q F 1/dev/null 2/dev/null))) or something like that, using a specialized validation program. Another check might be encoding check like: (in (list enca -L none F) (not (from UCS-2 Unrecognized non-text))) I hope people will find this useful. Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: problem reading XML
Hi Alex, 1. There was a slight error (still '_xml2' instead of '_xml') Oops, sorry about that. 2. I replaced occurrences like (ifn (= '`(chop DOCTYPE) (list (char) (char) (char) (char) (char) (char) (char))) with (if (find '((C) ( C (char))) '`(chop DOCTYPE)) to avoid the excessive 'list'ing. That's what I was looking for:-) 3. The case ??? echo to string? is a bit cumbersome. There is in fact no proper equivalent of the 'echo' functionality in e.g. 'from'. Using 'pipe' is quite elegant and short, but I'm hesitating to use it is such a context. (pipe (echo ]]) (till NIL T)) My proposal would be (pack (head -3 (make (until (= '`(chop ]]) (tail 3 (made))) (link (char)) ) ) ) ) This avoids the overhead of 'pipe', but is longer. Is this OK? Yes, better solution without pipe. I think we don't we need prog1 and (from ]]) in that case. It'll take me a while to understand it though;-) BTW, why is the (from ]]) ) ) ) in the following line needed? (from ]]) in the original code (prog1 # ??? echo to string? (pipe (echo ]]) (till NIL T)) (from ]])) was necessary in the parent process because (echo ]]) in the child process did not seem to affect stdin of the parent process and all those characters had to be read again in the parent process. I am not sure why it works this way. : 3c64 6f63 3ef0 9080 80f4 8fbf bd3c 2f64 doc/d 0010: 6f63 3e oc The first character after the '' starts with F0, which is not a legal UTF-8 sequence. UTF-8 has the following structure (doc/utf8): .. 007F 0xxx 0080 .. 07FF 110x 10xx 0800 .. 1110 10xx 10xx The pattern is this not possible for any (not just the first) UTF-8 character. Thanks for explanation, I'll ignore the invalid test cases then. Sorry, I did not send you this, but (de xml (Lst N) (if Lst (let Tag (pop 'Lst) (space (default N 0)) (prin Tag) (for X (pop 'Lst) (prin (car X) =\) (escXml (cdr X)) (prin \) ) (nond (Lst (prinl /)) ((or (cdr Lst) (pair (car Lst))) (prin ) (escXml (car Lst)) (prinl / Tag ) ) (NIL (prinl ) (for X Lst (if (pair X) (xml X (+ 3 N)) (space (+ 3 N)) (escXml X) (prinl) ) ) (space N) (prinl / Tag ) ) ) ) (_xml (till / T)) ) ) should be just (de xml (Lst N) (if Lst (let Tag (pop 'Lst) (space (default N 0)) (prin Tag) (for X (pop 'Lst) (prin (car X) =\) (escXml (cdr X)) (prin \) ) (nond (Lst (prinl /)) ((or (cdr Lst) (pair (car Lst))) (prin ) (escXml (car Lst)) (prinl / Tag ) ) (NIL (prinl ) (for X Lst (if (pair X) (xml X (+ 3 N)) (space (+ 3 N)) (escXml X) (prinl) ) ) (space N) (prinl / Tag ) ) ) ) (_xml ) ) ) I'll run test your changed code and let you know. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Evolving db schema?
Hi Alex, Yes. In lib/too.l there is a function 'rebuild'. It takes a list of objects and a relation specification. thank you for the examples. The function 'dbgc' does this (also in lib/too.l). Also, thanks for the back.l file! I have one more question: I started with one db file and now thinking about spliting it into more files. How can I move some objects/relations to another db file? Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Evolving db schema?
Hi Alex, - This should of course have been (rel nr (+Key +Number)) - Somewhere here should be a line (load lib/too.l) I also had to (allow '*PW) ;-) Thanks for help, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Getl and maps behavior?
Hi Henrik, convert all Ts to true, and NILs to false in the JSON string. With the NILs we run into a problem, because a property value of NIL means that this property does not exist. So it can never be extracted from the object itself. maybe the js - picolisp mapping false - NIL is not the right thing to do here? There are things like undefined, null, (empty string), NaN (maybe too?) or false you could represent as NIL but then you lose information during conversion and cannot rebuild the js data back again exactly. To solve the problem with the NILs, you'll have to keep a separate record of possible properties (as is done, for example, in the '+Entity' objects). Or, you could create your own unique NIL which would be treated by picolisp as any other non-NIL value and interpret it yourself during picolisp - javascript conversion as false, for example. : (setq MyNIL (new)) (setq Tst (new)) (put Tst 'a hello) (put Tst 'b T) (put Tst 'c MyNIL) # swap false, null, undefined or even NIL for MyNIL (getl Tst) (mapcar '((X) (or (pair X) (cons T X))) (getl Tst) ) (prog (prin [) (for (I . X) (mapcar '((X) (or (pair X) (cons T X))) (getl Tst) ) (when ( 1 I) (prin , )) (prin (cdr X) : ) (cond ((== (car X) MyNIL) (prin false)) ((== (car X) T) (prin true)) (T (print (car X) (prin ])) - $519715527 : - $519715537 : - hello : - T : - $519715527 : - (($519715527 . c) b (hello . a)) : - (($519715527 . c) (T . b) (hello . a)) : [c: false, b: true, a: hello]- ] This is oversimplified version as there are lots of special cases in javascript to handle, e.g. you have to double-quote keys if they are negative numbers if I remember well: [-1: negative numbers as strings in key] Alex, why does getl return a list of (property-value . property-name) and not a list of (property-name . property-value)? Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Getl and maps behavior?
Hi Alex, Having list cells behave like variables (by referring to their CAR parts) is a very useful feature. Not only for properties, but also for other list structures. : (setq L (1 2 3 4 5 6 7 8 9)) - (1 2 3 4 5 6 7 8 9) : (nth L 6) - (6 7 8 9) : (inc (nth L 6) 100) - 106 : (set (nth L 9) 777) - 777 : L - (1 2 3 4 5 106 7 8 777) ohh, I see now! Thanks for your patience:-) # convert xml list (as returned by xml function) to xml symbol ... # convert xml symbol to xml list (as consumed by xml function) ... As I said, this might give surprising results if you by chance encounter symbols used somewhere else in the system. Try (getl 'select)! If I try to convert 'select to XML, I get an error: (setq X2 (new)) (put X2 'select 'select) (xwrite X2) ?xml version=1.0 encoding=utf-8? !? (getl S) (((@Obj . @X) . @Lst) (@ unify (- @X)) (@P box (cdr (- @Lst))) (@C box (let L (car (- @Lst)) (setq L (or (mapcan select L) (select (car L) T))) (cons NIL L L))) (_gen @Obj) (_sel)) -- Symbol expected ? which is completely fine because it is not a valid input for sym2xml. It is a bit like feeding the 'xml' function with invalid XML, just get an error. Well, I do not know how to convert (((@Obj . @X) . @Lst) (@ unify (- @X)) (@P box (cdr (- @Lst))) (@C box (let L (car (- @Lst)) (setq L (or (mapcan select L) (select (car L) T))) (cons NIL L L))) (_gen @Obj) (_sel)) to XML so an error seems quite reasonable. However, if I feed it with the example Henrik provided: (class +Product +Entity) (rel name (+Need +String)) (rel id (+Need +Number)) (rel descr (+String)) (setq Product (new '(+Product) 'name PC 'id 123)) (setq X (new)) (put X 'product Product) (xwrite X) I get an XML: ?xml version=1.0 encoding=utf-8? product namePC/name id123/id /product I think that Henrik is basically aiming for similar thing, except his output format is not XML but JSON. It always returns the _whole_ property list, and this may contain other irrelevant data (as, for example, also Pilog stores rules in symbol properties, and the debug environment file names and line numbers). I think that storing these irrelevant data (or rather specific purpose data) is the good thing about representing XML using symbols. I can easily add more helper properties to a symbol during a computation. It might be more efficient working with lists, but maybe not so convenient. This would need an example though which I currently don't have:-( Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: FFI and miniPicolisp
Hi Simon, (cfun RNG* new_RNG (ulong seed)) (cfun double RNG_next_double (RNG* self)) {cfun_new_RNG, epi:w_RNG}, {cfun_RNG_next_double, epi:G_next_double}, Everything links fine, but are these functions automatically exposed? Are there any tips so I can do things like (setq r (epi:new_RNG 1)) the functions should be exposed, if you try (setq r (epi:w_RNG 1)), because that's how you specified the name transformation with the module function. The second arg to module says how the C function names are turned into picolisp function names. By default, they stay the same. In your case '((X) (pack epi: (cddr (chop X chops off the first two characters and prepends epi:. If you want to keep the name as is and prepend epi: only, try: (module 'epi '((X) (pack epi: X))) That should do the trick;-) Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
chart row reordering?
Hi Alex, app/ord.l:24-52 there is chart which allows to chage the order of the rows. Could you please explain how this works? The app/er.l contains something like: (class +Ord +Entity) (rel nr (+Need +Key +Number)) (rel pos (+List +Joint) ord (+Pos)) (class +Pos +Entity) (rel ord (+Dep +Joint) (art) pos (+Ord)) What does +Dep and (art) mean and how does it work? The only thing I found is a +Dep prefix class controlling dependencies between other relations in tut.html. For example, I have: (class +Cat +Entity) (rel nr (+Need +Key +Number)) (rel nm (+Ref +String)) (rel it (+List +Joint) cat (+It)) (class +It +Entity) (rel nr (+Need +Key +Number)) (rel nm (+Sn +Idx +String)) (rel cat (+List +Joint) it (+Cat)) (gui '(+E/R +Chart) '(it : home obj) 3 '((This) (list NIL This NIL)) cadr) (table NIL NIL '((btn) NIL (btn)) (do 6 (row NIL (gui 1 '(+ChoButton) '(choIt (field 1))) (gui 2 '(+Obj +TextField) '(nm +It) 40) (gui 3 '(+DelRowButton (row NIL NIL (scroll 6))) I would like to be able to reorder items +It in a category +Cat. What else do I need to do except adding (gui 4 '(+BubbleButton)) ? Is +Dep and (art) related to row reordering? Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: chart row reordering?
Hi Alex, Does the following script something close? yes, that's exactly what I am trying to achieve except how would this work with persistent objects? Assuming I have the following schema and want to change order of items it in a category *ID of type +Cat? (class +Cat +Entity) (rel nr (+Need +Key +Number)) (rel nm (+Ref +String)) (rel it (+List +Joint) cat (+It)) (class +It +Entity) (rel nr (+Need +Key +Number)) (rel nm (+Sn +Idx +String)) (rel cat (+List +Joint) it (+Cat)) What I am after is what would the db update code be like? I imagine roughly something like: (setq *List (; *ID it)) (when (nth *List *Bubble) (xchg @ (cdr @)) ) (put! *ID 'it *List) (commit) but what about locking and maybe other stuff? Also, I have seen put! being used to set simple relations but is it intended for lists? How would that impact +Joint relation etc.? Also, if the db is big and the list is really long, isn't there a mechanism avoiding fetching the whole list from db and just swapping the two objects? Or, maybe I am worrying about it too much and it will turn out really simple? ;-) Thanks for help, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: chart row reordering?
Hi Alex, thank you for great explanation! Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
deploying multiple picolisp web applications
Hi Alex, I would like to ask whether you ever deploy multiple picolisp applications on a server and if yes what is your setup (assuming the only http entrance from outside is the port 80)? I imagine that I could start several apps on different ports, put each behind httpGate and use a web server with url rewriting. Is there a way of achieving similar thing without a heavy-weight server with url rewriting? I am thinking about something like: pound -- httpGate -- picolisp -- apps/sessions reverse port=8762 port=8763 ... proxy port=80 -- thttpd (static content) port=8761 where urls matching ^/picolisp/ would be served by picolisp and anything else by thttpd: my.com/picolisp/app1* served by picolisp my.com/picolisp/app2* served by picolisp my.com/*served by thttpd I can create a diretory structure in the picolisp root directory matching the url so that the picolisp server finds the right *.l files if I use (allowed (picolisp/) ...) but it breaks all the rest as picolisp + httpGate expect all urls without the app prefix and all the url stuff is relying on the url convention. Or, I could modify httpGate to rewrite urls: my.com/picolisp/app1/* = my.com:8771/* (app1 port) my.com/picolisp/app2/* = my.com:8772/* (app2 port) which might be even easier than trying to change/hook into the picolisp url convention. Or, is there a simpler way of achieving this? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: deploying multiple picolisp web applications
Hi Alex, In fact, this is rather the normal case. There is hardly ever a server running only a single application. If I understand it well, you have a server with static content http://www.software-lab.de/ running apache (and no picolisp application) and a server with picolisp web server http://7fach.de/ to run picolisp applications (and not any other web server). For each picolisp application, you create a DNS record first, e.g. app.7fach.de CNAME 7fach.de Then you use the home.l application behind httpGate to redirect to the right local port (application): http://app.7fach.de/ = http://7fach.de/8080 Your static content and picolisp applications simply live on different servers. I have one server only though and do not want to use picolisp server exclusively on that server to serve all my web content. Right. Just that 'httpGate' already does url rewriting, it is its main purpose (besides to SSL de/encrytion). The url rewriting by httpGate is only to find the right port to handle the request and it also assumes that the url have a special format: 1) ^/port/ some session 2) ^/ app entry point on a second httpGate port, interpreted *.l file or a static file This is only part of what would be needed to combine picolisp with other webserver and still going through port 80 only. Is my understanding correct? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
v2.3.3 and v2.3.4 core dump at gc.c:68
Hi Alex, I encountered the following problem with GC: === $ gdb ~/picolisp/bin/picolisp ~/picolisp/core GNU gdb 6.8-debian Copyright (C) 2008 Free Software Foundation, Inc. License GPLv3+: GNU GPL version 3 or later http://gnu.org/licenses/gpl.html This is free software: you are free to change and redistribute it. There is NO WARRANTY, to the extent permitted by law. Type show copying and show warranty for details. This GDB was configured as x86_64-linux-gnu... warning: Can't read pathname for load map: Input/output error. Reading symbols from /lib32/libc.so.6...done. Loaded symbols for /lib32/libc.so.6 Reading symbols from /lib32/libm.so.6...done. Loaded symbols for /lib32/libm.so.6 Reading symbols from /lib32/libdl.so.2...done. Loaded symbols for /lib32/libdl.so.2 Reading symbols from /lib/ld-linux.so.2...done. Loaded symbols for /lib/ld-linux.so.2 warning: Lowest section in system-supplied DSO at 0xe000 is .hash at e0b4 Program terminated with signal 11, Segmentation fault. [New process 13100] #0 0x080525d8 in gc (c=131072) at gc.c:68 68 if (num(val(p-car)) 1) (gdb) === The same problem happens in v2.3.3 and v2.3.4 but v2.3.2 works fine. My code leading to this is something that reads a csv file and parses the data into a picolisp db, roughly: === (in my.csv (setq @Nr 1) (until (eof) (let (L (mapcar pack (mapcar clip (split (line) |))) @Nm ... ...) (when @Nm (inc '@Nr) (eval (fill '(obj ((+MyObj) nr @Nr) nm @Nm ...))) (commit) === If I add: (gc 10) # avoid segfault at the beginning of the script, it works. Not sure what is going on exactly but some change in v2.3.3 must have broken gc. Looks like too much garbage is killing picolisp;-( Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Asyncronous IO
Hi Konrad and Henrik, Is the best way to simply review the Twisted source and reimplementing in Pico, keeping the OODB in mind all the time maybe? reading from http://en.wikipedia.org/wiki/Twisted_(software) Twisted supports an abstraction over raw threads=E2=80=94using a thread = as a deferred source. How threads fit in the Twisted framework? I thought that Konrad's idea was not to use threads or processes at all? In case of forking, it is as efficient to use processes as using threads, at least on Linux, as Rand already mentioned. The advantage of picoLisp is that the processes are small, say 3MB so you can have many sessions and fork many times before you run out of memory. This is very hard to achieve with Common Lisp implementations (or Java) for example, so people there need threads with their monster process. I do not think Konrad could achieve single process/thread http server without a bit of coding in C. PicoLisp I/O operations block I think and that is not good for this problem. It would be at least hard to make sure no operation blocks the process. Maybe the best or most pragmatic way is splitting your web app into a static files part that can be served by a specialized web server, e.g. thttpd or nginx and a dynamic part served by picolisp. It would be nice to see Konrad's aim come true though;-) Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
picoWiki
Hi all, I am implementing a wiki in picoLisp, see http://logand.com/picoWiki Do you think it would be useful for the picoLisp comunity (can we call it that way yet?) to have a wiki with publicly editable info about picoLisp and related stuff? If yes, any ideas and/or content contributions welcome;-) Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Asyncronous IO
Hi Alex, In addition, I sometimes use the 'alarm' function (in combination with 'catch', 'throw' and 'finally') to ensure that no operation takes too long. I don't think alarm is good enough though. It is good for timeouts but not for schedulling. BTW: I found a typo in http://www.software-lab.de/refD.html#alarm which should be http://www.software-lab.de/refA.html#alarm Not necessarily. If we use the select() mechanism provided by '*Run' and 'task', you can make input operations like 'listen', 'accept', 'read', 'rd' etc. non-blocking. How would this work, could you provide a simple example? How would I know that 'read' does not have data available, or only part of the data is available? If I just use alarm (or maybe something with smaller granularity) I would be wasting precious time on timeouts. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: picoWiki
Hi Alex, Good idea! However, I did not succeed to connect (yet?). I just tried with w3m, looks like w3m messes up the relative links, e.g. if I am at http://logand.com/picoWiki and have a relative link a class=i href=?ChangesChanges/a, w3m will interpret it as http://logand.com/?Changes. It works in Firefox though, i.e. it opens http://logand.com/picoWiki?Changes page as intended. I'll think how to do the links better. Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Asyncronous IO
Hi Alex, Not necessarily. If we use the select() mechanism provided by '*Run' and 'task', you can make input operations like 'listen', 'accept', 'read', 'rd' etc. non-blocking. select() does not make thinks non-blocking as far as I am aware. It just wakes up the process when something is going on. I think that to be non-blocking, all I/O operations must be able to say how much data to read/write without blocking. I posted some examples in my initial response to Konrad yesterday (if (rd) # read them (out Sock (eval @)) # Do something with the data I think these two lines are the problematic ones. I have this mechanism very often for communication between different systems. For communication with a browser you would better use (line) instead of (rd), and send HTML-data instead of (eval @). Does not (line) try to read until eol or eof? That could block if the client is naughty or something happens (like delay while receiving the line and being in the middle of it). Also, http://www.software-lab.de/refL.html#line says Note that a single carriage return may not work on network connections, because the character look-ahead to distinguish from return+linefeed can block the connection. How would I know that 'read' does not have data available, or only part of the data is available? For the above communication between my own machines, I can guarantee that no message received with the (rd) is longer than the system pipe buffer size (at least 4096 bytes, larger on most systems). In that case the (rd) will never block if select() said that data are available. How can you guarantee that? Simply by sending little data or some special protocol? Also, that is a very special case. I don't think you can make such assumptions with HTTP server where you don't have the clients under control. If you receive data from a browser, they may be larger. But I think this will never make problems if you always read reasonable chunks (e.g. chunked transfers, or character by character to be absolutely sure) in a single step in the 'task' body. select() will either return immediately when more data are available, or will not call the 'task' body, so nothing will actually block. How big is a reasonable chunk? What if something happens (a delay) with the client in the middle of sending the chunk? Would not reading by character loose the magic of striving for supercalifragilisticexpialidoucious server?;-) Also, not blocking is only a part of the story, what about schedulling? If two people share a computer say with MS-DOS, one must go for a coffee and wait until the other one finished. If they use UNIX, they can work simultaneously because the system splits the time between them in tiny chunks which they don't notice. The non-forking server in picolisp is of the first kind. Once the server is serving a request, everything else (all the other requests) have to wait until it is finished with the current task. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Asyncronous IO
Hi Alex, thanks for the explanation! Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Asyncronous IO
Hi Alex, The drawback of implementing such a fully non-blocking system will be that the present separation of event generation (select) and data processing (read) cannot be held up any longer, and a completely different application flow is required. yes, indeed. I attach a simple non-blocking echo server. There are some functions in C just to get the C read write functions and some blocking stuff up to the picolisp level. Then the echo server waits for events on a socket and writes back what it read. Conceptually it should not block, I am not sure how to test it though. Any ideas? There are some things that could be done better, like: - the buffer could be circular and support for this could be in the C functions rdx and wrx. - buffer could be local for the sockets, so 'callback' should be a closure... I guess I would have to use 'job' but that's next lesson I have to look at:-) It might be nice to build some kind of abstraction above this low level, non-blocking code. Maybe to implement continuations to abstract away the event driven code. Not sure how difficult it would be in picolisp. There should really be -m32 switch in the 'gcc' function. It would also be useful if it would be possible optionally switch on -g without having to modify the gcc.l file. Cheers, Tomas (load lib/gcc.l) (gcc nb NIL 'eagain 'block 'rdx 'wrx) //(eagain) - 'cnt any eagain(any ex __attribute__((unused))) { return boxCnt(EAGAIN); } //(block 'any 'flg) - 'flg any block(any ex) { int sd = (int)evCnt(ex,cdr(ex)); any y = EVAL(caddr(ex)); bool flg = isNil(y) ? NO : YES; blocking(flg, ex, sd); return y; } //(rdx 'lst 'cnt ['cnt]) - 'cnt|NIL any rdx(any ex) { any lst = EVAL(cadr(ex)); int cnt = (int)evCnt(ex,cddr(ex)); int off = isNil(cadddr(ex)) ? 0 : (int)evCnt(ex,cdddr(ex)); int i = 0; int j = 0; NeedLst(ex,lst); byte buf[cnt]; int n = read(InFile-fd, buf, cnt); if (0 n) { for (; j off isCell(lst); lst = cdr(lst), j++); for (; i n i cnt isCell(lst); lst = cdr(lst), i++) { lst-car = boxCnt(buf[i]); } } return n == 0 ? Nil : boxCnt(n 0 ? -errno : i); } //(wrx 'lst 'cnt ['cnt]) - 'cnt|NIL any wrx(any ex) { any lst = EVAL(cadr(ex)); int cnt = (int)evCnt(ex,cddr(ex)); int off = isNil(cadddr(ex)) ? 0 : (int)evCnt(ex,cdddr(ex)); int i = 0; int j = 0; NeedLst(ex,lst); byte buf[cnt]; for (; j off isCell(lst); lst = cdr(lst), j++); for (; i cnt isCell(lst); lst = cdr(lst), i++) { buf[i] = (byte)evCnt(ex,lst); } int n = write(OutFile-fd, buf, i); return n == 0 ? Nil : boxCnt(n 0 ? -errno : n); } /**/ (cd (pack (sys HOME) /picolisp)) (load (pack (sys HOME) /src/picolisp/nb.l)) # (out /tmp/a (wrx '(1 2 3 4) 4)) # (out /tmp/a (wrx '(1 2 3 4) 3 1)) # (setq *B (need 5)) # (in /tmp/a (rdx *B 3)) # (in /tmp/a (rdx *B 2 3)) # *B # non-blocking echo server (setq *N 5) # try bigger buffer;-) (setq *B (need *N)) (setq *I 0) (setq *J 0) (set 'EAGAIN (eagain)) (de _rdx (Sock) (in Sock (let? N (rdx *B (- *N *I) *I) (when (gt0 N) (inc '*I N)) N))) (de _wrx (Sock) (out Sock (let? N (wrx *B (- *I *J) *J) (when (gt0 N) (inc '*J N)) N))) (de callback (Sock) (let End NIL (prinl callback Sock J= *J I= *I N= *N) (block Sock NIL) # first time would be enough (unless End (let N (_rdx Sock) (prinl read N) (unless (or (gt0 N) (= N 'EAGAIN)) (setq End (cons rd N) (unless End (let N (_wrx Sock) (prinl written N) (unless (or (gt0 N) (= N 'EAGAIN)) (setq End (cons wr N) (when End (prinl finish) (task Sock) (close Sock)) (when (= *I *J) (prinl rotate J= *J I= *I N= *N) (setq *I 0) (setq *J 0)) (prinl end Sock J= *J I= *I N= *N))) (task (port ) # Listen on port (when (accept @) # A connect arrived (task @ # Install another task on this socket Sock @ # Keep the socket in the task's env (callback Sock) ) ) )
Re: Asyncronous IO
Hi Konrad, train. The task and *Run mechanism (if used with enough care) give us non blocking reads. But the underlying select function also provides non blocking writes. so that you can dely trying to write to a socket until it is ready for more data. I would say that select (in C) and task and *Run (in picolisp) do not have anything to do with blocking i/o. It has to do something with the concept of asynchronous. In other words, when the process does not have anything to do, it goes to sleep by calling select and when there is some event on the registered file descriptors (e.g. read or write is possible), the process is woken up. Whether i/o is blocking or not is a property of the file/socket and i/o functions. So what gives you non-blocking reads and writes is setting the file to non-blocking mode and then handling partial i/o data in a specific way. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Asyncronous IO
Hi Alex, http://www.software-lab.de/refP.html#poll says: (poll 'cnt) - cnt | NIL Checks for the availability of data for reading on the file descriptor cnt. See also open, in and close. : (and (poll *Fd) (in @ (read))) # Prevent blocking The comment is a bit misleading as it does not prevent blocking really. The data might be available but the 'read' function might still block. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: picoWiki
Hi Henrik, I could help with implementing the code highlighting I have on prodevtips, it's all happening in the client through javascript, very easy actually, you simply need the ability to add html in the content, if the necessary javascript files are included then you can do: code=classpico /code And all pico lisp code in the code block will be highlighted. nice, I did not notice the syntax highliting feature though as I have javascript turned off. Syntax highlighting is nice but I think the links to picolisp reference manual are the most important part of the lisp markup. That's the main power of the web I think, not having to look things up but simply click on them... instant information. If you fancy doing this in picoLisp (that's the thing we are after here anyway;-), there are a few things that could be improved in the current lisp tag in picoWiki: 1) highlight class names and link them to a reference explanation. As there is no single reference place similar to built in functions, maybe create a picoWiki reference for classes and link it there, i.e. create a page classes, list there classes similar to the reference for functions and refer markup there. (I will have to implement some picoWiki markup for html anchor for this.) 2) highlight strings and persistent symbols 3) cute parenthesis highliting as in lisp paste would be nice, see http://paste.lisp.org/display/68251 for example 4) the content of the lisp element can start with prompt, e.g. : (setq lambda quote) - 67293272 the : and - are currently linked to the picolisp reference which should not be the case. I attach the file which generates the picolisp xref/highliting. To use it: : (load '@lib/http.l) - http404 : (load '@lib/xhtml.l) - reset : (load /tmp/markupLisp.l) - markupLisp : (markupLisp (setq lambda quote)) (a href=http://www.software-lab.de/refS.html#setq;setq/a lambda a href=http://www.software-lab.de/refQ.html#quote;quote/a)- T : The markupLisp function gets a string and outputs html. I hope to post the whole picoWiki code at some point when it's more complete and the mess cleaned up bit:-) Cheers, Tomas (setq *Xref (mapcar pack '(new sym str char name sp? pat? fun? all intern extern loc box? str? ext? touch zap length size format chop pack glue pad align center text wrap pre? sub? low? upp? lowc uppc fold val getd set setq def de dm recur undef redef daemon patch xchg on off onOff zero one default expr subr let let? use accu push push1 pop cut del queue fifo idx lup cache locale dirname put get prop ; =: : :: putl getl wipe meta atom pair lst? num? sym? flg? sp? pat? fun? box? str? ext? bool not == n== = =0 =T n0 nT = = match + - * / % */ ** inc dec lt0 ge0 gt0 abs bit? | x| sqrt seed rand max min length size accu format pad oct hex fmt64 money car cdr caar cadr cdar cddr caaar caadr cadar caddr cdaar cdadr cddar cdddr cadddr cr nth con cons conc circ rot list need full make made chain link yoke copy mix append delete delq replace insert remove place strip split reverse flip trim clip head tail stem fin last member memq mmeq sect diff index offset assoc asoq rank sort uniq group length size val set xchg push push1 pop cut queue fifo idx balance get fill apply load args next arg rest pass quote as pid lit eval run macro curry def de dm recur recurse undef box new type isa method meth send try super extra with bind job let let? use and or nand nor xor bool not nil t prog prog1 prog2 if if2 ifn when unless cond nond case state while until loop do at for catch throw finally ! e $ sys call tick ipid opid kill quit task fork pipe later timeout bye apply pass maps map mapc maplist mapcar mapcon mapcan filter seek find pick cnt sum maxi mini fish by path in ipid out opid pipe ctl any sym str load hear tell key poll peek char skip eol eof from till line format scl read print println printsp prin prinl msg space beep tab flush rewind rd pr wr rpc wait sync echo info file dir lines open close port listen accept host connect nagle udp rc pretty pp show view here prEval mail *Class class dm rel var var: new type isa method meth send try object extend super extra with This pool journal id seq lieu lock begin commit rollback mark free dbck rel dbs dbs+ db: fmt64 tree root fetch store count leaf minKey maxKey genKey useKey init step scan iter prune zapTree chkTree db aux collect be goal prove - unify ? pretty pp show loc debug vi ld trace lint lintAll fmt64 argv opt gc raw alarm protect heap env up stk date time usec stamp dat$ $dat datSym datStr strDat expDat day week ultimo tim$ $tim telStr expTel locale allowed allow pwd cd chdir ctty info dir dirname call tick kill quit task fork pipe timeout mail test bye NIL *OS *DB T *Solo *PPid *Pid @ @@ @@@ This *Dbg *Zap *Scl *Class *Dbs *Run *Hup *Sig1 *Sig2 ^ *Err *Rst *Msg *Uni *Led
Re: picoWiki
I will have to implement some picoWiki markup for html anchor for this. Anchors is a bad idea actually. It does not go well with the wiki style links and page management. Also, using anchors leads to long documents which are pain to edit in a wiki. Every topic worth referencing should have its own page. i.e. create a page classes, list there classes similar to the reference for functions and refer markup there. I created http://logand.com/picoWiki/classes page with list of classes. I started documenting a few, e.g. http://logand.com/picoWiki/+Blob so feel free to add more stuff if you feel other could benefit from your knowledge. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Cutting a circular list.
Hi Konrad, The one nice thing about having core documetnation, which is local to my system is that I can access it when I'm offline, which is most of the time. I get the impression that some people stay online constantly. Here in Australia however internet connections are comparable expensive (we don't have true unlimited usage plans, it is all metered by download amount). So my laptop stays offline unless I really, really, need somthing that isn't on my system. good point, I didn't think about that. Maybe picoWiki could have the data available for off-line use as a tarball or so allowing you to run a local picoWiki server? Or, maybe generate static read-only snapshot available for download once in a while? Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Status of 64 picoLisp
Hi Konrad, I;m on a 64 bit system which for the moment has prevented me from trying out Thomas's Async read and write code. I'm working on a 32 bit chroot enviornment to run pico in for now, but it would be nice to go native. It should work even on 64 bit Linux without chroot environment. You'll need to install some 32 bit compatibility packages and gcc, I think these were called ia32-libs, libc6-dev-i386 and maybe something more. Then -m32 will instruct the compiler and linker to generate use 32 bit code and use 32 bit libraries. The compiled application will run on your 64 bit Linux fine. You'll need to add the -m32 option to gcc.l though, or use the 'patch' trick Alex recommended in that mail thread about async io. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Status of 64 picoLisp
Hi Alex, It is a complete rewrite. Even the implementation language changed. Instead of C it is written in a generic assembler (which in turn is written in PicoLisp :) that generates GNU assembler code (currently there is only a x86-64 generator, but other CPUs are possible). I guess that miniPicoLisp is not 64 bit incarnation of future picoLisp-3 then? What are the reasons for a) complete rewrite and b) switching from C to asm? Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Status of 64 picoLisp
Hi Alex, Yes, the current version of gcc.l will not work any longer :-( What is the reason for this not being possible? I though C and asm can be linked together (C is compiled to asm anyway). Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Status of 64 picoLisp
Hi Alex, thanks for explanation. I was curious to try picolisp bignums and must say that for somebody doing anything serious, it is probably rather inefficient. As a benchmark, I tried the example from http://paste.lisp.org/display/15116 (setq X 0) (setq Y 1) (for (N 2 (= N 100) (inc N)) (let Z (+ X Y) (setq X Y) (setq Y Z))) (prinl Y) Very rough results using picolisp native bignums: (= N 1) $ time ~/picolisp/p gmp-test2.l -bye gmp-test2.log real0m0.131s user0m0.124s sys 0m0.008s (= N 10) $ time ~/picolisp/p gmp-test2.l -bye gmp-test2.log real0m10.190s user0m10.157s sys 0m0.008s (= N 100) $ time ~/picolisp/p gmp-test2.l -bye gmp-test2.log C-c C-cKilled real17m58.856s user17m51.687s sys 0m5.572s (killed after 18 mins!) The original C program: $ time ./gmp gmp.log real0m50.060s user0m50.059s sys 0m0.004s I wrote simple ffi wrapper for gmp library and the results: $ time ../../p gmp-test.l -bye gmp-test.log real0m50.507s user0m50.239s sys 0m0.248s using the following code: (setq X (mpz_new)) (setq Y (mpz_new)) (mpz_init X) (mpz_init Y) (mpz_set_ui X 0) (mpz_set_ui Y 1) (setq Z (mpz_new)) (for (N 2 (= N 100) (inc N)) (mpz_init Z) (mpz_add Z X Y) (mpz_set X Y) (mpz_set Y Z) (mpz_clear Z)) (mpz_print Y) (prinl) Would not it be better to use gmp library for bignums if they are going to be supported? What is the reason picolisp has bignums in the first place? Do you/somebody else use it for anything? Would not it be simpler and good enough on 64 bit systems not having them at all? What impact on interfacing foreign libraries the asm rewrite have? Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Cookie question
Hi Henrik, (cookie 'uid Uid) (redirect @desktop)) The cookie won't get set if you are redirecting. I found the same problem when implementing this in picoWiki and solved this by going to the same page and then redirecting. So on successful login we jump to @desktop, that is actually another separate problem, I want to jump to http://localhost:8080/@desktop but the GUI stuff is overriding something so I end up for instance at http://localhost:54688/@desktop. This is because you called (app) so you are redirecting to your session which uses different port then the parent process. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Pipe and http
Hi Alex, 'pipe' worked fine except when run in a server which returned NIL. This would indeed be a bug in the PicoLisp kernel. Do you think you can construct a simple, stand-alone example that demonstrates this effect? the following script shows the bug: #!bin/picolisp lib.l (load @ext.l @lib/http.l @lib/xhtml.l) (de prinLength1 (X) # (length X)) (length (pipe (prin X) (line T #(test 2 (prinLength1 hi)) #(test 5 (prinLength1 'hello)) #(test 9 (prinLength1 '(1 2 3 4 56 789))) (de start1 () (for X (mapcar prinLength1 '(hi hello (1 2 3 4 56 789))) (html 0 Hello lib.css NIL (br (ht:Prin X) (de start2 () (msg start2) (msg (prinLength1 bug)) (msg (length bug)) (html 0 Hello lib.css NIL (for X '(hi hello (1 2 3 4 56 789)) (p NIL (ht:Prin X) (ht:Prin (prinLength1 X)) (server 8080 @start2) It works with (de prinLength1 (X) (length X)) but breaks with (de prinLength1 (X) (length (pipe (prin X) (line T (msg ...) show prinLength1 0 for the server version. However, the tests (test 2 (prinLength1 hi)) (test 5 (prinLength1 'hello)) (test 9 (prinLength1 '(1 2 3 4 56 789))) pass when not run in a server. Also, when using pipe version, the http output is messed up... Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Variable number of arguments in SVG functions
How about the following? (de text Prg (prin text) (while (atom (car Prg)) (prin (pop 'Prg) =\ (eval (pop 'Prg) 1) \) ) (prin ) (run Prg) # the text, or other elements (prinl /text) ) Then you could write : (text id 123 dx (+ 3 4) dy (* 3 4) (prin No font and color arguments yet) ) text id=123 dx=7 dy=12No font and color arguments yet/text That's nice. It could even be: (de xml Prg (prin (pop 'Prg)) (while (atom (car Prg)) (prin (pop 'Prg) =\ (eval (pop 'Prg) 1) \) ) (prin ) (run Prg) # the text, or other elements (prinl /text) ) (xml text id 123 dx (+ 3 4) dy (* 3 4) (prin No font and color arguments yet) ) :-) Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: picoWiki
Hi Konrad, I think Picowiki could use a title index. As somthing that is automatically generated there has been a page called All but the link was down at the bottom. I moved it to the top menu now. Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Variable number of arguments in SVG functions
The disadvantage of gensym'd symbols is that the code is more difficult to understand when pretty printed, and cannot be written to some file and retrieved later. True. The PicoLisp solution of transient symbols has an identical effect (especially if you surround the function definition(s) with ()). I see! Though the usage of transient symbols (like gensym'd symbols) nicely protects from symbol capture, there is one nasty detail: Symbols that we *want* to be evaluated in the outer environment, most notably '@'. Thanks for explanation. Is @ the only problem? How serious problem/inconvenience do you consider it? Would not it be possible somehow to rebind it again with some trick along the lines of: (de foo Prg (when (car Prg) (run (let @ (up '@) (cdr Prg)) ) ) ) Why this does not work? Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Variable number of arguments in SVG functions
Up until now, the simplest (and recommended, I think) version was: (de foo Prg (when (car Prg) (run (cdr Prg) 1) ) ) Well, I think this version has one important limitation: if Prg has a recursive call(s) to foo, the deeper foo won't see any values set by the foo above, or will it? : (de foo Prg (when (car Prg) (print Foo) (let Foo (pack Foo %) (run (cdr Prg) 1) ) ) ) - foo : (foo T (foo T (foo T)) (foo T)) NILNILNILNIL- NIL : (de foo Prg (when (car Prg) (print Foo) (let Foo (pack Foo %) (run (cdr Prg)) ) ) ) # foo redefined - foo : (foo T (foo T (foo T)) (foo T)) NIL- NIL : (de foo Prg (when (car Prg) (print Foo) (let Foo (pack Foo %) (run (cdr Prg)) ) ) ) - foo : (foo T (foo T (foo T)) (foo T)) FooFoo%Foo%%Foo%- NIL : So if I want to write recursive xml function, I cannot use (run ... 1). So far, I have this: () (de xml Lst (let (At @ Tag (pop 'Lst)) (if Tag (queue 'Xml (make (link Tag) (let Att (make (while (and Lst (atom (car Lst))) (link (cons (pop 'Lst) (eval (pop 'Lst) 1))) ) ) (let Xml NIL (let @ At (run Lst) ) (ifn Xml (when Att (link Att) ) (link Att) (chain Xml) ) ) ) ) ) (let (Xml NIL Out (when (and Lst (atom (car Lst))) (eval (pop 'Lst) 1) ) xmlPrin '(@ (queue 'Xml (pass pack))) ) (let @ At (run Lst) ) (if (=T Out) (car Xml) (out Out (xml (car Xml)) ) ) ) ) ) ) () This works well: : (load '@lib/xml.l) - attr : (and 4 (xml NIL (xml elt att @ (xmlPrin hi elt att=4hi/elt - : I don't think it could possibly work without me being esotheric:-) Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Variable number of arguments in SVG functions
Hi Alex and Jon, Indenting is impossible to do well I think because the function does not know what is going to happen in the body (the 'xml' function knows I think so, too. This is also the reason why the functions in lib/xhtml.l don't do any efforts to indent. And with this xml function we go a little in the direction of HTML (as Jon also mentioned in his initial post). So it is possible. The file implementing xml function is attached. I might improve formatting/indenting in the original 'xml' function later. I welcome any comments on the code. Ah, I was not aware that this is also legal in XML. I double checked and it is legal, see http://www.w3.org/TR/REC-xml/#syntax ...they MUST be escaped using either numeric character references or the strings amp; and lt; respectively. The right angle bracket... * Usage of the attached code The top-level xml call can be: (xml T = returns list suitable as input for 'xml' function (xml NIL -3 T = writes to NIL (stdout) with 3 tabs indenting and xml decl (xml /tmp/a 3 = writes to /tmp/a with 3 spaces indenting (xml = writes to NIL (stdout) with no indenting (and 4 (xml NIL -3 T (xml hoy id 123 class 'yes att Xml at @ (xml inner1) (xml text id 123 dx (+ 3 4) dy (* 3 4) xx you me yy ![CDATA[\Me, Myself I\]] (xmlPrin No font color arguments yet) ) (xml inner2 fun abc (xmlPrin Hi 1 asfdlkasjhfdshad) (xml line x 0 y 0 dx 100 dy 100 (xmlPrin thick @)) (xmlPrin Hi 2) ) (xml inner3 (xml inner3a (xml inner3a1) ) ) (xml inner4 fun abc) ) ) ) will print ?xml version=1.0 encoding=utf-8? hoy id=123 class=yes att=Xml at=4 inner1/ text id=123 dx=7 dy=12 xx=you #38; me yy=#60;![CDATA[#34;Me, Myself #38; #60;I#34;]]No font #38; color arguments yet/text inner2 fun=abcHi 1 asfdlkasjhfdshadline x=0 y=0 dx=100 dy=100thick4/lineHi 2/inner2 inner3 inner3a inner3a1/ /inner3a /inner3 inner4 fun=abc/ /hoy Thanks, Tomas (de xmlL Lst (let Att @ (push 'Xml (make (link (pop 'Lst)) (let Att (make (while (and Lst (atom (car Lst))) (link (cons (pop 'Lst) (eval (pop 'Lst) 1))) ) ) (let Xml NIL (let @ At (run Lst) ) (ifn Xml (when Att (link Att) ) (link Att) (chain (flip Xml)) ) ) ) ) ) ) ) (de xmlO Lst (let (Att @ Tag (pop 'Lst) ) (when Nl (prinl) (when Pre (prin Pre) )) (prin Tag) (while (and Lst (atom (car Lst))) (prin (pop 'Lst) =\) (escXml (eval (pop 'Lst) 1)) (prin \) ) (ifn Lst (prin /) (prin ) (use Nlx (let (@ At Nl N Pre (cons Pre Nn)) (run Lst) (setq Nlx Nl) ) (when Nlx (prinl) (when Pre (prin Pre) )) ) (prin / Tag ) ) ) ) (de xml Lst (let (At @ Out (when (and Lst (atom (car Lst))) (eval (pop 'Lst) 1) )) (if (=T Out) (let (Xml NIL xml xmlL xmlPrin '(@ (push 'Xml (pass pack))) ) (let @ At (run Lst) ) (car (flip Xml)) ) (let (N (when (and Lst (atom (car Lst))) (eval (pop 'Lst) 1) ) Decl (when (and Lst (atom (car Lst))) (eval (pop 'Lst) 1) ) Nn NIL Nl NIL Pre NIL xml xmlO xmlPrin '(@ (off Nl) (mapc escXml (rest))) ) (when N (do (abs N) (push 'Nn (if (lt0 N) ^I ))) ) (out Out (when Decl (xml? T) ) (let @ At (run Lst) ) ) ) ) ) ) (de escXml (X) (for C (chop X) (prin (case C (\ quot;) ( amp;) ( lt;) ( gt;) (T C) ) ) ) )
Re: Let's extend 'eval' and 'run' (was: Variable number of arguments
Hi Alex, So I would propose to extend 'eval' and 'run' with another optional argument (eval 'any ['cnt ['lst]]) (run 'any ['cnt ['lst]]) I prefer this solution:-) Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
closures
Hi Alex, is there a better way of achieving the following? (let @S '((I . 0)) (def 'count (fill '(() (job '@S (inc 'I) (def 'reset (fill '(() (job '@S (zero I)) The two functions are closed over the same var/env. (count) = 1 (count) = 2 (reset) = 0 (count) = 1 http://www.software-lab.de/faq.html#closures discusses curry function which allows closure inside a single function only. Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
'do'
Hi Alex, I am wondering whether it would be possible (and worth it) to extend 'do' function to accomodate the following scenario: : (do2 (I . 5) (print I) finished) 12345- finished : (do2 (I . -5) (print I) finished) 54321- finished Here is the prototype code but that would have to be integrated in the C function... (de do2 A (bind (list (car A) (cons 'N (cdar A))) (set (caar A) (if (gt0 N) 1 (abs N))) (do (abs N) (prog1 (run (cdr A)) (if (gt0 N) (inc (caar A)) (dec (caar A))) (run (cdr A)) should probably be (run (cdr A) 123 (list (caar A))) using the new 'run' convention. However, I am not sure what level it should be (not 123 really)... How do you count how many frames need to be skipped in such cases to get to the scope out of the function? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: closures
Hi Alex, (let @S '((I . 0)) (def 'count (curry (@S) () (job '@S (inc 'I (def 'reset (curry (@S) () (job '@S (zero I ) (let @S (list (cons 'I 0)) (let I (cons 0) I like it this way, thanks. I also found that once the things inside the closures get complicated, it might be worth using objects to get better code factoring: (class +Counter) # i (dm T () (=: i 0)) (dm count () (inc (:: i))) (dm reset () (=: i 0)) (let @C (list (cons 'C (new '(+Counter (def 'count (curry (@C) () (job '@C (count C (def 'reset (curry (@C) () (job '@C (reset C ) Or using objects directly so that I can have many independent counters... It did the job for my understanding of closures in picoLisp, I hope:-) Sometimes non-evaluating functions are a little more convenient, and at least theoretically more efficient. (zero A) occupies two cells. (zero 'A) would be three, and that's the same as (setq A 0), so it would not save any space. Have you measured and/or noticed impact on performance of these micro-optimizations? I mean, are they really worth it? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
'pre?', 'sub?' and 'length'
Hi Alex, diving more into picoLisp utility functions I foud some functions that could be extended: For example 'pre?' and 'sub?' could understand lists: (de pre (P L) (let X T (while (and X P L) (if (and (pair P) (pair L) (= (car P) (car L))) (setq P (cdr P) L (cdr L)) (off X) ) ) X ) ) : (pre '(1 2) '(1 2 3 4)) - T : (pre '(1 2) '(1 5 2 3 4)) - NIL 'length' returns T for circular lists currently, which is not great. It could return the real length too (as the number of 'car' elements), maybe like = (T . 5) (de fifoLength (F) (let (N (if F 1 0) H F) (until (== H (setq F (cdr F))) (inc 'N) ) N ) ) : (fifo 'A 1 2 3 4 5 6) - 6 : A - (6 1 2 3 4 5 .) : (length A) - T : (fifoLength A) - 6 Actually, this would need to work differently together with the original 'length'. picoLisp does not have many types and it would be nice to have these utility functions more generic. What are your thoughts? Are you interested in hearing such suggestions or do you consider it too specific that everybody should implement these themselves if they need them? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Http query variables
Hi Alex, I would definitely not use +String, to avoid the trouble and cost of conversions. If it is just a list of cons pairs where the CDR parts are atomic, there is no currently other way than +Any. But if it is of a homogeneous list structure like ((key1 string1 123) (key2 string2 456) ...) then thinking about (rel xxx (+List +Bag) ((+Symbol)) # key ((+String)) ((+Number) 2) ) thanks for suggestions, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
http server hangs on post without enctype=multipart/form-data
Hi Alex, I have the following code: === (load @lib/http.l @lib/xhtml.l @lib/form.l) (de done () (msg done) (html 0 done NIL NIL Finito ) ) (de start () (html 0 start NIL NIL (prin form action=\@done\ method=\post\ input type=\hidden\ value=\v1\ name=\n1\/ input type=\hidden\ value=\v2\ name=\n2\/ input type=\submit\ value=\Done 1\/ /form) (prin form action=\@done\ method=\post\ enctype=\multipart/form-data\ input type=\hidden\ value=\v1\ name=\n1\/ input type=\hidden\ value=\v2\ name=\n2\/ input type=\submit\ value=\Done 2\/ /form) (post NIL @done (hidden 'n1 'v1) (hidden 'n2 'v2) (submit Done 3) ) ) ) (server 8080 @start) === It works if I press Done 2 or Done 3 button. It hangs if I press Done 1. It seems to me that picolisp hangs in the else branch of the following code in http.l, 'http' function: (if (and *MPartLim *MPartEnd) (_htMultipart) (for L (split (line) ') (when (cdr (setq L (split L =))) (_htSet (car L) (ht:Pack (cadr L))) ) ) ) It unhangs when I press stop button in the browser so I think it hangs inside the 'line' call waiting for eol or eof but the browser did not sent any of these... Any ideas what is wrong and how to fix it? Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
I was thinking about rewriting the server, I already wrote a prototype asynchronous http server but I have only the reading part non-blocking and not the writing part yet. I do not want to spend too much time on it right now. Sorry, I was not clear. It would not have to be a asynhronous server, just structured a bit differently than the current one... but then how far do we want to go changing the server? We would need to be careful to keep it working with @lib/form.l Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
An even better solution might be to extend the built-in 'line' function in that a way that when only a single 'cnt' argument is passed it is taken as a length parameter. The idea is that in the current semantics of 'line' a single 'cnt' argument makes no sense. But would cnt mean number of chars or number of bytes? That could be confusing. Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
Hi Alex, thanks for fixing it. Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
Hi Alex, (redef _htSet @ (if (and *HtVarsHook (*HtVarsHook)) (push '*HtVars (cons (pack (next)) (next))) (pass _htSet) ) ) thank you, I will use this;-) Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
cookie parsing bug fix
Hi Alex, in file @lib/http.l (de _htHead () .. (setq *Cookies (mapcar '((L) (setq L (split L =)) (cons (htArg (car L)) (htArg (cadr L))) ) (split @X ;) ) ) ) leaves single space in front of all cookie names except the first one. I am using FireFox and cookies are separated by ; so I had to add 'clip' for the cookie name: (cons (htArg (clip (car L))) (htArg (cadr L))) ) I did not test it with other browsers but I assume the problem would be general. Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
Hi Alex, My suspicion is that it has something to do with Keep-Alive, and one just a thought: even if the client sends keep-alive, the server can respond close and close the connection. Is there any particular reason you do not want to close the connection after you served the request? Would you get those problem if you always closed the connection? Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
Hi Alex, Sometimes POST seems to lose data, or contain data out of context. No idea yet, but I observe this once every few weeks, and I'm tracing the activities now. I haven't noticed this yet but I'll let you know if I do;-) Cheers, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: http server hangs on post without enctype=multipart/form-data
Hi Alex, it works for me now with ht:Read. Would it be possible to put comment into CHANGES file? Do you use any version control system? Thanks, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: db and multiple processes
Hi Alex, Usually not, though I do it in certain cases. In what cases and how you do it? I want to split my app into two independent processes (process families): an admin part (quite complex, can change a lot and significantly, can stop quite often for upgrades etc.) and public part (quite simple, changes little, minimize downtime). The reason is that I want to be able to kill and upgrade these two parts independently without affecting each other. If you have an independent process accessing such a db, it must make sure never to write to that db (or write only objects which are guaranteed not to be written by other processes), and be aware that the state of its cached objects might be out of date (e.g. call (rollback) from time to time to cause a reload). This is usually not so easy to guarantee, because changing a single object often triggers the change of many other objects as a side effect, like objects connected via '+Joint', or whole branches of an index tree. I cannot guarantee that. In fact, there *is* an important communication going on. Now how to achieve the above requirements? Maybe having a master parent process which would - open the database 'pool' - fork into two apps (each forked process would load code for different app) This way I would have both apps in the same process family and could still kill/restart them independently. To be on the safe side, I would recommend to allow only members of a single family to access a db, and implement external accesses via some RPC mechanisms (for queries, '*Ext' comes in handy here). What is '*Ext', I cannot find anything about that? This whole matter is a good candidate for the Wiki ;-) Yes, why not, I have to understand it first though. Or, feel free to put your thoughts in there;-) Thank you, Tomas -- UNSUBSCRIBE: mailto:[EMAIL PROTECTED]
Re: Let's extend 'eval' and 'run' (was: Variable number of
Hi Alex, BTW, did you have a chance to experiment with the new extensions of 'eval' and 'run'? I feel that the new 'lst' argument (for excluding specific symbols from the process) was a good idea. I think it was a good idea too. I have attached the xml function which makes use of the new feature:-) See the xml2.l and xml2-test.l files. I have also attached an improved version of the 'xml' function (file xml-my.l) which allows to switch off line breaks or use tabs for indenting. Would it be a good idea for these to become part of picolisp as we discussed earlier? The attached version fixes all the doubts against it as discussed in this thread so far... Cheers, Tomas # top-level xml sets up xml output # - use prin (file/fd arg to out) + indenting lt0 tab, gt0 spaces + ?xml decl? # - or T create list formated for 'xml' function # recursive xml tag [attr val]* ... # pair or NIL attr key starts body # NIL attr val not output, use T '((T . attr)) to output empty attr # atom in body = xprin, pair = eval # xprin, xrun (de xmlL Lst (push 'Xml (make (link (pop 'Lst)) (let Att (make (while (and Lst (car Lst) (atom (car Lst))) (let K (pop 'Lst) (if (=T K) (for X (eval (pop 'Lst) 1) (if (=T (car X)) (link (cons (cdr X) NIL)) (when (cdr X) (link X) ) ) ) (when (eval (pop 'Lst) 1) (link (cons K @)) ) ) ) ) ) (let Xml NIL (xrun Lst) (ifn Xml (when Att (link Att) ) (link Att) (chain (flip Xml)) ) ) ) ) ) ) (de xmlO Lst (let Tag (pop 'Lst) (when Nl (prinl) (when Pre (prin Pre) ) ) (prin Tag) (while (and Lst (car Lst) (atom (car Lst))) (let K (pop 'Lst) (if (=T K) (for X (eval (pop 'Lst) 1) (if (=T (car X)) (prin (cdr X) =\\) (when (cdr X) (prin (car X) =\) (escXml (cdr X)) (prin \) ) ) ) (when (eval (pop 'Lst) 1) (prin K =\) (escXml @) (prin \) ) ) ) ) (ifn Lst (prin /) (prin ) (use Nl (let (Nl N Pre (cons Pre Nn) ) (xrun Lst) (setq Nl Nl) ) (when Nl (prinl) (when Pre (prin Pre) ) ) ) (prin / Tag ) ) ) ) (de xml Lst (let Out (and Lst (atom (car Lst)) (eval (pop 'Lst) 1)) (if (=T Out) (let (xml xmlL xprin '(@ (push 'Xml (pass pack))) xrun '((Lst Ofs) (default Ofs 2) (for X Lst (if (pair X) (eval X Ofs '(Xml)) (when (eval X Ofs '(Xml)) (xprin @) ) ) ) ) Xml NIL ) (run Lst 1 '(xml xprin xrun Xml)) (car (flip Xml)) ) (let (xml xmlO xprin '(@ (off Nl) (mapc escXml (rest))) xrun '((Lst Ofs) (default Ofs 2) (for X Lst (if (pair X) (eval X Ofs '(Nl Pre)) (when (eval X Ofs '(Nl Pre)) (xprin @) ) ) ) ) N (and Lst (atom (car Lst)) (eval (pop 'Lst) 1)) Nn NIL Nl NIL Pre NIL ) (when N (do (abs N) (push 'Nn (if (lt0 N) ^I )) ) ) (out Out (when (and Lst (atom (car Lst)) (eval (pop 'Lst) 1)) (xml? T) ) (run Lst 1 '(xml xprin xrun N Nn Nl Pre)) ) ) ) ) ) (de escXml (X) (for C (chop X) (prin (case C (\ quot;) ( amp;) ( lt;) ( gt;) (T C) ) ) ) ) # ~/lisp/picoLisp/p xml2.l xml2-test.l -bye (de xmlTest (N Out Str . Prg) (prinl test N (if (= (chop Str) (if Out (pipe (run Prg 1) (till) ) (run Prg 1) ) ) OK Fail ) ) ) (xmlTest 1 T text id=\123\ dx=\7\ dy=\12\ xx=\you amp; me\ yy=\lt;![CDATA[quot;Me, Myself amp; lt;Igt;quot;]]gt;\No font amp; color arguments yet/text (xml (xml text id 123 dx (+ 3 4) dy (* 3 4) xx you me yy ![CDATA[\Me, Myself I\]] (xprin No font color arguments yet) ) ) ) (xmlTest 2 T hoy id=\123\inner
Re: Let's extend 'eval' and 'run' (was: Variable number of
Hi all, happy New Year! Sure. Both the new 'xml' as well as the improved 'xml' should be included. I would suggest to put 'xml' and the changes into lib/xml.l. Alex, the merged lib/xml.l file is attached. I guess it will be -r again when you save it? Can you merge them together, and send it to me during this week? Then it can be included in picoLisp-2.3.5 due to the end of this month. It'll have to go in the next version:-o Thank you, Tomas # 09aug08abu # 09aug08 Tomas Hlavaty kviet...@seznam.cz # Check or write header (de xml? (Flg) (if Flg (prinl ?xml version=\1.0\ encoding=\utf-8\?) (skip) (prog1 (head '( ? x m l) (till )) (char) ) ) ) # Generate/Parse XML data # expects well formed XML # encoding by picolisp (utf8 only, no utf16 etc.) # trim whitespace except in cdata # ignore ? !-- !DOCTYPE # non-builtin entities as normal text: ent; = ent (de xml (Lst N) (if Lst (let (Nn NIL Nl NIL Pre NIL) (when N (do (abs N) (push 'Nn (if (lt0 N) ^I )) ) ) (xml_ Lst) ) (_xml) ) ) (de xml_ (Lst) (let Tag (pop 'Lst) (when Nl (prinl) (when Pre (prin Pre) ) ) (prin Tag) (for X (pop 'Lst) (prin (car X) =\) (escXml (cdr X)) (prin \) ) (ifn Lst (prin /) (prin ) (use Nlx (let (Nl N Pre (cons Pre Nn) ) (for X Lst (if (pair X) (xml_ X) (off Nl) (escXml X) ) ) (setq Nlx Nl) ) (when Nlx (prinl) (when Pre (prin Pre) ) ) ) (prin / Tag ) ) ) ) (de _xml (In Char) (unless Char (skip) (unless (= (char)) (quit Bad XML) ) ) (case (peek) (? (from ?) (unless In (_xml In)) ) (! (char) (case (peek) (- (ifn (= - (char) (char)) (quit XML comment expected) (from --) (unless In (_xml In)) ) ) (D (if (find '((C) ( C (char))) '`(chop DOCTYPE)) (quit XML DOCTYPE expected) (when (= [ (from [ )) (use X (loop (T (= ] (setq X (from ] \ ' !-- (case X (\ (from \)) (' (from ')) (!-- (from --)) (NIL (quit Unbalanced XML DOCTYPE)) ) ) ) (from ) ) (unless In (_xml In)) ) ) ([ (if (find '((C) ( C (char))) '`(chop [CDATA[)) (quit XML CDATA expected) (pack (head -3 (make (loop (NIL (link (char)) (quit Unbalanced XML CDATA)) (T (= '`(chop ]]) (tail 3 (made ) ) ) ) ) ) (T (quit Unhandled XML tag)) ) ) (T (let Tok (till ^I^M^J/ T) (use X (make (link (intern (pack Tok))) (let L (make (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (member @ '(/ ))) (NIL (setq X (intern (pack (trim (till =)) (char) (skip) (let C (char) (unless (member C '(\ ')) (quit XML attribute quote expected X) ) (link (cons X (pack (xmlEsc (till C) ) (char) ) ) (if (= / (char)) (prog (char) (and L (link L))) (link L) (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (and (= (setq X (char))) (= / (peek))) (char) (unless (= Tok (till ^I^M^J/ T)) (quit Unbalanced XML Tok) ) (skip) (char) ) (if (= X) (when (_xml T ) (link @) ) (link (pack (xmlEsc (trim (cons X (till ^M^J) ) ) ) ) ) ) ) ) ) ) ) (de xmlEsc (L) (use (@A @X @Z) (make (while L (ifn (match '( @X ; @Z) L) (link (pop 'L)) (link (cond ((= @X
Re: sort
Hi Alex, : (lintAll) - ((order (bnd S))) I tried it on the multi-method code and got a warning: (de mmApply @ (let (N (next) A (rest) K (mapcar type A) Mm (filter '((M) (mmApplicable K (car M))) (get N 'mm)) ) (ifn Mm (quit 'mm (list No applicable method N A K)) (let mmNext '(() (ifn (cdr (pop 'Mm)) (quit 'mm (list No other method N A K)) (apply @ A) ) ) (apply (cdr (pop 'Mm)) A) ) ) ) ) : (lintAll) (lintAll) - ((mmApply (use mmNext))) A false positive? ('mmNext' can be called in the function under 'apply'.) Maybe a dynamically scoped code is impossible to check reliably? I also got: - ((xml (use Pre Nl)) (xml_ (bnd Nn N Pre Nl)) (xmlEsc (use @A))) when run with the new lib/xml.l loaded. The xml and xml_ are fine, xmlEsc looks like it has unused @A. Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: sort
Hi Alex, : (let L (make (do 10 (link (rand (bench (sort L) T)) 0.251 sec - T thanks for pointing out the 'bench' function;-) Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: sort
Hi Alex, A typical example would be sorting a list of customers by city, name and customer number, in that order. A binary comparison for 'sort2' would look like (sort2 (collect ... '+CuSu ...) '((CuSu1 CuSu2) (cond (( (; CuSu1 ort) (; CuSu2 ort)) ( (; CuSu2 ort) (; CuSu1 ort)) ) (( (; CuSu1 nm) (; CuSu2 nm)) ( (; CuSu2 nm) (; CuSu1 nm)) ) (T ( (; CuSu2 nr) (; CuSu1 nr)) ) ) ) ) This binary function is rather complicated (and thus slow), and it might be called nearly O(N^2) times. it will be called as many times as the C function 'compare' is called. Not sure about the picolisp 'sort' function, but usual sorting algorithms are O(N*log(N)) so it will be called O(N^2) times only if the built-in 'sort' is O(N^2). I guess the built-in 'sort' function is O(N*log(N)) so the code above will be O(N*log(N)) too. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Let's extend 'eval' and 'run' (was: Variable number of
Hi Alex, I have attached the lib/xml.l with a minor change which avoids calling 'out' when the output file is NIL. I found that (ht:Out *Chunked (xml *Sock ... was breaking chunking output so if I use (ht:Out *Chunked (xml ... with the attached file, chunking works fine. I tried it with the v2.3.5 + the latest lib/xml.l from the testing release only so I am not sure whether it is caused by the recent changes in i/o functions. Thank you, Tomas # 03jan09abu # 07jan09 Tomas Hlavaty kviet...@seznam.cz # Check or write header (de xml? (Flg) (if Flg (prinl ?xml version=\1.0\ encoding=\utf-8\?) (skip) (prog1 (head '( ? x m l) (till )) (char) ) ) ) # Generate/Parse XML data # expects well formed XML # encoding by picolisp (utf8 only, no utf16 etc.) # trim whitespace except in cdata # ignore ? !-- !DOCTYPE # non-builtin entities as normal text: ent; = ent (de xml (Lst N) (if Lst (let (Nn NIL Nl NIL Pre NIL) (when N (do (abs N) (push 'Nn (if (lt0 N) ^I )) ) ) (_xml_ Lst) ) (_xml) ) ) (de _xml_ (Lst) (let Tag (pop 'Lst) (when Nl (prinl) (when Pre (prin Pre) ) ) (prin Tag) (for X (pop 'Lst) (prin (car X) =\) (escXml (cdr X)) (prin \) ) (ifn Lst (prin /) (prin ) (use Nlx (let (Nl N Pre (cons Pre Nn) ) (for X Lst (if (pair X) (_xml_ X) (off Nl) (escXml X) ) ) (setq Nlx Nl) ) (when Nlx (prinl) (when Pre (prin Pre) ) ) ) (prin / Tag ) ) ) ) (de _xml (In Char) (unless Char (skip) (unless (= (char)) (quit Bad XML) ) ) (case (peek) (? (from ?) (unless In (_xml In)) ) (! (char) (case (peek) (- (ifn (= - (char) (char)) (quit XML comment expected) (from --) (unless In (_xml In)) ) ) (D (if (find '((C) ( C (char))) '`(chop DOCTYPE)) (quit XML DOCTYPE expected) (when (= [ (from [ )) (use X (loop (T (= ] (setq X (from ] \ ' !-- (case X (\ (from \)) (' (from ')) (!-- (from --)) (NIL (quit Unbalanced XML DOCTYPE)) ) ) ) (from ) ) (unless In (_xml In)) ) ) ([ (if (find '((C) ( C (char))) '`(chop [CDATA[)) (quit XML CDATA expected) (pack (head -3 (make (loop (NIL (link (char)) (quit Unbalanced XML CDATA)) (T (= '`(chop ]]) (tail 3 (made ) ) ) ) ) ) (T (quit Unhandled XML tag)) ) ) (T (let Tok (till ^I^M^J/ T) (use X (make (link (intern (pack Tok))) (let L (make (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (member @ '(/ ))) (NIL (setq X (intern (pack (trim (till =)) (char) (skip) (let C (char) (unless (member C '(\ ')) (quit XML attribute quote expected X) ) (link (cons X (pack (xmlEsc (till C) ) (char) ) ) (if (= / (char)) (prog (char) (and L (link L))) (link L) (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (and (= (setq X (char))) (= / (peek))) (char) (unless (= Tok (till ^I^M^J/ T)) (quit Unbalanced XML Tok) ) (skip) (char) ) (if (= X) (when (_xml T ) (link @) ) (link (pack (xmlEsc (trim (cons X (till ^M^J) ) ) ) ) ) ) ) ) ) ) ) (de xmlEsc (L) (use (@X @Z) (make (while L (ifn (match '( @X ; @Z) L) (link (pop 'L)) (link (cond
Re: sort
I'm not sure. I feel that it is its ugliness which predestines it to denote such a local concept. Fair enough:-) Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: sort
Hi Alex, and on top of that calls the retrieval code twice on each invocation). I am not sure about what you mean. The 'sort' algorithm have some strategy how it accesses the elements and by the time the function compare() is called, it already has the elements available so it does not have to retrieve them. Thanks, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Let's extend 'eval' and 'run' (was: Variable number of
Hi Alex, Then (xml T ...) would generate a list, while (xml ...) would write to the current stream, no matter if it is chunked or not. you are right, the interface would be more logical without 'out'. I think the parameter Out = T should have been associated with the N parameter, i.e. -2 ~ two tabs, 2 ~ two spaces, 0 ~ new lines only, NIL ~ no indenting and line breaks, T ~ collect into a list. I'll change that. Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: deploying multiple picolisp web applications
Hi Alex, A direct link to the default port might not always be desired, as this is often not the main application (but some other home page). I cannot see how this can be a problem? Having the same configuration, the only difference is that with httpGate you would get connection error while with httpGate0 you would get not found error. Everything works the same otherwise. Your approach is viable in general, though we have the void solution in 'httpGate' (described in my previous mail) in common use now. comparing the two approaches: 1) httpGate solution either gets connection error or displays a static file/page. 2) httpGate0 solution either gets not found error or does *anything* the default gate server is programmed to do, e.g. gets not found error, redirects or displays a dynamically generated page (or gets connection error if the default gate server is not running). Also, httpGate0 solution seems simpler to me in terms of C code and overall logic. If 'httpGate' fails to connect to the local server, an arbitrary page can be triggered. you see that it tries to open a file named void. The page can be arbitrary but static. That means that if I have more web applications, the only thing I can display is that the session expired but I cannot show a link or redirect to the original application. This void is usually a symbolic link to some page. It typically says Session timed out / Could not connect to the current session / Probably, a timeout occurred, and the session terminated. / Please try to re-connect to your last recently used application. I find this is not user friendly at all as the user have to navigate to the original application himself manually but it should be done by the computer. In other cases this page contains a link to the main application (if there is any) telling the user to click that link, otherwise it automatically redirects the user to that application after 10 seconds or so. But how does it know which application when there are more than one? Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: deploying multiple picolisp web applications
Hi Alex, But still I want to keep simple things simple. 'httpGate0' connects back to the first port without asking, which I think is the worst default behavior. I guess that it depends on the point of view. I think httpGate is more complicated than httpGate0 and also it is broken in the sense that it does not allow to display a *proper* error or timeout page. You need a some management *inside* the application to display a proper error or timeout page. Only inside the default server. That's the only way to display a *proper* error or timeout page. With the current httpGate, I have two choices: 1) dont use 'void' and get connection error 2) use 'void' and display a page which is broken (no way to link to the correct app start page) 3) use one httpGate process per application with different 'void' pages (each with hardcoded link to the app start page) All of those are not good. Managing more than one application may be done by home.l, but is not required. As I understand it, home.l does not manage multiple applications. It only rewrites urls/redirects. It only handles the part when I enter a human readable link in my browser. After that, the whole picolisp system looses track of how to get back to the app start page. Timeouts are managed by 'httpGate' and 'void'. The app itself does not know about those concepts. That's the choice I do not agree with;-) I think httpGate should not handle timeouts. With httpGate0, the applications do not know about timeouts either, only the default server can handle that if it wishes to. I think that the concept of 'void' is complicated and limited. I would say that httpGate prematurely handles timeout with the hardwired piece of C code and this limits usability. Also, the error handling in lib/http.l where *CondId *SesId and *ConId NIL is a bit arbitrary, while that case suddenly makes sense in the context of httpGate0. I know that everything works as before, and not much code is added. But it adds a new concept to 'httpGate' (automatic reconnection to the default port, as opposed to a direct error (with or without 'void')), It just interprets httpGate differently. httpGate: if the url is /([0-9]+)/ connect to port $1, if it fails display page 'void'. For other urls connect to the default port. httpGate0: if the url is /([0-9]+)/ connect to port $1. If it fails or for other urls connect to the default port. For the httpGate case, once it fails to connect, it is the end of everything, I cannot fix the problem (display a *proper* error or timeout page) as the control path is out of any reach and outside my system. and to the syntax of the session ID, which may now hold an additional application name. Well, syntax of a session id can be anything sufficiently unique so I don't think that is an issue. It is not used for anything anyway except for comparing with other session ids. And, by default, application name is NIL so the session id will look the same as now. Also, it is not necessary to think about it as an application name. It is simply a string which carries custom information in the url. That information can then be used later, e.g. to handle timeouts *properly*. That's why I think your solution is good and useful, but a little bit too much for the default release. Fair enough, I see that I won't persuade you on this one;-) I'll have to patch picoLisp with every release though:-( Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: deploying multiple picolisp web applications
Hi Alex, parse the Referer: So I added it to lib/http.l, available now in the testing release. thank you, the referer could be useful to have there. I think it would be good to have all headers the client sent accessible though. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Let's extend 'eval' and 'run' (was: Variable number of
Hi Alex, Then (xml T ...) would generate a list, while (xml ...) would write to the current stream, no matter if it is chunked or not. you are right, the interface would be more logical without 'out'. I think the parameter Out = T should have been associated with the N parameter, i.e. -2 ~ two tabs, 2 ~ two spaces, 0 ~ new lines only, NIL ~ no indenting and line breaks, T ~ collect into a list. I'll change that. I have fixed lib/xml.l which is attached. I removed Out parameter and made N parameter required. I also removed the optional 'xml?' call. It makes more sense now. Thank you, Tomas # 03jan09abu # 21jan09 Tomas Hlavaty kviet...@seznam.cz # Check or write header (de xml? (Flg) (if Flg (prinl ?xml version=\1.0\ encoding=\utf-8\?) (skip) (prog1 (head '( ? x m l) (till )) (char) ) ) ) # Generate/Parse XML data # expects well formed XML # encoding by picolisp (utf8 only, no utf16 etc.) # trim whitespace except in cdata # ignore ? !-- !DOCTYPE # non-builtin entities as normal text: ent; = ent (de xml (Lst N) (if Lst (let (Nn NIL Nl NIL Pre NIL) (when N (do (abs N) (push 'Nn (if (lt0 N) ^I )) ) ) (_xml_ Lst) ) (_xml) ) ) (de _xml_ (Lst) (let Tag (pop 'Lst) (when Nl (prinl) (when Pre (prin Pre) ) ) (prin Tag) (for X (pop 'Lst) (prin (car X) =\) (escXml (cdr X)) (prin \) ) (ifn Lst (prin /) (prin ) (use Nlx (let (Nl N Pre (cons Pre Nn) ) (for X Lst (if (pair X) (_xml_ X) (off Nl) (escXml X) ) ) (setq Nlx Nl) ) (when Nlx (prinl) (when Pre (prin Pre) ) ) ) (prin / Tag ) ) ) ) (de _xml (In Char) (unless Char (skip) (unless (= (char)) (quit Bad XML) ) ) (case (peek) (? (from ?) (unless In (_xml In)) ) (! (char) (case (peek) (- (ifn (= - (char) (char)) (quit XML comment expected) (from --) (unless In (_xml In)) ) ) (D (if (find '((C) ( C (char))) '`(chop DOCTYPE)) (quit XML DOCTYPE expected) (when (= [ (from [ )) (use X (loop (T (= ] (setq X (from ] \ ' !-- (case X (\ (from \)) (' (from ')) (!-- (from --)) (NIL (quit Unbalanced XML DOCTYPE)) ) ) ) (from ) ) (unless In (_xml In)) ) ) ([ (if (find '((C) ( C (char))) '`(chop [CDATA[)) (quit XML CDATA expected) (pack (head -3 (make (loop (NIL (link (char)) (quit Unbalanced XML CDATA)) (T (= '`(chop ]]) (tail 3 (made ) ) ) ) ) ) (T (quit Unhandled XML tag)) ) ) (T (let Tok (till ^I^M^J/ T) (use X (make (link (intern (pack Tok))) (let L (make (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (member @ '(/ ))) (NIL (setq X (intern (pack (trim (till =)) (char) (skip) (let C (char) (unless (member C '(\ ')) (quit XML attribute quote expected X) ) (link (cons X (pack (xmlEsc (till C) ) (char) ) ) (if (= / (char)) (prog (char) (and L (link L))) (link L) (loop (NIL (skip) (quit Unexpected end of XML Tok)) (T (and (= (setq X (char))) (= / (peek))) (char) (unless (= Tok (till ^I^M^J/ T)) (quit Unbalanced XML Tok) ) (skip) (char) ) (if (= X) (when (_xml T ) (link @) ) (link (pack (xmlEsc (trim (cons X (till ^M^J) ) ) ) ) ) ) ) ) ) ) ) (de xmlEsc (L) (use (@X @Z) (make (while L
IPC
Hi Alex, I am struggling to understand picolisp IPC functions (hear, tell, rpc, sync...). I have attached code for the Dining Philosophers problem which gets stuck after calling 'hear' in the philosopher (child) process. The idea is that each philosopher is a process which opens a fifo and all philosophers talk to their neighbours via those fifos. 'hear' in the following snippet seems to block the whole process: ... (log 'before) (hear (mailbox I)) (log 'after) ... outputs $ ~/picolisp/p phil.l 0 -1 0 before 1 -1 0 before 2 -1 0 before 3 -1 0 before 4 -1 0 before : ..only and does nothing afterwards. I would expect 'hear' to install some kind of event handler which would evaluate incoming messages and then carry on immediately with the next (log 'after) line. Is my understanding correct? I though that 'hear' was working in the background so why the code blocks? Thank you, Tomas # ~/picolisp/p phil.l # http://en.wikipedia.org/wiki/Dining_philosophers_problem # Chandy / Misra solution # philosophers: N = total, I = current, P = other # forks: L = left, R = right; lt0 ~ dirty, =0 none, gt0 ~ clean (de log @ (pass println I L R) (flush) ) (de idle () (wait (rand 1000 3000)) ) (de left () (% (+ N (- I 1)) N) ) (de right () (% (+ I 1) N) ) (de mailbox (P) (pack phil P) ) (de obtain (P) (log 'obtain P) (when (= P (left)) (if (=0 L) (setq L 1) (quit Already have the left fork) ) ) (when (= P (right)) (if (=0 R) (setq R 1) (quit Already have the right fork) ) ) ) (de give (P) (log 'give P) (when (and (= P (left)) (lt0 L)) (out (mailbox P) (rpc 'obtain I) ) (setq L 0) ) (when (and (= P (right)) (lt0 R)) (out (mailbox P) (rpc 'obtain I) ) (setq R 0) ) ) (de grab () (while (or (=0 L) (=0 R)) (when (lt0 L) (setq L 1) ) (when (lt0 R) (setq R 1) ) (when (=0 L) (out (mailbox (left)) (rpc 'give I) ) ) (when (=0 R) (out (mailbox (right)) (rpc 'give I) ) ) (wait 500) ) ) (de phil (I N L R) (unless (info (mailbox I)) (call 'mkfifo (mailbox I)) ) (log 'before) (hear (mailbox I)) (log 'after) (loop (log 'thinking) (idle) # think (log 'hungry) (grab) (log 'eating) (idle) # eat (setq L -1 R -1) ) ) # dirty (de main (N) (push '*Bye '(mapc 'kill *C)) (for (I 0 ( I N) (inc I)) (if (fork) (push '*C @) (phil I N -1 0) ) ) ) (main 5)
Re: IPC
Hi Alex, as in 'open'. Therefore, I would rather reduce the functionality of 'hear', so that from now on it only accepts a file descriptor (and no longer a symbolic argument). I'll write it into the ReleaseNotes. I see, thank you. You tried to use 'rpc' to send messages to the other philosophers. While this is basically a correct idea, 'rpc' is not suitable in the current situation. It sends the message via standard output, and is intended to be used in a 'pipe' call. What is the functional difference between 'rpc' and 'pr' and why the specific constraint on 'rpc' being suitable only for stdout? With 'rpc' I get: : (hear (pipe (do 3 (wait 2000) (rpc 'println ''Ok - 3 : Ok Ok Ok and with 'pr' I get the same thing: : (hear (pipe (do 3 (wait 2000) (pr '(println 'Ok)) (flush - 3 : Ok Ok Ok If you look in the reference for 'hear', it says hear is usually only called explicitly by a top level parent process. The reason is that upon a 'fork', the 'hear' channel is automatically set up in the child process to be used by the built-in IPC routines. I see, where can I find this automatic channel, is it a named pipe? If not, what channel is used for communication? As a consequence, if you re-open that channel with 'hear', the child is effectively cut off from its parent and could, for example, not synchronize on DB operations. I noticed that 'tell' did not work for me when I opened the fifos, so this is why:-) So the recommended and natural way is to use 'tell'. In combination with 'pid', it can also send messages selectively to other processes. Using 'tell' I cannot send a message to the parent process though. I would like to have the philosophers talking to a monitor process which cannot be the parent but must be another child for 'tell' to work. Is that correct? How are children supposed to communicate with the parent process? As an example, I modified your phil.l (I hope I understood it). Each philosopher (process) keeps the PIDs of his neighbors in the global variables '*LeftNeighbor' and '*RightNeighbor', and the state of the forks in '*LeftFork' and '*RightFork'. In the beginning, he waits until he received the PIDs from the parent process. That's interesting, thank you. 'tell' seems to be asynchronous. If I want to query the philosopher processes about their state, I cannot use something like: (de philState () (list *Pid *State *LeftFork *RightFork) ) .. and in *Monitor process call... (let S (tell 'pid P 'philState) (println S) because 'tell' does not return the result of calling 'philState'. Is there a standard/easy way of achieving this? Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: IPC
Hi all, the Chandy / Misra solution to Dining Philosophers Problem in picolisp seems to be working now so the code is now at http://logand.com/sw/phil.l for anybody interested. The problem with the previous code was that once the hungry philosopher handed over his dirty fork, he had to ask to get it back. This was the message I thought was getting lost but it was not generated in the first place. Thanks Alex for your suggestions. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: IPC
Hi Alex, There is no other place where the internal event loop (the C-function waitFd()) is called. I see. I'm wondering whether the 'fifo' is really necessary? The fifo is there to defer requests for chopsticks when the philosopher is hungry or eating. Do you have any other mechanism in mind? Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: IPC
Hi Alex, The fifo is there to defer requests for chopsticks when the philosopher is hungry or eating. Do you have any other mechanism in mind? As the tell - hear mechanism is a pipe, it behaves like a fifo. So I would expect that this would suffice. Not due to the logic of the algorithm, e.g. when the philosopher is hungry, he must hand over dirty forks immediately but not clean forks. He must remember that he was asked for it and hand it over when he is finished. I should explain that the internal tell - hear mechanism maintains dynamic buffers for each parent/child connection, to avoid blocking if a child should not fetch (hear) its data fast enough. This way, the standard limitation of the PIPE_BUF size is avoided. That's good to know. Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
'match' side-effect interacts with '_htSet'
Hi Alex, I have a web application which displays a page by loading an allowed *.l file. In that *.l file, I use 'match' with @Z pattern var and then process and display the result. The var @Z is set by 'match' to whatever was matched and displaying the data for the first time works fine. However, displaying the data in that app session for the second time fails with bad suffix error as the var @Z in '_htSet' was rebound by my call to 'match'. It looks like there is some unwanted interaction between my application code and lib/http.l code, some vars from lib/http.l seem to be leaking to the user code. Is that desirable? Should not those variables be uninterned, e.g. @Z? Thanks, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: +BubbleButton does not update chart when javascript enabled
Hi Alex, I pasted it into app/role.l, changed 'it' to 'usr', '+It' to '+User' and (choIt ..) to (choDlg ..), and it works just fine. I found it works with the standard deployment with httpGate but does not work for me when running behind a web server (nginx). Everything seems to be working fine except when I press the 'Edit' button and then +BubbleButton (for example, but it seems it can be other kind of button too, e.g. [+] button), the client side javascript code should submit the form first and then carry on with ajax requests for other button presses (as I understand it). However, the form does not seem to be submitted for the first button press in my case even though the response from the server is: Response 1 T 0 which I guess means submit the form? The form is not submited when the button is pressed first (or more time). If I then press the update link, the buttons start working fine so I guess the problem is really that the form is not submitted from the javascript ajax callback when it should be. Not sure why it is different when running behind a web server/proxy instead of httpGate. The following nginx configuration should be equivalent to httpGate: location ~ ^/[0-9]+ { if ($request_filename ~* /([0-9]+)/?(.*)) { set $gate http://127.0.0.1:$1/$2$is_args$args; } proxy_set_header Host $host; proxy_set_header Gate $scheme $remote_addr; proxy_pass$gate; } I actualy use a fallback server to internaly redirect the proxy when the application on the port (which was tried first time) is not running: location ~ ^/[0-9]+ { if ($request_filename ~* /([0-9]+)/?(.*)) { set $gate http://127.0.0.1:$1/$2$is_args$args; } proxy_set_header Host $host; proxy_set_header Gate $scheme $remote_addr; proxy_pass$gate; error_page502 = /fallback$uri; } location ~ ^/fallback/[0-9]+ { internal; proxy_set_header Host $host; proxy_set_header Gate $scheme $remote_addr; proxy_passhttp://127.0.0.1:1234; # fallback server on port 1234 } This way the user does not get an error but is redirected to the right login page of the correct application, if possible. I put the *Port1 (the application login page port) in the session id so that nothing else in picolisp had to be changed, the javascript part seems to be using the right session id anyway so this should not be the problem. I am wondering what other things could influence submitting the form from the ajax callback? (I'll probably have to debug the javascript code or switch *JS off for now.) Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: +BubbleButton does not update chart when javascript enabled
Hi Alex, it looks like it should not be getting 1 T 0 from the server but only T. Not sure why is that... Could you please describe the form.js protocol briefly? Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: +BubbleButton does not update chart when javascript enabled
)) ) (let Str (or (eval (: alt)) (eval (: lbl))) ((if (: img) image submit) Str Var T (: js)) ) ) ) ) (dm act () (and (able) (eval (: act))) ) (class +JS) (dm T @ (=: js T) (pass extra) ) (class +Auto +JS) # auto (dm T (Fld Exe . @) (=: auto (cons Fld Exe)) (pass super) ) (dm act () (when (able) (=: home auto (cons (eval (car (: auto))) (eval (cdr (: auto))) ) ) (extra) ) ) (class +DnButton +Tiny +Rid +JS +Able +Button) (dm T (Exe Lbl) (super (list '= '(length (chart 'data)) (list '+ Exe '(chart 'ofs))) (or Lbl ) (list 'scrl Exe) ) ) (class +UpButton +Tiny +Rid +JS +Able +Button) (dm T (Exe Lbl) (super '( (chart 'ofs) 1) (or Lbl ) (list 'scrl (list '- Exe)) ) ) (class +GoButton +Tiny +Rid +JS +Able +Button) (dm T (Exe Lbl) (super (list 'and (list '= '(length (chart 'data)) Exe) (list ' '(chart 'ofs) Exe) ) Lbl (list 'goto Exe) ) ) (de scroll (N Flg) (when Flg (gui '(+Tip +GoButton) ,Go to first line 1 |) ) (gui '(+Tip +UpButton) ,Scroll up one page N ) (gui '(+Tip +UpButton) ,Scroll up one line 1) (gui '(+Tip +DnButton) ,Scroll down one line 1) (gui '(+Tip +DnButton) ,Scroll down one page N ) (when Flg (gui '(+Tip +GoButton) ,Go to last line (list '- '(length (chart 'data)) (dec N)) | ) ) ) # Delete row (class +DelRowButton +Tiny +JS +Able +Tip +Button) # exe del (dm T (Exe Txt) (=: exe Exe) (=: del Txt) (super '(nth (: chart 1 data) (row)) ,Delete row x '(if (or (: home del) (not (curr))) (_delRow) (alert (env 'Fld This) (span 'ask (ht:Prin (if (get Fld 'del) (with Fld (eval @)) ,Delete row? ) ) ) (--) (yesButton '(with Fld (=: home del T) (_delRow (: exe)) ) ) (noButton) ) ) ) ) (de _delRow (Exe) (eval Exe) (set (: chart 1) (remove (row) (: chart 1 data))) ) # Move row up (class +BubbleButton +Tiny +JS +Able +Tip +Button) (dm T () (super '( (: chart 2) 1) ,Shift row up \^ '(let L (: chart 1 data) (set (: chart 1) (conc (cut (row -2) 'L) (cons (cadr L)) (cons (car L)) (cddr L) ) ) ) ) ) (class +ClrButton +JS +Tip +Button) # clr (dm T (Lbl Lst . @) (=: clr Lst) (pass super ,Clear all input fields Lbl '(for X (: clr) (if (atom X) (clr (field X)) (set (field (car X)) (eval (cdr X))) ) ) ) ) (class +ShowButton +Button) (dm T (Flg Exe) (super ,Show (list '=: 'home 'show (lit Exe)) ) (and Flg (=: home show Exe)) ) (class +Checkbox +field) # lbl # ([lbl]) (dm T (Lbl) (=: lbl Lbl) (super) ) (dm txt (Val) (if Val ,Yes ,No) ) (dm show (Var) (showFld (check Var (not (able ) (dm set (Val Dn) (super (bool Val) Dn) ) (dm val () (bool (super)) ) (class +Radio +field) # Inited by Tomas Hlavaty kviet...@seznam.cz # grp val lbl # (grp val [lbl]) (dm T (Grp Val Lbl) (super) (=: grp (if Grp (field @) This)) (=: val Val) (=: lbl Lbl) ) (dm show (Var) (showFld (radio (cons '*Gui (: grp id)) (: val) (not (able)) ) ) ) (dm js () (pack (ht:Fmt (: val)) (= (: val) (val (: grp))) (unless (able) =) ) ) (dm set (Val Dn) (when (== This (: grp)) (super Val Dn) ) ) (class +TextField +field) # dx dy lst lbl lim align # ([dx [dy] [lbl]]) # ([lst [lbl]]) (dm T (X . @) (nond ((num? X) (=: lst X) (=: lbl (next)) ) ((num? (next)) (=: dx X) (=: lbl (arg)) ) (NIL (=: dx X) (=: dy (arg)) (=: lbl (next)) ) ) (super) (or (: dx) (: lst) (=: chg)) ) (dm show (Var) (showFld (cond ((: dy) (area (: dx) (: dy) Var (not (able))) ) ((: dx) (field (if (: align) (- (: dx)) (: dx)) Var (eval (: lim)) (not (able)) ) ) ((: lst) (let (L (mapcar val @) S (str This)) (select (if (member S L) L (cons S L)) Var (not (able)) ) ) ) (T (style (cons 'id (pack *Form '- (: id))) (span *Style (if (str This) (ht:Prin @) (nbsp)) ) ) ) ) ) ) (class +ListTextField +TextField) # split (dm T (Lst . @) (=: split Lst) (pass super) ) (dm set (Val Dn) (super (glue (car (: split)) Val) Dn) ) (dm val () (extract pack (apply split (: split) (chop (super))) ) ) # Password field (class +PwField +TextField) (dm show (Var) (showFld (passwd (: dx) Var (eval (: lim)) (not (able
Re: +BubbleButton does not update chart when javascript enabled
Hi Alex, The restriction to HTTP/1.0 has another disadvantage: It will degrade the performance of XMLHttpRequests, because it needs to open and close a separate TCP connection for each HTTP transaction. Certain operations, like scrolling in charts, are perceptibly slowed down, especially when using SSL connections. I know, you have mentioned this before in another discussion, but it is not an issue for me yet;-) Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
picoLisp and Gtk
Hi all, I updated the gtk-server interface at http://logand.com/gtk/ and added a some more complicated examples: http://logand.com/gtk/gtk-mandelbrot.l http://logand.com/gtk/gtk-gl-teapot.l Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: cookies redirect fix
Hi Alex, I'm a bit late with my reply, as I'm travelling through the south of Japan since almost two weeks, and have only infrequent (and unreliable) access to the internet. enjoy your trip then;-) ( (loc *Cookies http)) I see. To just redefine 'httpStat' in the way you suggested, there is an even more dirty way ;-) : (setq httpStat (insert 6 httpStat (assoc 'for httpHead))) That's both beautiful and ugly at the same time:-o Thanks for your ideas, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Cookie question
Hi Henrik, (cookie 'uid Uid) (setq *Cookies (cons 'uid Uid)) (redirect (pack *Domain @desktop))) The problem is that 'redirect' does not set the cookies (see the previous discussion and @lib/http.l code for 'redirect', 'httpStat' and 'httpHead'). Also, you do not need (setq *Cookies (cons 'uid Uid)) because *Cookies is only for cookies received, not the ones being sent (*Cookies internal to @lib/http.l is used for that which is set by 'cookies' function). I don't know if something new has been introduced but I've been following the discussions and I don't think so, but I'm not 100% sure, hence this post. nothing has been changed in this area as far as I am aware. We discussed this issue recently (see cookies redirect fix thread) but there did not seem much demand for fixing this in the official distribution (I seemed to be the only one using cookies;-). Maybe now is the right time to go ahead with the fix? I would suggest putting this in @lib/http.l: (de cookie @ (let At (rest) (if (assoc (car At) *Cookies) (con @ (cdr At)) (push '*Cookies At) ) ) ) (de httpCookie (K V P E D S H) (prin Set-Cookie: (ht:Fmt K) = (ht:Fmt V) ; path= (or P /)) (when E (prin ; expires= @)) (when D (prin ; domain= @)) (when S (prin ; secure)) (when H (prin ; HttpOnly)) (prinl) ) (de httpCookies () (mapc httpCookie *Cookies) ) (redef httpHead (Typ Upd File Att) (http1 Typ Upd File Att) (and *Chunked (prinl Transfer-Encoding: chunked^M)) (httpCookies) (prinl ^M) ) (redef httpStat (N Str . @) (prinl HTTP/1.0 N Str ^M) (prinl Server: PicoLisp^M) (while (args) (prinl (next) ^M) ) (prinl Content-Type: text/html^M) (httpCookies) (prinl Content-Length: (+ 68 (length N) (* 2 (length Str))) ^M) (prinl ^M) (prinl HTML) (prinl HEADTITLE N Str /TITLE/HEAD) (prinl BODYH1 Str /H1/BODY) (prinl /HTML) ) If Alex agrees, I can send the fix to be included in the official distribution, otherwise you can use the patching code from the cookies redirect fix thread. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Status of 64 picoLisp
Hi Alex, However, I am aware of the fact that in picoLisp the printing of numeric results is often much more expensive than the actual calculations, due to the conversions necessary for the decimal base. If I take out the final (prinl Y) from gmp-test2.l, I get: It makes a considerable difference. Interesting, it does not seem to make much difference with the C version when I take the final 'printf' out of the C code. So I believe that for practical uses, where processing does not consist solely of arithmetics, the overhead will be negligible, and not justify extra efforts. Yes, I haven't got any issues with bignum performance in picolisp;-) We are not using picolisp to compute Mersenne prime numbers http://www.mersenne.org/ after all:-D Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Cookie question
Hi Alex, ok, ok, now as there is such a _huge_ demand for cookies ;-) :-D I was always reluctant to include any cookie support at all, as the http and form frameworks are designed to work without them Fair enough. I privately consider cookies a bad design issue. I agree to some extent. However, carrying session id in the url is bad for other reasons (e.g. security...) and there isn't any decent http authentication protocol available so using a cookie can be a dirty workaround for tracking a session. Are you sure that this works as expected? 'mapc' with a function of seven arguments expects seven lists as arguments. Sorry, it was an idea waiting for feedback about demand, not production quality code:-( I have put this into the current testing version. Please let me know if it is all right. Thanks a lot. Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Some input/output problems
Hi Henrik, any example of using the normal curl to handle redirects would be welcome so I don't have to go via php. $ man curl suggests that using the -L option will cause curl to use the redirected url, e.g.: curl -s -L http://feeds.feedburner.com/codinghorror works. However, it again returns the original latin1 encoding: (in (list curl -s -L http://feeds.feedburner.com/codinghorror;) (till)) To convert from latin1 to utf8, I would pipe the output to iconv utility, something like: sh -c curl ... | iconv ... Hope it helps, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Subscribe
Hello Tomas Hlavaty t...@logand.com :-) You are now subscribed Changing address -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
collect and db difference?
Hi Alex, is this expected behaviour? : (collect 'usr '+Pat *U 'doc *D) -(NIL) : (db 'usr '+Pat *U 'doc *D) -{Bg} I would expect 'collect' returning ({Bg}). Or could it be some problem with my ER schema? (class +Pat +Entity) (rel doc (+Ref +Link) NIL (+Doc)) (rel usr (+Ref +Link) NIL (+Usr)) Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
(pack (intern NIL)) bug?
Hi Alex, is there a function to look up an interned symbol? 'intern' does not seem to be doing that: : (intern NIL) - NIL : (pack NIL) - NIL : (pack (intern NIL)) - NIL : This behaviour seems a bit strange to me. I would expect (pack (intern NIL)) to return NIL... Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: (pack (intern NIL)) bug?
Hi Alex, The question is: What is the correct way? I am writing my own sexp reader which is safe against malicious input, i.e. it does not call eval (the escape chars like ` are not understood). : (intern 123) - 123 : (+ @ 7) 123 -- Number expected I thought I could use (intern (till ^I^M^J()\ T)) to read in atoms but obviously it's not possible because intern does not understand numbers. 'any' seems to be using the picolisp reader so I cannot use that: : (intern 12`+453) - 12\`+453 : (any 12`+453) - 12 is not the same. Looks I need to make more effort and determine the type of the atom before feeding it to 'intern' or 'format'. In general, 'intern' should do what it is supposed to do, and intern a symbol. When the user chooses to intern a symbol with a strange name like 123 it is his choice. I suppose that's reasonable. Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
'chain' and atom argument
Hi Alex, (chain 'lst ..) - lst is there a reason 'chain' does not work with atoms? : (make (link 1)) - (1) : (make (link 1) (chain 2)) - (1) : (make (link 1) (chain (cons 2 3))) - (1 2 . 3) : (make (link 1) (chain 2) (chain (cons 3 4))) - (1 3 . 4) : (make (link 1) (chain 2) (chain (cons 3 4)) (chain (cons 5 6))) - (1 3 5 . 6) I would expect: : (make (link 1) (chain 2)) - (1 . 2) I guess this is not currently achievable using 'make'? Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: 'chain' and atom argument
Hi Alex, I would expect: : (make (link 1) (chain 2)) - (1 . 2) In this respect, 'chain' is analogous, it simply processes the cell arguments, and does not preserve any CDRs, as it cannot not know if later more elements will be added with 'link' or 'chain'. Yes, I think the behaviour above is quite simple, natural, logical, practical and efficient:-D I guess this is not currently achievable using 'make'? The following would do that : (make (link 1) (conc (made) 2)) - (1 . 2) but is rather inefficient because it traverses the whole (made) list to concatenate the '2'. I see. Thanks. I guess that destructively messing with the make environment in general breaks it, if it is not the last operation on it: : (make (link 1) (conc (made) 2) (chain (conc 3 4))) - (1 . 2) Anyway, this seems to be a useful feature. It basically just needs the exchange of two lines in 'doChain()' in src/subr.c: do { if (isCell(y = EVAL(car(x { *Env.make = y; do - do { *Env.make = y = EVAL(car(x)); if (isCell(y)) { do Should I keep that change? Yes please;-) Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: collect and db difference?
Hi Alex, 1. You could use the Pilog functions 'pilog' or 'solve' and 'select' 2. The most efficient way is to use an '+Aux' key. This generates a combined key in addition to the two indexes for 'usr' and 'doc'. Thank you for the examples, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: parsing input
Hi Randall, I read a line, which looks something like: 01/02/2009 30.00400.00tRandall Dow in which the fields are separated by a varying number of spaces. That gets put into L, and then I delete the NILs that come from multiple spaces. Do you have a suggestion for a better way than this: (let L (mapcar pack (split (line) )) (loop (NIL (memq NIL L)) (setq L (delete NIL L)) ) not sure how do you use the parsed fields but what about something like: (use (@A @B @C @D @E) (when (match '(@A @B @C @D @E) (line)) (mapcar clip (list @A @B @C @D @E)) ) ) will return the five fields in a list without the delimiting spaces. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
postscript utf8
Hi Alex, current @lib/ps.l does not deal with utf well enough and comes with a workaround involving bin/lat1. Bellow is a prototype code for displaying utf characters in poscript insired by https://mailman.research.att.com/pipermail/graphviz-interest/2004q2/001407.html # *PsGlyph (in glyphlist.txt (until (eof) (let L (line) (unless (= # (car L)) (let (I (index ; L) G (pack (head (- I 1) L)) H (hex (pack (tail (- I) L))) ) (let A (assoc H *PsGlyph) (if A (con A (cons G (cdr A))) (push '*PsGlyph (list H G)) ) ) ) ) ) ) ) (de psString (S) (prin () (for X (if (atom S) (chop S) S) (let C (char X) (cond (( C 32) # control char (case X (^M (prin \\r)) (^J (prin \\n)) (^I (prin \\t)) ) ) ((= 32 C 126) # ascii (prin (case X (\\ ) (( \\() () \\)) (T X) ) ) ) ((= 130 C) # utf (let? L (cdr (assoc C *PsGlyph)) (prinl )) (prin [) (for G L (prin / G) ) (prinl ] {glyphshow} forall) (prin () ) ) (T (prinl )) (prinl /.notdef glyphshow) (prin () ) ) ) ) (prinl )) ) (de psLabel (X Y Text Center) (if Center (prog # http://www.postscript.org/FAQs/language/node67.html (prinl X Y moveto) (psString Text) (prinl dup stringwidth pop 2 div neg 0 rmoveto show) ) (prinl newpath X Y moveto) (psString Text) (prinl show) ) ) glyphlist.txt from adobe http://www.adobe.com/devnet/opentype/archives/glyphlist.txt is needed and has to be converted to utf8. I am not sure about Japanese but it works with Czech;-) However, centering unicode/non-ascii characters does not work. Any ideas how to achieve that? Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Forgot the code again!
Hi Alex, the usage of 'idx' in my implementation had a serious flaw: Because the unicod values in glyphlist.txt are partially sorted, we get a highly imbalanced tree: Why does inserting and removing using 'idx' require manual rebalancing using 'balance' in the first place? I would expect insert and remove to keep the tree balanced which should be more efficient than rebalancing the whole tree. It seems to me that to keep key/value pairs in the tree, the key must be a symbol holding that value. What if I want the keys to be numbers or pairs? Then, to avoid the conflict with multiple values, I simply ignored all lines with multiple values, by checking with (member L). Does this sound reasonable? In this way the first entry in lib/glyphlist.txt will win. At least this is the simplest solution ;-) I would actually prefer keeping the complete mapping as in the original code I sent. That would allow searching through the fonts for the right glyph. I see. For now I would like to stick with the simple version to see how it works out. I have to be very careful, as lib/ps.l is used heavily in several business applications. Fair enough. In the long-term, wouldn't it be better to put the glyph related stuff into @lib/glyph.l and keep access to the full glyph - codepoint mapping? # *Glyph *Codepoint (in lib/glyphlist.txt (use (L N) (while (setq L (line)) (unless (= '# (car L)) (setq L (split L ';) N (pack (car L))) (for C (mapcar '((X) (char (hex (pack X (split (cadr L) )) (if (idx '*Glyph C) (push (car @) N) (set C (list N)) (idx '*Glyph C T) ) (if (idx '*Codepoint N) (push (car @) C) (set N (list C)) (idx '*Codepoint N T) ) ) ) ) ) ) (balance '*Glyph (sort (idx '*Glyph))) (balance '*Codepoint (sort (idx '*Codepoint))) (de glyph (C) (val (car (idx '*Glyph C))) ) (de codepoint (C) (val (car (idx '*Codepoint C))) ) I prefer 'glyph' returning NIL instead of .notdef. OK, me too. Is it not necessary? It would be good to keep .notdef in the output postscript file so we could use (or (glyph X) .notdef) or (or (car (glyph X)) .notdef) in case 'glyph' returns a list. (I don't think I want to output .notdef in pdf.) Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: postscript utf8
Hi Alex, them into a lib/head.ps header file. This file is now included from ... I just downloaded the testing version and can't find it there? Hmm, it should be there: $ tar tvfz picoLisp.tgz |grep head.ps -rw-r--r-- abu/abu 641 2009-05-05 15:19 lib/head.ps I see the problem, it is not under the picoLisp directory: -rw-r--r-- abu/abu1627 picoLisp/lib/gcc.l -rw-r--r-- abu/abu 78200 lib/glyphlist.txt -rw-r--r-- abu/abu 641 lib/head.ps -rw-r--r-- abu/abu 424 picoLisp/lib/heartbeat.l Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: pdf generator
Hi Alex, I think it is wiser and much easier to write a separate C library for specialized I/O. you convinced me:-) Thanks, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: 'idx' and balancing
Hi Alex, 'idx' is deliberately designed in this way. It does only the basic, straight-forward binary tree operations. This can be quite fast, because balancing operations (or using self-balancing trees like splay trees) introduce additional overhead. And - except for pathological situations where all data are inserted in sequentially ascending or descending order - this performs surprisingly well. interesting. 'balance' does not re-balance the tree. Instead, it builds an optimally balanced tree, only once in the beginning. This is most useful in situation like we had with this unicode index, which is not modified thereafter but only used for rapid lookup. So 'idx' is usually used with data that don't change? How does indexing in the database work for example? BTW, there is also an external program @bin/balance which does the same by reading from a file. It can typically be used as: (in (list bin/balance -sort MyFile) (while (line) .. (The -sort is not needed when the file is already sorted) I saw the proram, but I haven't had a chance to find out what for, when and how to use it yet;-) If you insert cells or lists with the key in the CAR, you can use 'lup' to lookup the data. I see, that's what I was thinking about. the typical key-value situation, symbols work best, though. You can, for example, convert a numeric key to a symbol with 'format', and Is this generally prefered to using lup? Thank you, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Questions
Hi Kriangkrai, (with-xml (tag1 (@ attr1 val1) text (tag2 text) text )) If you go this route, why not something like: (with-xml (tag1 @attr1 val1 text (tag2 text) text ) ) Also, if you don't manage to hook your error handler to define the tag functions on-the-fly, you can always traverse the tree argument of 'with-xml' and replace (or define) the tag symbols with your generic tag function and then eval the whole tree. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Questions
Hi Kriangkrai, A tutorial on PicoLisp FFI would be great; with that, PicoLisp would have no shortage of libraries! ;-) not exactly a tutorial, but I have looked into this a while ago and you can find a prototype ffi generator at http://logand.com/mplisp/src/mod/ It should be fairly straitforward to understand how different types get converted between picolisp and C, e.g. http://logand.com/mplisp/src/mod/ffi.l is the ffi generator and http://logand.com/mplisp/src/mod/gl.ffi is sample ffi binding for OpenGL. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe
Re: Questions
Hi Kriangkrai, Because with (@ attr1 val1 ...), you can retrive the attributes by just using (assoc '@ sxml). Is there any advantage of using your syntax @attr1 val1 ...? advantage is that you don't have to put the attributes in a list manually, your 'with-xml' function can do that for you;-) Also, if you don't manage to hook your error handler to define the tag functions on-the-fly, you can always traverse the tree argument of 'with-xml' and replace (or define) the tag symbols with your generic tag function and then eval the whole tree. Good idea. Thanks :-) On the other hand, 'with-xml' will then waste lot's of time traversing all those trees (unless you get somehow clever, memoize the replaced tree) so I would recommend to use @lib/xhtml.l if you use 'built-in' html components or @lib/xml.l if your xml tags can be anything. With your original approach, there is still danger Henrik emphasized, that you can overshadow existing functions. The libraries above do not have this problem. Cheers, Tomas -- UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe