Fixpoint list_nat (n:nat) (x:value) {struct n} :=
match n, x with
| 0, value_label 1%positive => True
| S n', value_cons (value_label 1%positive) x' => list_nat n' x'
| _, _ => False
end.
Fixpoint list_length (x:value) :=
match x with
| value_cons _ x' => S (list_length x')
| _ => 0
end.
Definition list_nat_var (n:nat) (v:var) (r:store) :=
match r#v with
| None => False
| Some x => list_nat n x
end.
Definition add_term_measure (_:label) (r:store) :=
match r#(V 1) with
| Some x => Some (list_length x)
| None => None
end.
Definition add_P' n m st :=
list_nat_var n (V 1) st /\
list_nat_var m (V 2) st.
Definition add_Q' n m st := list_nat_var (n+m) (V 2) st.
Definition add_P (nm:nat*nat) := store_op (add_P' (fst nm) (snd nm)).
Definition add_Q (nm:nat*nat) := store_op (add_Q' (fst nm) (snd nm)).
(* Destructively add the unary-enocded natural numbers stored in V 1 and V 2, putting the result in V 2 *)
Program Definition add_phi : map instruction :=
set _ (empty _) (L 0)
( instr_assert (EX nm:_, add_P nm) ;;
instr_if_nil (V 1)
(*then *) ( instr_return ) (*else *) ( (instr_fetch_field (V 1) 0 (V 3) ;; instr_fetch_field (V 1) 1 (V 1) ;; instr_cons (V 3) (V 2) (V 2)) ;; instr_getlabel (L 0) (V 0) ;; (instr_call (V 0) ;; instr_return) ) ). Next Obligation. unfold hereditary; intros. (*  apply boxy_i; auto. simpl; intros.*)
destruct a as [? [? ?]].
destruct a' as [? [? ?]].
destruct H0 as [[n m] [_ [? _]]].
simpl in *.
unfold add_P' in *. exists (n,m); simpl in *.
unfold age, age1 in H. simpl in H.
revert H; case_eq (age1 k); intros; inv H1. auto.
Qed.
Next Obligation.
apply boxy_i; auto.
simpl; intros.
destruct w as [? [? ?]].
destruct w' as [? [? ?]].
destruct H0 as [[n m] [_ [? _]]].
rewrite K.expandM_spec in H.
destruct H. destruct H1. simpl in *.
exists (n,m). split; auto. split; auto.
simpl.
destruct H0; split.
hnf in H0. hnf; simpl V in *.
hnf in H1.
case_eq (s#2); intros;
rewrite H4 in H0; try tauto.
apply H1 in H4. rewrite H4; auto.
hnf in H3. hnf; simpl V in *.
case_eq (s#3); intros;
rewrite H4 in H3; try tauto.
apply H1 in H4. rewrite H4; auto.
Qed.
(* For every store satisfying the addition precondition, calling the addition function will halt with a store satisfing the postcondition. *)

Lemma addition_totally_correct :
forall r n m,
add_P' n m r ->
exists n', exists p', exists r',
stepstar add_term_measure (K.squash (n',add_phi)) p'
r ((instr_getlabel (L 0) (V 0) ;; instr_call (L 0) ;; instr_return ;; instr_nil _)::nil)
r' nil /\
add_Q' n m r'.