| 1 | open Common |
| 2 | |
| 3 | |
| 4 | |
| 5 | type kbuild_info = directory list |
| 6 | and directory = Directory of string (*dirname*) * group list |
| 7 | and group = Group of filename list |
| 8 | |
| 9 | let directories_to_assoc xs = |
| 10 | xs +> List.map (function (Directory (s, ys)) -> s, ys) |
| 11 | let directories_to_hash xs = |
| 12 | xs +> directories_to_assoc +> Common.hash_of_list |
| 13 | let files_of_groups xs = |
| 14 | xs +> List.map (function Group ys -> ys) +> Common.union_all |
| 15 | |
| 16 | |
| 17 | |
| 18 | let adjust_dirs dirs = |
| 19 | dirs +> Common.map_filter (fun s -> |
| 20 | match s with |
| 21 | | s when s =~ "^\\.$" -> None |
| 22 | | s when s =~ "^\\./\\.git" -> None |
| 23 | | s when s =~ "^\\./\\.tmp_versions" -> None |
| 24 | | s when s =~ "^\\./include/config/" -> None |
| 25 | | s when s =~ "^\\./usr/include" -> None |
| 26 | | s when s =~ "^\\./\\(.*\\)" -> Some (matched1 s) |
| 27 | | s -> Some s |
| 28 | ) |
| 29 | |
| 30 | |
| 31 | |
| 32 | let unparse_kbuild_info xs filename = |
| 33 | Common.with_open_outfile filename (fun (pr_no_nl,chan) -> |
| 34 | let pr s = pr_no_nl (s ^ "\n") in |
| 35 | |
| 36 | xs +> List.iter (function Directory (s, ys) -> |
| 37 | pr s; |
| 38 | ys +> List.iter (function Group zs -> |
| 39 | pr (" " ^ (join " " zs)); |
| 40 | ); |
| 41 | pr ""; |
| 42 | ) |
| 43 | ) |
| 44 | |
| 45 | let parse_kbuild_info filename = |
| 46 | let xs = cat filename in |
| 47 | let xs = xs +> List.map (Str.global_replace (Str.regexp "#.*") "" ) in |
| 48 | let xs = xs +> List.filter (fun s -> not (s =~ "^[ \t]*$")) in |
| 49 | |
| 50 | (* split by header of section *) |
| 51 | let xs = xs +> Common.split_list_regexp "^[^ ]" in |
| 52 | |
| 53 | xs +> List.map (fun (s, xs) -> |
| 54 | let groups = xs +> List.map (fun s -> |
| 55 | assert (s =~ "^[ ]+\\(.*\\)"); |
| 56 | let files = matched1 s in |
| 57 | let cfiles = Common.split " +" files in |
| 58 | Group cfiles |
| 59 | ) in |
| 60 | |
| 61 | Directory (s, groups) |
| 62 | ) |
| 63 | |
| 64 | let generate_naive_kbuild_info dirs = |
| 65 | dirs +> List.map (fun s -> |
| 66 | let files = Common.readdir_to_file_list s in |
| 67 | let files_ext = files +> List.map Common.dbe_of_filename_safe in |
| 68 | let cfiles = files_ext +> Common.map_filter |
| 69 | (function |
| 70 | | Left (d,base, "c") -> |
| 71 | if base =~ ".*\\.mod$" then None |
| 72 | else Some base |
| 73 | | _ -> None |
| 74 | ) in |
| 75 | let ys = cfiles +> List.map (fun c -> Group [c ^ ".c"]) in |
| 76 | Directory (s, ys) |
| 77 | ) |
| 78 | |
| 79 | |
| 80 | |
| 81 | |
| 82 | let generate_kbuild_info_from_depcocci dirs outfile = |
| 83 | Common.with_open_outfile outfile (fun (pr_no_nl, chan) -> |
| 84 | dirs +> List.iter (fun s -> |
| 85 | pr_no_nl (s ^ "\n"); |
| 86 | let depcocci = Common.cat (Filename.concat s "depcocci.dep") in |
| 87 | depcocci +> List.iter (fun s -> pr_no_nl (s ^ "\n")); |
| 88 | pr_no_nl "\n"; |
| 89 | ) |
| 90 | ) |
| 91 | (* |
| 92 | dirs +> List.map (fun s -> |
| 93 | let groups = depcocci +> List.map (fun s -> Group (Common.split " +" s)) |
| 94 | in |
| 95 | Directory (s, groups) |
| 96 | ) |
| 97 | *) |
| 98 | |
| 99 | |
| 100 | type makefile = |
| 101 | { |
| 102 | obj_dirs : string stack ref; |
| 103 | obj_config: (string list) stack ref; |
| 104 | obj_objs: (string * (string list)) stack ref; |
| 105 | } |
| 106 | let empty_makefile () = |
| 107 | failwith "empty_makefile" |
| 108 | |
| 109 | let parse_makefile file = |
| 110 | let xs = Common.cat file in |
| 111 | let s = Common.unlines xs in |
| 112 | let s = Str.global_replace (Str.regexp "\\\\\n") "" s in |
| 113 | let xs = Common.lines_with_nl s in |
| 114 | let xs = xs +> List.map (Str.global_replace (Str.regexp "#.*") "" ) in |
| 115 | let xs = xs +> List.filter (fun s -> not (s =~ "^[ \t]*$")) in |
| 116 | let _m = empty_makefile () in |
| 117 | |
| 118 | xs +> List.iter (fun s -> |
| 119 | match s with |
| 120 | | s when s =~ "obj-\\$(CONFIG_.*)[ \t]*[\\+:]=\\(.*/\\)" -> |
| 121 | pr2_no_nl ("DIR: " ^ s) |
| 122 | | s when s =~ "obj-y[ \t]*\\+=\\(.*/\\)" -> |
| 123 | pr2_no_nl ("DIR: " ^ s) |
| 124 | | s when s =~ "obj-\\$(CONFIG_.*)[ \t]*[\\+:]=\\(.*\\)" -> |
| 125 | let s = matched1 s in |
| 126 | let objs = Common.split "[ \t]+" s in |
| 127 | assert(List.for_all (fun s -> thd3 (Common.dbe_of_filename s) =$= "o") |
| 128 | objs); |
| 129 | |
| 130 | pr2 ("OBJS: " ^ (join "|" objs)) |
| 131 | |
| 132 | | s when s =~ "[a-zA-Z0-9_]+-objs[ \t]*[\\+:]=\\(.*\\)" -> |
| 133 | let s = matched1 s in |
| 134 | let objs = Common.split "[ \t]+" s in |
| 135 | |
| 136 | pr2 ("OBJSMODULE: " ^ (join "|" objs)) |
| 137 | |
| 138 | | s -> |
| 139 | pr2_no_nl ("OTHER: " ^ s) |
| 140 | |
| 141 | ) |
| 142 | |
| 143 | |
| 144 | let generate_less_naive_kbuild_info dirs = |
| 145 | dirs +> List.map (fun s -> |
| 146 | let files = Common.readdir_to_file_list s in |
| 147 | let files_ext = files +> List.map Common.dbe_of_filename_safe in |
| 148 | let cfiles = files_ext +> Common.map_filter |
| 149 | (function |
| 150 | | Left (d,base, "c") -> |
| 151 | if base =~ ".*\\.mod$" then None |
| 152 | else Some base |
| 153 | | _ -> None |
| 154 | ) in |
| 155 | match cfiles with |
| 156 | | [] -> Directory (s, []) |
| 157 | | _::_ -> |
| 158 | if Common.lfile_exists (Filename.concat s "Makefile") |
| 159 | then |
| 160 | let _res = parse_makefile (Filename.concat s "Makefile") in |
| 161 | let ys = cfiles +> List.map (fun c -> Group [c ^ ".c"]) in |
| 162 | Directory (s, ys) |
| 163 | else |
| 164 | failwith ("no Makefile found in: " ^ s) |
| 165 | |
| 166 | ) |
| 167 | |
| 168 | |
| 169 | |
| 170 | (* a = current info file, in general manually extended; b = generated one *) |
| 171 | let check_up_to_date a b = |
| 172 | let das = directories_to_assoc a in |
| 173 | let dbs = directories_to_assoc b in |
| 174 | let all_dirs = (das +> List.map fst) $+$ (dbs +> List.map fst) in |
| 175 | all_dirs +> List.iter (fun dir -> |
| 176 | match |
| 177 | optionise (fun () -> List.assoc dir das), |
| 178 | optionise (fun () -> List.assoc dir dbs) |
| 179 | with |
| 180 | | None, None -> raise Impossible |
| 181 | | None, Some gbs -> pr2 ("new directory appeared:" ^ dir) |
| 182 | | Some gas, None -> pr2 ("old directory disappeared:" ^ dir) |
| 183 | | Some gas, Some gbs -> |
| 184 | let afiles = files_of_groups gas in |
| 185 | let bfiles = files_of_groups gbs in |
| 186 | let all_files = afiles $+$ bfiles in |
| 187 | all_files +> List.iter (fun file -> |
| 188 | match List.mem file afiles, List.mem file bfiles with |
| 189 | | false, false -> raise Impossible |
| 190 | | false, true -> pr2 ("new file appeared:" ^ file ^ " in " ^ dir) |
| 191 | | true, false -> pr2 ("old file disappeared:" ^ file ^ " in " ^ dir) |
| 192 | | true, true -> () |
| 193 | ) |
| 194 | ) |
| 195 | |
| 196 | |
| 197 | let files_in_dirs dirs kbuild_info = |
| 198 | dirs +> List.map (fun dir -> |
| 199 | let dir = Common.chop_dirsymbol dir in |
| 200 | (* could use assoc, but we accept "parasite" prefix *) |
| 201 | let gooddirs = |
| 202 | kbuild_info +> Common.map_filter (function (Directory (s, groups)) -> |
| 203 | if dir =~ ("\\(.*\\)" ^ s ^ "$") |
| 204 | then |
| 205 | let prefix = matched1 dir in |
| 206 | Some (prefix, s, groups) |
| 207 | else None |
| 208 | ) |
| 209 | in |
| 210 | |
| 211 | (match gooddirs with |
| 212 | | [prefix, dir, groups] -> |
| 213 | groups +> List.map (function (Group xs) -> |
| 214 | Group (xs +> List.map (fun s -> |
| 215 | Filename.concat (prefix ^ dir) s)) |
| 216 | ) |
| 217 | |
| 218 | | [] -> |
| 219 | pr2 ("can't find kbuild info for directory :" ^ dir); |
| 220 | [] |
| 221 | | x::y::ys -> |
| 222 | pr2 ("too much kbuild info candidate for directory :" ^ dir); |
| 223 | [] |
| 224 | ) |
| 225 | ) +> List.concat |
| 226 | |
| 227 | |
| 228 | |
| 229 | |