Commit | Line | Data |
---|---|---|
993936c0 | 1 | (* |
17ba0788 C |
2 | * Copyright 2012, INRIA |
3 | * Julia Lawall, Gilles Muller | |
4 | * Copyright 2010-2011, INRIA, University of Copenhagen | |
993936c0 C |
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 | (* ---------------------------------------------------------------------- *) | |
28 | (* useful functions *) | |
29 | ||
30 | let starts_with c s = | |
31 | if String.length s > 0 && String.get s 0 = c | |
32 | then Some (String.sub s 1 ((String.length s) - 1)) | |
33 | else None | |
34 | ||
35 | let ends_with c s = | |
36 | if String.length s > 0 && String.get s ((String.length s) - 1) = c | |
37 | then Some (String.sub s 0 ((String.length s) - 1)) | |
38 | else None | |
39 | ||
40 | let split_when fn l = | |
41 | let rec loop acc = function | |
42 | | [] -> raise Not_found | |
43 | | x::xs -> | |
44 | (match fn x with | |
45 | Some x -> List.rev acc, x, xs | |
46 | | None -> loop (x :: acc) xs) in | |
47 | loop [] l | |
48 | ||
49 | (* ---------------------------------------------------------------------- *) | |
50 | (* make a semantic patch from a string *) | |
51 | ||
52 | let find_metavariables tokens = | |
53 | let rec loop env = function | |
54 | [] -> (env,[]) | |
55 | | x :: xs -> | |
56 | (* single upper case letter is a metavariable *) | |
57 | let (x,xs,env) = | |
58 | (* | |
59 | Testing for uppercase and length is not enough as "+" is | |
60 | a single character identical in upper/lower case. | |
61 | *) | |
62 | (* | |
63 | The ":" delimiter could not be used two times | |
64 | 1) Str.split | |
65 | 2) split_when (ends_with ...) | |
66 | ||
67 | Otherwise split_when will raise a Not_found exception. | |
68 | *) | |
69 | match Str.bounded_split (Str.regexp ":") x 2 with | |
70 | [before;after] -> | |
71 | let (ty,endty,afterty) = split_when (ends_with ':') (after::xs) in | |
72 | let decl = | |
73 | Printf.sprintf "%s %s;\n" | |
74 | (String.concat "" (ty@[endty])) | |
75 | before in | |
76 | (try | |
77 | if decl = List.assoc before env | |
78 | then (before,afterty,env) | |
79 | else failwith (before^" already declared with another type") | |
80 | with Not_found -> | |
81 | let env = (before, decl) :: env in | |
82 | (before,afterty,env)) | |
83 | | _ -> | |
84 | if Str.string_match (Str.regexp "[A-Z]") x 0 | |
85 | then | |
86 | begin | |
87 | try let _ = Some(List.assoc x env) in (x,xs,env) | |
88 | with Not_found -> | |
89 | let env = | |
90 | (x,(Printf.sprintf "metavariable %s;\n" x)) :: env in | |
91 | (x,xs,env) | |
92 | end | |
93 | else (x,xs,env) in | |
94 | let (env,sp) = loop env xs in | |
95 | (env,x::sp) in | |
96 | loop [] tokens | |
97 | ||
98 | let find_when_dots tokens = | |
99 | let rec loop = function | |
100 | [] -> [] | |
101 | | "when !=" :: e :: rest -> | |
102 | "when != " :: e :: "\n" :: (loop rest) | |
103 | | "when ==" :: e :: rest -> | |
104 | "when == " :: e :: "\n" :: (loop rest) | |
105 | | "when" :: " " :: e :: rest -> | |
106 | "when" :: " " :: e :: "\n" :: (loop rest) | |
107 | | "..." :: "when" :: rest -> "\n" :: "..." :: (loop ("when" :: rest)) | |
108 | | "..." :: rest -> "\n" :: "..." :: "\n" :: (loop rest) | |
109 | | x::xs -> x::(loop xs) in | |
110 | loop tokens | |
111 | ||
112 | let add_stars tokens = | |
113 | let rec loop = function | |
114 | [] -> [] | |
115 | | "." :: "." :: "." :: rest -> "..." :: skip rest | |
116 | | "<" :: "." :: "." :: "." :: rest -> "<..." :: skip rest | |
117 | | "<" :: "+" :: "." :: "." :: "." :: rest -> "<+..." :: skip rest | |
118 | | "\n" :: rest -> "\n" :: loop rest | |
119 | | x :: xs -> ("* " ^ x) :: (skip xs) | |
120 | and skip = function | |
121 | [] -> [] | |
122 | | "\n" :: rest -> "\n" :: loop rest | |
123 | | x :: xs -> x :: skip xs in | |
124 | loop tokens | |
125 | ||
126 | let rec add_spaces = function | |
127 | [] -> [] | |
128 | | x :: "\n" :: rest -> x :: "\n" :: (add_spaces rest) | |
129 | | "\n" :: rest -> "\n" :: (add_spaces rest) | |
130 | | x :: rest -> x :: " " :: (add_spaces rest) | |
131 | ||
132 | let reparse tokens = | |
133 | let (env,code) = find_metavariables tokens in | |
134 | let env = String.concat "" (List.map snd env) in | |
135 | let code = find_when_dots code in | |
136 | let code = add_stars code in | |
137 | let code = String.concat "" code in | |
138 | let res = "@@\n"^env^"@@\n"^code in | |
139 | Printf.printf "%s\n\n" res; | |
140 | let out = Common.new_temp_file "sp" ".cocci" in | |
141 | let o = open_out out in | |
142 | Printf.fprintf o "%s\n" res; | |
143 | close_out o; | |
144 | out | |
145 | ||
146 | let tokenize first = | |
147 | let lexbuf = Lexing.from_string first in | |
148 | let rec loop b = | |
149 | let tok = Lexer_cli.token b in | |
150 | if not (tok = Lexer_cli.EOF) then | |
151 | let s = Lexer_cli.pretty_print tok in | |
152 | s :: loop b | |
153 | else | |
154 | [] | |
155 | in loop lexbuf | |
156 | ||
157 | (* ---------------------------------------------------------------------- *) | |
158 | (* entry point *) | |
159 | ||
160 | let command_line args = | |
161 | let info = | |
17ba0788 | 162 | try Some (Common.split_when (function x -> List.mem x ["-sp";"--sp"]) args) |
993936c0 C |
163 | with Not_found -> None in |
164 | match info with | |
165 | None -> args | |
166 | | Some(pre_args,sp,post_args) -> | |
167 | (match post_args with | |
168 | first::post_args -> | |
17ba0788 | 169 | pre_args @ "--sp_file" :: |
993936c0 C |
170 | (reparse (tokenize first)) :: |
171 | post_args | |
17ba0788 | 172 | | [] -> failwith "--sp needs an argument") |