8f3adc99b66bfceaca90f36d85cbfaa1a63f03ef
1 (*****************************************************************************)
3 (*****************************************************************************)
5 (* This module was introduced to factorize code between
6 * pattern.ml and transformation.ml. In both cases we need
7 * to "compare" a piece of C with a piece of Cocci, and depending
8 * if we want just to pattern or transform, we perform different
9 * actions on the tokens. So, the common code is in this module
10 * and the module specific actions are in pattern.ml and transformation.ml.
12 * We could have used a visitor approach as in visitor_c but I prefer
13 * this time to use a functor. The specific actions are passed
14 * via a module to the functor.
16 * If the functor is too complex too understand, you can look at
17 * the comments in pattern.ml and transformation.ml to look at
18 * how it was done before, which may help to understand how
21 * You can also look at the papers on parser combinators in haskell
22 * (cf a pearl by meijer in ICFP) to understand our monadic
23 * approach to matching/unifying.
27 (* should be used as less as possible. Most of the time the code in
28 * cocci_vs_c should be the same if we pattern or transform *)
29 type mode
= PatternMode
| TransformMode
31 (* used in both pattern and transform, in envf *)
32 val equal_metavarval
:
33 Ast_c.metavar_binding_kind
-> Ast_c.metavar_binding_kind
-> bool
35 (* for inherited metavariables. no declaration link on expressions *)
36 val equal_inh_metavarval
:
37 Ast_c.metavar_binding_kind
-> Ast_c.metavar_binding_kind
-> bool
39 (*****************************************************************************)
40 (* The parameter of the functor (the specific actions) *)
41 (*****************************************************************************)
49 (* a matcher between 'a' and 'b' take 'a' and 'b' in parameter,
50 * and "something" (tin; a state that is threaded across calls),
51 * and return a new 'a' and 'b' encapsulated in "something" (tout)
53 type ('a
, 'b
) matcher
= 'a
-> 'b
-> tin
-> ('a
* 'b
) tout
57 (* -------------------------------------------------------------------- *)
58 (* The monadic combinators *)
59 (* -------------------------------------------------------------------- *)
61 (* it kinds of take a matcher in parameter, and another matcher,
62 * and returns a matcher, so =~ matcher -> matcher -> matcher
65 (tin
-> ('a
* 'b
) tout
) ->
66 ('a
-> 'b
-> tin
-> ('c
* 'd
) tout
) ->
69 val return
: 'a
* 'b
-> tin
-> ('a
* 'b
) tout
70 val fail
: tin
-> ('a
* 'b
) tout
72 val ( >||> ) : (tin
-> 'a tout
) -> (tin
-> 'a tout
) -> tin
-> 'a tout
73 val ( >|+|> ) : (tin
-> 'a tout
) -> (tin
-> 'a tout
) -> tin
-> 'a tout
74 val ( >&&> ) : (tin
-> bool) -> (tin
-> 'a tout
) -> tin
-> 'a tout
76 (* -------------------------------------------------------------------- *)
78 (* -------------------------------------------------------------------- *)
79 val tokenf
: ('a
Ast_cocci.mcode
, Ast_c.info
) matcher
80 val tokenf_mck
: (Ast_cocci.mcodekind
, Ast_c.info
) matcher
82 (* -------------------------------------------------------------------- *)
83 (* Distr_f functions, to tag a range of tokens *)
84 (* -------------------------------------------------------------------- *)
87 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.expression
) matcher
90 (Ast_cocci.meta_name
Ast_cocci.mcode
,
91 (Ast_c.argument
, Ast_c.il
) Common.either list
)
95 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.fullType
) matcher
98 (Ast_cocci.meta_name
Ast_cocci.mcode
,
99 (Ast_c.parameterType
, Ast_c.il
) Common.either list
)
102 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.parameterType
) matcher
105 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.initialiser
) matcher
107 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.declaration
) matcher
109 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.field
) matcher
112 (Ast_cocci.meta_name
Ast_cocci.mcode
, Control_flow_c.node
) matcher
114 val distrf_define_params
:
115 (Ast_cocci.meta_name
Ast_cocci.mcode
,
116 (string Ast_c.wrap
, Ast_c.il
) Common.either list
)
119 val distrf_struct_fields
:
120 (Ast_cocci.meta_name
Ast_cocci.mcode
, Ast_c.field list
)
124 (Ast_cocci.meta_name
Ast_cocci.mcode
,
125 (Ast_c.constant
, string) Common.either
Ast_c.wrap
)
128 (* -------------------------------------------------------------------- *)
129 (* Modifying nested expression and nested types, with Exp and Ty *)
130 (* -------------------------------------------------------------------- *)
133 (Ast_cocci.expression
, Ast_c.expression
) matcher
->
134 (Ast_cocci.expression
, Control_flow_c.node
) matcher
137 (Ast_cocci.expression
, Ast_c.expression
) matcher
->
138 (Ast_cocci.expression
, Ast_c.expression
) matcher
141 (Ast_cocci.fullType
, Ast_c.fullType
) matcher
->
142 (Ast_cocci.fullType
, Control_flow_c.node
) matcher
145 (Ast_cocci.initialiser
, Ast_c.initialiser
) matcher
->
146 (Ast_cocci.initialiser
, Control_flow_c.node
) matcher
148 (* -------------------------------------------------------------------- *)
149 (* Environment manipulation. Extract info from tin, the "something" *)
150 (* -------------------------------------------------------------------- *)
152 Ast_cocci.keep_binding
->
153 Ast_cocci.inherited
->
154 Ast_cocci.meta_name
Ast_cocci.mcode
* Ast_c.metavar_binding_kind
*
155 (* pos info, if needed *)
156 (unit -> Common.filename
* string * Ast_c.posl
* Ast_c.posl
) ->
157 (unit -> tin
-> 'x tout
) -> (tin
-> 'x tout
)
159 val check_idconstraint
:
160 ('a
-> 'b
-> bool) -> 'a
-> 'b
->
161 (unit -> tin
-> 'x tout
) -> (tin
-> 'x tout
)
163 val check_constraints_ne
:
164 ('a
, 'b
) matcher
-> 'a list
-> 'b
->
165 (unit -> tin
-> 'x tout
) -> (tin
-> 'x tout
)
167 val all_bound
: Ast_cocci.meta_name list
-> tin
-> bool
170 val optional_storage_flag
: (bool -> tin
-> 'x tout
) -> (tin
-> 'x tout
)
171 val optional_qualifier_flag
: (bool -> tin
-> 'x tout
) -> (tin
-> 'x tout
)
172 val value_format_flag
: (bool -> tin
-> 'x tout
) -> (tin
-> 'x tout
)
178 (*****************************************************************************)
179 (* The functor itself *)
180 (*****************************************************************************)
183 functor (X
: PARAM
) ->
185 type ('a
, 'b
) matcher
= 'a
-> 'b
-> X.tin
-> ('a
* 'b
) X.tout
187 val rule_elem_node
: (Ast_cocci.rule_elem
, Control_flow_c.node
) matcher
189 val expression
: (Ast_cocci.expression
, Ast_c.expression
) matcher
191 (* there are far more functions in this functor but they do not have