1 files changed, 145 insertions, 0 deletions
diff --git a/ocaml-binary-annot/camlp4/Camlp4/Struct/CleanAst.ml b/ocaml-binary-annot/camlp4/Camlp4/Struct/CleanAst.ml
new file mode 100644
index 0000000000..ab9250543c
--- /dev/null
+++ b/ocaml-binary-annot/camlp4/Camlp4/Struct/CleanAst.ml
@@ -0,0 +1,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;