(*
- * 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
let res = k re in
match Ast.unwrap re with
Ast.FunHeader(bef,_,fninfo,name,lp,params,rp) ->
- bind (mcode r ((),(),bef,Ast.NoMetaPos)) res
+ bind (mcode r ((),(),bef,[])) res
| Ast.Decl(bef,_,decl) ->
- bind (mcode r ((),(),bef,Ast.NoMetaPos)) res
+ bind (mcode r ((),(),bef,[])) res
| _ -> res in
let recursor =
V.combiner bind option_default
(* --------------------------------------------------------------------- *)
-(* drop all distinguishing information from a term *)
-let strip =
- let do_nothing r k e = Ast.make_term (Ast.unwrap (k e)) in
+(* drop all distinguishing information from a term except inherited
+ variables, which are used to improve efficiency of matching process *)
+let strip x =
+ let do_nothing r k e =
+ let inh = Ast.get_inherited e in
+ Ast.make_inherited_term (Ast.unwrap (k e)) inh in
let do_absolutely_nothing r k e = k e in
let mcode m = Ast.make_mcode(Ast.unwrap_mcode m) in
let rule_elem r k re =
do_nothing do_nothing do_nothing do_nothing do_nothing do_nothing
do_nothing rule_elem do_nothing do_nothing
do_nothing do_absolutely_nothing in
- recursor.V.rebuilder_rule_elem
+ recursor.V.rebuilder_rule_elem x
(* --------------------------------------------------------------------- *)
(* --------------------------------------------------------------------- *)
(* the main translation loop *)
-let rule_elem re =
+let rec rule_elem re =
match Ast.unwrap re with
- Ast.DisjRuleElem(res) -> [[(List.length res,strip re)]]
+ Ast.DisjRuleElem(res) ->
+ (* why was the following done? ors have to be kept together for
+ efficiency, so they are considered at once and not individually
+ anded with everything else *)
+ let re =
+ let all_inhs = List.map Ast.get_inherited res in
+ let inhs =
+ List.fold_left
+ (function prev ->
+ function inh ->
+ Common.inter_set inh prev)
+ (List.hd all_inhs) (List.tl all_inhs) in
+ Ast.make_inherited_term (Ast.unwrap re) inhs in
+ [[(List.length res,strip re)]]
| _ -> [[(1,strip re)]]
let conj_one testfn x l =
| Ast.While(header,branch,(_,_,_,aft))
| Ast.For(header,branch,(_,_,_,aft))
| Ast.Iterator(header,branch,(_,_,_,aft)) ->
- if testfn header or mcode () ((),(),aft,Ast.NoMetaPos)
+ if testfn header or mcode () ((),(),aft,[])
then conj (rule_elem header) (statement testfn mcode tail branch)
else statement testfn mcode tail branch
conj
(statement testfn mcode tail branch1)
(statement testfn mcode tail branch2) in
- if testfn ifheader or mcode () ((),(),aft,Ast.NoMetaPos)
+ if testfn ifheader or mcode () ((),(),aft,[])
then conj (rule_elem ifheader) branches
else branches
| Ast.Define(header,body) ->
conj_one testfn header (statement_list testfn mcode tail body)
+ | Ast.AsStmt(stm,asstm) ->
+ conj
+ (statement testfn mcode tail stm)
+ (statement testfn mcode tail asstm)
+
| Ast.OptStm(stm) -> []
| Ast.UniqueStm(stm) -> statement testfn mcode tail stm
let top_level testfn mcode t : 'a list list =
match Ast.unwrap t with
Ast.FILEINFO(old_file,new_file) -> failwith "not supported fileinfo"
- | Ast.DECL(stmt) -> statement testfn mcode false stmt
+ | Ast.NONDECL(stmt) -> statement testfn mcode false stmt
| Ast.CODE(stmt_dots) -> statement_list testfn mcode false stmt_dots
| Ast.ERRORWORDS(exps) -> failwith "not supported errorwords"