146 lines
5.3 KiB
OCaml
146 lines
5.3 KiB
OCaml
(****************************************************************************)
|
|
(* *)
|
|
(* 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;
|