+lemma Realize_to_GRealize : ∀sig,M.∀P,R.
+ M ⊨ R → GRealize sig M P R.
+#alpha #M #Pre #R #HR #t #HPre
+cases (HR t) -HR #k * #outc * #Hloop #HR
+@(ex_intro ?? k) @(ex_intro ?? outc) %
+ [ @Hloop | @HR ]
+qed.
+
+lemma acc_Realize_to_acc_GRealize: ∀sig,M.∀q:states sig M.∀P,R1,R2.
+ M ⊨ [q:R1,R2] → accGRealize sig M q P R1 R2.
+#alpha #M #q #Pre #R1 #R2 #HR #t #HPre
+cases (HR t) -HR #k * #outc * * #Hloop #HRtrue #HRfalse
+@(ex_intro ?? k) @(ex_intro ?? outc) %
+ [ % [@Hloop] @HRtrue | @HRfalse]
+qed.
+
+(******************************** monotonicity ********************************)
+lemma Realize_to_Realize : ∀alpha,M,R1,R2.
+ R1 ⊆ R2 → Realize alpha M R1 → Realize alpha M R2.
+#alpha #M #R1 #R2 #Himpl #HR1 #intape
+cases (HR1 intape) -HR1 #k * #outc * #Hloop #HR1
+@(ex_intro ?? k) @(ex_intro ?? outc) % /2/
+qed.
+
+lemma WRealize_to_WRealize: ∀sig,M,R1,R2.
+ R1 ⊆ R2 → WRealize sig M R1 → WRealize ? M R2.
+#alpha #M #R1 #R2 #Hsub #HR1 #intape #i #outc #Hloop
+@Hsub @(HR1 … i) @Hloop
+qed.
+
+lemma GRealize_to_GRealize : ∀alpha,M,P,R1,R2.
+ R1 ⊆ R2 → GRealize alpha M P R1 → GRealize alpha M P R2.
+#alpha #M #P #R1 #R2 #Himpl #HR1 #intape #HP
+cases (HR1 intape HP) -HR1 #k * #outc * #Hloop #HR1
+@(ex_intro ?? k) @(ex_intro ?? outc) % /2/
+qed.
+
+lemma GRealize_to_GRealize_2 : ∀alpha,M,P1,P2,R1,R2.
+ P2 ⊆ P1 → R1 ⊆ R2 → GRealize alpha M P1 R1 → GRealize alpha M P2 R2.
+#alpha #M #P1 #P2 #R1 #R2 #Himpl1 #Himpl2 #H1 #intape #HP
+cases (H1 intape (Himpl1 … HP)) -H1 #k * #outc * #Hloop #H1
+@(ex_intro ?? k) @(ex_intro ?? outc) % /2/
+qed.
+
+lemma acc_Realize_to_acc_Realize: ∀sig,M.∀q:states sig M.∀R1,R2,R3,R4.
+ R1 ⊆ R3 → R2 ⊆ R4 → M ⊨ [q:R1,R2] → M ⊨ [q:R3,R4].
+#alpha #M #q #R1 #R2 #R3 #R4 #Hsub13 #Hsub24 #HRa #intape
+cases (HRa intape) -HRa #k * #outc * * #Hloop #HRtrue #HRfalse
+@(ex_intro ?? k) @(ex_intro ?? outc) %
+ [ % [@Hloop] #Hq @Hsub13 @HRtrue // | #Hq @Hsub24 @HRfalse //]
+qed.
+
+(**************************** A canonical relation ****************************)
+
+definition R_TM ≝ λsig.λM:TM sig.λq.λt1,t2.
+∃i,outc.
+ loopM ? M i (mk_config ?? q t1) = Some ? outc ∧
+ t2 = (ctape ?? outc).
+
+lemma R_TM_to_R: ∀sig,M,R. ∀t1,t2.
+ M ⊫ R → R_TM ? M (start sig M) t1 t2 → R t1 t2.
+#sig #M #R #t1 #t2 whd in ⊢ (%→?); #HMR * #i * #outc *
+#Hloop #Ht2 >Ht2 @(HMR … Hloop)
+qed.
+
+(******************************** NOP Machine *********************************)
+
+(* NO OPERATION
+ t1 = t2 *)
+
+definition nop_states ≝ initN 1.
+definition start_nop : initN 1 ≝ mk_Sig ?? 0 (le_n … 1).
+
+definition nop ≝
+ λalpha:FinSet.mk_TM alpha nop_states
+ (λp.let 〈q,a〉 ≝ p in 〈q,None ?,N〉)
+ start_nop (λ_.true).
+
+definition R_nop ≝ λalpha.λt1,t2:tape alpha.t2 = t1.
+
+lemma sem_nop :
+ ∀alpha.nop alpha ⊨ R_nop alpha.
+#alpha #intape @(ex_intro ?? 1)
+@(ex_intro … (mk_config ?? start_nop intape)) % %
+qed.
+
+lemma nop_single_state: ∀sig.∀q1,q2:states ? (nop sig). q1 = q2.
+normalize #sig * #n #ltn1 * #m #ltm1
+generalize in match ltn1; generalize in match ltm1;
+<(le_n_O_to_eq … (le_S_S_to_le … ltn1)) <(le_n_O_to_eq … (le_S_S_to_le … ltm1))
+// qed.