Release coccinelle-0.2.3rc1
[bpt/coccinelle.git] / parsing_cocci / parse_cocci.ml
index 8c7b4b1..d4d78a4 100644 (file)
  *)
 
 
+(*
+ * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller, Nicolas Palix
+ * This file is part of Coccinelle.
+ *
+ * Coccinelle is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation, according to version 2 of the License.
+ *
+ * Coccinelle is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with Coccinelle.  If not, see <http://www.gnu.org/licenses/>.
+ *
+ * The authors reserve the right to distribute this or future versions of
+ * Coccinelle under other licenses.
+ *)
+
+
 (* splits the entire file into minus and plus fragments, and parses each
 separately (thus duplicating work for the parsing of the context elements) *)
 
@@ -112,7 +134,8 @@ let token2c (tok,_) =
   | PC.Tconst(clt) -> "const"^(line_type2c clt)
   | PC.Tvolatile(clt) -> "volatile"^(line_type2c clt)
 
-  | PC.TPragma(s,_) -> s
+  | PC.TPragma(Ast.Noindent s,_) -> s
+  | PC.TPragma(Ast.Indent s,_)   -> s
   | PC.TIncludeL(s,clt) -> (pr "#include \"%s\"" s)^(line_type2c clt)
   | PC.TIncludeNL(s,clt) -> (pr "#include <%s>" s)^(line_type2c clt)
   | PC.TDefine(clt,_) -> "#define"^(line_type2c clt)
@@ -156,6 +179,7 @@ let token2c (tok,_) =
   | PC.TAnd (clt) -> "&"^(line_type2c clt)
   | PC.TEqEq(clt) -> "=="^(line_type2c clt)
   | PC.TNotEq(clt) -> "!="^(line_type2c clt)
+  | PC.TSub(clt) -> "<="^(line_type2c clt)
   | PC.TTildeEq(clt) -> "~="^(line_type2c clt)
   | PC.TTildeExclEq(clt) -> "~!="^(line_type2c clt)
   | PC.TLogOp(op,clt) ->
@@ -266,6 +290,7 @@ let token2c (tok,_) =
   | PC.TIsoExpression -> "Expression"
   | PC.TIsoArgExpression -> "ArgExpression"
   | PC.TIsoTestExpression -> "TestExpression"
+  | PC.TIsoToTestExpression -> "ToTestExpression"
   | PC.TIsoStatement -> "Statement"
   | PC.TIsoDeclaration -> "Declaration"
   | PC.TIsoType -> "Type"
@@ -304,7 +329,8 @@ let plus_attachable only_plus (tok,_) =
   | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
 
   | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
-  | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt) | PC.TLogOp(_,clt)
+  | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt)
+  | PC.TLogOp(_,clt)
   | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
   | PC.TDmOp(_,clt) | PC.TTilde (clt)
 
@@ -321,6 +347,9 @@ let plus_attachable only_plus (tok,_) =
   | PC.TWhen(clt) |  PC.TWhenTrue(clt) |  PC.TWhenFalse(clt)
   | PC.TAny(clt) | PC.TStrict(clt) | PC.TEllipsis(clt)
   (* | PC.TCircles(clt) | PC.TStars(clt) *)
+  | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
+  | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt)
+  | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *)
 
   | PC.TWhy(clt) | PC.TDotDot(clt) | PC.TBang(clt) | PC.TOPar(clt)
   | PC.TCPar(clt)
@@ -337,11 +366,9 @@ let plus_attachable only_plus (tok,_) =
       else if only_plus then NOTPLUS
       else if line_type clt = D.CONTEXT then PLUS else NOTPLUS
 
-  | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
-  | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
-  | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) (* | PC.TOCircles(clt)
-  | PC.TCCircles(clt) | PC.TOStars(clt) | PC.TCStars(clt) *) -> NOTPLUS
+  | PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt) -> NOTPLUS
   | PC.TMetaPos(nm,_,_,_) -> NOTPLUS
+  | PC.TSub(clt) -> NOTPLUS
 
   | _ -> SKIP
 
@@ -369,7 +396,8 @@ let get_clt (tok,_) =
   | PC.TString(_,clt) | PC.TChar(_,clt) | PC.TFloat(_,clt) | PC.TInt(_,clt)
 
   | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
-  | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt) | PC.TLogOp(_,clt)
+  | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt)
+  | PC.TSub(clt) | PC.TLogOp(_,clt)
   | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
   | PC.TDmOp(_,clt) | PC.TTilde (clt)
 
