Quick and dirty SNOBOL4/Snocone DOM-like XML parser

xml.sc

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)