Release coccinelle-0.2.3rc4
[bpt/coccinelle.git] / parsing_cocci / ast0_cocci.ml
index fe3ba6a..fbdd107 100644 (file)
@@ -1,23 +1,25 @@
 (*
-* Copyright 2005-2009, Ecole des Mines de Nantes, University of Copenhagen
-* Yoann Padioleau, Julia Lawall, Rene Rydhof Hansen, Henrik Stuart, Gilles Muller
-* 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.
-*)
+ * 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.
+ *)
 
 
 module Ast = Ast_cocci
@@ -35,21 +37,31 @@ let default_token_info =
 
 (* MIXED is like CONTEXT, since sometimes MIXED things have to revert to
 CONTEXT - see insert_plus.ml *)
+type count = ONE (* + *) | MANY (* ++ *)
+
 type mcodekind =
     MINUS       of (Ast.anything list list * token_info) ref
-  | PLUS
+  | PLUS        of Ast.count
   | CONTEXT     of (Ast.anything Ast.befaft * token_info * token_info) ref
   | MIXED       of (Ast.anything Ast.befaft * token_info * token_info) ref
 
-type info = { line_start : int; line_end : int;
-             logical_start : int; logical_end : int;
+type position_info = { line_start : int; line_end : int;
+                      logical_start : int; logical_end : int;
+                      column : int; offset : int; }
+
+type info = { pos_info : position_info;
              attachable_start : bool; attachable_end : bool;
              mcode_start : mcodekind list; mcode_end : mcodekind list;
-             column : int; offset : int;
              (* the following are only for + code *)
-             strings_before : string list; strings_after : string list }
-
-type 'a mcode = 'a * arity * info * mcodekind * meta_pos ref (* pos, - only *)
+             strings_before : (Ast.added_string * position_info) list;
+             strings_after : (Ast.added_string * position_info) list }
+
+(* adjacency index is incremented when we skip over dots or nest delimiters
+it is used in deciding how much to remove, when two adjacent code tokens are
+removed. *)
+type 'a mcode =
+    'a * arity * info * mcodekind * meta_pos ref (* pos, - only *) *
+      int (* adjacency_index *)
 (* int ref is an index *)
 and 'a wrap =
     { node : 'a;
@@ -90,10 +102,10 @@ and 'a dots = 'a base_dots wrap
 (* Identifier *)
 
 and base_ident =
-    Id of string mcode
-  | MetaId        of Ast.meta_name mcode * ident list * pure
-  | MetaFunc      of Ast.meta_name mcode * ident list * pure
-  | MetaLocalFunc of Ast.meta_name mcode * ident list * pure
+    Id            of string mcode
+  | MetaId        of Ast.meta_name mcode * Ast.idconstraint * pure
+  | MetaFunc      of Ast.meta_name mcode * Ast.idconstraint * pure
+  | MetaLocalFunc of Ast.meta_name mcode * Ast.idconstraint * pure
   | OptIdent      of ident
   | UniqueIdent   of ident
 
@@ -128,8 +140,8 @@ and base_expression =
   | SizeOfType     of string mcode (* sizeof *) * string mcode (* ( *) *
                       typeC * string mcode (* ) *)
   | TypeExp        of typeC (* type name used as an expression, only in args *)
-  | MetaErr        of Ast.meta_name mcode * expression list * pure
-  | MetaExpr       of Ast.meta_name mcode * expression list *
+  | MetaErr        of Ast.meta_name mcode * constraints * pure
+  | MetaExpr       of Ast.meta_name mcode * constraints *
                      Type_cocci.typeC list option * Ast.form * pure
   | MetaExprList   of Ast.meta_name mcode (* only in arg lists *) *
                      listlen * pure
@@ -146,6 +158,12 @@ and base_expression =
 
 and expression = base_expression wrap
 
+and constraints =
+    NoConstraint
+  | NotIdCstrt     of Ast.reconstraint
+  | NotExpCstrt    of expression list
+  | SubExpCstrt    of Ast.meta_name list
+
 and listlen = Ast.meta_name mcode option
 
 (* --------------------------------------------------------------------- *)
@@ -296,6 +314,7 @@ and base_statement =
                     statement * (info * mcodekind) (* after info *)
   | Switch        of string mcode (* switch *) * string mcode (* ( *) *
                     expression * string mcode (* ) *) * string mcode (* { *) *
+                    statement (*decl*) dots *
                     case_line dots * string mcode (* } *)
   | Break         of string mcode (* break *) * string mcode (* ; *)
   | Continue      of string mcode (* continue *) * string mcode (* ; *)
@@ -350,6 +369,8 @@ and base_case_line =
     Default of string mcode (* default *) * string mcode (*:*) * statement dots
   | Case of string mcode (* case *) * expression * string mcode (*:*) *
        statement dots
+  | DisjCase of string mcode * case_line list *
+       string mcode list (* the |s *) * string mcode
   | OptCase of case_line
 
 and case_line = base_case_line wrap
@@ -379,8 +400,12 @@ and parsed_rule =
       (rule * Ast.metavar list *
         (string list * string list * Ast.dependency * string * Ast.exists)) *
        (rule * Ast.metavar list) * Ast.ruletype
-  | ScriptRule of
-      string * Ast.dependency * (string * Ast.meta_name) list * string
+  | ScriptRule of string (* name *) *
+      string * Ast.dependency *
+       (Ast.script_meta_name * Ast.meta_name * Ast.metavar) list *
+       string
+  | InitialScriptRule of  string (* name *) *string * Ast.dependency * string
+  | FinalScriptRule of  string (* name *) *string * Ast.dependency * string
 
 (* --------------------------------------------------------------------- *)
 
@@ -426,12 +451,16 @@ let top x = TopTag x
 (* --------------------------------------------------------------------- *)
 (* Avoid cluttering the parser.  Calculated in compute_lines.ml. *)
 
-let default_info _ = (* why is this a function? *)
+let pos_info =
   { line_start = -1; line_end = -1;
     logical_start = -1; logical_end = -1;
+    column = -1; offset = -1; }
+
+let default_info _ = (* why is this a function? *)
+  { pos_info = pos_info;
     attachable_start = true; attachable_end = true;
     mcode_start = []; mcode_end = [];
-    column = -1; offset = -1; strings_before = []; strings_after = [] }
+    strings_before = []; strings_after = [] }
 
 let default_befaft _ =
   MIXED(ref (Ast.NOTHING,default_token_info,default_token_info))
