viewcvs.cgi/tests/overloading.cd

type Person = FPerson | MPerson;; 
type FPerson = <person gender = ['F'] >[ Name Children ];; 
type MPerson = <person gender="M">[ Name Children];; 
type Children = <children>[Person*];; 
type Name = <name>[ PCDATA ];;

type Man = <man>[ Name Sons Daughters ];;
type Woman = <woman>[ Name Sons Daughters ];;
type Sons = <sons>[ Man* ];;
type Daughters = <daughters>[ Woman* ];;

let fun sort (MPerson -> Man ; FPerson -> Woman)
   <person gender=g>[ n <children>[(mc::MPerson | fc::FPerson)*] ] ->
       let tag = match g with "F" -> `woman | "M" -> `man in
       let s = map mc with x -> sort x in
       let d = map fc with x -> sort x in       
           <(tag)>[ n  <sons>s  <daughters>d ] 
in 
let base : Person = 
<person gender="F">[ 
  <name>"Veronique"
  <children>[ 
    <person gender="F">[
      <name>"Ilaria"
      <children>[]
     ]
  ]
]
in sort 3;;
1	type Person = FPerson \| MPerson;;
2	type FPerson = <person gender = ['F'] >[ Name Children ];;
3	type MPerson = <person gender="M">[ Name Children];;
4	type Children = <children>[Person*];;
5	type Name = <name>[ PCDATA ];;
6
7	type Man = <man>[ Name Sons Daughters ];;
8	type Woman = <woman>[ Name Sons Daughters ];;
9	type Sons = <sons>[ Man* ];;
10	type Daughters = <daughters>[ Woman* ];;
11
12	let fun sort (MPerson -> Man ; FPerson -> Woman)
13	<person gender=g>[ n <children>[(mc::MPerson \| fc::FPerson)*] ] ->
14	let tag = match g with "F" -> `woman \| "M" -> `man in
15	let s = map mc with x -> sort x in
16	let d = map fc with x -> sort x in
17	<(tag)>[ n <sons>s <daughters>d ]
18	in
19	let base : Person =
20	<person gender="F">[
21	<name>"Veronique"
22	<children>[
23	<person gender="F">[
24	<name>"Ilaria"
25	<children>[]
26	]
27	]
28	]
29	in sort 3;;