Re: Subscribe

2008-04-10 Thread Tomas Hlavaty
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

2008-07-27 Thread Tomas Hlavaty
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

2008-07-27 Thread Tomas Hlavaty
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

2008-08-06 Thread Tomas Hlavaty
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

2008-08-08 Thread Tomas Hlavaty
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?

2008-08-20 Thread Tomas Hlavaty
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?

2008-08-20 Thread Tomas Hlavaty
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?

2008-08-21 Thread Tomas Hlavaty
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?

2008-08-23 Thread Tomas Hlavaty
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

2008-09-03 Thread Tomas Hlavaty
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?

2008-09-15 Thread Tomas Hlavaty
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?

2008-09-17 Thread Tomas Hlavaty
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?

2008-09-17 Thread Tomas Hlavaty
Hi Alex,

thank you for great explanation!

Tomas
-- 
UNSUBSCRIBE: mailto:[EMAIL PROTECTED]


deploying multiple picolisp web applications

2008-09-26 Thread Tomas Hlavaty
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

2008-09-26 Thread Tomas Hlavaty
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

2008-10-03 Thread Tomas Hlavaty
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

2008-10-08 Thread Tomas Hlavaty
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

2008-10-08 Thread Tomas Hlavaty
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

2008-10-08 Thread Tomas Hlavaty
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

2008-10-08 Thread Tomas Hlavaty
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

2008-10-08 Thread Tomas Hlavaty
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

2008-10-08 Thread Tomas Hlavaty
Hi Alex,

thanks for the explanation!

Tomas
-- 
UNSUBSCRIBE: mailto:[EMAIL PROTECTED]


Re: Asyncronous IO

2008-10-09 Thread Tomas Hlavaty
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

2008-10-10 Thread Tomas Hlavaty
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

2008-10-10 Thread Tomas Hlavaty
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

2008-10-10 Thread Tomas Hlavaty
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

2008-10-12 Thread Tomas Hlavaty
 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.

2008-10-13 Thread Tomas Hlavaty
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

2008-10-15 Thread Tomas Hlavaty
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

2008-10-15 Thread Tomas Hlavaty
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

2008-10-16 Thread Tomas Hlavaty
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

2008-10-16 Thread Tomas Hlavaty
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

2008-10-18 Thread Tomas Hlavaty
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

2008-10-19 Thread Tomas Hlavaty
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

2008-10-20 Thread Tomas Hlavaty
 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

2008-10-21 Thread Tomas Hlavaty
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

2008-10-22 Thread Tomas Hlavaty
 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

2008-10-22 Thread Tomas Hlavaty
 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

2008-10-22 Thread Tomas Hlavaty
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

2008-10-24 Thread Tomas Hlavaty
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

2008-10-24 Thread Tomas Hlavaty
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'

2008-10-24 Thread Tomas Hlavaty
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

2008-10-26 Thread Tomas Hlavaty
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'

2008-10-26 Thread Tomas Hlavaty
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

2008-11-21 Thread Tomas Hlavaty
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

2008-11-22 Thread Tomas Hlavaty
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

2008-11-23 Thread Tomas Hlavaty
 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

2008-11-23 Thread Tomas Hlavaty
 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

2008-11-23 Thread Tomas Hlavaty
Hi Alex,

thanks for fixing it.

Tomas
-- 
UNSUBSCRIBE: mailto:[EMAIL PROTECTED]


Re: http server hangs on post without enctype=multipart/form-data

2008-11-23 Thread Tomas Hlavaty
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

2008-11-25 Thread Tomas Hlavaty
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

2008-11-26 Thread Tomas Hlavaty
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

2008-11-26 Thread Tomas Hlavaty
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

2008-11-26 Thread Tomas Hlavaty
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

2008-11-27 Thread Tomas Hlavaty
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

2008-12-23 Thread Tomas Hlavaty
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

2009-01-02 Thread Tomas Hlavaty
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

2009-01-02 Thread Tomas Hlavaty
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

2009-01-07 Thread Tomas Hlavaty
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

2009-01-07 Thread Tomas Hlavaty
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

2009-01-07 Thread Tomas Hlavaty
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

2009-01-07 Thread Tomas Hlavaty
 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

2009-01-07 Thread Tomas Hlavaty
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

2009-01-17 Thread Tomas Hlavaty
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

2009-01-19 Thread Tomas Hlavaty
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

2009-01-19 Thread Tomas Hlavaty
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

2009-01-20 Thread Tomas Hlavaty
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

2009-01-21 Thread Tomas Hlavaty
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

2009-01-31 Thread Tomas Hlavaty
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

2009-02-02 Thread Tomas Hlavaty
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

2009-02-07 Thread Tomas Hlavaty
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

2009-02-08 Thread Tomas Hlavaty
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

2009-02-09 Thread Tomas Hlavaty
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'

2009-02-16 Thread Tomas Hlavaty
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

2009-02-20 Thread Tomas Hlavaty
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

2009-02-20 Thread Tomas Hlavaty
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

2009-02-21 Thread Tomas Hlavaty
)) )
 (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

2009-02-21 Thread Tomas Hlavaty
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

2009-02-26 Thread Tomas Hlavaty
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

2009-03-21 Thread Tomas Hlavaty
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

2009-04-02 Thread Tomas Hlavaty
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

2009-04-02 Thread Tomas Hlavaty
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

2009-04-02 Thread Tomas Hlavaty
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

2009-04-04 Thread Tomas Hlavaty
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

2009-04-20 Thread Tomas Hlavaty
Hello Tomas Hlavaty t...@logand.com :-)
You are now subscribed


Changing address
-- 
UNSUBSCRIBE: mailto:picol...@software-lab.de?subject=unsubscribe


collect and db difference?

2009-04-21 Thread Tomas Hlavaty
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?

2009-04-21 Thread Tomas Hlavaty
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?

2009-04-22 Thread Tomas Hlavaty
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

2009-04-22 Thread Tomas Hlavaty
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

2009-04-22 Thread Tomas Hlavaty
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?

2009-04-22 Thread Tomas Hlavaty
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

2009-04-24 Thread Tomas Hlavaty
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

2009-04-25 Thread Tomas Hlavaty
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!

2009-05-06 Thread Tomas Hlavaty
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

2009-05-06 Thread Tomas Hlavaty
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

2009-05-07 Thread Tomas Hlavaty
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

2009-05-07 Thread Tomas Hlavaty
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

2009-05-11 Thread Tomas Hlavaty
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

2009-05-12 Thread Tomas Hlavaty
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

2009-05-12 Thread Tomas Hlavaty
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


  1   2   3   >