> The only problem with this code is that the body is not run in the
> parent environment, which I don't know how to fix or what problems it
> could cause.

The trick with run/eval in parent environment is used quite often in
picoLisp to avoid variable binding clashes.  I was wandering whether
it would not be better sometimes to do something like Common Lispers
do with gensyms which would avoid clashes by using fresh symbols:

(def 'w/gensym
   (let A (new)
      (fill '(A (bind (mapcar '((X) (cons X (new))) (car A))
                   (fill (cdr A) (car A)) ) )
         'A) ) )

#(w/gensym (X) . X) => $519668770
#(w/gensym (X) . (+ X 1)) => (+ $519668786 1)
#(w/gensym (X) (+ X 1)) => ((+ $519669514 1))
#(w/gensym (A) (de plus Lst (+ A B))) => ((de plus Lst (+ $519735190 B)))

'w/gensym' is like 'fill' but it uses new symbols for replacement.

(de deu A
      (let (@N (pop 'A) @A (pop 'A) @S (pop 'A) @B A)
         (macro (w/gensym @S (de @N @A . @B))) ) ) )

#(deu plus Lst (A) (+ A B)) => (de plus Lst (+ $519735363 B) )
#(deu plus (A B) (A) (+ A B)) => (de plus ($519735405 B) (+ $519735405 B) )

'deu' is like 'de' accepting a list of symbols which are unique for
that function.

The only drawback is that using fresh symbols makes debugging harder.

The final <xml> function could look like this:

(deu <xml> Lst (Lst Tag Xml Att)
   (let Tag (pop 'Lst)
      (if Tag
         (queue 'Xml
               (link Tag)
               (let Att
                     (while (and Lst (atom (car Lst)))
                        (link (cons (pop 'Lst) (eval (pop 'Lst) 1))) ) )
                  (let Xml NIL
                     (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))) )
            (run Lst)
            (if (=T Out)
               (car Xml)
               (out Out
                  (xml (car Xml)) ) ) ) ) ) )

and could be called as:

(<xml> NIL
   (<xml> hoy id 123 class 'yes
      (<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 fun "abc") ) )

(<xml> NIL "/tmp/aa"
   (<xml> hoy id 123 class 'yes

(<xml> NIL T
   (<xml> hoy id 123 class 'yes



Reply via email to