Skip to content
Snippets Groups Projects
Commit b1095f5b authored by Patrick Baudin's avatar Patrick Baudin
Browse files

[wp] improves mask simplifier

parent 63cd5595
No related branches found
No related tags found
No related merge requests found
...@@ -989,76 +989,68 @@ end ...@@ -989,76 +989,68 @@ end
let mask_simplifier = let mask_simplifier =
object(self) let update x m ctx =
Tmap.insert (fun _ m old -> if Integer.lt m old then (*better*) m else old)
(** Must be 2^n-1 *) x m ctx
val mutable magnitude : Integer.t Tmap.t = Tmap.empty and rewrite ctx e =
let reduce m x = match F.repr x with
method name = "Rewrite unsigned masks" | Kint v -> F.e_zint (Integer.logand m v)
method copy = {< magnitude = magnitude >} | _ -> x
and collect ctx d x = try
method private update x m = let m = Tmap.find x ctx in
let better =
try Integer.lt m (Tmap.find x magnitude)
with Not_found -> true in
if better then magnitude <- Tmap.add x m magnitude
method private collect d x =
try
let m = Tmap.find x magnitude in
match d with match d with
| None -> Some m | None -> Some m
| Some m0 -> if Integer.lt m m0 then Some m else d | Some m0 -> if Integer.lt m m0 then Some m else d
with Not_found -> d with Not_found -> d
in
match F.repr e with
| Fun(f,es) when f == f_land ->
begin
match List.fold_left (collect ctx) None es with
| None -> raise Not_found
| Some m -> F.e_fun f_land (List.map (reduce m) es)
end
| _ -> raise Not_found
in
object
method private reduce m x = (** Must be 2^n-1 *)
match F.repr x with val mutable magnitude : Integer.t Tmap.t = Tmap.empty
| Kint v -> F.e_zint (Integer.logand m v)
| _ -> x
method private rewrite e = method name = "Rewrite unsigned masks"
match F.repr e with method copy = {< magnitude = magnitude >}
| Fun(f,es) when f == f_land ->
begin
match List.fold_left self#collect None es with
| None -> raise Not_found
| Some m -> F.e_fun f_land (List.map (self#reduce m) es)
end
| _ -> raise Not_found
method target _ = () method target _ = ()
method infer = [] method infer = []
method fixpoint = () method fixpoint = ()
method assume p = method assume p =
let rec walk e = match F.repr e with Lang.iter_confident_literals
| And es -> List.iter walk es (fun p -> match F.repr p with
| Fun(f,[x]) -> | Fun(f,[x]) -> begin
begin try
try let iota = is_cint f in
let iota = is_cint f in if not (Ctypes.signed iota) then
if not (Ctypes.signed iota) then magnitude <- update x (snd (Ctypes.bounds iota)) magnitude
self#update x (snd (Ctypes.bounds iota)) with Not_found -> ()
with Not_found -> () end
end | _ -> ()) (F.e_prop p)
| _ -> ()
in walk (F.e_prop p)
method simplify_exp e = method simplify_exp e =
if Tmap.is_empty magnitude then e else if Tmap.is_empty magnitude then e else
Lang.e_subst self#rewrite e Lang.e_subst (rewrite magnitude) e
method simplify_hyp p = method simplify_hyp p =
if Tmap.is_empty magnitude then p else if Tmap.is_empty magnitude then p else
Lang.p_subst self#rewrite p Lang.p_subst (rewrite magnitude) p
method simplify_branch p = method simplify_branch p =
if Tmap.is_empty magnitude then p else if Tmap.is_empty magnitude then p else
Lang.p_subst self#rewrite p Lang.p_subst (rewrite magnitude) p
method simplify_goal p = method simplify_goal p =
if Tmap.is_empty magnitude then p else if Tmap.is_empty magnitude then p else
Lang.p_subst self#rewrite p Lang.p_subst (rewrite magnitude) p
end end
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment