coccinelle release 1.0.0-rc2
[bpt/coccinelle.git] / parsing_cocci / lexer_cocci.mll
index 9e25896..46fdde8 100644 (file)
  *)
 
 
-(*
- * Copyright 2010, INRIA, University of Copenhagen
- * Julia Lawall, Rene Rydhof Hansen, Gilles Muller, Nicolas Palix
- * Copyright 2005-2009, 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.
- *)
-
-
 {
 open Parser_cocci_menhir
 module D = Data
@@ -76,7 +52,7 @@ let get_current_line_type lexbuf =
     if !line_start < 0 then 0 else lex_start - !line_start in
   (*line_start := -1;*)
   prev_plus := (c = D.PLUS) or (c = D.PLUSPLUS);
-  (c,l,ll,lex_start,preceeding_spaces,[],[],Ast0.NoMetaPos)
+  (c,l,ll,lex_start,preceeding_spaces,[],[],[])
 let current_line_started = ref false
 let col_zero = ref true
 
@@ -221,7 +197,8 @@ let id_tokens lexbuf =
   let in_iso = !Data.in_iso in
   let in_prolog = !Data.in_prolog in
   match s with
-    "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier
+    "metavariable" when in_meta -> check_arity_context_linetype s; TMetavariable
+  | "identifier" when in_meta -> check_arity_context_linetype s; TIdentifier
   | "type" when in_meta ->       check_arity_context_linetype s; TType
   | "parameter" when in_meta ->  check_arity_context_linetype s; TParameter
   | "constant"  when in_meta ->  check_arity_context_linetype s; TConstant
@@ -355,9 +332,13 @@ let init _ =
   Hashtbl.clear iterator_names;
   Hashtbl.clear declarer_names;
   let get_name (_,x) = x in
+  Data.add_meta_meta :=
+    (fun name pure ->
+      let fn clt = TMeta(name,pure,clt) in
+      Hashtbl.replace metavariables (get_name name) fn);
   Data.add_id_meta :=
     (fun name constraints pure ->
-      let fn clt = TMetaId(name,constraints,pure,clt) in
+      let fn clt = TMetaId(name,constraints,Ast.NoVal,pure,clt) in
       Hashtbl.replace metavariables (get_name name) fn);
   Data.add_virt_id_meta_found :=
     (fun name vl ->
@@ -365,11 +346,11 @@ let init _ =
       Hashtbl.replace metavariables name fn);
   Data.add_virt_id_meta_not_found :=
     (fun name pure ->
-      let fn clt = TMetaId(name,Ast.IdNoConstraint,pure,clt) in
+      let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast.NoVal,pure,clt) in
       Hashtbl.replace metavariables (get_name name) fn);
   Data.add_fresh_id_meta :=
