File: re_constraints.ml

package info (click to toggle)
coccinelle 1.0.8.deb-5
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, sid
  • size: 26,148 kB
  • sloc: ml: 136,392; ansic: 23,594; sh: 2,189; makefile: 2,157; perl: 1,576; lisp: 840; python: 823; awk: 70; csh: 12
file content (146 lines) | stat: -rw-r--r-- 5,127 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
(*
 * This file is part of Coccinelle, licensed under the terms of the GPL v2.
 * See copyright.txt in the Coccinelle source code for more information.
 * The Coccinelle source code can be obtained at http://coccinelle.lip6.fr
 *)

module Ast = Ast_cocci
module V = Visitor_ast

(* if a variable affected by a script constraint is always referenced only
with all the other local variables that are mentioned by that script
constraint, then we can push the script constraint down to the rule_element
level *)

(* Could be more optimal by checking that the params of the constraint
are not under a disj. Memoize to avoid rechecking for each constraint. *)

let disj_free_table = Hashtbl.create 101

let disj_free re =
  let bind = (&&) in
  let option_default = true in
  let mcode _ _ = true in
  let donothing r k e = k e in
  (* case for anything with a disj *)
  let ident r k e =
    match Ast.unwrap e with Ast.DisjId _ -> false | _ -> k e in
  let expr r k e =
    match Ast.unwrap e with Ast.DisjExpr _ -> false | _ -> k e in
  let ty r k e =
    match Ast.unwrap e with Ast.DisjType _ -> false | _ -> k e in
  let decl r k e =
    match Ast.unwrap e with Ast.DisjDecl _ -> false | _ -> k e in
  let field r k e =
    match Ast.unwrap e with Ast.DisjField _ -> false | _ -> k e in
  let rule_elem r k e =
    match Ast.unwrap e with Ast.DisjRuleElem _ -> false | _ -> k e in
  let statement r k e =
    match Ast.unwrap e with Ast.Disj _ -> false | _ -> k e in
  let v =
    V.combiner bind option_default
    mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
    mcode mcode
    donothing donothing donothing donothing donothing donothing ident
    expr donothing donothing donothing donothing ty donothing
    donothing donothing donothing decl donothing field donothing
    rule_elem statement donothing donothing donothing in
  try Hashtbl.find disj_free_table re
  with Not_found ->
    let res = v.V.combiner_rule_elem re in
    Hashtbl.add disj_free_table re res;
    res

let ok_for_all_rule_elems cstr minirules =
  let bind = (&&) in
  let option_default = true in
  let mcode _ _ = true in
  let donothing r k e = k e in

  let (self,(_key,_lang,params,_pos,_code)) = cstr in
  let rule_elem r k re =
    let available = Ast.get_minus_nc_fvs re in
    if List.mem self available
    then
      let res =
	(List.for_all (fun x -> List.mem x available) (List.map fst params)) &&
	(disj_free re) in
      if res
      then res
      else
	failwith
	  (Printf.sprintf
	     "%s: constraint on variable %s cannot be evaluated in line %d. available: %s"
	     (fst self) (snd self) (Ast.get_line re) (Dumper.dump available))
    else true (* not relevant to this rule_elem *) in

  let v =
    V.combiner bind option_default
      mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
      mcode mcode
      donothing donothing donothing donothing donothing donothing donothing
      donothing donothing donothing donothing donothing donothing donothing
      donothing donothing donothing donothing donothing donothing donothing
      rule_elem donothing donothing donothing donothing in
  List.for_all v.V.combiner_top_level minirules

let update_for_all_rule_elems cstr minirules =
  let mcode mc = mc in
  let donothing r k e = k e in

  let (self,((_key,_lang,params,_pos,_code) as sc)) = cstr in
  let rule_elem r k re =
    let re = k re in
    let available = Ast.get_minus_nc_fvs re in
    if List.mem self available
    then Ast.add_constraint re (self,Ast.CstrScript(true,sc))
    else re in
    
  let v =
    V.rebuilder
      mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode mcode
      mcode mcode
      donothing donothing donothing donothing donothing donothing
      donothing donothing donothing donothing donothing donothing
      donothing donothing donothing donothing
      donothing donothing donothing donothing
      donothing rule_elem donothing donothing donothing donothing in
  List.map v.V.rebuilder_top_level minirules

let remove rule_name ((nm,_) as x) =
  let cell = Hashtbl.find Data.non_local_script_constraints (rule_name,nm) in
  let rest = List.filter (function y -> not(x = y)) !cell in
  cell := rest

let re_constraints rules =
  let constraints_by_rules = Hashtbl.create 101 in
  Hashtbl.iter
    (fun (rl,_) cstr ->
      List.iter (Common.hashadd constraints_by_rules rl) !cstr)
    Data.non_local_script_constraints;
  let rules =
    List.map
      (function rule ->
	match rule with
	  Ast.CocciRule(rule_name,info,minirules,b,ty) ->
	    let constraints =
	      try !(Hashtbl.find constraints_by_rules rule_name)
	      with Not_found -> [] in
	    let minirules =
	      List.fold_left
		(fun minirules cstr ->
		  if ok_for_all_rule_elems cstr minirules
		  then
		    begin
		      remove rule_name cstr;
		      update_for_all_rule_elems cstr minirules
		    end
		  else minirules)
		minirules constraints in
	    Ast.CocciRule(rule_name,info,minirules,b,ty)
	| Ast.ScriptRule _ | Ast.InitialScriptRule _ | Ast.FinalScriptRule _ ->
	    rule)
      rules in
  Hashtbl.clear disj_free_table;
  rules