viewcvs.cgi/tests/notes.cd

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";;
1	type Doc = <doc>Text;;
2	type Text = [ (Char \| (Letter+ ' '* Note))* ];;
3	type Letter = 'a'--'z' \| 'A'--'Z';;
4	type Note = <note>[ PCDATA ];;
5
6	type Flow = [ (Char \| <ref no=Int>[ PCDATA ])* ];;
7	type Notes = [ <note no=Int>[ PCDATA ]* ];;
8	type Result = <doc>[ <body>Flow <notes>Notes ];;
9
10	let fun format (<doc>s : Doc) : Result =
11	let (body,notes) = text (s,1) in
12	<doc>[ <body>body <notes>notes ];;
13
14	let fun text ( (Text,Int) -> (Flow,Notes) )
15	\| ([ pre::Char? (word::Letter+ ' ' <note>n); rem ], count) ->
16	let (body,notes) = text (rem, count + 1) in
17	(pre @ [<ref no=count>word] @ body,
18	[<note no=count>n] @ notes)
19	\| (body,_) -> (body, []);;
20
21	match load_xml "tests/notes.xml" with
22	\| x & Doc -> format x
23	\| _ -> raise "Invalid input document";;