popl09/insert_quantifiers.ml

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