(*
- * Copyright 2005-2010, Ecole des Mines de Nantes, University of Copenhagen
+ * 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.
*
*)
-(* Yoann Padioleau
- *
- * Copyright (C) 2006, 2007 Ecole des Mines de Nantes
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License (GPL)
- * version 2 as published by the Free Software Foundation.
- *
- * This program 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
- * file license.txt for more details.
- *
- * This file was part of Coccinelle.
- *)
open Common
module Flag_engine = Flag_matcher
in
tag_mck_pos_mcode mcode posmck x tin
- let distrf_e = distrf (Lib_parsing_c.ii_of_expr)
- let distrf_args = distrf (Lib_parsing_c.ii_of_args)
- let distrf_type = distrf (Lib_parsing_c.ii_of_type)
- let distrf_param = distrf (Lib_parsing_c.ii_of_param)
+ let distrf_e = distrf (Lib_parsing_c.ii_of_expr)
+ let distrf_args = distrf (Lib_parsing_c.ii_of_args)
+ let distrf_type = distrf (Lib_parsing_c.ii_of_type)
+ let distrf_param = distrf (Lib_parsing_c.ii_of_param)
let distrf_params = distrf (Lib_parsing_c.ii_of_params)
- let distrf_ini = distrf (Lib_parsing_c.ii_of_ini)
+ let distrf_ini = distrf (Lib_parsing_c.ii_of_ini)
+ let distrf_inis = distrf (Lib_parsing_c.ii_of_inis)
+ let distrf_decl = distrf (Lib_parsing_c.ii_of_decl)
+ let distrf_field = distrf (Lib_parsing_c.ii_of_field)
let distrf_node = distrf (Lib_parsing_c.ii_of_node)
- let distrf_struct_fields = distrf (Lib_parsing_c.ii_of_struct_fields)
- let distrf_cst = distrf (Lib_parsing_c.ii_of_cst)
+ let distrf_enum_fields = distrf (Lib_parsing_c.ii_of_enum_fields)
+ let distrf_struct_fields = distrf (Lib_parsing_c.ii_of_struct_fields)
+ let distrf_cst = distrf (Lib_parsing_c.ii_of_cst)
let distrf_define_params = distrf (Lib_parsing_c.ii_of_define_params)
else None
| None ->
- let valu' =
- match valu with
- Ast_c.MetaIdVal a -> Ast_c.MetaIdVal a
- | Ast_c.MetaFuncVal a -> Ast_c.MetaFuncVal a
- | Ast_c.MetaLocalFuncVal a -> Ast_c.MetaLocalFuncVal a (*more?*)
- | Ast_c.MetaExprVal a ->
- Ast_c.MetaExprVal
- (if strip
- then Lib_parsing_c.al_expr a
- else Lib_parsing_c.semi_al_expr a)
- | Ast_c.MetaExprListVal a ->
- Ast_c.MetaExprListVal
- (if strip
- then Lib_parsing_c.al_arguments a
- else Lib_parsing_c.semi_al_arguments a)
-
- | Ast_c.MetaStmtVal a ->
- Ast_c.MetaStmtVal
- (if strip
- then Lib_parsing_c.al_statement a
- else Lib_parsing_c.semi_al_statement a)
- | Ast_c.MetaTypeVal a ->
- Ast_c.MetaTypeVal
- (if strip
- then Lib_parsing_c.al_type a
- else Lib_parsing_c.semi_al_type a)
-
- | Ast_c.MetaInitVal a ->
- Ast_c.MetaInitVal
- (if strip
- then Lib_parsing_c.al_init a
- else Lib_parsing_c.semi_al_init a)
-
- | Ast_c.MetaListlenVal a -> Ast_c.MetaListlenVal a
-
- | Ast_c.MetaParamVal a -> failwith "not handling MetaParamVal"
- | Ast_c.MetaParamListVal a ->
- Ast_c.MetaParamListVal
- (if strip
- then Lib_parsing_c.al_params a
- else Lib_parsing_c.semi_al_params a)
-
- | Ast_c.MetaPosVal (pos1,pos2) -> Ast_c.MetaPosVal (pos1,pos2)
- | Ast_c.MetaPosValList l -> Ast_c.MetaPosValList l
- in Some (tin.binding +> Common.insert_assoc (k, valu'))
+ let success valu' =
+ Some (tin.binding +> Common.insert_assoc (k, valu')) in
+ (match valu with
+ Ast_c.MetaIdVal (a,c) ->
+ (* c is a negated constraint *)
+ let rec loop = function
+ [] -> success(Ast_c.MetaIdVal(a,[]))
+ | c::cs ->
+ let tmp =
+ Common.optionise
+ (fun () -> tin.binding0 +> List.assoc c) in
+ (match tmp with
+ Some (Ast_c.MetaIdVal(v,_)) ->
+ if a =$= v
+ then None (* failure *)
+ else success(Ast_c.MetaIdVal(a,[]))
+ | Some _ -> failwith "Not possible"
+ | None -> success(Ast_c.MetaIdVal(a,[]))) in
+ loop c
+ | Ast_c.MetaFuncVal a ->
+ success(Ast_c.MetaFuncVal a)
+ | Ast_c.MetaLocalFuncVal a ->
+ success(Ast_c.MetaLocalFuncVal a) (*more?*)
+ | Ast_c.MetaExprVal (a,c) ->
+ (* c in the value is only to prepare for the future in which
+ we figure out how to have subterm constraints on unbound
+ variables. Now an environment will only contain expression
+ values with empty constraints, as all constraints are
+ resolved at binding time *)
+ let stripped =
+ if strip
+ then Lib_parsing_c.al_expr a
+ else Lib_parsing_c.semi_al_expr a in
+ let inh_stripped = Lib_parsing_c.al_inh_expr a in
+ let rec loop = function
+ [] -> success(Ast_c.MetaExprVal(stripped,[]))
+ | c::cs ->
+ let tmp =
+ Common.optionise
+ (fun () -> tin.binding0 +> List.assoc c) in
+ (match tmp with
+ Some (Ast_c.MetaExprVal(v,_)) ->
+ if C_vs_c.subexpression_of_expression inh_stripped v
+ then loop cs (* forget satisfied constraints *)
+ else None (* failure *)
+ | Some _ -> failwith "not possible"
+ (* fail if this should be a subterm of something that
+ doesn't exist *)
+ | None -> None) in
+ loop c
+ | Ast_c.MetaExprListVal a ->
+ success
+ (Ast_c.MetaExprListVal
+ (if strip
+ then Lib_parsing_c.al_arguments a
+ else Lib_parsing_c.semi_al_arguments a))
+
+ | Ast_c.MetaDeclVal a ->
+ success
+ (Ast_c.MetaDeclVal
+ (if strip
+ then Lib_parsing_c.al_declaration a
+ else Lib_parsing_c.semi_al_declaration a))
+ | Ast_c.MetaFieldVal a ->
+ success
+ (Ast_c.MetaFieldVal
+ (if strip
+ then Lib_parsing_c.al_field a
+ else Lib_parsing_c.semi_al_field a))
+ | Ast_c.MetaStmtVal a ->
+ success
+ (Ast_c.MetaStmtVal
+ (if strip
+ then Lib_parsing_c.al_statement a
+ else Lib_parsing_c.semi_al_statement a))
+ | Ast_c.MetaTypeVal a ->
+ success
+ (Ast_c.MetaTypeVal
+ (if strip
+ then Lib_parsing_c.al_type a
+ else Lib_parsing_c.semi_al_type a))
+
+ | Ast_c.MetaInitVal a ->
+ success
+ (Ast_c.MetaInitVal
+ (if strip
+ then Lib_parsing_c.al_init a
+ else Lib_parsing_c.semi_al_init a))
+
+ | Ast_c.MetaListlenVal a -> success(Ast_c.MetaListlenVal a)
+
+ | Ast_c.MetaParamVal a ->
+ success
+ (Ast_c.MetaParamVal
+ (if strip
+ then Lib_parsing_c.al_param a
+ else Lib_parsing_c.semi_al_param a))
+ | Ast_c.MetaParamListVal a ->
+ success
+ (Ast_c.MetaParamListVal
+ (if strip
+ then Lib_parsing_c.al_params a
+ else Lib_parsing_c.semi_al_params a))
+
+ | Ast_c.MetaPosVal (pos1,pos2) ->
+ success(Ast_c.MetaPosVal (pos1,pos2))
+ | Ast_c.MetaPosValList l -> success (Ast_c.MetaPosValList l))
let envf keep inherited = fun (k, valu, get_max_min) f tin ->
let x = Ast_cocci.unwrap_mcode k in
let value_format_flag f = fun tin ->
f (tin.extra.value_format_iso) tin
-
(* ------------------------------------------------------------------------*)
(* Tokens *)
(* ------------------------------------------------------------------------*)
HCoop / bpt / coccinelle.git / blobdiff