@@ -471,6 +499,7 @@ let update_clt (tok,x) clt =
   | PC.TEqEq(_) -> (PC.TEqEq(clt),x)
   | PC.TNotEq(_) -> (PC.TNotEq(clt),x)
   | PC.TTildeEq(_) -> (PC.TTildeEq(clt),x)
+  | PC.TSub(_) -> (PC.TSub(clt),x)
   | PC.TLogOp(op,_) -> (PC.TLogOp(op,clt),x)
   | PC.TShOp(op,_) -> (PC.TShOp(op,clt),x)
   | PC.TPlus(_) -> (PC.TPlus(clt),x)
@@ -642,14 +671,15 @@ let split_token ((tok,_) as t) =
   | PC.TFunDecl(clt)
   | PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
   | PC.TAny(clt) | PC.TStrict(clt) | PC.TLineEnd(clt)
-  | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *) -> split t clt
+  | PC.TEllipsis(clt) (* | PC.TCircles(clt) | PC.TStars(clt) *)
+  | PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
+  | PC.TPOEllipsis(clt) | PC.TPCEllipsis(clt) -> split t clt
 
-  | PC.TOEllipsis(_) | PC.TCEllipsis(_) (* clt must be context *)
-  | PC.TPOEllipsis(_) | PC.TPCEllipsis(_) (* clt must be context *)
 (*
   | PC.TOCircles(_) | PC.TCCircles(_)   (* clt must be context *)
   | PC.TOStars(_) | PC.TCStars(_)       (* clt must be context *)
 *)
+
   | PC.TBang0 | PC.TPlus0 | PC.TWhy0 ->
       ([t],[t])
 
@@ -663,7 +693,8 @@ let split_token ((tok,_) as t) =
       split t clt
 
   | PC.TOrLog(clt) | PC.TAndLog(clt) | PC.TOr(clt) | PC.TXor(clt)
-  | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt) | PC.TTildeExclEq(clt) | PC.TLogOp(_,clt)
+  | PC.TAnd (clt) | PC.TEqEq(clt) | PC.TNotEq(clt) | PC.TTildeEq(clt)
+  | PC.TTildeExclEq(clt) | PC.TSub(clt) | PC.TLogOp(_,clt)
   | PC.TShOp(_,clt) | PC.TPlus(clt) | PC.TMinus(clt) | PC.TMul(clt)
   | PC.TDmOp(_,clt) | PC.TTilde (clt) -> split t clt
 
@@ -679,7 +710,8 @@ let split_token ((tok,_) as t) =
 
   | PC.TIso | PC.TRightIso
   | PC.TIsoExpression | PC.TIsoStatement | PC.TIsoDeclaration | PC.TIsoType
-  | PC.TIsoTopLevel | PC.TIsoArgExpression | PC.TIsoTestExpression ->
+  | PC.TIsoTopLevel | PC.TIsoArgExpression | PC.TIsoTestExpression
+  | PC.TIsoToTestExpression ->
       failwith "unexpected tokens"
   | PC.TScriptData s -> ([t],[t])
 
@@ -943,6 +975,36 @@ let rec translate_when_true_false = function
 
 (* ----------------------------------------------------------------------- *)
 
+(* In a nest, if the nest is -, all of the nested code must also be -.
+All are converted to context, because the next takes care of the -. *)
+let check_nests tokens =
+  let is_minus t =
+    let (line_type,a,b,c,d,e,f,g) = get_clt t in
+    List.mem line_type [D.MINUS;D.OPTMINUS;D.UNIQUEMINUS] in
+  let drop_minus t =
+    let clt = try Some(get_clt t) with Failure _ -> None in
+       match clt with
+         Some (line_type,a,b,c,d,e,f,g) ->
+           (match line_type with
+             D.MINUS -> update_clt t (D.CONTEXT,a,b,c,d,e,f,g)
+           | D.OPTMINUS -> update_clt t (D.OPT,a,b,c,d,e,f,g)
+           | D.UNIQUEMINUS -> update_clt t (D.UNIQUE,a,b,c,d,e,f,g)
+           | _ -> failwith "minus token expected")
+       | None -> t in
+  let rec outside = function
+      [] -> []
+    | ((PC.TPOEllipsis(clt),q) as t)::r when is_minus t -> t :: inside 0 r
+    | t::r -> t :: outside r
+  and inside stack = function
+      [] -> failwith "missing nest end"
+    | ((PC.TPCEllipsis(clt),q) as t)::r ->
+       (drop_minus t)
+       :: (if stack = 0 then outside r else inside (stack - 1) r)
+    | ((PC.TPOEllipsis(clt),q) as t)::r ->
+       (drop_minus t) :: (inside (stack + 1) r)
+    | t :: r -> (drop_minus t) :: (inside stack r) in
+  outside tokens
+
 let check_parentheses tokens =
   let clt2line (_,line,_,_,_,_,_,_) = line in
   let rec loop seen_open = function
