ast.ml 4.3 KB
Newer Older
1
2
3
(*  Abstract syntax as produced by the parsed *)

open Location
4
open Ident
5
6
7
8
9
10
11
12
13
14

type pprog = pmodule_item list

and pmodule_item = pmodule_item' located
and pmodule_item' =
  | TypeDecl of string * ppat
  | PatDecl of string * ppat
  | FunDecl of abstr
  | LetDecl of ppat * pexpr
  | EvalStatement of pexpr
15
16
17
18
  | Debug of debug_directive
and debug_directive =
  [ `Filter of ppat * ppat
  | `Accept of ppat
19
20
  | `Compile of ppat * ppat list 
  | `Normal_record of ppat
21
  | `Compile2 of ppat * ppat list
22
  | `Subtype of ppat * ppat
23
  ]
24

25
26
27

and pexpr = pexpr' located
and pexpr' = 
28
  | Forget of pexpr * ppat    
29
  (* CDuce is a Lambda-calculus ... *)
30
  | Var of id
31
32
33
34
35
36
  | Apply of pexpr * pexpr
  | Abstraction of abstr
      
  (* Data constructors *)
  | Cst of Types.const
  | Pair of pexpr * pexpr
37
  | Xml of pexpr * pexpr
38
  | RecordLitt of pexpr label_map
39
40
      
  (* Data destructors *)
41
  | Op of string * pexpr list
42
43
  | Match of pexpr * branches
  | Map of pexpr * branches
44
  | Ttree of pexpr * branches
45
46
  | Dot of pexpr* label
  | RemoveField of pexpr * label
47
48
49
50

  (* Exceptions *)
  | Try of pexpr * branches

51
52
  | MatchFail  (* internal usage *)

53
and abstr = { 
54
  fun_name : id option; 
55
56
57
58
59
60
61
62
63
64
65
66
67
68
  fun_iface : (ppat * ppat) list;
  fun_body : branches
}

and branches = (ppat * pexpr) list
    
(* A common syntactic class for patterns and types *) 

and ppat = ppat' located
and ppat' =
  | PatVar of string
  | Recurs of ppat * (string * ppat) list
  | Internal of Types.descr
  | Or of ppat * ppat
69
  | And of ppat * ppat
70
71
  | Diff of ppat * ppat
  | Prod of ppat * ppat
72
  | XmlT of ppat * ppat
73
  | Arrow of ppat * ppat
74
  | Optional of ppat
75
  | Record of bool * ppat label_map
76
77
  | Capture of id
  | Constant of id * Types.const
78
79
80
81
82
83
84
85
86
  | Regexp of regexp * ppat

and regexp =
  | Epsilon
  | Elem of ppat
  | Seq of regexp * regexp
  | Alt of regexp * regexp
  | Star of regexp
  | WeakStar of regexp
87
  | SeqCapture of id * regexp
88
 
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151

let rec equal_ppat p1 p2 =
  let p1 = p1.descr and p2 = p2.descr in
  (p1 == p2) ||
  match (p1,p2) with
    | PatVar x1, PatVar x2 -> x1 = x2
    | Internal x1, Internal x2 -> Types.equal_descr x1 x2
    | Or (x1,y1), Or (x2,y2) 
    | And (x1,y1), And (x2,y2) 
    | Diff (x1,y1), Diff (x2,y2) 
    | Prod (x1,y1), Prod (x2,y2) 
    | XmlT (x1,y1), XmlT (x2,y2) 
    | Arrow (x1,y1), Arrow (x2,y2) 
	-> (equal_ppat x1 x2) && (equal_ppat y1 y2)
    | Optional x1, Optional x2 -> equal_ppat x1 x2
    | Record (o1,r1), Record (o2,r2) ->
	(o1 == o2) && (LabelMap.equal equal_ppat r1 r2)
    | Capture x1, Capture x2 ->	x1 == x2
    | Constant (x1,y1), Constant (x2,y2) ->
	(x1 == x2) && (Types.equal_const y1 y2)
    | Regexp (x1,y1), Regexp (x2,y2) ->
	(equal_regexp x1 x2) && (equal_ppat y1 y2)
(* todo: Recurs *)
    | _ -> false
and equal_regexp r1 r2 =
  (r1 == r2) ||
  match (r1,r2) with
    | Elem x1, Elem x2 -> equal_ppat x1 x2
    | Seq (x1,y1), Seq (x2,y2)
    | Alt (x1,y1), Alt (x2,y2) -> (equal_regexp x1 x2) && (equal_regexp y1 y2)
    | Star x1, Star x2 
    | WeakStar x1, WeakStar x2 -> equal_regexp x1 x2
    | SeqCapture (x1,y1), SeqCapture (x2,y2) -> 
	(x1 == x2) && (equal_regexp y1 y2)
    | _ -> false

let rec hash_ppat p = 
  match p.descr with
    | PatVar x -> 1 + 17 * (Hashtbl.hash x)
    | Internal x -> 2 + 17 * (Types.hash_descr x)
    | Or (x,y) -> 3 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
    | And (x,y) -> 4 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
    | Diff (x,y) -> 5 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
    | Prod (x,y) -> 6 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
    | XmlT (x,y) -> 7 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
    | Arrow (x,y) -> 8 + 17 * (hash_ppat x) + 257 * (hash_ppat y)
    | Optional x -> 9 + 17 * (hash_ppat x)
    | Record (o,r) ->
	(if o then 10 else 11) + (LabelMap.hash hash_ppat r)
    | Capture x -> 12 + 17 * (Id.hash x)
    | Constant (x,y) -> 13 + 17 * (Id.hash x) + 257 * (Types.hash_const y)
    | Regexp (x,y) ->
	14 + 17 * (hash_regexp x) + 16637 * (hash_ppat y)
    | Recurs (x,l) ->
	15 + 17 * (hash_ppat x) (* todo: hash l *)
and hash_regexp = function
  | Epsilon -> 1
  | Elem x -> 2 + 17 * (hash_ppat x)
  | Seq (x,y) -> 3 + 17 * (hash_regexp x) + 257 * (hash_regexp y)
  | Alt (x,y) -> 4 + 17 * (hash_regexp x) + 257 * (hash_regexp y)
  | Star x -> 5 + 17 * (hash_regexp x)
  | WeakStar x -> 6 + 17 * (hash_regexp x)
  | SeqCapture (x,y) -> 7 + 17 * (Id.hash x) + 257 * (hash_regexp y)