-    (fun name ->
-      let fn clt = TMetaId(name,Ast.IdNoConstraint,Ast0.Impure,clt) in
+    (fun name seed ->
+      let fn clt = TMetaId(name,Ast.IdNoConstraint,seed,Ast0.Impure,clt) in
       Hashtbl.replace metavariables (get_name name) fn);
   Data.add_type_meta :=
     (fun name pure ->
@@ -379,6 +360,10 @@ let init _ =
     (fun name pure ->
       let fn clt = TMetaInit(name,pure,clt) in
       Hashtbl.replace metavariables (get_name name) fn);
+  Data.add_initlist_meta :=
+    (function name -> function lenname -> function pure ->
+      let fn clt = TMetaInitList(name,lenname,pure,clt) in
+      Hashtbl.replace metavariables (get_name name) fn);
   Data.add_param_meta :=
     (function name -> function pure ->
       let fn clt = TMetaParam(name,pure,clt) in
@@ -419,6 +404,10 @@ let init _ =
     (function name -> function pure ->
       let fn clt = TMetaField(name,pure,clt) in
       Hashtbl.replace metavariables (get_name name) fn);
+  Data.add_field_list_meta :=
+    (function name -> function lenname -> function pure ->
+      let fn clt = TMetaFieldList(name,lenname,pure,clt) in
+      Hashtbl.replace metavariables (get_name name) fn);
   Data.add_stm_meta :=
     (function name -> function pure ->
       let fn clt = TMetaStm(name,pure,clt) in
@@ -529,12 +518,24 @@ rule token = parse
 
   | [' ' '\t'  ]+  { start_line false; token lexbuf }
 
-  | "//" [^ '\n']* {
+  | [' ' '\t'  ]* (("//" [^ '\n']*) as after) {
     match !current_line_type with
       (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
-       TPragma (Ast.Indent (tok lexbuf), get_current_line_type lexbuf)
+       let str =
+         if !current_line_started
+         then (tok lexbuf)
+         else after in
+       start_line true;
+       TPragma (Ast.Indent str, get_current_line_type lexbuf)
     | _ -> start_line false; token lexbuf }
 
+  | "__attribute__" [' ' '\t']* "((" _* "))"
+   { match !current_line_type with
+      (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
+       start_line true;
+       TPragma (Ast.Space (tok lexbuf), get_current_line_type lexbuf)
+    | _ -> failwith "attributes only allowedin + code" }
+
   | "@@" { start_line true; TArobArob }
   | "@"  { pass_zero();
           if !Data.in_rule_name or not !current_line_started
@@ -699,6 +700,17 @@ rule token = parse
   | "^"            { start_line true; TXor(get_current_line_type lexbuf) }
 
   | "##"            { start_line true; TCppConcatOp }
+  | (( ("#" [' ' '\t']*  "undef" [' ' '\t']+)) as def)
+    ( (letter (letter |digit)*) as ident)
+      { start_line true;
+       let (arity,line,lline,offset,col,strbef,straft,pos) as lt =
+         get_current_line_type lexbuf in
+       let off = String.length def in
+       (* -1 in the code below because the ident is not at the line start *)
+       TUndef
+         (lt,
+          check_var ident
+            (arity,line,lline,offset+off,col+off,[],[],[])) }
   | (( ("#" [' ' '\t']*  "define" [' ' '\t']+)) as def)
     ( (letter (letter |digit)*) as ident)
       { start_line true;
@@ -709,7 +721,7 @@ rule token = parse
        TDefine
          (lt,
           check_var ident
-            (arity,line,lline,offset+off,col+off,[],[],Ast0.NoMetaPos)) }
+            (arity,line,lline,offset+off,col+off,[],[],[])) }
   | (( ("#" [' ' '\t']*  "define" [' ' '\t']+)) as def)
     ( (letter (letter | digit)*) as ident)
     '('
@@ -748,12 +760,16 @@ rule token = parse
       { start_line true; check_plus_linetype (tok lexbuf);
        TPragma (Ast.Noindent(tok lexbuf), get_current_line_type lexbuf) }
   | "/*"
-      { start_line true; check_plus_linetype (tok lexbuf);
+      {
+       match !current_line_type with
+        (D.PLUS,_,_) | (D.PLUSPLUS,_,_) ->
+        start_line true;
        (* second argument to TPragma is not quite right, because
           it represents only the first token of the comment, but that
           should be good enough *)
-       TPragma (Ast.Indent("/*"^(comment lexbuf)),
-                get_current_line_type lexbuf) }
+       TPragma (Ast.Indent("/*"^(comment check_comment lexbuf)),
+                get_current_line_type lexbuf)
+      |        _ -> let _ = comment (fun _ -> ()) lexbuf in token lexbuf }
   | "---" [^'\n']*
       { (if !current_line_started
       then lexerr "--- must be at the beginning of the line" "");
@@ -834,27 +850,28 @@ and string  = parse
        }
   | _ { lexerr "unrecognised symbol: " (tok lexbuf) }
 
-and comment = parse
+and comment check_comment = parse
   | "*/" { let s = tok lexbuf in check_comment s; start_line true; s }
   | ['\n' '\r' '\011' '\012']
       { let s = tok lexbuf in
         (* even blank line should have a + *)
         check_comment s;
-        reset_line lexbuf; s ^ comment lexbuf }
+        reset_line lexbuf; s ^ comment check_comment lexbuf }
   | "+" { pass_zero();
          if !current_line_started
-         then (start_line true; let s = tok lexbuf in s^(comment lexbuf))
-         else (start_line true; comment lexbuf) }
+         then (start_line true;
+               let s = tok lexbuf in s^(comment check_comment lexbuf))
+         else (start_line true; comment check_comment lexbuf) }
   (* noteopti: *)
   | [^ '*']
       { let s = tok lexbuf in
-        check_comment s; start_line true; s ^ comment lexbuf }
+        check_comment s; start_line true; s ^ comment check_comment lexbuf }
   | [ '*']
       { let s = tok lexbuf in
-        check_comment s; start_line true; s ^ comment lexbuf }
+        check_comment s; start_line true; s ^ comment check_comment lexbuf }
   | _
       { start_line true; let s = tok lexbuf in
         Common.pr2 ("LEXER: unrecognised symbol in comment:"^s);
-        s ^ comment lexbuf
+        s ^ comment check_comment lexbuf
       }