blob: ab9250543c07541a0f5de80fe6491343bb815e65 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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
|
(****************************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* INRIA Rocquencourt *)
(* *)
(* Copyright 2006 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed under *)
(* the terms of the GNU Library General Public License, with the special *)
(* exception on linking described in LICENSE at the top of the Objective *)
(* Caml source tree. *)
(* *)
(****************************************************************************)
(* Authors:
* - Nicolas Pouillard: initial version
*)
(** This module is suppose to contain nils elimination. *)
module Make (Ast : Sig.Camlp4Ast) = struct
class clean_ast = object
inherit Ast.map as super;
method with_constr wc =
match super#with_constr wc with
[ <:with_constr< $ <:with_constr<>> $ and $wc$ >> |
<:with_constr< $wc$ and $ <:with_constr<>> $ >> -> wc
| wc -> wc ];
method expr e =
match super#expr e with
[ <:expr< let $rec:_$ $ <:binding<>> $ in $e$ >> |
<:expr< { ($e$) with $ <:rec_binding<>> $ } >> |
<:expr< $ <:expr<>> $, $e$ >> |
<:expr< $e$, $ <:expr<>> $ >> |
<:expr< $ <:expr<>> $; $e$ >> |
<:expr< $e$; $ <:expr<>> $ >> -> e
| e -> e ];
method patt p =
match super#patt p with
[ <:patt< ( $p$ as $ <:patt<>> $ ) >> |
<:patt< $ <:patt<>> $ | $p$ >> |
<:patt< $p$ | $ <:patt<>> $ >> |
<:patt< $ <:patt<>> $, $p$ >> |
<:patt< $p$, $ <:patt<>> $ >> |
<:patt< $ <:patt<>> $; $p$ >> |
<:patt< $p$; $ <:patt<>> $ >> -> p
| p -> p ];
method match_case mc =
match super#match_case mc with
[ <:match_case< $ <:match_case<>> $ | $mc$ >> |
<:match_case< $mc$ | $ <:match_case<>> $ >> -> mc
| mc -> mc ];
method binding bi =
match super#binding bi with
[ <:binding< $ <:binding<>> $ and $bi$ >> |
<:binding< $bi$ and $ <:binding<>> $ >> -> bi
| bi -> bi ];
method rec_binding rb =
match super#rec_binding rb with
[ <:rec_binding< $ <:rec_binding<>> $ ; $bi$ >> |
<:rec_binding< $bi$ ; $ <:rec_binding<>> $ >> -> bi
| bi -> bi ];
method module_binding mb =
match super#module_binding mb with
[ <:module_binding< $ <:module_binding<>> $ and $mb$ >> |
<:module_binding< $mb$ and $ <:module_binding<>> $ >> -> mb
| mb -> mb ];
method ctyp t =
match super#ctyp t with
[ <:ctyp< ! $ <:ctyp<>> $ . $t$ >> |
<:ctyp< $ <:ctyp<>> $ as $t$ >> |
<:ctyp< $t$ as $ <:ctyp<>> $ >> |
<:ctyp< $t$ -> $ <:ctyp<>> $ >> |
<:ctyp< $ <:ctyp<>> $ -> $t$ >> |
<:ctyp< $ <:ctyp<>> $ | $t$ >> |
<:ctyp< $t$ | $ <:ctyp<>> $ >> |
<:ctyp< $t$ of $ <:ctyp<>> $ >> |
<:ctyp< $ <:ctyp<>> $ and $t$ >> |
<:ctyp< $t$ and $ <:ctyp<>> $ >> |
<:ctyp< $t$; $ <:ctyp<>> $ >> |
<:ctyp< $ <:ctyp<>> $; $t$ >> |
<:ctyp< $ <:ctyp<>> $, $t$ >> |
<:ctyp< $t$, $ <:ctyp<>> $ >> |
<:ctyp< $t$ & $ <:ctyp<>> $ >> |
<:ctyp< $ <:ctyp<>> $ & $t$ >> |
<:ctyp< $ <:ctyp<>> $ * $t$ >> |
<:ctyp< $t$ * $ <:ctyp<>> $ >> -> t
| t -> t ];
method sig_item sg =
match super#sig_item sg with
[ <:sig_item< $ <:sig_item<>> $; $sg$ >> |
<:sig_item< $sg$; $ <:sig_item<>> $ >> -> sg
| <:sig_item@loc< type $ <:ctyp<>> $ >> -> <:sig_item@loc<>>
| sg -> sg ];
method str_item st =
match super#str_item st with
[ <:str_item< $ <:str_item<>> $; $st$ >> |
<:str_item< $st$; $ <:str_item<>> $ >> -> st
| <:str_item@loc< type $ <:ctyp<>> $ >> -> <:str_item@loc<>>
| <:str_item@loc< value $rec:_$ $ <:binding<>> $ >> -> <:str_item@loc<>>
| st -> st ];
method module_type mt =
match super#module_type mt with
[ <:module_type< $mt$ with $ <:with_constr<>> $ >> -> mt
| mt -> mt ];
method class_expr ce =
match super#class_expr ce with
[ <:class_expr< $ <:class_expr<>> $ and $ce$ >> |
<:class_expr< $ce$ and $ <:class_expr<>> $ >> -> ce
| ce -> ce ];
method class_type ct =
match super#class_type ct with
[ <:class_type< $ <:class_type<>> $ and $ct$ >> |
<:class_type< $ct$ and $ <:class_type<>> $ >> -> ct
| ct -> ct ];
method class_sig_item csg =
match super#class_sig_item csg with
[ <:class_sig_item< $ <:class_sig_item<>> $; $csg$ >> |
<:class_sig_item< $csg$; $ <:class_sig_item<>> $ >> -> csg
| csg -> csg ];
method class_str_item cst =
match super#class_str_item cst with
[ <:class_str_item< $ <:class_str_item<>> $; $cst$ >> |
<:class_str_item< $cst$; $ <:class_str_item<>> $ >> -> cst
| cst -> cst ];
end;
end;
|