@@ -461,23 +490,25 @@ let context_wrap x =
     true_if_test_exp = false;
     iso_info = [] }
 let unwrap x = x.node
-let unwrap_mcode (x,_,_,_,_) = x
+let unwrap_mcode (x,_,_,_,_,_) = x
 let rewrap model x = { model with node = x }
-let rewrap_mcode (_,arity,info,mcodekind,pos) x = (x,arity,info,mcodekind,pos)
+let rewrap_mcode (_,arity,info,mcodekind,pos,adj) x =
+  (x,arity,info,mcodekind,pos,adj)
 let copywrap model x =
   { model with node = x; index = ref !(model.index);
     mcodekind = ref !(model.mcodekind); exp_ty = ref !(model.exp_ty)}
-let get_pos (_,_,_,_,x) = !x
-let get_pos_ref (_,_,_,_,x) = x
-let set_pos pos (m,arity,info,mcodekind,_) = (m,arity,info,mcodekind,ref pos)
+let get_pos (_,_,_,_,x,_) = !x
+let get_pos_ref (_,_,_,_,x,_) = x
+let set_pos pos (m,arity,info,mcodekind,_,adj) =
+  (m,arity,info,mcodekind,ref pos,adj)
 let get_info x      = x.info
 let set_info x info = {x with info = info}
