From Undecidability.L Require Import Util.L_facts Complexity.ResourceMeasures.
From Undecidability.L Require Import LM_heap_def.
(* ** Direct correctness proof  *)
(* *** Correctnes Heap-interaction *)
Definition extended (H H' : Heap) := forall alpha m, nth_error H alpha = Some m -> nth_error H' alpha = Some m.
(* *** Unfolding *)
Inductive unfolds H a: nat -> term -> term -> Prop :=
| unfoldsUnbound k n :
n < k ->
unfolds H a k (var n) (var n)
| unfoldsBound k b P s s' n:
n >= k ->
lookup H a (n-k) = Some (b,P) ->
reprP P s ->
unfolds H b 0 s s' ->
unfolds H a k (var n) s'
| unfoldsLam k s s':
unfolds H a (S k) s s' ->
unfolds H a k (lam s) (lam s')
| unfoldsApp k (s t s' t' : term):
unfolds H a k s s' ->
unfolds H a k t t' ->
unfolds H a k (s t) (s' t').
Definition unfolds_ind' (H : Heap) (P : HAdd -> nat -> term -> term -> Prop)
(f : forall (a : HAdd) (k n : nat), n < k -> P a k n n)
(f0 : forall (a : HAdd) (k : nat) (b : HAdd) (P0 : list Tok)
(s s' : term) (n : nat),
n >= k ->
lookup H a (n - k) = Some (b, P0) ->
P0 = compile s -> unfolds H b 1 s s' -> P b 1 s s' -> P a k n (lam s'))
(f1 : forall (a : HAdd) (k : nat) (s s' : term),
unfolds H a (S k) s s' -> P a (S k) s s' -> P a k (lam s) (lam s'))
(f2 : forall (a : HAdd) (k : nat) (s t s' t' : term),
unfolds H a k s s' ->
P a k s s' -> unfolds H a k t t' -> P a k t t' -> P a k (s t) (s' t'))
: forall (a : HAdd) (n : nat) (t t0 : term),
unfolds H a n t t0 -> P a n t t0.
Definition unfolds_rect (H : Heap) (P : HAdd -> nat -> term -> term -> Type)
(f : forall (a : HAdd) (k n : nat), n < k -> P a k n n)
(f0 : forall (a : HAdd) (k : nat) (b : HAdd) (P0 : list Tok)
(s s' : term) (n : nat),
n >= k ->
lookup H a (n - k) = Some (b, P0) ->
P0 = compile s -> unfolds H b 1 s s' -> P b 1 s s' -> P a k n (lam s'))
(f1 : forall (a : HAdd) (k : nat) (s s' : term),
unfolds H a (S k) s s' -> P a (S k) s s' -> P a k (lam s) (lam s'))
(f2 : forall (a : HAdd) (k : nat) (s t s' t' : term),
unfolds H a k s s' ->
P a k s s' -> unfolds H a k t t' -> P a k t t' -> P a k (s t) (s' t'))
: forall (a : HAdd) (n : nat) (t t0 : term),
unfolds H a n t t0 -> P a n t t0.
Inductive reprC : Heap -> _ -> term -> Prop :=
reprCC H P s a s' :
reprP P s ->
unfolds H a 0 s s' ->
reprC H (a,P) s'.
Instance extended_PO :
PreOrder extended.
Typeclasses Opaque extended.
Instance unfold_extend_Proper : Proper (extended ==> eq ==> eq ==> eq ==> eq ==>Basics.impl) unfolds.
Instance reprC_extend_Proper : Proper (extended ==> eq ==> eq ==>Basics.impl) reprC.
(* *** BS correctness *)
Definition init s :state := ([(0,compile s)],[],[]).
(* *** BS soundness *)

Lemma soundness' s0 s P a T V H k sigma:
evaluatesIn step k ((a,compile s0++P)::T,V,H) sigma ->
unfolds H a 0 s0 s ->
exists k1 k2 g H' t n , k = k1 + k2
/\ pow step k1 ((a,compile s0++P)::T,V,H) (tailRecursion (a,P) T,g::V,H')
/\ evaluatesIn step k2 (tailRecursion (a,P) T,g::V,H') sigma
/\ timeBS n s t
/\ extended H H'
/\ reprC H' g t
/\ k1 = 3*n + 1.