@@ -1233,7 +1295,10 @@ let prepare_tokens tokens =
     (translate_when_true_false (* after insert_line_end *)
        (insert_line_end
          (detect_types false
-            (find_function_names (detect_attr (check_parentheses tokens))))))
+            (find_function_names
+               (detect_attr
+                  (check_nests
+                     (check_parentheses tokens)))))))
 
 let prepare_mv_tokens tokens =
   detect_types false (detect_attr tokens)
@@ -1334,8 +1399,8 @@ let get_rule_name parse_fn starts_with_name get_tokens file prefix =
       | Ast.GeneratedRulename (nm,a,b,c,d,e) ->
           Ast.GeneratedRulename (check_name nm,a,b,c,d,e)
       | Ast.ScriptRulename(s,deps) -> Ast.ScriptRulename(s,deps)
-      | Ast.InitialScriptRulename(s) -> Ast.InitialScriptRulename(s)
-      | Ast.FinalScriptRulename(s) -> Ast.FinalScriptRulename(s)
+      | Ast.InitialScriptRulename(s,deps) -> Ast.InitialScriptRulename(s,deps)
+      | Ast.FinalScriptRulename(s,deps) -> Ast.FinalScriptRulename(s,deps)
     else
       Ast.CocciRulename(Some(mknm()),Ast.NoDep,[],[],Ast.Undetermined,false) in
   Data.in_rule_name := false;
@@ -1373,7 +1438,7 @@ let parse_iso file =
            let (more,tokens) =
              get_tokens
                [PC.TIsoStatement;PC.TIsoExpression;PC.TIsoArgExpression;
-                 PC.TIsoTestExpression;
+                 PC.TIsoTestExpression; PC.TIsoToTestExpression;
                  PC.TIsoDeclaration;PC.TIsoType;PC.TIsoTopLevel] in
            let next_start = List.hd(List.rev tokens) in
            let dummy_info = ("",(-1,-1),(-1,-1)) in
@@ -1381,7 +1446,7 @@ let parse_iso file =
            let tokens = prepare_tokens (start@tokens) in
             (*
               print_tokens "iso tokens" tokens;
-           *)
+           å*)
            let entry = parse_one "iso main" PC.iso_main file tokens in
            let entry = List.map (List.map Test_exps.process_anything) entry in
            if more
@@ -1456,8 +1521,10 @@ let eval_depend dep virt =
     in
   loop dep
 
-let rec parse file =
+let parse file =
   Lexer_cocci.init();
+  let rec parse_loop file =
+  Lexer_cocci.include_init ();
   let table = Common.full_charpos_to_pos file in
   Common.with_open_infile file (fun channel ->
   let lexbuf = Lexing.from_channel channel in
@@ -1485,13 +1552,13 @@ let rec parse file =
          List.iter (function x -> Hashtbl.add Lexer_cocci.rule_names x ())
            virt;
 
-         let (extra_iso_files, extra_rules, extra_virt) =
+         let (extra_iso_files, extra_rules, extra_virt, extra_metas) =
            let rec loop = function
-               [] -> ([],[],[])
-             | (a,b,c)::rest ->
-                 let (x,y,z) = loop rest in
-                 (a::x,b::y,c::z) in
-           loop (List.map parse include_files) in
+               [] -> ([],[],[],[])
+             | (a,b,c,d)::rest ->
+                 let (x,y,z,zz) = loop rest in
+                 (a::x,b::y,c::z,d@zz) in
+           loop (List.map parse_loop include_files) in
 
           let parse_cocci_rule ruletype old_metas
              (rule_name, dependencies, iso, dropiso, exists, is_expression) =
@@ -1613,23 +1680,28 @@ let rec parse file =
             let data = collect_script_tokens tokens in
             (more,Ast0.ScriptRule(language, deps, metavars, data),[],tokens) in
 
-          let parse_if_script_rule k language =
+          let parse_if_script_rule k language _ deps =
             let get_tokens = tokens_script_all table file false lexbuf in
 
               (* script code *)
             let (more, tokens) = get_tokens [PC.TArobArob; PC.TArob] in
             let data = collect_script_tokens tokens in
-            (more,k (language, data),[],tokens) in
+            (more,k (language, deps, data),[],tokens) in
 
          let parse_iscript_rule =
            parse_if_script_rule
-             (function (language,data) ->
-               Ast0.InitialScriptRule(language,data)) in
+             (function (language,deps,data) ->
+               Ast0.InitialScriptRule(language,deps,data)) in
 
          let parse_fscript_rule =
            parse_if_script_rule
-             (function (language,data) ->
-               Ast0.FinalScriptRule(language,data)) in
+             (function (language,deps,data) ->
+               Ast0.FinalScriptRule(language,deps,data)) in
+
+         let do_parse_script_rule fn l old_metas deps =
+           match eval_depend deps virt with
+             Some deps -> fn l old_metas deps
+           | None ->  fn l old_metas Ast.FailDep in
 
           let parse_rule old_metas starts_with_name =
             let rulename =
@@ -1665,11 +1737,11 @@ let rec parse file =
                    Data.in_generating := false;
                    res)
             | Ast.ScriptRulename(l,deps) ->
