(* Copyright (C) 2012  G. Gonthier, B. Ziliani, A. Nanevski, D. Dreyer  This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.  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 GNU General Public License for more details.  You should have received a copy of the GNU General Public License along with this program.  If not, see <http://www.gnu.org/licenses/>. *)
From mathcomp
From LemmaOverloading
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
(******************************************************************************)
(* This file contains several lemmas automated with canonical structures to   *)
(* verify programs with HTT                                                   *)
(******************************************************************************)
(*************************************************************************)
(* First, the mechanism for search-and-replace for the overloaded lemas, *)
(* pattern-matching on heap expressions.                                 *)
(*************************************************************************)
Structure tagged_heap := Tag {untag :> heap}.
Definition right_tag := Tag.
Definition left_tag := right_tag.
Canonical Structure found_tag i := left_tag i.
Definition update_axiom k r (h : tagged_heap) := untag h = k :+ r.
Structure update (k r : heap) :=
Update {heap_of :> tagged_heap;
_ : update_axiom k r heap_of}.

(* Specifications: *)
Lemma updateE r k (f : update k r) : untag f = k :+ r.
Lemma try_doR (s : spec A) s1 s2 i j (f : forall k, update k j) (r : cont B) :
s.1 i ->
(forall x m, s.2 (Val x) i m -> verify (s1 x) (f m) r) ->
(forall e m, s.2 (Exn e) i m -> verify (s2 e) (f m) r) ->
verify (try_s s s1 s2) (f i) r.
Lemma bnd_doR (s : spec A) s2 i j (f : forall k, update k j) (r : cont B) :
s.1 i ->
(forall x m, s.2 (Val x) i m -> verify (s2 x) (f m) r) ->
(forall e m, s.2 (Exn e) i m -> def (f m) -> r (Exn e) (f m)) ->
verify (bind_s s s2) (f i) r.