overloading.cd 2.04 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12
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* ]
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 22 23 24 25 26
let fun sort2 (MPerson -> Man ; FPerson -> Woman)
   <person gender=(("F" & (tag := `woman)) | (tag := `man))>[ <name>n <children>[(mc::MPerson | fc::FPerson)*]; _] ->
       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 ] 

27

28
let base : Person = 
29
<person gender="M">[ 
30
  <name>"Claude"
31 32
  <children>[ 
    <person gender="F">[
33 34 35 36 37 38 39 40 41
      <name>"Vronique"
      <children>[
        <person gender="F">[
          <name>"Ilaria"
          <children>[] 
        ] 
      ] 
    <tel> "314-1592654"
    ]
42
  ]
43 44
];;

45

46

47
print (print_xml (sort2 base));;
48

49

50 51 52
(*

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


57 58 59 60 61 62 63 64 65 66 67 68
contact(
    <person gender="F">[
      <name>"Vronique"
      <children>[
        <person gender="F">[
          <name>"Ilaria"
          <children>[] 
        ] 
      ] 
    <tel> "314-1592654"
    ])
;;
69

70
contact base;;
71

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

74 75 76 77 78 79 80
let fun name (Person | Man | Woman -> String)
  <person>[ <name>n ; _ ] 
| <_ name=n>_ -> n;;


name base;;
name (sort base);;
81 82 83 84

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

86

87
*)