parsing_c/cpp_ast_c.ml

   1 open Common
   2
   3 open Ast_c
   4
   5 (*****************************************************************************)
   6 (* Cpp Ast Manipulations *)
   7 (*****************************************************************************)
   8
   9 (*
  10  * cpp-include-expander-builtin.
  11  *
  12  * alternative1: parse and call cpp tour a tour ?
  13  * alternative2: apply cpp at the very end. Process that go through ast
  14  * and do the stuff such as #include,  macro expand,
  15  * ifdef.
  16  *
  17  * But need keep those info in ast at least, even bad
  18  * macro for instance, and for parse error region ? maybe can
  19  * get another chance ?
  20  * I think it's better to do the cpp-include-expander in a different step
  21  * rather than embedding it in the parser. The parser is already too complex.
  22  * Also keep with the tradition to try to parse as-is.
  23  *
  24  * todo? but maybe could discover new info that could help reparse
  25  * the ParseError in original file. Try again parsing it by
  26  * putting it in a minifile ?
  27  *
  28  *
  29  * todo? maybe can do some pass that work at the ifdef level and for instance
  30  * try to paren them, so have in Ast some stuff that are not
  31  * present at parsing time but that can then be constructed after
  32  * some processing (a little bit like my type for expression filler,
  33  * or position info filler, or include relative position filler).
  34  *
  35  * ??add such info about what was done somewhere ? could build new
  36  * ??ast each time but too tedious (maybe need delta-programming!)
  37  *
  38  *
  39  * TODO: macro expand,
  40  * TODO: handle ifdef
  41  *
  42  *
  43  *
  44  * cpp_ifdef_statementize: again better to separate concern and in parser
  45  *  just add the directives in a flat way (IfdefStmt) and later do more
  46  *  processing and transform them in a tree with some IfdefStmt2.
  47  *)
  48
  49
  50
  51 (*****************************************************************************)
  52 (* Types  *)
  53 (*****************************************************************************)
  54
  55 type cpp_option =
  56   | I of Common.filename
  57   | D of string * string option
  58
  59
  60
  61 let i_of_cpp_options xs =
  62   xs +> Common.map_filter (function
  63   | I f -> Some f
  64   | D _ -> None
  65   )
  66
  67 let cpp_option_of_cmdline (xs, ys) =
  68   (xs +> List.map (fun s -> I s)) ++
  69   (ys +> List.map (fun s ->
  70     if s =~ "\\([A-Z][A-Z0-9_]*\\)=\\(.*\\)"
  71     then
  72       let (def, value) = matched2 s in
  73       D (def, Some value)
  74     else
  75       D (s, None)
  76   ))
  77
  78 (*****************************************************************************)
  79 (* Helpers *)
  80 (*****************************************************************************)
  81
  82 (* may return a list of match ? *)
  83 let find_header_file cppopts dirname inc_file =
  84   match inc_file with
  85   | Local f ->
  86       let finalfile =
  87         Filename.concat dirname (Ast_c.s_of_inc_file inc_file) in
  88       if Sys.file_exists finalfile
  89       then [finalfile]
  90       else []
  91   | NonLocal f ->
  92       i_of_cpp_options cppopts +> Common.map_filter (fun dirname ->
  93         let finalfile =
  94           Filename.concat dirname (Ast_c.s_of_inc_file inc_file) in
  95         if Sys.file_exists finalfile
  96         then Some finalfile
  97         else None
  98       )
  99   | Wierd s ->
 100       pr2 ("CPPAST: wierd include not handled:" ^ s);
 101       []
 102
 103
 104 let trace_cpp_process depth mark inc_file =
 105   pr2 (spf "%s>%s %s"
 106           (Common.repeat "-" depth +> Common.join "")
 107           mark
 108           (s_of_inc_file_bis inc_file));
 109   ()
 110
 111
 112 (*****************************************************************************)
 113 (* Main entry *)
 114 (*****************************************************************************)
 115
 116
 117 let (cpp_expand_include:
 118  cpp_option list -> Common.dirname -> Ast_c.program -> Ast_c.program) =
 119  fun iops dirname ast ->
 120
 121   pr2_xxxxxxxxxxxxxxxxx();
 122   let already_included = ref [] in
 123
 124   let rec aux stack dirname ast =
 125     let depth = List.length stack in
 126
 127     ast +> Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with
 128       Visitor_c.kcppdirective_s = (fun (k, bigf) cpp ->
 129         match cpp with
 130         | Include {i_include = (inc_file, ii);
 131                    i_rel_pos = h_rel_pos;
 132                    i_is_in_ifdef = b;
 133                    i_content = copt;
 134                    }
 135           ->
 136             (match find_header_file iops dirname inc_file with
 137             | [file] ->
 138                 if List.mem file !already_included
 139                 then begin
 140                   (* pr2 ("already included: " ^ file); *)
 141                   trace_cpp_process depth "*" inc_file;
 142                   k cpp
 143                 end else begin
 144                   trace_cpp_process depth "" inc_file;
 145                   Common.push2 file already_included;
 146                   (* CONFIG *)
 147                   Flag_parsing_c.verbose_parsing := false;
 148                   Flag_parsing_c.verbose_lexing := false;
 149                   let (ast2, _stat) = Parse_c.parse_c_and_cpp file in
 150
 151                   let ast = Parse_c.program_of_program2 ast2 in
 152                   let dirname' = Filename.dirname file in
 153
 154                   (* recurse *)
 155                   let ast' = aux (file::stack) dirname' ast in
 156
 157                   Include {i_include = (inc_file, ii);
 158                            i_rel_pos = h_rel_pos;
 159                            i_is_in_ifdef = b;
 160                            i_content = Some (file, ast');
 161                   }
 162                 end
 163             | [] ->
 164                 trace_cpp_process depth "!!" inc_file;
 165                 pr2 "CPPAST: file not found";
 166                 k cpp
 167             | x::y::zs ->
 168                 trace_cpp_process depth "!!" inc_file;
 169                 pr2 "CPPAST: too much candidates";
 170                 k cpp
 171             )
 172         | _ -> k cpp
 173       );
 174     }
 175   in
 176   aux [] dirname ast
 177
 178
 179
 180 (*
 181 let unparse_showing_include_content ?
 182 *)
 183
 184
 185 (*****************************************************************************)
 186 (* Ifdef-statementize *)
 187 (*****************************************************************************)
 188
 189
 190 let is_ifdef_and_same_tag tag x =
 191   match x with
 192   | IfdefStmt (IfdefDirective ((_, tag2),_)) ->
 193       tag = tag2
 194   | StmtElem _ | CppDirectiveStmt _ -> false
 195   | IfdefStmt2 _ -> raise Impossible
 196
 197
 198
 199 (* What if I skipped in the parser only some of the ifdef elements
 200  * of the same tag. Once I passed one, I should pass all of them and so
 201  * at least should detect here that one tag is not "valid". Maybe in the parser
 202  * can return or marked some tags as "partially_passed_ifdef_tag".
 203  * Maybe could do in ast_c a MatchingTag of int * bool ref (* one_was_passed *)
 204  * where the ref will be shared by the ifdefs with the same matching tag
 205  * indice. Or simply count  the number of directives with the same tag and
 206  * put this information in the tag. Hence the total_with_this_tag below.
 207  *)
 208 let should_ifdefize tag ifdefs_directives xxs =
 209   let IfdefTag (_tag, total_with_this_tag) = tag in
 210
 211   if total_with_this_tag <> List.length ifdefs_directives
 212   then begin
 213     pr2 "CPPASTC: can not ifdefize, some of its directives were passed";
 214     false
 215   end else
 216     (* todo? put more condition ? dont ifdefize declaration ? *)
 217     true
 218
 219
 220
 221
 222
 223 (* return a triple, (ifdefs directive * grouped xs * remaining sequencable)
 224  * XXX1 XXX2 elsif YYY1 else ZZZ1 endif WWW1 WWW2
 225  * => [elsif, else, endif], [XXX1 XXX2; YYY1; ZZZ1], [WWW1 WWW2]
 226  *)
 227 let group_ifdef tag xs =
 228   let (xxs, xs) = group_by_post (is_ifdef_and_same_tag tag) xs in
 229
 230   xxs +> List.map snd +> List.map (fun x ->
 231     match x with
 232     | IfdefStmt y -> y
 233     | StmtElem _ | CppDirectiveStmt _ | IfdefStmt2 _ -> raise Impossible
 234   ),
 235   xxs +> List.map fst,
 236   xs
 237
 238
 239 let rec cpp_ifdef_statementize ast =
 240   Visitor_c.vk_program_s { Visitor_c.default_visitor_c_s with
 241     Visitor_c.kstatementseq_list_s = (fun (k, bigf) xs ->
 242
 243       let rec aux xs =
 244         match xs with
 245         | [] -> []
 246         | stseq::xs ->
 247             (match stseq with
 248             | StmtElem st ->
 249                 Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
 250             | CppDirectiveStmt directive ->
 251                 Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
 252             | IfdefStmt ifdef ->
 253                 (match ifdef with
 254                 | IfdefDirective ((Ifdef,tag),ii) ->
 255
 256                     let (restifdefs, xxs, xs') = group_ifdef tag xs in
 257                     if should_ifdefize tag (ifdef::restifdefs) xxs
 258                     then
 259                       let res = IfdefStmt2 (ifdef::restifdefs, xxs) in
 260                       Visitor_c.vk_statement_sequencable_s bigf res::aux xs'
 261                     else
 262                       Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
 263
 264                 | IfdefDirective (((IfdefElseif|IfdefElse|IfdefEndif),b),ii) ->
 265                     pr2 "wierd: first directive is not a ifdef";
 266                     (* maybe not wierd, just that should_ifdefize
 267                      * returned false *)
 268                     Visitor_c.vk_statement_sequencable_s bigf stseq::aux xs
 269                 )
 270
 271             | IfdefStmt2 (ifdef, xxs) ->
 272                 failwith "already applied cpp_ifdef_statementize"
 273             )
 274       in
 275       aux xs
 276     );
 277   } ast