Fixpoint reach'' (m:mem) (B:block -> bool) (L:list (block * Z)): block -> bool:=
  match L with
    nil => B
  | l::L => match l with
             (b',z) => match ZMap.get z (PMap.get b' (Mem.mem_contents m))
                       with Fragment (Vptr b off) q  n => fun bb => eq_block bb b &&
                                               Mem.perm_dec m b' z Cur Readable  &&
                                               reach'' m B L b'
                           | _ => fun bb => false
                       end
            end
  end.

Lemma reach_mono: forall B1 B2 (HB : forall b, B1 b = true -> B2 b = true) m b L1 (R : reach m (fun bb : block => B1 bb = true) L1 b), exists L, reach m (fun bb : block => B2 bb = true) L b.