type Doc = <doc>Text;; type Text = [ (Char | (Letter+ ' '* Note))* ];; type Letter = 'a'--'z' | 'A'--'Z';; type Note = <note>[ PCDATA ];; type Flow = [ (Char | <ref no=Int>[ PCDATA ])* ];; type Notes = [ <note no=Int>[ PCDATA ]* ];; type Result = <doc>[ <body>Flow <notes>Notes ];; let fun format (<doc>s : Doc) : Result = let (body,notes) = text (s,1) in <doc>[ <body>body <notes>notes ];; let fun text ( (Text,Int) -> (Flow,Notes) ) | ([ pre::Char*? (word::Letter+ ' '* <note>n); rem ], count) -> let (body,notes) = text (rem, count + 1) in (pre @ [<ref no=count>word] @ body, [<note no=count>n] @ notes) | (body,_) -> (body, []);; match load_xml "tests/notes.xml" with | x & Doc -> format x | _ -> raise "Invalid input document";;
