overloading.cd 1.77 KB
Newer Older
1
type Person = FPerson | MPerson;; 
2
3
type FPerson = <person gender = "F" >[ Name Children (Tel | Email)?];; 
type MPerson = <person gender="M">[ Name Children (Tel | Email)?];; 
4
type Children = <children>[Person*];; 
5
type Name = <name>[ PCDATA ];;
6
7
type Tel = <tel kind=?"home"|"work">['0'--'9'+ '-' '0'--'9'+];;
type Email = <email>[PCDATA '@' PCDATA];;
8

9
10
type Man = <man name=String>[ Sons Daughters ];;
type Woman = <woman name=String>[ Sons Daughters ];;
11
12
13
type Sons = <sons>[ Man* ];;
type Daughters = <daughters>[ Woman* ];;

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
20
           <(tag) name=n>[ <sons>s  <daughters>d ] 
;; 
21
let base : Person = 
22
23
<person gender="M">[ 
  <name>"Claude"
24
25
  <children>[ 
    <person gender="F">[
26
27
28
29
30
31
32
33
34
35
36
      <name>"Vronique"
      <children>[
        <person gender="F">[
          <name>"Ilaria"
          <children>[] 
        ] 
      ] 
    <tel> "314-1592654"
    ]
  ] 
  <tel kind="home"> "271-828182"
37
]
38
39
40
41
;;

sort base;;

42
43

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


48
49
50
51
52
53
54
55
56
57
58
59
contact(
    <person gender="F">[
      <name>"Vronique"
      <children>[
        <person gender="F">[
          <name>"Ilaria"
          <children>[] 
        ] 
      ] 
    <tel> "314-1592654"
    ])
;;
60

61
contact base;;
62

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

65
66
67
68
69
70
71
let fun name (Person | Man | Woman -> String)
  <person>[ <name>n ; _ ] 
| <_ name=n>_ -> n;;


name base;;
name (sort base);;
72
73
74
75

transform [ base base ] with 
        <person>[  n  <children>[Person]; _] -> [n]
  | _ -> [];;