viewcvs.cgi/tests/overloading.cd

type Person = FPerson | MPerson;; 
type FPerson = <person gender = "F" >[ Name Children (Tel | Email)?];; 
type MPerson = <person gender="M">[ Name Children (Tel | Email)?];; 
type Children = <children>[Person*];; 
type Name = <name>[ PCDATA ];;
type Tel = <tel kind=?"home"|"work">['0'--'9'+ '-' '0'--'9'+];;
type Email = <email>[PCDATA '@' PCDATA];;

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

let fun sort (MPerson -> Man ; FPerson -> Woman)
   <person gender=g>[ <name>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) name=n>[ <sons>s  <daughters>d ] 
;; 
let base : Person = 
<person gender="M">[ 
  <name>"Claude"
  <children>[ 
    <person gender="F">[
      <name>"Véronique"
      <children>[
        <person gender="F">[
          <name>"Ilaria"
          <children>[] 
        ] 
      ] 
    <tel> "314-1592654"
    ]
  ] 
  <tel kind="home"> "271-828182"
]
;;

sort base;;


let fun contact(Person->String)
 | <person>[ _ _ ((<tel kind="work"> x) | (<email> x) | (<tel kind="home"> x))] -> x
 | _ ->"no contact";;


(* compilation efficace avec _ a la place de person *)

let fun name (Person | Man | Woman -> String)
  <person>[ <name>n ; _ ] 
| <_ name=n>_ -> n;;


name base;;
name (sort base);;
1	type Person = FPerson \| MPerson;;
2	type FPerson = <person gender = "F" >[ Name Children (Tel \| Email)?];;
3	type MPerson = <person gender="M">[ Name Children (Tel \| Email)?];;
4	type Children = <children>[Person*];;
5	type Name = <name>[ PCDATA ];;
6	type Tel = <tel kind=?"home"\|"work">['0'--'9'+ '-' '0'--'9'+];;
7	type Email = <email>[PCDATA '@' PCDATA];;
8
9	type Man = <man name=String>[ Sons Daughters ];;
10	type Woman = <woman name=String>[ Sons Daughters ];;
11	type Sons = <sons>[ Man* ];;
12	type Daughters = <daughters>[ Woman* ];;
13
14	let fun sort (MPerson -> Man ; FPerson -> Woman)
15	<person gender=g>[ <name>n <children>[(mc::MPerson \| fc::FPerson)*]; _] ->
16	let tag = match g with "F" -> `woman \| "M" -> `man in
17	let s = map mc with x -> sort x in
18	let d = map fc with x -> sort x in
19	<(tag) name=n>[ <sons>s <daughters>d ]
20	;;
21	let base : Person =
22	<person gender="M">[
23	<name>"Claude"
24	<children>[
25	<person gender="F">[
26	<name>"Véronique"
27	<children>[
28	<person gender="F">[
29	<name>"Ilaria"
30	<children>[]
31	]
32	]
33	<tel> "314-1592654"
34	]
35	]
36	<tel kind="home"> "271-828182"
37	]
38	;;
39
40	sort base;;
41
42
43
44	let fun contact(Person->String)
45	\| <person>[ _ _ ((<tel kind="work"> x) \| (<email> x) \| (<tel kind="home"> x))] -> x
46	\| _ ->"no contact";;
47
48
49
50
51	(* compilation efficace avec _ a la place de person *)
52
53	let fun name (Person \| Man \| Woman -> String)
54	<person>[ <name>n ; _ ]
55	\| <_ name=n>_ -> n;;
56
57
58	name base;;
59	name (sort base);;