File: command_line.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 (152 lines) | stat: -rw-r--r-- 4,502 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
147
148
149
150
151
152
(*
 * 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
 *)

(* ---------------------------------------------------------------------- *)
(* useful functions *)

let starts_with c s =
  if String.length s > 0 && String.get s 0 = c
  then Some (String.sub s 1 ((String.length s) - 1))
  else None

let ends_with c s =
  if String.length s > 0 && String.get s ((String.length s) - 1) = c
  then Some (String.sub s 0 ((String.length s) - 1))
  else None

let split_when fn l =
  let rec loop acc = function
  | []    -> raise Not_found
  | x::xs ->
      (match fn x with
	Some x -> List.rev acc, x, xs
      |	None -> loop (x :: acc) xs) in
  loop [] l

(* ---------------------------------------------------------------------- *)
(* make a semantic patch from a string *)

let find_metavariables tokens =
  let rec loop env = function
      [] -> (env,[])
    | x :: xs ->
	(* single upper case letter is a metavariable *)
	let (x,xs,env) =
(*
  Testing for uppercase and length is not enough as "+" is
  a single character identical in upper/lower case.
*)
	  (*
		The ":" delimiter could not be used two times
		1) Str.split
		2) split_when (ends_with ...)

		Otherwise split_when will raise a Not_found exception.
	  *)
	  match Str.bounded_split (Str.regexp ":") x 2 with
	    [before;after] ->
	      let (ty,endty,afterty) = split_when (ends_with ':') (after::xs) in
	      let decl =
		Printf.sprintf "%s %s;\n"
		  (String.concat "" (ty@[endty]))
		  before in
	      (try
		if decl = List.assoc before env
		then (before,afterty,env)
		else failwith (before^" already declared with another type")
	      with Not_found ->
		let env = (before, decl) :: env in
		(before,afterty,env))
	  | _ ->
	      if Str.string_match (Str.regexp "[A-Z]") x 0
	      then
		begin
		  try let _ = Some(List.assoc x env) in (x,xs,env)
		  with Not_found ->
		    let env =
		      (x,(Printf.sprintf "metavariable %s;\n" x)) :: env in
		    (x,xs,env)
		end
	      else (x,xs,env) in
	let (env,sp) = loop env xs in
	(env,x::sp) in
  loop [] tokens

let find_when_dots tokens =
  let rec loop = function
      [] -> []
    | "when !=" :: e :: rest ->
	"when != " :: e :: "\n" :: (loop rest)
    | "when ==" :: e :: rest ->
	"when == " :: e :: "\n" :: (loop rest)
    | "when" :: " " :: e :: rest ->
	"when" :: " " :: e :: "\n" :: (loop rest)
    | "..." :: "when" :: rest -> "\n" :: "..." :: (loop ("when" :: rest))
    | "..." :: rest -> "\n" :: "..." :: "\n" :: (loop rest)
    | x::xs -> x::(loop xs) in
  loop tokens

let add_stars tokens =
  let rec loop = function
      [] -> []
    | "." :: "." :: "." :: rest -> "..." :: skip rest
    | "<" :: "." :: "." :: "." :: rest -> "<..." :: skip rest
    | "<" :: "+" :: "." :: "." :: "." :: rest -> "<+..." :: skip rest
    | "\n" :: rest -> "\n" :: loop rest
    | x :: xs -> ("* " ^ x) :: (skip xs)
  and skip = function
      [] -> []
    | "\n" :: rest -> "\n" :: loop rest
    | x :: xs -> x :: skip xs in
  loop tokens

let rec add_spaces = function
    [] -> []
  | x :: "\n" :: rest -> x :: "\n" :: (add_spaces rest)
  | "\n" :: rest -> "\n" :: (add_spaces rest)
  | x :: rest -> x :: " " :: (add_spaces rest)

let reparse tokens =
  let (env,code) = find_metavariables tokens in
  let env = String.concat "" (List.map snd env) in
  let code = find_when_dots code in
  let code = add_stars code in
  let code = String.concat "" code in
  let res = "@@\n"^env^"@@\n"^code in
  Printf.printf "%s\n\n" res;
  let out = Common.new_temp_file "sp" ".cocci" in
  let o = open_out out in
  Printf.fprintf o "%s\n" res;
  close_out o;
  out

let tokenize first =
  let lexbuf = Lexing.from_string first in
  let rec loop b =
    let tok = Lexer_cli.token b in
    if not (tok = Lexer_cli.EOF) then
      let s = Lexer_cli.pretty_print tok in
      s :: loop b
    else
      []
  in loop lexbuf

(* ---------------------------------------------------------------------- *)
(* entry point *)

let command_line args =
  let info =
    try Some (Common.split_when (function x -> List.mem x ["-sp";"--sp"]) args)
    with Not_found -> None in
  match info with
    None -> args
  | Some(pre_args,sp,post_args) ->
      (match post_args with
	first::post_args ->
	  pre_args @ "--sp-file" ::
		     (reparse (tokenize first)) ::
		     post_args
      | [] -> failwith "--sp needs an argument")