-               (match eval_depend deps virt with
-                 Some deps -> parse_script_rule l old_metas deps
-               | None ->  parse_script_rule l old_metas Ast.FailDep)
-            | Ast.InitialScriptRulename(l) -> parse_iscript_rule l
-            | Ast.FinalScriptRulename(l)   -> parse_fscript_rule l
+               do_parse_script_rule parse_script_rule l old_metas deps
+            | Ast.InitialScriptRulename(l,deps) ->
+               do_parse_script_rule parse_iscript_rule l old_metas deps
+            | Ast.FinalScriptRulename(l,deps)   ->
+               do_parse_script_rule parse_fscript_rule l old_metas deps
             | _ -> failwith "Malformed rule name" in
 
          let rec loop old_metas starts_with_name =
@@ -1685,28 +1757,36 @@ let rec parse file =
 
             let (more, rule, metavars, tokens) =
               parse_rule old_metas starts_with_name in
+           let all_metas = metavars @ old_metas in
+
             if more then
-              rule::
-             (loop (metavars @ old_metas) (gen_starts_with_name more tokens))
-            else [rule] in
+             let (all_rules,all_metas) =
+               loop all_metas (gen_starts_with_name more tokens) in
+             (rule::all_rules,all_metas)
+            else ([rule],all_metas) in
+
+         let (all_rules,all_metas) =
+           loop extra_metas (x = PC.TArob) in
 
          (List.fold_left
             (function prev -> function cur -> Common.union_set cur prev)
             iso_files extra_iso_files,
           (* included rules first *)
           List.fold_left (function prev -> function cur -> cur@prev)
-            (loop [] (x = PC.TArob)) (List.rev extra_rules),
-          List.fold_left (@) virt extra_virt (*no dups allowed*))
+            all_rules (List.rev extra_rules),
+          List.fold_left (@) virt extra_virt (*no dups allowed*),
+          (all_metas : 'a list))
       |        _ -> failwith "unexpected code before the first rule\n")
   | (false,[(PC.TArobArob,_)]) | (false,[(PC.TArob,_)]) ->
-      ([],([] : Ast0.parsed_rule list),[] (*virtual rules*))
+      ([],([] : Ast0.parsed_rule list),[] (*virtual rules*), [] (*all metas*))
   | _ -> failwith "unexpected code before the first rule\n" in
-  res)
+  res) in
+  parse_loop file
 
 (* parse to ast0 and then convert to ast *)
 let process file isofile verbose =
   let extra_path = Filename.dirname file in
-  let (iso_files, rules, virt) = parse file in
+  let (iso_files, rules, virt, _metas) = parse file in
   eval_virt virt;
   let std_isos =
     match isofile with
@@ -1718,8 +1798,8 @@ let process file isofile verbose =
     List.map
       (function
           Ast0.ScriptRule (a,b,c,d) -> [([],Ast.ScriptRule (a,b,c,d))]
-       | Ast0.InitialScriptRule (a,b) -> [([],Ast.InitialScriptRule (a,b))]
-       | Ast0.FinalScriptRule (a,b) -> [([],Ast.FinalScriptRule (a,b))]
+       | Ast0.InitialScriptRule (a,b,c) -> [([],Ast.InitialScriptRule (a,b,c))]
+       | Ast0.FinalScriptRule (a,b,c) -> [([],Ast.FinalScriptRule (a,b,c))]
        | Ast0.CocciRule
            ((minus, metavarsm,
              (iso, dropiso, dependencies, rule_name, exists)),