(*
- * Copyright 2010, INRIA, University of Copenhagen
+ * Copyright 2012, INRIA
+ * Julia Lawall, Gilles Muller
+ * Copyright 2010-2011, 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
| PC.TMPtVirg -> ";"
| PC.TArobArob -> "@@"
| PC.TArob -> "@"
- | PC.TPArob -> "P@"
+ | PC.TPArob clt -> "P@"
| PC.TScript -> "script"
| PC.TInitialize -> "initialize"
| PC.TFinalize -> "finalize"
| PC.TPtrOp(clt)
| PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
- | PC.TPtVirg(clt)
+ | PC.TPArob(clt) | PC.TPtVirg(clt)
| PC.TOPar0(clt) | PC.TMid0(clt) | PC.TCPar0(clt)
| PC.TOEllipsis(clt) | PC.TCEllipsis(clt)
| PC.TAssign(s,_) -> (PC.TAssign(s,clt),x)
| PC.TDot(_) -> (PC.TDot(clt),x)
| PC.TComma(_) -> (PC.TComma(clt),x)
+ | PC.TPArob(_) -> (PC.TPArob(clt),x)
| PC.TPtVirg(_) -> (PC.TPtVirg(clt),x)
| PC.TLineEnd(_) -> (PC.TLineEnd(clt),x)
| PC.TMetaDeclarer(_,_,_,clt) | PC.TMetaIterator(_,_,_,clt) -> split t clt
| PC.TMPtVirg | PC.TArob | PC.TArobArob | PC.TScript
| PC.TInitialize | PC.TFinalize -> ([t],[t])
- | PC.TPArob | PC.TMetaPos(_,_,_,_) -> ([t],[])
+ | PC.TPArob clt | PC.TMetaPos(_,_,_,clt) -> split t clt
| PC.TFunDecl(clt)
| PC.TWhen(clt) | PC.TWhenTrue(clt) | PC.TWhenFalse(clt)
| PC.TIncludeL(_,clt) | PC.TIncludeNL(_,clt)
| PC.TEq(clt) | PC.TAssign(_,clt) | PC.TDot(clt) | PC.TComma(clt)
- | PC.TPtVirg(clt) ->
+ | PC.TPArob(clt) | PC.TPtVirg(clt) ->
let (_,line,_,_,_,_,_,_) = clt in Some line
| _ -> None
(PC.TExists,a) :: (find_line_end inwhen line clt q xs)
| ((PC.TComma(clt),a) as x)::xs when token2line x = line ->
(PC.TComma(clt),a) :: (find_line_end inwhen line clt q xs)
- | ((PC.TPArob,a) as x)::xs -> (* no line #, just assume on the same line *)
- x :: (find_line_end inwhen line clt q xs)
+ | ((PC.TPArob(clt),a) as x)::xs when token2line x = line ->
+ (PC.TPArob(clt),a) :: (find_line_end inwhen line clt q xs)
| x::xs when token2line x = line -> x :: (find_line_end inwhen line clt q xs)
| xs -> (PC.TLineEnd(clt),q)::(insert_line_end xs)
let prepare_mv_tokens tokens =
detect_types false (detect_attr tokens)
-let rec consume_minus_positions = function
+let unminus (d,x1,x2,x3,x4,x5,x6,x7) = (* for hidden variables *)
+ match d with
+ D.MINUS | D.OPTMINUS | D.UNIQUEMINUS -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7)
+ | D.PLUS -> failwith "unexpected plus code"
+ | D.PLUSPLUS -> failwith "unexpected plus code"
+ | D.CONTEXT | D.UNIQUE | D.OPT -> (D.CONTEXT,x1,x2,x3,x4,x5,x6,x7)
+
+let process_minus_positions x name clt meta =
+ let (arity,ln,lln,offset,col,strbef,straft,pos) = get_clt x in
+ let name = Parse_aux.clt2mcode name (unminus clt) in
+ update_clt x (arity,ln,lln,offset,col,strbef,straft,meta name::pos)
+
+(* first attach positions, then the others, so that positions can refer to
+the larger term represented by the preceding metavariable *)
+let rec consume_minus_positions toks =
+ let rec loop_pos = function
+ [] -> []
+ | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
+ | ((PC.TMid0(_),_) as x)::xs -> x::loop_pos xs
+ | x::(PC.TPArob _,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
+ let x =
+ process_minus_positions x name clt
+ (function name ->
+ Ast0.MetaPosTag(Ast0.MetaPos(name,constraints,per))) in
+ (loop_pos (x::xs))
+ | x::xs -> x::loop_pos xs in
+ let rec loop_other = function
+ [] -> []
+ | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
+ | ((PC.TMid0(_),_) as x)::xs -> x::loop_other xs
+ | x::(PC.TPArob _,_)::(PC.TMetaExp(name,constraints,pure,ty,clt),_)::xs ->
+ let x =
+ process_minus_positions x name clt
+ (function name ->
+ Ast0.ExprTag
+ (Ast0.wrap
+ (Ast0.MetaExpr(name,constraints,ty,Ast.ANY,pure)))) in
+ (loop_other (x::xs))
+ | x::(PC.TPArob _,_)::(PC.TMetaInit(name,pure,clt),_)::xs ->
+ let x =
+ process_minus_positions x name clt
+ (function name ->
+ Ast0.InitTag(Ast0.wrap(Ast0.MetaInit(name,pure)))) in
+ (loop_other (x::xs))
+ | x::(PC.TPArob _,_)::(PC.TMetaType(name,pure,clt),_)::xs ->
+ let x =
+ process_minus_positions x name clt
+ (function name ->
+ Ast0.TypeCTag(Ast0.wrap(Ast0.MetaType(name,pure)))) in
+ (loop_other (x::xs))
+ | x::(PC.TPArob _,_)::(PC.TMetaDecl(name,pure,clt),_)::xs ->
+ let x =
+ process_minus_positions x name clt
+ (function name ->
+ Ast0.DeclTag(Ast0.wrap(Ast0.MetaDecl(name,pure)))) in
+ (loop_other (x::xs))
+ | x::(PC.TPArob _,_)::(PC.TMetaStm(name,pure,clt),_)::xs ->
+ let x =
+ process_minus_positions x name clt
+ (function name ->
+ Ast0.StmtTag(Ast0.wrap(Ast0.MetaStmt(name,pure)))) in
+ (loop_other (x::xs))
+ | x::xs -> x::loop_other xs in
+ loop_other(loop_pos toks)
+
+let rec consume_plus_positions = function
[] -> []
- | ((PC.TOPar0(_),_) as x)::xs | ((PC.TCPar0(_),_) as x)::xs
- | ((PC.TMid0(_),_) as x)::xs -> x::consume_minus_positions xs
- | x::(PC.TPArob,_)::(PC.TMetaPos(name,constraints,per,clt),_)::xs ->
- let (arity,ln,lln,offset,col,strbef,straft,pos) = get_clt x in
- let name = Parse_aux.clt2mcode name clt in
- let x =
- update_clt x
- (arity,ln,lln,offset,col,strbef,straft,
- (Ast0.MetaPos(name,constraints,per)::pos)) in
- (consume_minus_positions (x::xs))
- | x::xs -> x::consume_minus_positions xs
+ | (PC.TPArob _,_)::x::xs -> consume_plus_positions xs
+ | x::xs -> x::consume_plus_positions xs
let any_modif rule =
let mcode x =
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
else [(iso_metavars,entry,rule_name)] in
loop starts_with_name start
| (false,_) -> [] in
+ List.iter Iso_compile.process res;
res)
let parse_iso_files existing_isos iso_files extra_path =
*)
let minus_tokens = consume_minus_positions minus_tokens in
+ let plus_tokens = consume_plus_positions plus_tokens in
let minus_tokens = prepare_tokens minus_tokens in
let plus_tokens = prepare_tokens plus_tokens in
List.filter
(function (_,_,nm) -> not (List.mem nm dropiso))
chosen_isos in
- List.iter Iso_compile.process chosen_isos;
let dropped_isos =
match reserved_names with
"all"::others ->
if !Flag.sgrep_mode2 then minus
else Single_statement.single_statement minus in
let minus = Simple_assignments.simple_assignments minus in
+ (* has to be last, introduced AsExpr, etc *)
+ let minus = Get_metas.process minus in
let minus_ast =
Ast0toast.ast0toast rule_name dependencies dropped_isos
exists minus is_exp ruletype in