# Quick and dirty SNOBOL4/Snocone DOM-like XML parser

struct tag {type, params, lastp, children, last, parent}
struct param {name, value}
word = SPAN("_0123456789" && &LCASE)
xml = (("<!--" && ARB && "-->") $ *ITEM(children(current),last(current) = last(current) + 1) |
       "<" && word $ *type(current = ITEM(children(current),last(current) = last(current) + 1) =
                                     tag(NULL, ARRAY(10), 0, ARRAY(10), 0, current)) &&
           ARBNO(SPAN(" ") && word $ *name(ITEM(params(current), lastp(current) = lastp(current) + 1) = param()) &&
                 ARBNO(" ") && "=" && ARBNO(" ") && ("'"|'"') $ st && BREAK(*st) $ *value(ITEM(params(current),lastp(current))) && *st) &&
       (">" | "/>" && *godown()) | "</" && word $ tag_name && ">" && *(tag_name :: type(current)) && *godown() |
       (BREAK("<") | REM) $ *ITEM(children(current),last(current) = last(current) + 1)) && (RPOS(0) | *xml)
procedure godown() {
 current = parent(current); return
}

# recursive function to produce a XML tree from a TAG data structure
procedure node_to_xml(node) i {
 if(type(node) :!: NULL) {
  node_to_xml = node_to_xml && "<" && type(node)
  for(i=1, i <= lastp(node), i=i+1)
   node_to_xml = node_to_xml && " " && name(ITEM(params(node), i)) && '="' && value(ITEM(params(node), i)) && '"'
  if(last(node) == 0)
   node_to_xml = node_to_xml && "/>"
    else
   node_to_xml = node_to_xml && ">"
 }

 for(i=1, i <= last(node), i=i+1)
  if(DATATYPE(ITEM(children(node),i)) :: "TAG")
   node_to_xml = node_to_xml && node_to_xml(ITEM(children(node),i))
    else
   node_to_xml = node_to_xml && ITEM(children(node),i)

 if(type(node) :!: NULL && last(node) > 0)
  node_to_xml = node_to_xml && "</" && type(node) && ">"
}

# TEST CODE
current = tag(NULL, NULL, NULL, ARRAY(10), 0, NULL)
'<test arg1="a1" arg2="a2">hgg<br/>jklhg<b><!-- Kommentar -->Bold text</b></test>' ? xml

test_tag = ITEM(children(current),1)
OUTPUT = type(test_tag)
OUTPUT = name(ITEM(params(test_tag),2))
OUTPUT = ITEM(children(test_tag),1)
b_tag = ITEM(children(test_tag),4)
OUTPUT = ITEM(children(b_tag),1)
OUTPUT = ITEM(children(b_tag),2)

type(test_tag) = "neu"
OUTPUT = node_to_xml(current)