-let get_line x      = x.info.line_start
-let get_line_end x  = x.info.line_end
+let get_line x      = x.info.pos_info.line_start
+let get_line_end x  = x.info.pos_info.line_end
 let get_index x     = !(x.index)
 let set_index x i   = x.index := i
 let get_mcodekind x = !(x.mcodekind)
-let get_mcode_mcodekind (_,_,_,mcodekind,_) = mcodekind
+let get_mcode_mcodekind (_,_,_,mcodekind,_,_) = mcodekind
 let get_mcodekind_ref x = x.mcodekind
 let set_mcodekind x mk  = x.mcodekind := mk
 let set_type x t        = x.exp_ty := t
@@ -492,7 +523,7 @@ let get_test_exp x      = x.true_if_test_exp
 let set_test_exp x      = {x with true_if_test_exp = true}
 let get_iso x           = x.iso_info
 let set_iso x i = if !Flag.track_iso_usage then {x with iso_info = i} else x
-let set_mcode_data data (_,ar,info,mc,pos) = (data,ar,info,mc,pos)
+let set_mcode_data data (_,ar,info,mc,pos,adj) = (data,ar,info,mc,pos,adj)
 
 (* --------------------------------------------------------------------- *)
 
@@ -542,9 +573,9 @@ let rec ast0_type_to_type ty =
        Id(tag) ->
          Type_cocci.StructUnionName(structUnion su,false,unwrap_mcode tag)
       | MetaId(tag,_,_) ->
-         (Printf.printf
+         (Common.pr2
             "warning: struct/union with a metavariable name detected.\n";
-          Printf.printf
+          Common.pr2
             "For type checking assuming the name of the metavariable is the name of the type\n";
           let (rule,tag) = unwrap_mcode tag in
           Type_cocci.StructUnionName(structUnion su,true,rule^tag))
@@ -554,7 +585,10 @@ let rec ast0_type_to_type ty =
   | TypeName(name) -> Type_cocci.TypeName(unwrap_mcode name)
   | MetaType(name,_) ->
       Type_cocci.MetaType(unwrap_mcode name,Type_cocci.Unitary,false)
-  | DisjType(_,types,_,_) -> failwith "unexpected DisjType"
+  | DisjType(_,types,_,_) ->
+      Common.pr2_once
+       "disjtype not supported in smpl type inference, assuming unknown";
+      Type_cocci.Unknown
   | OptType(ty) | UniqueType(ty) ->
       ast0_type_to_type ty
 
@@ -587,8 +621,8 @@ and const_vol t =
 (* this function is a rather minimal attempt.  the problem is that information
 has been lost.  but since it is only used for metavariable types in the isos,
 perhaps it doesn't matter *)
-and make_mcode x = (x,NONE,default_info(),context_befaft(),ref NoMetaPos)
-let make_mcode_info x info = (x,NONE,info,context_befaft(),ref NoMetaPos)
+and make_mcode x = (x,NONE,default_info(),context_befaft(),ref NoMetaPos,-1)
+let make_mcode_info x info = (x,NONE,info,context_befaft(),ref NoMetaPos,-1)
 
 exception TyConv
 
@@ -607,18 +641,22 @@ let rec reverse_type ty =
       if mv
       then
        (* not right... *)
+       let rule = "" in
        EnumName
          (make_mcode "enum",
-          context_wrap(MetaId(make_mcode ("",tag),[],Impure)))
+          context_wrap(MetaId(make_mcode (rule,tag),Ast.IdNoConstraint,
+                              Impure)))
       else
        EnumName(make_mcode "enum",context_wrap(Id(make_mcode tag)))
   | Type_cocci.StructUnionName(su,mv,tag) ->
       if mv
       then
        (* not right... *)
+       let rule = "" in
        StructUnionName
          (reverse_structUnion su,
-          Some(context_wrap(MetaId(make_mcode ("",tag),[],Impure))))
+          Some(context_wrap(MetaId(make_mcode (rule,tag),Ast.IdNoConstraint,
+                                   Impure))))
       else
        StructUnionName
          (reverse_structUnion su,