badef2c87eea3f0968d247756c71aea2526a0e08
[bpt/coccinelle.git] / popl09 / insert_quantifiers.ml
1 (*
2 * Copyright 2012, INRIA
3 * Julia Lawall, Gilles Muller
4 * Copyright 2010-2011, INRIA, University of Copenhagen
5 * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
6 * Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
7 * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
8 * This file is part of Coccinelle.
9 *
10 * Coccinelle is free software: you can redistribute it and/or modify
11 * it under the terms of the GNU General Public License as published by
12 * the Free Software Foundation, according to version 2 of the License.
13 *
14 * Coccinelle is distributed in the hope that it will be useful,
15 * but WITHOUT ANY WARRANTY; without even the implied warranty of
16 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 * GNU General Public License for more details.
18 *
19 * You should have received a copy of the GNU General Public License
20 * along with Coccinelle. If not, see <http://www.gnu.org/licenses/>.
21 *
22 * The authors reserve the right to distribute this or future versions of
23 * Coccinelle under other licenses.
24 *)
25
26
27 # 0 "./insert_quantifiers.ml"
28 module Ast = Ast_cocci
29 module Past = Ast_popl
30
31 (* --------------------------------------------------------------------- *)
32
33 let rec fvs_sequence = function
34 Past.Seq(elem,seq) ->
35 Common.union_set (fvs_element elem) (fvs_sequence seq)
36 | Past.Empty -> []
37 | Past.SExists(var,seq) -> failwith "not possible"
38
39 and fvs_term = function
40 Past.Atomic(term) -> Ast.get_fvs term
41 | Past.IfThen(test,thn,(afvs,_,_,_)) ->
42 Common.union_set afvs
43 (Common.union_set (fvs_term test) (fvs_term thn))
44 | Past.TExists(var,term) -> failwith "not possible"
45
46 and fvs_element = function
47 Past.Term(term,_) -> fvs_term term
48 | Past.Or(seq1,seq2) ->
49 Common.union_set (fvs_sequence seq1) (fvs_sequence seq2)
50 | Past.DInfo(dots) -> fvs_dots dots
51 | Past.EExists(var,seq) -> failwith "not possible"
52
53 and fvs_dots = function
54 Past.Dots -> []
55 | Past.Nest(seq) -> fvs_sequence seq
56 | Past.When(dots,seq) -> Common.union_set (fvs_dots dots) (fvs_sequence seq)
57
58 (* --------------------------------------------------------------------- *)
59
60 let inter_set l1 l2 = List.filter (function l1e -> List.mem l1e l2) l1
61
62 let minus_set l1 l2 = List.filter (function l1e -> not (List.mem l1e l2)) l1
63
64 let rec quant_sequence bound = function
65 Past.Seq(elem,seq) ->
66 let fe = fvs_element elem in
67 let fs = fvs_sequence seq in
68 let inter = inter_set fe fs in
69 let free = minus_set inter bound in
70 let new_bound = free @ bound in
71 List.fold_right (function cur -> function rest -> Past.SExists(cur,rest))
72 free (Past.Seq(quant_element new_bound elem,
73 quant_sequence new_bound seq))
74 | Past.Empty -> Past.Empty
75 | Past.SExists(var,seq) -> failwith "not possible"
76
77 and quant_term bound = function
78 (Past.Atomic(term)) as x ->
79 let free = minus_set (Ast.get_fvs term) bound in
80 List.fold_right (function cur -> function rest -> Past.TExists(cur,rest))
81 free x
82 | Past.IfThen(test,thn,((afvs,_,_,_) as aft)) ->
83 let fts = fvs_term test in
84 let fth = fvs_term thn in
85 let inter = inter_set fts fth in
86 let free = minus_set inter bound in
87 let new_bound = free @ bound in
88 List.fold_right (function cur -> function rest -> Past.TExists(cur,rest))
89 free (Past.IfThen(quant_term new_bound test,
90 quant_term new_bound thn,
91 aft))
92 | Past.TExists(var,term) -> failwith "not possible"
93
94 and quant_element bound = function
95 Past.Term(term,ba) ->
96 Past.Term(quant_term bound term,dots_bef_aft bound ba)
97 | Past.Or(seq1,seq2) ->
98 Past.Or(quant_sequence bound seq1,quant_sequence bound seq2)
99 | Past.DInfo(dots) ->
100 Past.DInfo(quant_dots bound dots)
101 | Past.EExists(var,seq) -> failwith "not possible"
102
103 and dots_bef_aft bound = function
104 Past.AddingBetweenDots (brace_term,n) ->
105 Past.AddingBetweenDots (quant_term bound brace_term,n)
106 | Past.DroppingBetweenDots (brace_term,n) ->
107 Past.DroppingBetweenDots (quant_term bound brace_term,n)
108 | Past.NoDots -> Past.NoDots
109
110 and quant_dots bound = function
111 Past.Dots -> Past.Dots
112 | Past.Nest(seq) -> Past.Nest(quant_sequence bound seq)
113 | Past.When(dots,seq) ->
114 Past.When(quant_dots bound dots, quant_sequence bound seq)
115
116 (* --------------------------------------------------------------------- *)
117
118 let insert_quantifiers x = quant_sequence [] x