From b1550173994c1b775bb9f2b5c7506da95c24e672 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Fri, 9 Jul 2021 00:33:08 +0200
Subject: [PATCH 001/103] old ROOTS

---
 ROOTS | 0
 1 file changed, 0 insertions(+), 0 deletions(-)
 create mode 100644 ROOTS

diff --git a/ROOTS b/ROOTS
new file mode 100644
index 00000000..e69de29b

From bd0e75a8946e3edc7dca536801d00cf3f2d8ed25 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Fri, 13 Aug 2021 16:48:01 +0200
Subject: [PATCH 002/103] non-harmful changes to ease the refinement to HOL-nat

---
 ...Minus_Minus_To_SAS_Plus_Plus_Reduction.thy | 20 ++++++++++++-------
 ...us_To_SAS_Plus_Plus_State_Translations.thy |  1 +
 .../IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy    |  4 ++++
 .../SAS_Plus_Plus_To_SAS_Plus.thy             | 10 ++++++++--
 4 files changed, 26 insertions(+), 9 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction.thy
index f4933236..4416b3e4 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction.thy
@@ -19,7 +19,11 @@ type_synonym operator = "(variable, domain_element) sas_plus_operator"
 type_synonym problem = "(variable, domain_element) sas_plus_problem"
 
 definition pc_to_com :: "(variable \<times> domain_element) list \<Rightarrow> com" where
-"pc_to_com l = (case  l ! 0 of (_, PCV x) \<Rightarrow> x)"
+"pc_to_com l = (if l = [] then SKIP else (case  l ! 0 of (_, PCV x) \<Rightarrow> x | t \<Rightarrow> SKIP))"
+
+lemma pc_to_com_def2 :"l \<noteq> [] \<Longrightarrow> pc_to_com l = (case  l ! 0 of (_, PCV x) \<Rightarrow> x | t \<Rightarrow> SKIP)"
+  apply (auto simp add: pc_to_com_def)
+  done
 
 fun com_to_operators :: "com \<Rightarrow> operator list" where
 "com_to_operators (SKIP) = []" |
@@ -144,16 +148,18 @@ lemma map_of_precondition_of_op_PC[simp]: "op \<in> set (com_to_operators c)
 
 lemma pc_to_com_precondition_of_op_PC [simp]: "op \<in> set (com_to_operators c) 
   \<Longrightarrow> pc_to_com (precondition_of op) = c"
-  using PC_of_precondition  
-  by (metis PC_in_effect_precondition domain_element.simps nth_mem old.prod.case pc_to_com_def 
-      precondition_nonempty)
+  using PC_of_precondition  pc_to_com_def2
+  by (metis PC_in_effect_precondition domain_element.simps(6) 
+        length_greater_0_conv nth_mem old.prod.case precondition_nonempty)
+  
 
 lemma pc_to_com_effect[simp]: "op \<in> set (com_to_operators c) 
   \<Longrightarrow> (PC, y) \<in> set (effect_of op) \<longleftrightarrow> y = PCV (pc_to_com (effect_of op))"
   using com_to_operators_variables_distinct PC_in_effect_precondition 
-  by (auto simp: pc_to_com_def)
-   (metis domain_element.simps effect_nonempty eq_key_imp_eq_value nth_mem old.prod.case)+
-
+  pc_to_com_def2
+  by (metis domain_element.simps(6) effect_nonempty eq_key_imp_eq_value length_greater_0_conv
+ nth_mem old.prod.case)
+  
 lemma PC_of_effect[simp]: "op \<in> set (com_to_operators c) 
   \<Longrightarrow> map_of (effect_of op) PC = Some (PCV (pc_to_com (effect_of op)))"
   using com_to_operators_variables_distinct PC_in_effect_precondition 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy
index dae24314..0a1028e2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy
@@ -24,6 +24,7 @@ definition imp_minus_state_to_sas_plus :: "(com \<times> imp_state) \<Rightarrow
   \<circ>\<^sub>m (\<lambda>x. (case x of VN v \<Rightarrow> Some v)))
   (PC \<mapsto> PCV (fst ci))"
 
+
 definition sas_plus_state_to_imp_minus:: "sas_state \<Rightarrow> (com \<times> imp_state)" where
 "sas_plus_state_to_imp_minus ss = ((case (the (ss PC)) of (PCV c) \<Rightarrow> c), 
   (\<lambda>x. (case x of EV y \<Rightarrow> Some y | _ \<Rightarrow> None)) \<circ>\<^sub>m ss \<circ>\<^sub>m (\<lambda>x. Some (VN x)))"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
index bc78fcd1..f2899f7c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
@@ -106,6 +106,10 @@ text \<open> First direction of the correctness proof for the IMP- to SAS+ reduc
       no significance, rather they are just derived by adding up the various constants that we
       used in the correctness proofs for the different parts of the reduction. \<close> 
 
+
+lemma foo :
+  assumes "p I"
+  shows "q (sat_decode (Imp_minus_to_sat_nat (imp_encode I) (r_encode r)))"
 lemma IMP_Minus_to_SAS_Plus_correctness:
   assumes
     "I \<subseteq>\<^sub>m Some \<circ> s1" 
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy
index 42c806f4..35711d73 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy
@@ -124,16 +124,22 @@ lemma execute_SAS_Plus_Plus_ops_in_SAS_Plus[simp]:
       SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_def)
   by(auto simp: SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_applicable[simplified])
 
+fun thef:: "'a list option \<Rightarrow> 'a list" where 
+"thef None = []"|
+"thef (Some x) = x"
+
+
+
 definition initialization_operators:: "('v, 'd) sas_plus_problem \<Rightarrow> ('v, 'd) operator list" where
 "initialization_operators P = 
   concat (map (\<lambda> v. (if v \<in> dom ((P)\<^sub>I\<^sub>+) then [] 
     else map (\<lambda> y. \<lparr> precondition_of = [(Stage, Init)],  effect_of = [(Var v, DE y)]\<rparr>) 
-      (the (range_of P v)))) ((P)\<^sub>\<V>\<^sub>+))"
+      (thef (range_of P v)))) ((P)\<^sub>\<V>\<^sub>+))"
 
 lemma in_initialization_operators_iff: 
   "\<lparr>precondition_of = [(Stage, Init)], effect_of = [(Var x, DE y)]\<rparr> 
     \<in> set (initialization_operators P) 
-  \<longleftrightarrow> (x \<in> set ((P)\<^sub>\<V>\<^sub>+) \<and> ((P)\<^sub>I\<^sub>+) x = None \<and> y \<in> set (the (range_of P x)))"
+  \<longleftrightarrow> (x \<in> set ((P)\<^sub>\<V>\<^sub>+) \<and> ((P)\<^sub>I\<^sub>+) x = None \<and> y \<in> set (thef (range_of P x)))"
   by(auto simp: initialization_operators_def)
 
 lemma Stage_after_initialization_operator[simp]:

From b6a414e71828000d28071be88105ae450763803a Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Fri, 13 Aug 2021 17:26:36 +0200
Subject: [PATCH 003/103] refinement of the reduction to HOL_nat

---
 .../IMP_Minus_Max_Constant_Nat.thy            | 192 +++++
 .../IMP_Minus_To_SAS_Plus_Nat.thy             | 325 ++++++++
 .../IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy      | 417 ++++++++++
 Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy | 743 ++++++++++++++++++
 4 files changed, 1677 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
new file mode 100644
index 00000000..bc85eec2
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -0,0 +1,192 @@
+theory IMP_Minus_Max_Constant_Nat
+  imports "HOL-Library.Nat_Bijection"
+ Primitives  IMP_Minus_Max_Constant 
+begin
+
+
+fun atomExp_to_constant:: "atomExp \<Rightarrow> nat" where
+"atomExp_to_constant (V var) = 0" |
+"atomExp_to_constant (N val) = val"
+
+definition atomExp_to_constant_nat:: "nat \<Rightarrow> nat" where 
+"atomExp_to_constant_nat n = (if fst_nat n = 0 then 0 else snd_nat n)"
+
+lemma sub_atomExp_to_constant[simp]: "atomExp_to_constant_nat (atomExp_encode x) = atomExp_to_constant x"
+  apply (cases x)
+  apply (auto simp add: atomExp_to_constant_nat_def sub_fst sub_snd)
+  done
+
+
+fun aexp_max_constant:: "AExp.aexp \<Rightarrow> nat" where
+"aexp_max_constant (A a) = atomExp_to_constant a" |
+"aexp_max_constant (Plus a b) = max (atomExp_to_constant a) (atomExp_to_constant b)" |
+"aexp_max_constant (Sub a b) = max (atomExp_to_constant a) (atomExp_to_constant b)" |
+"aexp_max_constant (Parity a) = atomExp_to_constant a" | 
+"aexp_max_constant (RightShift a) = atomExp_to_constant a"
+
+fun aexp_max_constant_nat:: "nat \<Rightarrow> nat" where
+"aexp_max_constant_nat n = (if hd_nat n \<le>2 \<and> 1 \<le> hd_nat n 
+then max (atomExp_to_constant_nat (nth_nat (Suc 0) n)) (atomExp_to_constant_nat (nth_nat (Suc (Suc 0)) n))
+else atomExp_to_constant_nat (nth_nat (Suc 0) n))"
+
+lemma sub_aexp_max_constant:"aexp_max_constant_nat (aexp_encode x) = aexp_max_constant x"
+  apply (cases x)
+      apply (auto simp only: aexp_max_constant_nat.simps aexp_encode.simps
+                sub_nth  sub_hd head.simps nth.simps
+              sub_snd sub_fst snd_def fst_def sub_atomExp_to_constant)
+      apply auto
+  done
+
+  
+      
+fun max_constant :: "Com.com \<Rightarrow> nat" where
+"max_constant (Com.com.SKIP) = 0" |
+"max_constant (Com.com.Assign vname aexp) = aexp_max_constant aexp" |
+"max_constant (Com.com.Seq c1  c2) = max (max_constant c1) (max_constant c2)" |         
+"max_constant (Com.com.If  _ c1 c2) = max (max_constant c1) (max_constant c2)"  |   
+"max_constant (Com.com.While _ c) = max_constant c"
+
+lemma fst_less [simp]: "n >0 \<Longrightarrow>fst_nat n < n"
+  apply (auto simp add:fst_nat_def)
+  by (metis fst_conv leI le_add1 le_less_trans prod_decode_aux.cases prod_sum_less)
+
+lemma snd_less [simp]: "n >0 \<Longrightarrow> fst_nat n > 0 \<Longrightarrow>snd_nat n < n"
+  by (auto simp add:snd_nat_def fst_nat_def prod_snd_less)
+    
+lemma sum_less [simp]: "fst_nat n + snd_nat n \<le> n"
+  apply (simp add: fst_nat_def snd_nat_def)
+  by (simp add: prod_sum_less2)
+    
+
+declare nth_nat.simps [simp del]
+fun max_constant_nat :: "nat \<Rightarrow> nat" where 
+"max_constant_nat n = (if n=0 \<or> hd_nat n = 0 then 0 else if hd_nat n = 1 
+          then aexp_max_constant_nat (nth_nat (Suc (Suc 0)) n ) else (if hd_nat n =2 then 
+          max (max_constant_nat (nth_nat (Suc 0) n)) (max_constant_nat (nth_nat (Suc (Suc 0)) n)) 
+          else (if hd_nat n =3 then 
+       max (max_constant_nat (nth_nat (Suc (Suc 0)) n)) (max_constant_nat (nth_nat (Suc (Suc (Suc 0))) n))
+        else max_constant_nat (nth_nat (Suc (Suc 0)) n ) )))"
+declare nth_nat.simps [simp]
+
+lemma [simp]: "fst_nat 0 =0" 
+  by (simp add: fst_nat_def fst_def prod_decode_aux.simps prod_decode_def)
+    
+lemma sub_max_constant:"max_constant_nat (com_encode c) = max_constant c"
+  apply (subst max_constant_nat.simps)
+  apply (induction c)
+      apply (simp_all split:if_splits only: com_encode.simps sub_nth sub_hd nth.simps 
+        sub_aexp_max_constant  max_constant.simps head.simps)
+      apply auto
+  done
+
+fun atomExp_var:: "atomExp \<Rightarrow> vname list" where
+"atomExp_var (V var) = [ var ]" |
+"atomExp_var (N val) = []"
+
+fun atomExp_var_nat:: "nat \<Rightarrow> nat" where
+"atomExp_var_nat n = (if fst_nat n = 0 then cons (snd_nat n) 0 else 0)"
+
+
+lemma sub_atomExp_var: "atomExp_var_nat (atomExp_encode x) = vname_list_encode (atomExp_var x)"
+  apply (cases x)
+  apply (auto simp only: atomExp_encode.simps atomExp_var_nat.simps)
+   apply (auto simp add:vname_list_encode_def cons_def sub_fst sub_snd prod_encode_eq)
+  done
+
+fun aexp_vars:: "AExp.aexp \<Rightarrow> vname list" where
+"aexp_vars (A a) = atomExp_var a" |
+"aexp_vars (Plus a b) = (atomExp_var a) @ (atomExp_var b)" |
+"aexp_vars (Sub a b) = (atomExp_var a) @ (atomExp_var b)" |
+"aexp_vars (Parity a) = atomExp_var a" |
+"aexp_vars (RightShift a) = atomExp_var a"
+
+definition aexp_vars_nat:: "nat \<Rightarrow> nat" where
+"aexp_vars_nat n =  ( if hd_nat n = 1 \<or> hd_nat n = 2 then
+             append_nat (atomExp_var_nat (nth_nat (Suc 0) n)) (atomExp_var_nat(nth_nat (Suc (Suc 0)) n))
+                    else atomExp_var_nat (nth_nat (Suc 0) n))"
+
+lemma sub_aexp_vars : "aexp_vars_nat (aexp_encode x) = vname_list_encode (aexp_vars x)"
+  apply (cases x)
+      apply (auto simp only: aexp_vars_nat_def aexp_encode.simps sub_hd head.simps sub_nth nth.simps
+ sub_append sub_atomExp_var aexp_vars.simps vname_list_encode_def)
+      apply auto
+  done
+
+fun all_variables :: "Com.com \<Rightarrow> vname list" where
+"all_variables (Com.com.SKIP) = []" |
+"all_variables (Com.com.Assign v aexp) = v # aexp_vars aexp" |
+"all_variables (Com.com.Seq c1 c2) = all_variables c1 @ all_variables c2" |
+"all_variables (Com.com.If v c1 c2) = [ v ] @ all_variables c1 @ all_variables c2" |
+"all_variables (Com.com.While v c) = [ v ] @ all_variables c"
+
+declare nth_nat.simps[simp del]
+fun all_variables_nat :: "nat \<Rightarrow> nat" where
+"all_variables_nat n = (if n=0 \<or> hd_nat n =0 then 0 else if hd_nat n = 1 then cons (nth_nat (Suc 0) n) 
+(aexp_vars_nat (nth_nat (Suc (Suc 0)) n )) else if hd_nat n = 2
+then append_nat (all_variables_nat (nth_nat (Suc 0) n)) (all_variables_nat (nth_nat (Suc (Suc 0)) n))
+else if hd_nat n = 3 then
+ append_nat (append_nat (cons (nth_nat (Suc 0) n) 0) (all_variables_nat (nth_nat (Suc (Suc 0)) n)))
+ (all_variables_nat(nth_nat (Suc (Suc (Suc 0))) n))
+else append_nat (cons (nth_nat (Suc 0) n) 0)  (all_variables_nat (nth_nat (Suc (Suc 0)) n)) )"
+declare nth_nat.simps[simp]
+
+lemma sub_cons_vname: "cons (vname_encode x) (vname_list_encode xs) = vname_list_encode (x#xs)"
+  apply (auto simp add:cons_def vname_list_encode_def) done
+lemma sub_append_vname: "append_nat (vname_list_encode x) (vname_list_encode xs) = vname_list_encode (x@xs)"
+  apply (induction x)
+   apply (auto simp add: vname_list_encode_def sub_append simp flip: list_encode.simps)
+  done
+
+lemma sub_all_variables: "all_variables_nat (com_encode x ) = vname_list_encode (all_variables x)"
+  apply (induct x)
+  apply (subst all_variables_nat.simps)
+      apply (auto simp only: com_encode.simps)
+      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
+              vname_list_encode_def sub_append sub_cons cons0)
+      apply simp
+ apply (subst all_variables_nat.simps)
+      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
+              vname_list_encode_def sub_append sub_cons cons0)
+     apply simp
+ apply (subst all_variables_nat.simps)
+      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
+              vname_list_encode_def sub_append sub_cons cons0)
+    apply simp
+ apply (subst all_variables_nat.simps)
+      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
+              vname_list_encode_def sub_append sub_cons cons0)
+   apply simp
+ apply (subst all_variables_nat.simps)
+      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
+              vname_list_encode_def sub_append sub_cons cons0)
+  apply simp
+  done
+
+
+
+    
+   
+definition num_variables:: "Com.com \<Rightarrow> nat" where
+"num_variables c = length (remdups (all_variables c))" 
+
+definition num_variables_nat :: "nat \<Rightarrow> nat" where 
+"num_variables_nat n = length_nat (remdups_nat (all_variables_nat n))"
+
+lemma vname_encode_eq: "vname_encode x = vname_encode y \<Longrightarrow> x=y"
+  apply (auto simp add:vname_encode_def list_encode_eq idchar)
+  by (metis vname_encode_def vname_id)
+lemma [simp]: "remdups (map (vname_encode) x) = map vname_encode (remdups x)"
+  apply (induction x)
+  using vname_encode_eq by auto
+   
+lemma "num_variables_nat (com_encode c) = num_variables c"
+  apply (auto simp only:num_variables_nat_def sub_all_variables sub_remdups vname_list_encode_def
+        sub_length num_variables_def)
+  apply (induct "all_variables c"  arbitrary:c)
+  by (auto simp add:map_def)
+      
+    
+   
+
+               
+end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
new file mode 100644
index 00000000..85e6fd4f
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
@@ -0,0 +1,325 @@
+theory IMP_Minus_To_SAS_Plus_Nat imports Primitives IMP_Minus_To_SAS_Plus IMP_Minus_Max_Constant_Nat
+"IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat" "SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat" 
+    "IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat"
+
+begin
+
+definition max_input_bits:: "IMP_Minus_com \<Rightarrow> (vname \<rightharpoonup> nat) \<Rightarrow> nat \<Rightarrow> nat" where
+"max_input_bits c I r = 
+  bit_length (max (max (Max (ran I)) r) (max_constant c))" 
+
+definition max_input_bits_list :: "IMP_Minus_com \<Rightarrow> (vname,nat) assignment list \<Rightarrow> nat \<Rightarrow> nat" where 
+" max_input_bits_list c I r = 
+ bit_length (max (max (max_list (ran_list I)) r) (max_constant c)) "
+
+definition max_input_bits_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"max_input_bits_nat c I r =
+bit_length (max (max (max_list_nat (ran_nat I)) r) (max_constant_nat c))"
+
+lemma impm_assignment_simp:"impm_assignment_encode = prod_encode o (\<lambda>(a,b). (vname_encode a,b))"
+  apply auto
+  done
+lemma sublist_max_input_bits:
+  assumes "I \<noteq> []"
+  shows " max_input_bits_list c I r =  max_input_bits c (map_of I) r"
+  using assms ran_list_pre apply (auto simp only: max_input_bits_list_def  max_input_bits_def  simp flip:sub_ran_list  )
+  using sub_max_list  by fastforce
+
+lemma subnat_max_input_bits: " max_input_bits_nat (com_encode c) 
+(impm_assignment_list_encode  I) r = max_input_bits_list c I r"
+  using vname_inj
+  apply (auto simp only:max_input_bits_nat_def sub_ran_nat impm_assignment_list_encode_def 
+ impm_assignment_simp sub_max_list_nat sub_max_constant ran_inj max_input_bits_list_def simp flip: map_map
+)
+  done
+
+definition IMP_Minus_initial_to_IMP_Minus_Minus:: "(vname \<rightharpoonup> nat) 
+  \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (vname \<rightharpoonup> bit)" where
+"IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range = (\<lambda>v. 
+  (case var_to_operand_bit v of 
+    Some (CHR ''a'', k) \<Rightarrow> if k < n then Some Zero else None |
+    Some (CHR ''b'', k) \<Rightarrow> if k < n then Some Zero else None | 
+    _ \<Rightarrow> (if v = ''carry'' then Some Zero 
+  else (IMP_Minus_State_To_IMP_Minus_Minus_partial I n guess_range) v)))" 
+
+definition IMP_Minus_initial_to_IMP_Minus_Minus_list:: "(vname, nat) assignment list 
+  \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> vname \<Rightarrow> bit option" where
+"IMP_Minus_initial_to_IMP_Minus_Minus_list I n guess_range v =
+  (case var_to_operand_bit v of 
+    Some (CHR ''a'', k) \<Rightarrow> if k < n then Some Zero else None |
+    Some (CHR ''b'', k) \<Rightarrow> if k < n then Some Zero else None | 
+    _ \<Rightarrow> (if v = ''carry'' then Some Zero 
+  else (IMP_Minus_State_To_IMP_Minus_Minus_partial_list I n guess_range) v))" 
+
+lemma sublist_IMP_Minus_initial_to_IMP_Minus_Minus:
+"IMP_Minus_initial_to_IMP_Minus_Minus (map_of I) n guess_range v =
+IMP_Minus_initial_to_IMP_Minus_Minus_list I n guess_range v"
+  apply (auto simp only:IMP_Minus_initial_to_IMP_Minus_Minus_def
+sublist_IMP_Minus_State_To_IMP_Minus_Minus_partial
+IMP_Minus_initial_to_IMP_Minus_Minus_list_def
+)
+  done
+
+definition IMP_Minus_initial_to_IMP_Minus_Minus_nat::" nat 
+  \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range v =
+  (let p = var_to_operand_bit_nat v; v' = fst_nat (p-1) ; k = snd_nat (p-1) in if
+    p \<noteq> 0 \<and> v' = encode_char (CHR ''a'') then 
+    if k < n then Suc 0 else 0 else if  p \<noteq> 0 \<and> v' = encode_char (CHR ''b'')
+   then if k < n then Suc 0 else 0  
+ else (if v = vname_encode ''carry'' then Suc 0 
+  else (IMP_Minus_State_To_IMP_Minus_Minus_partial_nat I n guess_range) v))" 
+
+lemma subnat_IMP_Minus_initial_to_IMP_Minus_Minus:
+"IMP_Minus_initial_to_IMP_Minus_Minus_nat (impm_assignment_list_encode I) n guess_range 
+(vname_encode v) = 
+
+bit_option_encode (IMP_Minus_initial_to_IMP_Minus_Minus_list I n guess_range v)"
+  apply (cases "var_to_operand_bit
+        v")
+  apply (auto simp add: IMP_Minus_initial_to_IMP_Minus_Minus_nat_def vname_inj_simp Let_def
+     sub_var_to_operand_bit  char_nat_option_encode_0 char_inj_simp sub_snd sub_fst
+IMP_Minus_initial_to_IMP_Minus_Minus_list_def subnat_IMP_Minus_State_To_IMP_Minus_Minus_partial)
+   apply (smt char.case char.exhaust)
+  apply (smt char.case char.exhaust)
+  done
+
+
+
+definition IMP_Minus_to_SAS_Plus:: "IMP_Minus_com \<Rightarrow> (vname \<rightharpoonup> nat) \<Rightarrow> nat \<Rightarrow> (vname \<rightharpoonup> nat) 
+  \<Rightarrow>  nat \<Rightarrow> SAS_problem" where
+"IMP_Minus_to_SAS_Plus c I r G t = (let 
+  guess_range = max_input_bits c I r;
+  n = t + guess_range + 1;
+  c' = IMP_Minus_To_IMP_Minus_Minus c n;
+  I' = IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range
+    |` (set (enumerate_variables c')) ;
+  G' = (IMP_Minus_State_To_IMP_Minus_Minus_partial G n n) |` (set (enumerate_variables c')) in 
+  SAS_Plus_Plus_To_SAS_Plus (imp_minus_minus_to_sas_plus c' I' G'))"
+
+definition IMP_Minus_to_SAS_Plus_list:: "IMP_Minus_com \<Rightarrow> (vname, nat) assignment list \<Rightarrow> nat \<Rightarrow> (vname, nat) assignment list 
+  \<Rightarrow>  nat \<Rightarrow> (var,dom) sas_plus_list_problem" where
+"IMP_Minus_to_SAS_Plus_list c I r G t = (let 
+  guess_range = max_input_bits_list c I r;
+  n = t + guess_range + 1;
+  c' = IMP_Minus_To_IMP_Minus_Minus c n;
+  I' = 
+map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,IMP_Minus_initial_to_IMP_Minus_Minus_list I n guess_range x)) (enumerate_variables c')))
+;
+
+  G' = map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,IMP_Minus_State_To_IMP_Minus_Minus_partial_list G n n x)) (enumerate_variables c')))
+ in
+  SAS_Plus_Plus_To_SAS_Plus_list (imp_minus_minus_to_sas_plus_list c' I' G'))"
+
+lemma sublist_IMP_Minus_to_SAS_Plus:
+  assumes "I \<noteq> []"
+  shows
+" list_problem_to_problem ( IMP_Minus_to_SAS_Plus_list c I r G t)
+= IMP_Minus_to_SAS_Plus c (map_of I) r (map_of G) t "
+  apply (auto simp only:  IMP_Minus_to_SAS_Plus_list_def
+        IMP_Minus_to_SAS_Plus_def Let_def  sublist_imp_minus_minus_to_sas_plus
+sublist_SAS_Plus_Plus_To_SAS_Plus
+sub_restrict
+              
+ )
+  using assms 
+  apply (auto simp add: sublist_max_input_bits sublist_IMP_Minus_State_To_IMP_Minus_Minus_partial 
+simp flip:sublist_IMP_Minus_initial_to_IMP_Minus_Minus)
+  done
+
+fun map_IMP_Minus_initial_to_IMP_Minus_Minus:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n x  =(if x = 0 then 0 else (prod_encode(hd_nat x, IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range (hd_nat x)))## map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n (tl_nat x))"
+
+lemma submap_IMP_Minus_initial_to_IMP_Minus_Minus:
+"map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n x = map_nat (\<lambda>x. prod_encode(x, IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range x))x"
+  apply (induct I guess_range n x rule:map_IMP_Minus_initial_to_IMP_Minus_Minus.induct)
+  apply auto
+  done
+
+fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n x = (if x =0 then 0 else 
+( prod_encode(hd_nat x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat G n n (hd_nat x)))## map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n (tl_nat x) )"
+
+lemma submap_IMP_Minus_State_To_IMP_Minus_Minus_partial :
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n x = map_nat (\<lambda>x. prod_encode(x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat G n n x)) x "
+  apply(induct G n x rule: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.induct)
+  apply auto
+  done
+
+fun filter_none :: "nat \<Rightarrow> nat" where 
+"filter_none n = (if n =0 then 0 else if snd_nat (hd_nat n) \<noteq> 0 then (hd_nat n) ## (filter_none (tl_nat n)) else filter_none (tl_nat n))"
+lemma subfilter_none :
+"filter_none n = filter_nat (\<lambda>n . snd_nat n \<noteq> 0) n"
+  apply (induct n rule: filter_none.induct)
+  apply auto
+  done
+
+fun map_prod_the :: "nat \<Rightarrow> nat" where 
+"map_prod_the n = (if n = 0 then 0 else (prod_encode(fst_nat (hd_nat n), the_nat (snd_nat (hd_nat n)))) ## map_prod_the(tl_nat n) )"
+
+lemma submap_prod_the:
+"map_prod_the n = map_nat (\<lambda>n. prod_encode(fst_nat n, the_nat (snd_nat n))) n"
+  apply (induct n rule:map_prod_the.induct)
+  apply auto
+  done
+
+definition IMP_Minus_to_SAS_Plus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat
+  \<Rightarrow>  nat \<Rightarrow> nat" where
+"IMP_Minus_to_SAS_Plus_nat c I r G t = (let 
+  guess_range = max_input_bits_nat c I r;
+  n = t + guess_range + 1;
+  c' = IMP_Minus_To_IMP_Minus_Minus_nat c n;
+  I' = 
+map_prod_the (filter_none (map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n (enumerate_variables_nat c')))
+;
+
+  G' = map_prod_the (filter_none (map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n (enumerate_variables_nat c')))
+ in
+  SAS_Plus_Plus_To_SAS_Plus_nat (imp_minus_minus_to_sas_plus_nat c' I' G'))"
+
+
+
+lemma thef_bit_option_lambda:"
+map (\<lambda>x. prod_encode
+                     (vname_encode x,
+                      thefn
+                       (bit_option_to_option
+                         (ff x))))
+           (filter
+             (\<lambda>x. ff x \<noteq>
+                   None)
+xs) 
+= 
+map (\<lambda>x. prod_encode
+                     (vname_encode x,
+                      bit_encode ( the
+                         (ff x))))
+           (filter
+             (\<lambda>x. ff x \<noteq>
+                   None)
+xs) 
+
+"
+  apply (induct xs)
+   apply auto
+  done
+
+lemma subnat_IMP_Minus_to_SAS_Plus:
+"IMP_Minus_to_SAS_Plus_nat (com_encode c) (impm_assignment_list_encode I) r (impm_assignment_list_encode G) t
+=  list_problem_plus_encode (IMP_Minus_to_SAS_Plus_list c I r G t) "
+  apply (auto simp only:IMP_Minus_to_SAS_Plus_nat_def submap_IMP_Minus_State_To_IMP_Minus_Minus_partial
+          submap_IMP_Minus_initial_to_IMP_Minus_Minus  submap_prod_the  subfilter_none   
+         subnat_max_input_bits sub_IMP_Minus_To_IMP_Minus_Minus Let_def
+                sub_enumerate_variables vname_list_encode_def sub_map map_map
+filter_map sub_fst fst_def sub_snd snd_def
+comp_def sub_filter  subnat_SAS_Plus_Plus_To_SAS_Plus
+IMP_Minus_to_SAS_Plus_list_def
+subnat_IMP_Minus_State_To_IMP_Minus_Minus_partial
+bit_option_encode_0 sub_the
+subnat_imp_minus_minus_to_sas_plus
+subnat_IMP_Minus_initial_to_IMP_Minus_Minus
+ subnat_IMP_Minus_initial_to_IMP_Minus_Minus
+)
+  apply (auto simp only: bit_option_encode_simps comp_def sub_the2 
+
+ thef_bit_option_lambda
+
+
+ simp flip: imp_assignment_encode.simps)
+  apply (auto simp only:
+subnat_SAS_Plus_Plus_To_SAS_Plus
+ subnat_imp_minus_minus_to_sas_plus simp flip:comp_def[of imp_assignment_encode "\<lambda>x.(x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                               (t + max_input_bits_list c I r + 1)
+                               (max_input_bits_list c I r) x))" ]
+comp_def[of imp_assignment_encode "\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                               (t + max_input_bits_list c I r + 1)
+                               (t + max_input_bits_list c I r + 1) x))" ]
+
+ map_map
+imp_assignment_list_encode_def
+)
+proof -
+  let ?P = "imp_minus_minus_to_sas_plus_list
+         (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
+         (map (\<lambda>x. (x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                              (t + max_input_bits_list c I r + 1)
+                              (max_input_bits_list c I r) x)))
+           (filter
+             (\<lambda>x. IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                    (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r)
+                    x \<noteq>
+                   None)
+             (enumerate_variables
+               (IMP_Minus_To_IMP_Minus_Minus c
+                 (t + max_input_bits_list c I r + 1)))))
+         (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                              (t + max_input_bits_list c I r + 1)
+                              (t + max_input_bits_list c I r + 1) x)))
+           (filter
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                    (t + max_input_bits_list c I r + 1)
+                    (t + max_input_bits_list c I r + 1) x \<noteq>
+                   None)
+             (enumerate_variables
+               (IMP_Minus_To_IMP_Minus_Minus c
+                 (t + max_input_bits_list c I r + 1)))))"
+  have "is_valid_problem_sas_plus_plus (list_problem_to_problem ?P)"
+    by (auto simp only:sublist_imp_minus_minus_to_sas_plus  imp_minus_minus_to_sas_plus_valid)
+  thus "SAS_Plus_Plus_To_SAS_Plus_nat
+     (list_problem_encode
+       (imp_minus_minus_to_sas_plus_list
+         (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
+         (map (\<lambda>x. (x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                              (t + max_input_bits_list c I r + 1)
+                              (max_input_bits_list c I r) x)))
+           (filter
+             (\<lambda>x. IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                    (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r)
+                    x \<noteq>
+                   None)
+             (enumerate_variables
+               (IMP_Minus_To_IMP_Minus_Minus c
+                 (t + max_input_bits_list c I r + 1)))))
+         (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                              (t + max_input_bits_list c I r + 1)
+                              (t + max_input_bits_list c I r + 1) x)))
+           (filter
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                    (t + max_input_bits_list c I r + 1)
+                    (t + max_input_bits_list c I r + 1) x \<noteq>
+                   None)
+             (enumerate_variables
+               (IMP_Minus_To_IMP_Minus_Minus c
+                 (t + max_input_bits_list c I r + 1))))))) =
+    list_problem_plus_encode
+     (SAS_Plus_Plus_To_SAS_Plus_list
+       (imp_minus_minus_to_sas_plus_list
+         (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
+         (map (\<lambda>x. (x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                              (t + max_input_bits_list c I r + 1)
+                              (max_input_bits_list c I r) x)))
+           (filter
+             (\<lambda>x. IMP_Minus_initial_to_IMP_Minus_Minus_list I
+                    (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r)
+                    x \<noteq>
+                   None)
+             (enumerate_variables
+               (IMP_Minus_To_IMP_Minus_Minus c
+                 (t + max_input_bits_list c I r + 1)))))
+         (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                              (t + max_input_bits_list c I r + 1)
+                              (t + max_input_bits_list c I r + 1) x)))
+           (filter
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
+                    (t + max_input_bits_list c I r + 1)
+                    (t + max_input_bits_list c I r + 1) x \<noteq>
+                   None)
+             (enumerate_variables
+               (IMP_Minus_To_IMP_Minus_Minus c
+                 (t + max_input_bits_list c I r + 1)))))))"
+    by (auto simp only: subnat_SAS_Plus_Plus_To_SAS_Plus)
+qed
+
+end
+
+
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
new file mode 100644
index 00000000..577c0df1
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
@@ -0,0 +1,417 @@
+theory SAS_Plus_Strips_Nat 
+  imports "Verified_SAT_Based_AI_Planning.SAS_Plus_STRIPS" "IMP-_To_IMP--/Primitives"
+begin
+
+definition possible_assignments_for_list
+  :: "('variable, 'domain) sas_plus_list_problem \<Rightarrow> 'variable \<Rightarrow> ('variable \<times> 'domain) list" 
+  where "possible_assignments_for_list \<Psi> v \<equiv> [(v, a). a \<leftarrow> the (map_list_find (range_ofl \<Psi>) v)]"
+
+lemma sublist_possible_assignments_for:
+"possible_assignments_for_list P v =
+ possible_assignments_for (list_problem_to_problem P) v"
+  apply (auto simp add: sub_map_list_find possible_assignments_for_list_def possible_assignments_for_def )
+  done
+
+definition possible_assignments_for_nat
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat" 
+  where "possible_assignments_for_nat P v \<equiv> map_nat (\<lambda>a. prod_encode(v, a)) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"
+
+lemma vdlist_plus_simp:"vdlist_plus_encode = prod_encode o (\<lambda>(v,d). (var_encode v, list_encode (map dom_encode d)))"
+  apply auto
+  done
+lemma subnat_possible_assignments_for_pre:
+  assumes "v \<in> set (variables_ofl P)"
+  assumes " v \<in> set (variables_ofl P ) \<Longrightarrow> map_list_find  (range_ofl P)  v \<noteq> None"
+  shows
+"possible_assignments_for_nat (list_problem_plus_encode P) (var_encode v)
+= sas_plus_assignment_list_encode (possible_assignments_for_list P v)"
+  using inj_var assms
+  apply auto
+  apply (auto simp only: possible_assignments_for_nat_def
+              list_problem_plus_encode_def sub_nth nth.simps
+sub_map_list_find_nat  inj_map_list_find[of var_encode]
+            option_encode.simps the_nat.simps diff_Suc_1
+ map_list_find_map  sub_map
+possible_assignments_for_list_def
+sas_plus_assignment_list_encode_def
+vdlist_plus_simp simp flip:map_map 
+)
+  apply (auto simp add:comp_def)
+  done
+
+lemma inv_possible_assignments_for:
+  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  assumes "v \<in> set (variables_ofl P)"
+  shows "map_list_find  (range_ofl P)  v \<noteq> None"
+proof -
+  have "v \<in> set (sas_plus_problem.variables_of (list_problem_to_problem P))"
+    using assms by auto
+  hence "range_of (list_problem_to_problem P) v \<noteq> None" using assms apply (auto simp add:
+    is_valid_problem_sas_plus_def ) 
+    by (smt Ball_set_list_all)
+  thus ?thesis by (auto simp add: sub_map_list_find)
+qed
+
+lemma subnat_possible_assignments_for:
+  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  assumes "v \<in> set (variables_ofl P)"
+  shows "possible_assignments_for_nat (list_problem_plus_encode P) (var_encode v)
+= sas_plus_assignment_list_encode (possible_assignments_for_list P v)"
+  using  subnat_possible_assignments_for_pre inv_possible_assignments_for assms by fastforce
+
+definition all_possible_assignments_for_list
+  :: "('variable, 'domain) sas_plus_list_problem \<Rightarrow> ('variable \<times> 'domain) list"
+  where "all_possible_assignments_for_list \<Psi> 
+    \<equiv> concat [possible_assignments_for_list \<Psi> v. v \<leftarrow> variables_ofl \<Psi>]" 
+
+lemma sublist_all_possible_assignments_for:
+" all_possible_assignments_for_list P =
+all_possible_assignments_for (list_problem_to_problem P)"
+  apply (auto simp add: all_possible_assignments_for_list_def all_possible_assignments_for_def
+  sublist_possible_assignments_for)
+  done
+
+definition all_possible_assignments_for_nat::
+   "nat \<Rightarrow> nat"
+  where "all_possible_assignments_for_nat \<Psi> 
+    \<equiv> concat_nat (map_nat (possible_assignments_for_nat \<Psi>) (nth_nat 0 \<Psi>))" 
+
+lemma subnat_all_possible_assignments_for_map:
+  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  shows " map (\<lambda>x. possible_assignments_for_nat (list_problem_plus_encode P) (var_encode x))
+         (variables_ofl P) =
+ map sas_plus_assignment_list_encode (map (\<lambda>x. possible_assignments_for_list P x)  (variables_ofl P))"
+  apply (induct "variables_ofl P")
+   apply simp
+  using assms apply (auto simp del: list_problem_to_problem.simps)
+  apply (auto simp add:subnat_possible_assignments_for simp del: list_problem_to_problem.simps)
+  done
+
+lemma subnat_all_possible_assignments_for:
+  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  shows "all_possible_assignments_for_nat (list_problem_plus_encode P)
+= sas_plus_assignment_list_encode (all_possible_assignments_for_list P)"
+  using assms
+  apply (auto simp only:all_possible_assignments_for_nat_def list_problem_plus_encode_def
+            sub_nth nth.simps sas_plus_assignment_list_encode_def[of "all_possible_assignments_for_list P"] )
+  apply (auto simp only: sub_map map_map comp_def all_possible_assignments_for_list_def 
+    subnat_all_possible_assignments_for_map
+ simp flip:list_problem_plus_encode_def)
+  apply (auto simp only: sas_plus_assignment_list_encode_def sub_concat map_concat simp flip: map_map comp_def[of _ "\<lambda>x. map sas_plus_assignment_encode (possible_assignments_for_list P x)"] )
+  apply (auto simp only:map_map comp_def)
+  done
+
+definition state_to_strips_state_list
+  :: "('variable, 'domain) sas_plus_list_problem 
+    \<Rightarrow> ('variable, 'domain) assignment list 
+    \<Rightarrow> (('variable, 'domain) assignment ,bool) assignment list" 
+  where "state_to_strips_state_list \<Psi> s 
+    \<equiv> let defined = filter (\<lambda>v. map_list_find s v \<noteq> None) (variables_ofl \<Psi>) in
+      map (\<lambda>(v, a). ((v, a), the (map_list_find s v) = a)) 
+        (concat [possible_assignments_for_list \<Psi> v. v \<leftarrow> defined])"
+
+lemma sublist_state_to_strips_state:
+"map_of (state_to_strips_state_list P s) =
+state_to_strips_state (list_problem_to_problem P) (map_of s)"
+  apply (auto simp add:state_to_strips_state_list_def sub_map_list_find
+state_to_strips_state_def sublist_possible_assignments_for)
+  done
+
+definition state_to_strips_state_nat
+  :: "nat \<Rightarrow>nat \<Rightarrow>nat" 
+  where "state_to_strips_state_nat \<Psi> s 
+    \<equiv> let defined = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) (nth_nat 0 \<Psi>) in
+      map_nat (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) 
+        (concat_nat (map_nat (possible_assignments_for_nat \<Psi>)  defined))"
+
+
+lemma subnat_state_to_strips_state_map:
+  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
+shows
+"map (\<lambda>x. possible_assignments_for_nat (list_problem_plus_encode P) (var_encode x))
+           (filter (\<lambda>x. map_list_find s x \<noteq> None) (variables_ofl P))
+= map  sas_plus_assignment_list_encode  ( map (possible_assignments_for_list P)
+ (filter (\<lambda>x. map_list_find s x \<noteq> None) (variables_ofl P)) )"
+  using assms apply (auto simp add: subnat_possible_assignments_for)
+  done
+
+lemma  possible_assignments_fst: "(x, b) \<in> set (possible_assignments_for_list P y) \<Longrightarrow> x = y"
+  apply (auto simp add:possible_assignments_for_list_def)
+  done
+
+lemma subnat_state_to_strips_state:
+  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  shows "state_to_strips_state_nat (list_problem_plus_encode P) (sas_plus_assignment_list_encode s)
+= strips_assignment_list_encode (state_to_strips_state_list P s)"
+  apply (auto simp only:state_to_strips_state_nat_def list_problem_plus_encode_def sub_nth nth.simps)
+  apply (auto simp only: simp flip: list_problem_plus_encode_def)
+  apply (auto simp only:       sub_filter  sas_plus_assignment_list_encode_def sas_plus_simp sub_map_list_find_nat option_encode_0
+                    filter_map
+            simp flip: map_map )
+  using inj_var  apply (auto simp only:comp_def  inj_map_list_find  map_list_find_map_none 
+subnat_possible_assignments_for Let_def sub_map map_map
+)
+  using assms apply(auto simp only:sub_map
+state_to_strips_state_list_def
+ sub_concat subnat_state_to_strips_state_map  sas_plus_list_simp simp flip:map_map map_concat)
+  apply (auto simp only:map_map comp_def fst_sas_simp snd_sas_simp  inj_map_list_find
+ strips_assignment_list_encode_def list_encode_eq Let_def
+ )
+  apply (induct "variables_ofl P")
+   apply (auto simp del:list_problem_to_problem.simps)
+  subgoal for a x y aa b ya
+    apply (cases "map_list_find (map (\<lambda>(v, d). (v, dom_encode d)) s) aa")
+    using possible_assignments_fst[of aa b P y] 
+     apply (auto simp add: map_list_find_map_none map_list_find_map dom_inj_simp
+          simp del:list_problem_to_problem.simps)
+    done
+ subgoal for a x y aa b ya
+    apply (cases "map_list_find (map (\<lambda>(v, d). (v, dom_encode d)) s) aa")
+    using possible_assignments_fst[of aa b P y] 
+     apply (auto simp add: map_list_find_map_none map_list_find_map dom_inj_simp
+          simp del:list_problem_to_problem.simps)
+    done
+  done
+
+definition sasp_op_to_strips_list
+  :: "('variable, 'domain) sas_plus_list_problem
+    \<Rightarrow> ('variable, 'domain) sas_plus_operator
+    \<Rightarrow> ('variable, 'domain) assignment strips_operator" 
+  ("\<phi>\<^sub>O _ _" 99)
+  where "sasp_op_to_strips_list \<Psi> op \<equiv> let
+      pre = precondition_of op
+      ; add = effect_of op
+      ; delete = concat (map (\<lambda>(v,a). map (\<lambda>a'. (v, a')) (filter ((\<noteq>) a) (the (map_list_find (range_ofl \<Psi> )v)))) (effect_of op))
+    in STRIPS_Representation.operator_for pre add delete"
+
+lemma sublist_sasp_op_to_strips:
+"sasp_op_to_strips_list P op = sasp_op_to_strips (list_problem_to_problem P) op"
+  apply (auto simp add:sasp_op_to_strips_list_def  sasp_op_to_strips_def sub_map_list_find)
+  done
+
+fun operator_for_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"operator_for_nat pre add delete = pre ## add ## delete ##0 "
+
+lemma sub_operator_for : "operator_for_nat (sas_plus_assignment_list_encode pre) (sas_plus_assignment_list_encode add) (sas_plus_assignment_list_encode delete)
+= strips_operator_encode (operator_for pre add delete)"
+  apply (auto simp add: sub_cons cons0 simp del: list_encode.simps)
+  done
+
+
+definition sasp_op_to_strips_nat
+  :: "nat \<Rightarrow>nat \<Rightarrow> nat " 
+  where "sasp_op_to_strips_nat \<Psi> op \<equiv> let
+      pre = nth_nat 0 op
+      ; add = nth_nat (Suc 0)  op
+      ; delete = concat_nat (map_nat (\<lambda>n. map_nat (\<lambda>a'. prod_encode(fst_nat n, a')) (filter_nat ((\<noteq>) (snd_nat n)) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) \<Psi> ) (fst_nat n))))) (nth_nat (Suc 0) op))
+    in operator_for_nat pre add delete"
+
+
+
+
+lemma subnat_sasp_op_to_strips_map:
+  assumes "\<forall>(v,d)\<in> set (effect_of op). map_list_find (range_ofl P) v \<noteq> None"
+  shows
+"map (\<lambda>x. map_nat (\<lambda>a'. prod_encode (var_encode (fst x), a'))
+                            (filter_nat ((\<noteq>) (dom_encode (snd x)))
+                              (the_nat
+                                (option_encode
+                                  (map_list_find
+                                    (map (\<lambda>(v, d).
+                                             (var_encode v, list_encode (map dom_encode d)))
+                                      (range_ofl P))
+                                    (var_encode (fst x)))))))
+                  (effect_of op) =
+map (\<lambda>(v,d). map_nat (\<lambda>a'. prod_encode (var_encode v, a'))
+                            (filter_nat ((\<noteq>) (dom_encode d))
+                             (list_encode (map dom_encode (the (map_list_find (range_ofl P)  v))))))
+                  (effect_of op)
+
+"
+  apply (induct "effect_of op")
+  using inj_var
+   apply  (auto simp del:map_nat.simps filter_nat.simps the_nat.simps )
+  apply (auto simp only: inj_map_list_find[of var_encode])
+  subgoal for a b x ax bx
+    apply (cases "map_list_find (range_ofl P) ax")
+    using assms apply 
+(auto simp add:  map_list_find_map_none   simp del:map_nat.simps filter_nat.simps the_nat.simps
+)
+    subgoal for y
+    apply (auto simp add:  map_list_find_map)
+      done
+    done
+  done
+
+lemma subnat_sasp_op_to_strips_map2: 
+ "(\<lambda>(v, d).
+                         list_encode
+                          (map (\<lambda>a'. prod_encode (var_encode v, a'))
+                            (filter ((\<noteq>) (dom_encode d))
+                              (map dom_encode (the (map_list_find (range_ofl P) v))))))
+= list_encode o (\<lambda>(v,d). map (\<lambda>a'. prod_encode (var_encode v, a'))
+                            (filter ((\<noteq>) (dom_encode d))
+                              (map dom_encode (the (map_list_find (range_ofl P) v)))))"
+  apply (auto)
+  done
+lemma subnat_sasp_op_to_strips_map3:
+"(\<lambda>(v, d).
+                         map sas_plus_assignment_encode
+                          (map (Pair v) (filter ((\<noteq>) d) (the (map_list_find (range_ofl P) v)))))
+= map sas_plus_assignment_encode o (\<lambda>(v,d). map (Pair v) (filter ((\<noteq>) d) (the (map_list_find (range_ofl P) v))) )"
+  apply auto
+  done
+lemma subnat_sasp_op_to_strips_inv:
+  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"  "op \<in> set (operators_ofl P)"
+  shows  "\<forall>(v,d)\<in> set (effect_of op). map_list_find (range_ofl P) v \<noteq> None"
+  using assms
+  apply (auto simp add: is_valid_problem_sas_plus_def is_valid_operator_sas_plus_def)
+  by (smt case_prodD is_valid_operator_sas_plus_then(3) list_all_iff sas_plus_problem.select_convs(1) sub_map_list_find)
+
+lemma subnat_sasp_op_to_strips_pre:
+  assumes "\<forall>(v,d)\<in> set (effect_of op). map_list_find (range_ofl P) v \<noteq> None"
+  shows   "sasp_op_to_strips_nat (list_problem_plus_encode P) (operator_plus_encode op) 
+= 
+strips_operator_encode (sasp_op_to_strips_list P op)"
+  apply (auto simp only:sasp_op_to_strips_nat_def operator_plus_encode_def sub_nth nth.simps
+          list_problem_plus_encode_def sub_map_list_find_nat vdlist_plus_simp
+sas_plus_assignment_list_encode_def sub_map 
+
+ simp flip: map_map )
+  using inj_var apply (auto simp only: map_map comp_def fst_sas_simp snd_sas_simp
+
+)
+  using assms apply (auto simp only:subnat_sasp_op_to_strips_map sub_filter sub_map 
+subnat_sasp_op_to_strips_map2  sub_concat simp flip: map_map
+)
+  apply (auto simp only:filter_map comp_def dom_inj_simp map_map simp flip:
+sas_plus_assignment_encode.simps)
+  apply (auto simp only: simp flip: comp_def map_map)
+  apply (auto simp only: comp_def)
+  apply (auto simp only: subnat_sasp_op_to_strips_map3
+sasp_op_to_strips_list_def
+  Let_def sub_operator_for simp flip: map_map map_concat
+sas_plus_assignment_list_encode_def
+)
+  done
+
+lemma subnat_sasp_op_to_strips:
+  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"  "op \<in> set (operators_ofl P)"
+  shows   "sasp_op_to_strips_nat (list_problem_plus_encode P) (operator_plus_encode op)
+= 
+strips_operator_encode (sasp_op_to_strips_list P op)"
+  using assms  subnat_sasp_op_to_strips_pre  subnat_sasp_op_to_strips_inv by blast
+
+definition problem_for_list
+  :: "'variable list 
+  \<Rightarrow> 'variable strips_operator list 
+  \<Rightarrow> ('variable,bool) assignment list  
+  \<Rightarrow> ('variable,bool) assignment list
+  \<Rightarrow> ('variable) strips_list_problem"
+  where "problem_for_list vs ops I gs \<equiv> \<lparr> 
+    variables_of = vs
+    , operators_of = ops
+    , initial_of = I
+    , goal_of = gs \<rparr>" 
+
+lemma sublist_problem_for :
+"strips_list_problem_to_problem (problem_for_list vs ops I gs) = 
+problem_for vs ops (map_of I) (map_of gs)"
+  apply (auto simp add:problem_for_list_def)
+  done
+
+definition sas_plus_problem_to_strips_problem_list
+  :: "('variable, 'domain) sas_plus_list_problem \<Rightarrow> ('variable, 'domain) assignment strips_list_problem" 
+  ("\<phi> _ " 99)
+  where "sas_plus_problem_to_strips_problem_list \<Psi> \<equiv> let 
+      vs =  concat (map (possible_assignments_for_list \<Psi>)(variables_ofl \<Psi>))
+      ; ops = map (sasp_op_to_strips_list \<Psi>) (operators_ofl \<Psi>)
+      ; I = state_to_strips_state_list \<Psi> (initial_ofl \<Psi>)
+      ; G = state_to_strips_state_list \<Psi> (goal_ofl \<Psi>)
+    in problem_for_list vs ops I G"
+
+lemma sublist_sas_plus_problem_to_strips_problem:
+"strips_list_problem_to_problem (sas_plus_problem_to_strips_problem_list P) =
+sas_plus_problem_to_strips_problem (list_problem_to_problem P)"
+  apply (auto simp only: Let_def
+sublist_possible_assignments_for
+sas_plus_problem_to_strips_problem_def
+list_problem_to_problem.simps
+sas_plus_list_problem.simps
+sas_plus_problem.simps
+
+  sas_plus_problem_to_strips_problem_list_def   
+sublist_problem_for sublist_sasp_op_to_strips sublist_state_to_strips_state )
+  apply (auto simp add:sublist_sasp_op_to_strips sublist_possible_assignments_for simp flip: list_problem_to_problem.simps)
+  apply (meson sublist_possible_assignments_for)
+  done
+definition problem_for_nat
+  :: "nat 
+  \<Rightarrow> nat 
+  \<Rightarrow> nat  
+  \<Rightarrow> nat
+  \<Rightarrow> nat"
+  where "problem_for_nat vs ops I gs \<equiv> vs ## ops ## I ## gs ## 0 "
+
+lemma subnat_problem_for: 
+"problem_for_nat (sas_plus_assignment_list_encode vs) (strips_operator_list_encode ops)
+(strips_assignment_list_encode I) (strips_assignment_list_encode gs)
+= 
+ strips_list_problem_encode(problem_for_list vs ops I gs)
+ "
+  apply (auto simp only: problem_for_nat_def sub_cons cons0 problem_for_list_def
+strips_list_problem_encode.simps strips_list_problem.simps) done
+
+definition sas_plus_problem_to_strips_problem_nat
+  :: "nat\<Rightarrow>nat" 
+  ("\<phi> _ " 99)
+  where "sas_plus_problem_to_strips_problem_nat \<Psi> \<equiv> let 
+      vs =  concat_nat (map_nat (possible_assignments_for_nat \<Psi>)(nth_nat 0 \<Psi>))
+      ; ops = map_nat (sasp_op_to_strips_nat \<Psi>) (nth_nat (Suc 0) \<Psi>)
+      ; I = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc 0)) \<Psi>)
+      ; G = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc (Suc 0))) \<Psi>)
+    in problem_for_nat vs ops I G"
+
+
+lemma  subnat_sas_plus_problem_to_strips_problem_map:
+  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  shows  "map (\<lambda>x. possible_assignments_for_nat (list_problem_plus_encode P)
+                             (var_encode x))
+                   (variables_ofl P)
+  = map sas_plus_assignment_list_encode (map (possible_assignments_for_list P) (variables_ofl P))"
+  using subnat_all_possible_assignments_for_map assms by blast
+
+lemma  subnat_sas_plus_problem_to_strips_problem_map2:
+  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  shows  "map (\<lambda>x. sasp_op_to_strips_nat (list_problem_plus_encode P)
+                        (operator_plus_encode x))
+              (operators_ofl P)
+  = map strips_operator_encode (map (sasp_op_to_strips_list P) (operators_ofl P))"
+  using assms subnat_sasp_op_to_strips
+  by auto
+
+lemma subnat_sas_plus_problem_to_strips_problem:
+  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
+  shows "sas_plus_problem_to_strips_problem_nat (list_problem_plus_encode P)
+ =  strips_list_problem_encode (sas_plus_problem_to_strips_problem_list P)"
+  apply (auto simp only: sas_plus_problem_to_strips_problem_nat_def
+list_problem_plus_encode_def sub_nth nth.simps 
+)
+  using assms  apply (auto simp only: sub_map
+              subnat_possible_assignments_for map_map comp_def 
+              subnat_sasp_op_to_strips
+subnat_state_to_strips_state 
+ simp flip: list_problem_plus_encode_def)
+  apply (auto simp only:subnat_sas_plus_problem_to_strips_problem_map sas_plus_list_simp 
+sub_concat 
+simp flip: map_map map_concat )
+  apply (auto simp only: 
+ simp flip: sas_plus_assignment_list_encode_def)
+  apply (auto simp only:  subnat_sas_plus_problem_to_strips_problem_map2 simp flip: strips_operator_list_encode_def)
+  apply (auto simp only: Let_def  subnat_problem_for sas_plus_problem_to_strips_problem_list_def )
+  done
+
+
+
+      
+end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
new file mode 100644
index 00000000..34da4b83
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
@@ -0,0 +1,743 @@
+theory SAT_Plan_Base_Nat 
+  imports "Verified_SAT_Based_AI_Planning.SAT_Plan_Base" "IMP-_To_IMP--/Primitives"
+begin
+
+definition  encode_state_variable_nat
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Rightarrow> nat"
+  where "encode_state_variable_nat t k v = ( if v-1 >0  then 1##(0##t##k##0)##0
+else 2##(1##(0##t##k##0)##0)##0)"
+
+lemma sub_encode_state_variable:
+  assumes "v \<noteq> None"
+  shows "encode_state_variable_nat t k (bool_option_encode v)
+        = sat_formula_encode (encode_state_variable t k v)"
+  using assms
+  apply (auto simp add: encode_state_variable_nat_def 
+ encode_state_variable_def 
+sub_cons cons0 simp del:list_encode.simps  split:bool.splits)
+  done
+
+definition  encode_initial_state_list
+  :: "'variable strips_list_problem \<Rightarrow> sat_plan_variable formula" 
+  where "encode_initial_state_list \<Pi>
+    \<equiv> let I = initial_of \<Pi>
+        ; vs = variables_of \<Pi>
+      in \<^bold>\<And>(map (\<lambda>v. encode_state_variable 0 (index vs v) (map_list_find I v) \<^bold>\<or> \<bottom>)
+    (filter (\<lambda>v. map_list_find I v \<noteq> None) vs))"
+
+lemma sublist_encode_initial_state:
+"encode_initial_state_list P = encode_initial_state (strips_list_problem_to_problem P)"
+  apply (auto simp add: encode_initial_state_list_def
+      encode_initial_state_def sub_map_list_find Let_def
+)
+  done
+
+fun map_encode_initial_state :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat  \<Rightarrow> nat" where 
+"map_encode_initial_state t I vs  xs = (if xs =0 then 0 else ( 4 ## (encode_state_variable_nat t (index_nat vs (hd_nat xs)) (map_list_find_nat I (hd_nat xs)))## (0##0) ## 0) ## map_encode_initial_state t I vs (tl_nat xs))  "
+
+
+lemma submap_encode_initial_state:
+"map_encode_initial_state t I vs xs = map_nat (\<lambda>v. 4 ## (encode_state_variable_nat t (index_nat vs v) (map_list_find_nat I v))## (0##0) ## 0) xs"
+  apply (induct t I vs xs rule: map_encode_initial_state.induct)
+  apply (auto)
+  done
+declare map_list_find_nat.simps[simp del]
+fun filter_defined :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \<noteq> 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))"
+
+lemma subfilter_defined :
+"filter_defined s n = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) n "
+  apply (induct s n rule: filter_defined.induct)
+  apply auto
+  done
+
+definition  encode_initial_state_nat
+  :: "nat\<Rightarrow> nat" 
+  where "encode_initial_state_nat \<Pi>
+    \<equiv> let I = nth_nat (Suc (Suc 0)) \<Pi>
+        ; vs = nth_nat 0 \<Pi>
+      in BigAnd_nat ( map_encode_initial_state 0 I vs
+    (filter_defined I  vs))"
+
+lemma inj_sasp:"inj sas_plus_assignment_encode"
+  using sas_plus_assignment_id 
+  by (metis inj_onI)
+
+lemma subnat_encode_initial_state_map: 
+"map (\<lambda>x. list_encode
+                   [4, encode_state_variable_nat 0 (index (P\<^sub>\<V>) x)
+                        (option_encode
+                          (map_list_find (map (\<lambda>(s, b). (s, bool_encode b)) (P\<^sub>I)) x)),
+                    sat_formula_encode \<bottom>])
+         (filter (\<lambda>x. map_list_find (P\<^sub>I) x \<noteq> None) (P\<^sub>\<V>))
+= 
+map (\<lambda>x. list_encode
+                   [4, sat_formula_encode (encode_state_variable 0 (index (P\<^sub>\<V>) x)                        
+                          (map_list_find  (P\<^sub>I) x)),
+                    sat_formula_encode \<bottom>])
+         (filter (\<lambda>x. map_list_find (P\<^sub>I) x \<noteq> None) (P\<^sub>\<V>))
+"
+  apply (induct "(P\<^sub>\<V>)")
+   apply (auto simp add: list_encode_eq  map_list_find_map
+sub_encode_state_variable 
+ simp del:list_encode.simps simp flip: bool_option_encode.simps)
+  done
+
+lemma subnat_encode_initial_state:
+"encode_initial_state_nat (strips_list_problem_encode P) =
+ sat_formula_encode (encode_initial_state_list P) "
+  using inj_sasp
+  apply (auto simp only: encode_initial_state_nat_def subfilter_defined 
+            strips_list_problem_encode.simps Let_def
+            strips_assignment_list_encode_def
+            sas_plus_assignment_list_encode_def sub_index[of sas_plus_assignment_encode]
+            strips_simp submap_encode_initial_state
+          sub_nth nth.simps sub_cons cons0 sub_map_list_find_nat
+simp flip: map_map
+)
+  apply (auto simp only: sub_filter sub_map option_encode_0 filter_map comp_def
+ map_list_find_map_none
+ inj_map_list_find map_map sub_index 
+subnat_encode_initial_state_map
+simp flip: sat_formula_encode.simps
+)
+  apply (auto simp only:sub_BigAnd encode_initial_state_list_def Let_def simp flip: map_map  sat_formula_list_encode_def
+comp_def[of sat_formula_encode "\<lambda>x. encode_state_variable 0 (index ((P)\<^sub>\<V>) x) (map_list_find ((P)\<^sub>I) x) \<^bold>\<or> \<bottom>"])
+  done
+
+definition  encode_goal_state_list
+  :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula" ("\<Phi>\<^sub>G _" 99)
+  where "encode_goal_state_list \<Pi> t
+    \<equiv> let
+      vs = variables_of \<Pi>
+      ; G = goal_of \<Pi>
+    in \<^bold>\<And>(map (\<lambda>v. encode_state_variable t (index vs v) (map_list_find G v) \<^bold>\<or> \<bottom>)
+      (filter (\<lambda>v. map_list_find G v \<noteq> None) vs))"
+
+lemma sublist_encode_goal_state:
+"encode_goal_state_list P t = encode_goal_state (strips_list_problem_to_problem P) t"
+  apply (auto simp add: encode_goal_state_list_def
+      encode_goal_state_def sub_map_list_find Let_def
+)
+  done
+
+definition  encode_goal_state_nat
+  :: "nat\<Rightarrow> nat \<Rightarrow> nat" 
+  where "encode_goal_state_nat \<Pi> t
+    \<equiv> let G = nth_nat (Suc (Suc (Suc 0))) \<Pi>
+        ; vs = nth_nat 0 \<Pi>
+      in BigAnd_nat (map_encode_initial_state t G vs
+    (filter_defined G vs))"
+
+lemma subnat_encode_goal_state_map: 
+"map (\<lambda>x. list_encode
+                   [4, encode_state_variable_nat t (index (P\<^sub>G) x)
+                        (option_encode
+                          (map_list_find (map (\<lambda>(s, b). (s, bool_encode b)) (P\<^sub>I)) x)),
+                    sat_formula_encode \<bottom>])
+         (filter (\<lambda>x. map_list_find (P\<^sub>I) x \<noteq> None) (P\<^sub>G))
+= 
+map (\<lambda>x. list_encode
+                   [4, sat_formula_encode (encode_state_variable t (index (P\<^sub>G) x)                        
+                          (map_list_find  (P\<^sub>I) x)),
+                    sat_formula_encode \<bottom>])
+         (filter (\<lambda>x. map_list_find (P\<^sub>I) x \<noteq> None) (P\<^sub>G))
+"
+  apply (induct "(P\<^sub>G)")
+   apply (auto simp add: list_encode_eq  map_list_find_map
+sub_encode_state_variable 
+ simp del:list_encode.simps simp flip: bool_option_encode.simps)
+  done
+
+lemma subnat_encode_goal_state:
+"encode_goal_state_nat (strips_list_problem_encode P) t =
+ sat_formula_encode (encode_goal_state_list P t) "
+  using inj_sasp
+  apply (auto simp only: encode_goal_state_nat_def 
+            strips_list_problem_encode.simps Let_def
+            strips_assignment_list_encode_def
+subfilter_defined submap_encode_initial_state
+            sas_plus_assignment_list_encode_def sub_index[of sas_plus_assignment_encode]
+            strips_simp
+          sub_nth nth.simps sub_cons cons0 sub_map_list_find_nat
+simp flip: map_map
+)
+  apply (auto simp only: sub_filter sub_map option_encode_0 filter_map comp_def
+ map_list_find_map_none
+ inj_map_list_find map_map sub_index 
+subnat_encode_goal_state_map
+simp flip: sat_formula_encode.simps
+)
+  apply (auto simp only:sub_BigAnd encode_goal_state_list_def Let_def simp flip: map_map  sat_formula_list_encode_def
+comp_def[of sat_formula_encode "\<lambda>x. encode_state_variable t (index ((P)\<^sub>\<V>) x) (map_list_find (((P)\<^sub>G)) x) \<^bold>\<or> \<bottom>"])
+  done
+
+definition encode_operator_precondition_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> nat
+    \<Rightarrow> 'variable strips_operator
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_operator_precondition_list \<Pi> t op \<equiv> let
+      vs = variables_of \<Pi>
+      ; ops = strips_list_problem.operators_of \<Pi>
+    in \<^bold>\<And>(map (\<lambda>v.
+        \<^bold>\<not> (Atom (Operator t (index ops op))) \<^bold>\<or> Atom (State t (index vs v)))
+      (strips_operator.precondition_of op))"
+
+lemma sublist_encode_operator_precondition:
+"encode_operator_precondition_list \<Pi> t op =
+ encode_operator_precondition (strips_list_problem_to_problem \<Pi>) t op"
+  apply (auto simp add: encode_operator_precondition_list_def encode_operator_precondition_def)
+  done
+fun map_encode_operator_precondition :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_encode_operator_precondition t ops op vs xs = (if xs = 0 then 0 else 
+( 4 ##(2 ## (1## (1 ## t ##(index_nat ops op) ## 0)##0) ## 0 )##  (1##(0 ## t ##(index_nat vs (hd_nat xs)) ## 0)##0) ## 0)
+## map_encode_operator_precondition t ops op vs (tl_nat xs)
+)"
+
+lemma submap_encode_operator_precondition:
+"map_encode_operator_precondition t ops op vs xs = 
+map_nat (\<lambda>v.
+        4 ##(2 ## (1## (1 ## t ##(index_nat ops op) ## 0)##0) ## 0 )##  (1##(0 ## t ##(index_nat vs v) ## 0)##0) ## 0) xs
+"
+  apply (induct t ops op vs xs rule:map_encode_operator_precondition.induct)
+  apply auto
+  done
+
+definition encode_operator_precondition_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_operator_precondition_nat \<Pi> t op \<equiv> let
+      vs = nth_nat 0 \<Pi>
+      ; ops = nth_nat (Suc 0) \<Pi>
+    in BigAnd_nat (map_encode_operator_precondition t ops op vs
+      (nth_nat 0 op))"
+
+lemma inj_strips_op: "inj strips_operator_encode"
+  using strips_operator_id 
+  by (metis injI)
+lemma subnat_encode_operator_precondition:
+"encode_operator_precondition_nat (strips_list_problem_encode P) t  (strips_operator_encode op)
+= sat_formula_encode (encode_operator_precondition_list P t op)"
+  apply (auto simp only:encode_operator_precondition_nat_def
+          sub_cons cons0 sub_nth nth.simps
+submap_encode_operator_precondition
+sas_plus_assignment_list_encode_def sub_map
+strips_operator_encode.simps strips_list_problem_encode.simps
+ simp flip:sat_variable_encode.simps sat_formula_encode.simps
+            
+)
+
+  apply (auto simp only: map_map comp_def Let_def simp flip: strips_operator_encode.simps
+sas_plus_assignment_list_encode_def
+)
+  using  inj_strips_op inj_sasp
+  apply (auto simp only: strips_operator_list_encode_def  sas_plus_assignment_list_encode_def 
+sub_index)
+  apply (auto simp only: sub_BigAnd 
+encode_operator_precondition_list_def
+Let_def
+ simp flip:map_map sat_formula_list_encode_def
+comp_def[of sat_formula_encode 
+"\<lambda>x.\<^bold>\<not> (Atom (Operator t (index ((P)\<^sub>\<O>) op))) \<^bold>\<or> Atom (State t (index ((P)\<^sub>\<V>) x))"])
+  done
+
+lemma sub_foldr: "foldr (\<^bold>\<and>) xs (\<^bold>\<not>\<bottom>) = BigAnd xs "
+  apply (induct xs)
+   apply auto
+  done
+definition  encode_all_operator_preconditions_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> 'variable strips_operator list
+    \<Rightarrow> nat
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_all_operator_preconditions_list \<Pi> ops t \<equiv> let
+      l = List.product [0..<t] ops
+    in BigAnd (map (\<lambda>(t, op). encode_operator_precondition_list \<Pi> t op) l)"
+
+lemma sublist_encode_all_operator_preconditions:
+"encode_all_operator_preconditions_list \<Pi> ops t = 
+encode_all_operator_preconditions (strips_list_problem_to_problem \<Pi>) ops t"
+  apply (auto simp only:encode_all_operator_preconditions_list_def encode_all_operator_preconditions_def
+        sublist_encode_operator_precondition sub_foldr
+)
+  done
+lemma "(case x of (x1,x2) \<Rightarrow> (case  x of (x1,x2) \<Rightarrow> f x1 x2) (g x1 x2))
+= (case x of (x1,x2) \<Rightarrow> f x1 x2 (g x1 x2))"
+  by (simp add: prod.case_eq_if)
+
+fun maps_encode_operator_precondition :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"maps_encode_operator_precondition P xs = (if xs = 0 then 0 else 
+ (encode_operator_precondition_nat P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs))) ##(maps_encode_operator_precondition P (tl_nat xs))
+)"
+
+lemma submaps_encode_operator_precondition :
+"maps_encode_operator_precondition P xs = map_nat (\<lambda>n. encode_operator_precondition_nat P (fst_nat n) (snd_nat n )) xs "
+  apply (induct P xs rule:maps_encode_operator_precondition.induct)
+  apply auto
+  done
+
+
+definition  encode_all_operator_preconditions_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_all_operator_preconditions_nat \<Pi> ops t \<equiv> let
+      l = product_nat (list_less_nat t) ops
+    in BigAnd_nat (maps_encode_operator_precondition \<Pi>  l)"
+lemma case_prod_simp:"(\<lambda>x. case x of (a,b) \<Rightarrow> f a b) = (\<lambda>(x,y). f x y)"
+  by simp
+
+lemma subnat_encode_all_operator_preconditions:
+"encode_all_operator_preconditions_nat (strips_list_problem_encode P) (strips_operator_list_encode ops) t
+=
+sat_formula_encode(encode_all_operator_preconditions_list P ops t)
+"
+  using list.map_id [of "[0..<t]" ] sub_product[of id  "[0..<t]" strips_operator_encode  ops ]
+  apply (auto simp only: encode_all_operator_preconditions_nat_def 
+           sub_list_less    strips_operator_list_encode_def
+                    Let_def sub_map map_map comp_def 
+                    submaps_encode_operator_precondition
+              )
+  apply (auto simp only: prod.case_eq_if id_def sub_fst fst_conv sub_snd snd_conv
+subnat_encode_operator_precondition )
+  apply (auto simp only: sub_BigAnd encode_all_operator_preconditions_list_def
+Let_def case_prod_beta'
+ simp flip: map_map sat_formula_list_encode_def
+      comp_def [of sat_formula_encode  "\<lambda>x. encode_operator_precondition_list P (fst x) (snd x) "])
+  done
+
+definition  encode_operator_effect_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> nat
+    \<Rightarrow> 'variable strips_operator
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_operator_effect_list \<Pi> t op
+    \<equiv> let
+        vs = variables_of \<Pi>
+        ; ops = operators_of \<Pi>
+      in \<^bold>\<And>(map (\<lambda>v.
+              \<^bold>\<not>(Atom (Operator t (index ops op)))
+              \<^bold>\<or> Atom (State (Suc t) (index vs v)))
+            (add_effects_of op)
+          @ map (\<lambda>v.
+              \<^bold>\<not>(Atom (Operator t (index ops op)))
+               \<^bold>\<or> \<^bold>\<not> (Atom (State (Suc t) (index vs v))))
+            (delete_effects_of op))"
+
+lemma sublist_encode_operator_effect:
+"encode_operator_effect_list \<Pi> t op =
+encode_operator_effect (strips_list_problem_to_problem \<Pi>) t op"
+  apply (auto simp add: encode_operator_effect_list_def encode_operator_effect_def)
+  done
+
+fun map_encode_operator_effect::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_operator_effect t ops op vs n = (if n =0 then 0 else 
+( 4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (1 ## (0 ## (Suc t) ## (index_nat vs (hd_nat n))## 0) ## 0) ## 0)
+## map_encode_operator_effect t ops op vs (tl_nat n) 
+)"
+
+lemma submap_encode_operator_effect:
+"map_encode_operator_effect t ops op vs n = map_nat (\<lambda>v.
+             4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (1 ## (0 ## (Suc t) ## (index_nat vs v)## 0) ## 0) ## 0) n"
+  apply( induct t ops op vs n rule :map_encode_operator_effect.induct)
+  apply (auto)
+  done
+
+fun map_encode_operator_effect2 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_operator_effect2 t ops op vs n = (if n=0 then 0 else 
+( 4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs (hd_nat n)) ## 0) ## 0) ## 0) ## 0)
+## map_encode_operator_effect2 t ops op vs (tl_nat n) 
+)"
+lemma submap_encode_operator_effect2:
+"map_encode_operator_effect2 t ops op vs n = map_nat (\<lambda>v.
+             4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0) ## 0) ## 0) n "
+  apply( induct t ops op vs n rule :map_encode_operator_effect2.induct)
+  apply (auto)
+  done
+
+definition  encode_operator_effect_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_operator_effect_nat \<Pi> t op
+    \<equiv> let
+        vs = nth_nat 0 \<Pi>
+        ; ops = nth_nat (Suc 0) \<Pi>
+      in BigAnd_nat( append_nat  (map_encode_operator_effect t ops op vs
+            (nth_nat (Suc 0) op))
+          (map_encode_operator_effect2 t ops op vs
+            (nth_nat (Suc (Suc 0)) op)))"
+
+lemma subnat_encode_operator_effect:
+"encode_operator_effect_nat (strips_list_problem_encode P) t (strips_operator_encode op) = 
+ sat_formula_encode (encode_operator_effect_list P t op)"
+  using  inj_strips_op inj_sasp
+  apply (auto simp only: encode_operator_effect_nat_def
+submap_encode_operator_effect submap_encode_operator_effect2
+      sub_cons cons0 sub_index strips_operator_encode.simps sub_nth nth.simps strips_list_problem_encode.simps)
+
+  apply (auto simp only: 
+sas_plus_assignment_list_encode_def sub_map
+simp flip:strips_operator_encode.simps)
+  apply (auto simp only: simp flip: sas_plus_assignment_list_encode_def strips_operator_encode.simps  )
+  apply (auto simp only: sub_cons sas_plus_assignment_list_encode_def strips_operator_list_encode_def
+      Let_def map_map comp_def sub_index simp flip: sat_variable_encode.simps sat_formula_encode.simps
+ )
+  apply (auto simp only:sub_append simp flip:  map_append  map_map comp_def [of sat_formula_encode "\<lambda>x. Not (Atom (Operator t (index ((P)\<^sub>\<O>) op))) \<^bold>\<or>
+                      Atom (State (Suc t) (index ((P)\<^sub>\<V>) x))" ] comp_def [of sat_formula_encode "\<lambda>x. Not (Atom (Operator t (index ((P)\<^sub>\<O>) op))) \<^bold>\<or>
+                     Not ( Atom (State (Suc t) (index ((P)\<^sub>\<V>) x)))" ]
+
+ )
+  apply (auto simp only: simp flip: sat_formula_list_encode_def)
+  apply (auto simp only: map_append sub_BigAnd encode_operator_effect_list_def Let_def)
+  done
+
+definition encode_all_operator_effects_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> 'variable strips_operator list
+    \<Rightarrow> nat
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_all_operator_effects_list \<Pi> ops t
+    \<equiv> let l = List.product [0..<t] ops
+      in BigAnd (map (\<lambda>(t, op). encode_operator_effect_list \<Pi> t op) l)"
+
+lemma sublist_encode_all_operator_effects:
+"encode_all_operator_effects_list \<Pi> ops t =
+encode_all_operator_effects (strips_list_problem_to_problem \<Pi>) ops t"
+  apply (auto simp add: encode_all_operator_effects_list_def encode_all_operator_effects_def
+    sub_foldr sublist_encode_operator_effect
+)
+  done
+fun map_encode_all_operator_effects :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_all_operator_effects P xs = (if xs = 0 then 0 
+else (encode_operator_effect_nat P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs))) ##
+map_encode_all_operator_effects P (tl_nat xs)
+ )"
+lemma submap_encode_all_operator_effects:
+"map_encode_all_operator_effects P xs =
+map_nat (\<lambda>n. encode_operator_effect_nat P (fst_nat n) (snd_nat n)) xs "
+  apply (induct P xs rule:map_encode_all_operator_effects.induct)
+  apply auto
+  done
+
+definition encode_all_operator_effects_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_all_operator_effects_nat P ops t
+    \<equiv> let l = product_nat (list_less_nat t) ops
+      in BigAnd_nat (map_encode_all_operator_effects P l)"
+
+lemma subnat_encode_all_operator_effects:
+"encode_all_operator_effects_nat (strips_list_problem_encode P) (strips_operator_list_encode ops) t
+= 
+sat_formula_encode (encode_all_operator_effects_list P ops t)"
+using list.map_id [of "[0..<t]" ] sub_product[of id  "[0..<t]" strips_operator_encode  ops ]
+  apply (auto simp only: encode_all_operator_effects_nat_def 
+submap_encode_all_operator_effects
+           sub_list_less    strips_operator_list_encode_def
+                    Let_def sub_map map_map comp_def 
+                    
+              )
+  apply (auto simp only: prod.case_eq_if id_def sub_fst fst_conv sub_snd snd_conv
+subnat_encode_operator_effect )
+  apply (auto simp only: sub_BigAnd encode_all_operator_effects_list_def
+Let_def case_prod_beta'
+ simp flip: map_map sat_formula_list_encode_def
+      comp_def [of sat_formula_encode  "\<lambda>x. encode_operator_effect_list P (fst x) (snd x) "])
+  done
+
+
+definition encode_operators_list
+  :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula"
+  where "encode_operators_list \<Pi> t
+    \<equiv> let ops = operators_of \<Pi>
+      in encode_all_operator_preconditions_list \<Pi> ops t \<^bold>\<and> encode_all_operator_effects_list \<Pi> ops t"
+
+lemma sublist_encode_operators:
+"encode_operators_list P t = encode_operators (strips_list_problem_to_problem P) t"
+  apply (auto simp add:encode_operators_list_def encode_operators_def sublist_encode_all_operator_preconditions
+        sublist_encode_all_operator_effects
+ )
+  done
+
+definition encode_operators_nat
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_operators_nat \<Pi> t
+    \<equiv> let ops = nth_nat (Suc 0) \<Pi>
+      in 3 ## (encode_all_operator_preconditions_nat \<Pi> ops t) ## (encode_all_operator_effects_nat \<Pi> ops t) ## 0"
+
+lemma subnat_encode_operators:
+"encode_operators_nat (strips_list_problem_encode P) t =
+sat_formula_encode (encode_operators_list P t)"
+  apply (auto simp only: strips_list_problem_encode.simps encode_operators_nat_def
+      sub_nth nth.simps
+)
+  apply (auto simp only:Let_def subnat_encode_all_operator_preconditions 
+encode_operators_list_def
+subnat_encode_all_operator_effects sub_cons cons0
+                    simp flip: strips_list_problem_encode.simps sat_formula_encode.simps )
+  done
+
+definition  encode_negative_transition_frame_axiom_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> nat
+    \<Rightarrow> 'variable
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_negative_transition_frame_axiom_list \<Pi> t v
+    \<equiv> let vs = variables_of \<Pi>
+        ; ops = operators_of \<Pi>
+        ; deleting_operators = filter (\<lambda>op. ListMem v (delete_effects_of op)) ops
+      in \<^bold>\<not>(Atom (State t (index vs v)))
+          \<^bold>\<or> (Atom (State (Suc t) (index vs v))
+          \<^bold>\<or> \<^bold>\<Or> (map (\<lambda>op. Atom (Operator t (index ops op))) deleting_operators))"
+
+lemma sublist_encode_negative_transition_frame_axiom:
+"encode_negative_transition_frame_axiom_list \<Pi> t v = 
+encode_negative_transition_frame_axiom (strips_list_problem_to_problem \<Pi>) t v"
+  apply (auto simp add:encode_negative_transition_frame_axiom_list_def
+encode_negative_transition_frame_axiom_def) done
+
+declare elemof.simps [simp del]
+fun filter_del_effects :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_del_effects v ops = (if ops = 0 then 0 else if 
+elemof v (nth_nat (Suc (Suc 0)) (hd_nat ops)) \<noteq> 0 then 
+(hd_nat ops) ## filter_del_effects v (tl_nat ops) else  filter_del_effects v (tl_nat ops) )"
+
+lemma subfilter_del_effects:
+"filter_del_effects v ops = filter_nat (\<lambda>op. elemof v (nth_nat (Suc (Suc 0)) op) \<noteq> 0) ops "
+  apply(induct v ops rule:filter_del_effects.induct)
+  apply auto
+  done
+
+fun map_transition :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_transition t ops xs = (if xs =0 then 0 else 
+(1 ## (1 ## t  ## (index_nat ops (hd_nat xs)) ## 0) ## 0) ## map_transition t ops (tl_nat xs)
+  )"
+
+lemma submap_transition:
+"map_transition t ops xs = map_nat (\<lambda>op. 1 ## (1 ## t  ## (index_nat ops op) ## 0) ## 0) xs"
+  apply( induct t ops xs rule:map_transition.induct)
+  apply auto
+  done
+
+definition  encode_negative_transition_frame_axiom_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow>nat
+    \<Rightarrow> nat"
+  where "encode_negative_transition_frame_axiom_nat \<Pi> t v
+    \<equiv> let vs = nth_nat 0 \<Pi>
+        ; ops = nth_nat (Suc 0) \<Pi>
+        ; deleting_operators = filter_del_effects v ops
+     in   4 ## ( 2 ##(1 ## (0 ## t ## (index_nat vs v) ## 0) ## 0 ) ## 0) ##
+          (4 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0 )
+          ## (BigOr_nat (map_transition t ops deleting_operators)) ## 0) ## 0"
+
+lemma subnat_encode_negative_transition_frame_axiom:
+"encode_negative_transition_frame_axiom_nat (strips_list_problem_encode P) t (sas_plus_assignment_encode v) 
+= sat_formula_encode (encode_negative_transition_frame_axiom_list P t v)"
+  apply (auto simp only:encode_negative_transition_frame_axiom_nat_def  subfilter_del_effects
+      strips_list_problem_encode.simps sub_cons cons0
+          submap_transition
+          sub_nth nth.simps
+ )
+  using  inj_strips_op inj_sasp
+  apply (auto simp only: strips_operator_list_encode_def
+sas_plus_assignment_list_encode_def sub_index sub_filter
+ Let_def filter_map comp_def sub_elem_of_inj
+strips_operator_encode.simps sub_nth nth.simps
+sub_map map_map 
+      simp flip:  strips_list_problem_encode.simps)
+  apply (auto simp only:sub_index simp flip: sas_plus_assignment_list_encode_def
+strips_operator_encode.simps sat_variable_encode.simps sat_formula_encode.simps)
+  apply (auto simp only: sub_BigOr simp flip: map_map sat_formula_list_encode_def comp_def [of  sat_formula_encode "\<lambda>x. Atom (Operator t (index ((P)\<^sub>\<O>) x))"]
+ )
+  apply (auto simp only:encode_negative_transition_frame_axiom_list_def Let_def
+
+ simp flip:  sat_formula_encode.simps)
+  apply (metis (no_types, lifting) ListMem_iff filter_cong)
+  done
+
+definition  encode_positive_transition_frame_axiom_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> nat
+    \<Rightarrow> 'variable
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_positive_transition_frame_axiom_list \<Pi> t v
+    \<equiv> let vs = variables_of \<Pi>
+        ; ops = operators_of \<Pi>
+        ; adding_operators = filter (\<lambda>op. ListMem v (add_effects_of op)) ops
+      in (Atom (State t (index vs v))
+          \<^bold>\<or> (\<^bold>\<not>(Atom (State (Suc t) (index vs v)))
+          \<^bold>\<or> \<^bold>\<Or>(map (\<lambda>op. Atom (Operator t (index ops op))) adding_operators)))"
+
+lemma sublist_encode_positive_transition_frame_axiom:
+"encode_positive_transition_frame_axiom_list \<Pi> t v = 
+encode_positive_transition_frame_axiom (strips_list_problem_to_problem \<Pi>) t v"
+  apply (auto simp add:encode_positive_transition_frame_axiom_list_def
+encode_positive_transition_frame_axiom_def) done
+
+fun filter_add_effects :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_add_effects v ops = (if ops = 0 then 0 else if 
+elemof v (nth_nat (Suc 0) (hd_nat ops)) \<noteq> 0 then 
+(hd_nat ops) ## filter_add_effects v (tl_nat ops) else  filter_add_effects v (tl_nat ops) )"
+
+lemma subfilter_add_effects:
+"filter_add_effects v ops = filter_nat (\<lambda>op. elemof v (nth_nat (Suc 0) op) \<noteq> 0) ops "
+  apply(induct v ops rule:filter_add_effects.induct)
+  apply auto
+  done
+
+definition  encode_positive_transition_frame_axiom_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_positive_transition_frame_axiom_nat \<Pi> t v
+    \<equiv> let vs = nth_nat 0 \<Pi>
+        ; ops = nth_nat (Suc 0) \<Pi>
+        ; adding_operators = filter_add_effects v ops
+      in  4 ## (1 ## (0 ## t ## (index_nat vs v) ## 0) ## 0 ) ##
+          (4 ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0 ) ## 0)
+          ## (BigOr_nat (map_transition t ops adding_operators)) ## 0) ## 0"
+
+lemma subnat_encode_positive_transition_frame_axiom:
+"encode_positive_transition_frame_axiom_nat (strips_list_problem_encode P) t (sas_plus_assignment_encode v) 
+= sat_formula_encode (encode_positive_transition_frame_axiom_list P t v)"
+  apply (auto simp only:encode_positive_transition_frame_axiom_nat_def
+      strips_list_problem_encode.simps sub_cons cons0
+          sub_nth nth.simps submap_transition subfilter_add_effects
+ )
+  using  inj_strips_op inj_sasp
+  apply (auto simp only: strips_operator_list_encode_def
+sas_plus_assignment_list_encode_def sub_index sub_filter
+ Let_def filter_map comp_def sub_elem_of_inj
+strips_operator_encode.simps sub_nth nth.simps
+sub_map map_map 
+      simp flip:  strips_list_problem_encode.simps)
+  apply (auto simp only:sub_index simp flip: sas_plus_assignment_list_encode_def
+strips_operator_encode.simps sat_variable_encode.simps sat_formula_encode.simps)
+  apply (auto simp only: sub_BigOr simp flip: map_map sat_formula_list_encode_def comp_def [of  sat_formula_encode "\<lambda>x. Atom (Operator t (index ((P)\<^sub>\<O>) x))"]
+ )
+  apply (auto simp only:encode_positive_transition_frame_axiom_list_def Let_def
+
+ simp flip:  sat_formula_encode.simps)
+  apply (metis (no_types, lifting) ListMem_iff filter_cong)
+  done
+
+definition encode_all_frame_axioms_list
+  :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula"
+  where "encode_all_frame_axioms_list \<Pi> t
+    \<equiv> let l = List.product [0..<t] (variables_of \<Pi>)
+      in \<^bold>\<And>(map (\<lambda>(k, v). encode_negative_transition_frame_axiom_list \<Pi> k v) l
+            @ map (\<lambda>(k, v). encode_positive_transition_frame_axiom_list \<Pi> k v) l)"
+
+lemma sublist_encode_all_frame_axioms:
+" encode_all_frame_axioms_list \<Pi> t =
+encode_all_frame_axioms (strips_list_problem_to_problem \<Pi>) t"
+  apply (auto simp only: encode_all_frame_axioms_list_def 
+encode_all_frame_axioms_def sublist_encode_negative_transition_frame_axiom
+sublist_encode_positive_transition_frame_axiom
+strips_list_problem_to_problem.simps
+strips_list_problem.simps
+strips_problem.simps
+Let_def) done
+
+fun map_encode_negative ::"nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_negative P xs = (if xs = 0 then 0 else 
+( encode_negative_transition_frame_axiom_nat P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)))##
+map_encode_negative P (tl_nat xs)
+)"
+
+lemma submap_encode_negative:
+"map_encode_negative P xs =map_nat (\<lambda>n. encode_negative_transition_frame_axiom_nat P (fst_nat n) (snd_nat n)) xs "
+  apply (induct P xs rule:map_encode_negative.induct)
+  apply auto
+  done
+
+fun map_encode_positive ::"nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_positive P xs = (if xs = 0 then 0 else 
+( encode_positive_transition_frame_axiom_nat P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)))##
+map_encode_positive P (tl_nat xs)
+)"
+
+lemma submap_encode_positive:
+"map_encode_positive P xs =map_nat (\<lambda>n. encode_positive_transition_frame_axiom_nat P (fst_nat n) (snd_nat n)) xs "
+  apply (induct P xs rule:map_encode_positive.induct)
+  apply auto
+  done
+
+
+
+definition encode_all_frame_axioms_nat
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_all_frame_axioms_nat \<Pi> t
+    \<equiv> let l = product_nat (list_less_nat t) (nth_nat 0 \<Pi>)
+      in BigAnd_nat ( append_nat (map_encode_negative \<Pi> l)
+            (map_encode_positive \<Pi> l))"
+thm "prod.case_eq_if"
+lemma subnat_encode_all_frame_axioms:
+"encode_all_frame_axioms_nat (strips_list_problem_encode P) t =
+sat_formula_encode (encode_all_frame_axioms_list P t)"
+  apply (auto simp only: encode_all_frame_axioms_nat_def submap_encode_negative 
+submap_encode_positive 
+strips_list_problem_encode.simps sub_nth nth.simps)
+  apply (auto simp only: sas_plus_assignment_list_encode_def sub_list_less
+          simp flip: strips_list_problem_encode.simps)
+  using list.map_id [of "[0..<t]" ] sub_product[of id  "[0..<t]" sas_plus_assignment_encode  "(P)\<^sub>\<V>" ]
+  apply (auto simp only: Let_def sub_map map_map comp_def
+      prod.case_eq_if sub_fst sub_snd fst_conv snd_conv id_def
+      subnat_encode_positive_transition_frame_axiom
+       subnat_encode_negative_transition_frame_axiom sub_append
+ simp flip: strips_list_problem_encode.simps sas_plus_assignment_list_encode_def)
+  apply (auto simp only: case_prod_beta'
+encode_all_frame_axioms_list_def Let_def
+sub_BigAnd simp flip: sat_formula_list_encode_def map_append  map_map comp_def[of sat_formula_encode "\<lambda>x. encode_negative_transition_frame_axiom_list P (fst x) (snd x)"]
+ comp_def[of sat_formula_encode "\<lambda>x. encode_positive_transition_frame_axiom_list P (fst x) (snd x)"]
+)
+  done
+
+definition  encode_problem_list:: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_formula"
+  where "encode_problem_list \<Pi> t
+    \<equiv> encode_initial_state_list \<Pi>
+      \<^bold>\<and> (encode_operators_list \<Pi> t
+      \<^bold>\<and> (encode_all_frame_axioms_list \<Pi> t
+      \<^bold>\<and> (encode_goal_state_list \<Pi> t)))"
+
+lemma sublist_encode_problem : 
+"encode_problem_list \<Pi> t = encode_problem (strips_list_problem_to_problem \<Pi>) t"
+  apply (auto simp add: encode_problem_list_def encode_problem_def
+      sublist_encode_initial_state sublist_encode_operators sublist_encode_all_frame_axioms
+          sublist_encode_goal_state)
+  done
+
+definition  encode_problem_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_problem_nat \<Pi> t
+    \<equiv> 3 ## (encode_initial_state_nat \<Pi>) ## 
+      ( 3 ## (encode_operators_nat \<Pi> t)
+        ## (3 ##(encode_all_frame_axioms_nat \<Pi> t)
+     ## (encode_goal_state_nat \<Pi> t) ## 0) ## 0) ## 0"
+
+lemma subnat_encode_problem:
+"encode_problem_nat (strips_list_problem_encode P) t
+= sat_formula_encode (encode_problem_list P t)"
+  apply (auto simp only: encode_problem_nat_def encode_problem_list_def sub_cons cons0 
+subnat_encode_initial_state
+  subnat_encode_operators
+subnat_encode_all_frame_axioms
+subnat_encode_goal_state
+simp flip: sat_formula_encode.simps )
+  done
+
+end
\ No newline at end of file

From 285336a0c162608dcd4294a1b08ef732d1ddb41e Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Fri, 13 Aug 2021 17:26:59 +0200
Subject: [PATCH 004/103] refinement of the reduction to HOL_nat

---
 .../IMP_Minus_Minus_Subprograms_Nat.thy       | 108 +++
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy | 301 ++++++++
 ...o_SAS_Plus_Plus_State_Translations_Nat.thy |  83 ++
 ...theory IMP_Minus_Minus_Subprograms_Nat.thy |   4 +
 .../IMP-_To_IMP--/Binary_Arithmetic_Nat.thy   |  74 ++
 .../IMP-_To_IMP--/Binary_Operations_Nat.thy   | 366 +++++++++
 .../SAS_Plus_Plus_To_SAS_Plus_Nat.thy         | 714 ++++++++++++++++++
 7 files changed, 1650 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
new file mode 100644
index 00000000..b0e5258b
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
@@ -0,0 +1,108 @@
+theory IMP_Minus_Minus_Subprograms_Nat
+  imports "../IMP-_To_IMP--/Primitives" IMP_Minus_Minus_Subprograms 
+begin 
+
+
+fun map_all_subprograms:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms c n = (if n =0 then 0 else (2## (hd_nat n) ## (nth_nat (Suc (Suc 0)) c ) ## 0) ## map_all_subprograms c (tl_nat n) )"
+
+lemma submap_all_subprograms:
+  "map_all_subprograms c n = map_nat (\<lambda>c'. 2## c' ## (nth_nat (Suc (Suc 0)) c ) ## 0) n"
+  apply (induct c n rule: map_all_subprograms.induct)
+  apply auto
+  done
+
+fun map_all_subprograms2:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms2 c n = (if n =0 then 0 else ( 2## (hd_nat n) ## c ## 0) ## map_all_subprograms2 c (tl_nat n) )"
+lemma submap_all_subprograms2:
+"map_all_subprograms2 c n = map_nat (\<lambda>x. 2## x ## c ## 0) n"
+  apply (induct c n rule: map_all_subprograms2.induct)
+  apply auto
+  done
+
+declare nth_nat.simps[simp del]
+fun all_subprograms_nat :: "nat \<Rightarrow> nat" where
+"all_subprograms_nat c  = (if c=0 \<or> hd_nat c = 0 then (0##0)##0 else
+if hd_nat c = 1 then c##(0##0)##0 else
+if hd_nat c = 2 then append_nat (append_nat (map_all_subprograms c  (all_subprograms_nat (nth_nat (Suc 0) c)))
+(all_subprograms_nat (nth_nat (Suc 0) c))) (all_subprograms_nat (nth_nat (Suc (Suc 0)) c)) else
+if hd_nat c = 3 then c ## append_nat (all_subprograms_nat (nth_nat (Suc (Suc 0)) c)) (all_subprograms_nat (nth_nat (Suc (Suc (Suc 0))) c)) else
+c ## (0##0) ## append_nat (all_subprograms_nat (nth_nat (Suc (Suc 0)) c)) (map_all_subprograms2 c  (all_subprograms_nat (nth_nat (Suc (Suc 0)) c))) 
+)"
+declare nth_nat.simps[simp]
+
+lemma sub_all_subprograms:
+ "all_subprograms_nat (comm_encode c) = list_encode(map comm_encode (all_subprograms c))"
+  apply(induct c)
+      apply (subst all_subprograms_nat.simps)
+      apply (simp only: comm_encode.simps sub_hd head.simps cons0 all_subprograms.simps)
+      apply simp
+      apply (subst all_subprograms_nat.simps)
+      apply (simp only: comm_encode.simps sub_hd head.simps cons0 sub_cons sub_append all_subprograms.simps)
+     apply simp
+     apply (subst all_subprograms_nat.simps)
+    apply (simp only:  submap_all_subprograms comm_encode.simps sub_hd head.simps cons0 map_append map_map[of comm_encode] map_map[of _ comm_encode] comp_apply
+          sub_map sub_nth nth.simps sub_cons sub_append all_subprograms.simps extract_lambda2[of "\<lambda>i j. list_encode [2, i, comm_encode j]" ] flip: extract_lambda )
+    apply simp
+     apply (subst all_subprograms_nat.simps)
+    apply (simp only: comm_encode.simps sub_hd head.simps cons0 map_append map_map[of comm_encode] map_map[of _ comm_encode] comp_apply
+          sub_map sub_nth nth.simps sub_cons sub_append all_subprograms.simps extract_lambda2[of "\<lambda>i j. list_encode [2, i, comm_encode j]" ] flip: extract_lambda )
+   apply simp
+     apply (subst all_subprograms_nat.simps)
+    apply (simp only: submap_all_subprograms2  comm_encode.simps sub_hd head.simps cons0 map_append map_map[of comm_encode] map_map[of _ comm_encode] comp_apply
+          sub_map sub_nth nth.simps sub_cons sub_append all_subprograms.simps extract_lambda2[of "\<lambda>i j. list_encode [2, i,j]" ] flip: extract_lambda )
+  apply simp
+  done
+
+
+definition enumerate_subprograms_nat :: "nat \<Rightarrow>nat" where
+"enumerate_subprograms_nat c = remdups_nat (all_subprograms_nat c)"
+
+lemma sub_enumerate_subprograms:
+"enumerate_subprograms_nat (comm_encode c) = list_encode (map comm_encode (enumerate_subprograms c))"
+  using comm_inj
+  apply (auto simp only: enumerate_subprograms_nat_def enumerate_subprograms_def remdups_map sub_all_subprograms sub_remdups list_encode_eq)
+  done
+
+fun all_variables_nat :: "nat \<Rightarrow>nat" where
+"all_variables_nat n = (if n=0 \<or> hd_nat n =0 \<or> hd_nat n =2  then 0 else
+if hd_nat n = 1 then (nth_nat (Suc 0) n) ## 0 else
+nth_nat (Suc 0) n )"
+
+lemma sub_all_variables: "all_variables_nat (comm_encode c) = vname_list_encode (all_variables c)"
+  apply (cases c)
+      apply (auto simp only:all_variables_nat.simps sub_hd comm_encode.simps head.simps 
+              vname_list_encode_def cons0 sub_cons sub_nth nth.simps)
+      apply auto
+  done
+
+fun map_all_variables:: "nat \<Rightarrow> nat" where 
+"map_all_variables n = (if n =0 then 0 else (all_variables_nat (hd_nat n)) ## map_all_variables (tl_nat n) )"
+lemma submap_all_variables:
+"map_all_variables n = map_nat all_variables_nat n"
+  apply (induct n rule:map_all_variables.induct)
+  apply auto
+  done
+
+definition enumerate_variables_nat :: "nat \<Rightarrow> nat" where
+"enumerate_variables_nat c =
+     remdups_nat (concat_nat (map_all_variables (enumerate_subprograms_nat c)))"
+
+thm "remdups_map"
+lemma sub_enumerate_variables:
+  "enumerate_variables_nat (comm_encode c) = vname_list_encode ( enumerate_variables c)"
+  apply 
+   (simp only:  submap_all_variables enumerate_variables_nat_def enumerate_variables_def sub_enumerate_subprograms 
+                sub_map  map_map)
+  apply (simp only: comp_def)
+  apply (simp only: sub_all_variables)
+  apply (simp only: flip:comp_def) 
+  apply (simp only: flip:map_map)
+  apply (simp only: vname_list_encode_as_comp)
+  apply (simp only: flip:map_map)
+  using vname_inj
+  apply (simp only: sub_concat sub_remdups comp_apply map_concat flip:remdups_map )
+  done
+
+
+end 
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
new file mode 100644
index 00000000..71325e0e
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -0,0 +1,301 @@
+theory IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat
+  imports Primitives IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat  IMP_Minus_Minus_Subprograms_Nat
+ IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction  
+begin                               
+definition domain_nat :: "nat" where
+"domain_nat = list_encode [prod_encode(0,0), prod_encode(0,1)]"
+
+lemma sub_domain: "domain_nat = list_encode (map domain_element_encode domain)"
+  apply (auto simp add:domain_nat_def domain_def)
+  done
+
+definition pc_to_com_nat :: "nat\<Rightarrow> nat" where
+"pc_to_com_nat l =(if fst_nat(snd_nat(hd_nat l)) = 1 then snd_nat (snd_nat (hd_nat l)) 
+                  else  0##0)"
+
+lemma sub_pc_to_com :
+  "pc_to_com_nat (sas_assignment_list_encode l) = comm_encode (pc_to_com l)"
+  apply (cases l)
+  apply (auto simp only: pc_to_com_nat_def sas_assignment_list_encode_def sub_hd 
+              pc_to_com_def list.map head.simps sas_assignment_encode.simps
+                    sub_snd snd_def nth.simps 
+                  split:list.splits)
+  apply(simp add:fst_nat_def snd_nat_def prod_decode_def prod_decode_aux.simps cons_def)
+      
+  subgoal for a b l
+    apply (cases b)
+     apply (auto simp only: domain_element_encode.simps sub_snd snd_def sub_fst cons0)
+     apply auto
+    done
+  done
+
+declare nth_nat.simps[simp del]
+
+fun map_com_to_operators:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_com_to_operators c c2 n = (if n = 0 then 0 else 
+ (let c1' = pc_to_com_nat (nth_nat (Suc 0) (hd_nat n)) in  
+        (list_update_nat (nth_nat 0 (hd_nat n)) 0 (prod_encode (0,prod_encode(1,c))))##
+        (list_update_nat (nth_nat (Suc 0) (hd_nat n)) 0 (prod_encode(0, prod_encode(1, 2 ##c1'##c2##0))))##0 )
+## map_com_to_operators c c2 (tl_nat n)
+)"
+
+lemma submap_com_to_operators:
+"map_com_to_operators c c2 n =
+ map_nat (\<lambda> op. 
+    (let c1' = pc_to_com_nat (nth_nat (Suc 0) op) in  
+        (list_update_nat (nth_nat 0 op) 0 (prod_encode (0,prod_encode(1,c))))##
+        (list_update_nat (nth_nat (Suc 0) op) 0 (prod_encode(0, prod_encode(1, 2 ##c1'##c2##0))))##0 )) n
+ "
+  apply (induct c c2 n rule:map_com_to_operators.induct)
+  apply auto
+  done
+fun map_com_to_operators2 :: "nat \<Rightarrow> nat" where 
+" map_com_to_operators2 n = (if n = 0 then 0 else (prod_encode(Suc (hd_nat n), prod_encode(0,0)))##  map_com_to_operators2 (tl_nat n))"
+
+lemma submap_com_to_operators2: 
+" map_com_to_operators2 n =  map_nat (\<lambda>v. prod_encode(Suc v, prod_encode(0,0))) n"
+  apply (induct n rule:map_com_to_operators2.induct)
+  apply auto
+  done
+
+fun  map_com_to_operators3 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_com_to_operators3 i c1 n  = (if n =0 then 0 else ((((prod_encode(0, i))## (prod_encode(Suc (hd_nat n), prod_encode(0,1)))##0)## 
+         ((prod_encode(0, prod_encode(1, c1)))##0)## 0)) ##map_com_to_operators3 i c1 (tl_nat n))"
+
+lemma submap_com_to_operators3:
+"map_com_to_operators3 i c1 n = map_nat (\<lambda> v. 
+      ( ((prod_encode(0, i))## (prod_encode(Suc v, prod_encode(0,1)))##0)## 
+         ((prod_encode(0, prod_encode(1, c1)))##0)## 0)) n"
+  apply (induct i c1 n rule:map_com_to_operators3.induct)
+  apply auto
+  done
+
+fun  map_com_to_operators4 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where 
+"map_com_to_operators4 i j n = (if n=0 then 0 else (( (((prod_encode(0, i)) ## (prod_encode (Suc (hd_nat n), prod_encode(0,1) )) ##0)) ## 
+         (((prod_encode(0, j))##0) ## 0 ))) ## map_com_to_operators4 i j (tl_nat n))"
+
+lemma submap_com_to_operators4:
+"map_com_to_operators4 i j n =  map_nat (\<lambda> v. 
+      ( (((prod_encode(0, i)) ## (prod_encode (Suc v, prod_encode(0,1) )) ##0)) ## 
+         (((prod_encode(0, j))##0) ## 0 ))) n "
+  apply (induct i j n rule:map_com_to_operators4.induct)
+  apply auto
+  done
+
+fun com_to_operators_nat :: "nat \<Rightarrow> nat" where
+"com_to_operators_nat c = (if c = 0 \<or> hd_nat c = 0 then 0 else 
+if hd_nat c = 1 then (
+                        ((prod_encode(0,prod_encode(1,c)))##0)
+                        ##
+                          (
+                              (prod_encode(0,prod_encode(1,0##0)))
+                                ##
+                              (prod_encode(Suc (nth_nat (Suc 0) c),prod_encode(0,nth_nat (Suc (Suc 0)) c)))
+                               ##0
+                          )
+                        ##0)##0
+else if hd_nat c = 2 then (let c1 = nth_nat (Suc 0) c; c2= nth_nat (Suc (Suc 0)) c in 
+  (if c1 = 0##0 then (((prod_encode(0,prod_encode(1,c)))##0)##((prod_encode(0,prod_encode(1,c2)))##0)##0)##0
+else  (let ops = com_to_operators_nat c1 in map_com_to_operators c c2 ops)))
+else if hd_nat c = 3 then 
+(let i = prod_encode (1, c); vs = nth_nat (Suc 0) c ; c1 = nth_nat (Suc (Suc 0)) c ; c2 = nth_nat (Suc (Suc (Suc 0))) c
+   in  ( ((prod_encode(0, i)) ## map_com_to_operators2 (remdups_nat vs))## 
+        ((prod_encode(0, prod_encode(1, c2)))##0)## 0)
+      ## map_com_to_operators3 i c1 vs)
+else (let i = prod_encode(1,c) ;  vs = nth_nat (Suc 0) c ; c' = nth_nat (Suc (Suc 0)) c ; 
+  j = prod_encode(1, (2##c'## c##0)); k = prod_encode(1, 0##0) in 
+    ( ((prod_encode(0, i)) ##  map_com_to_operators2 (remdups_nat vs))## 
+        (((prod_encode(0, k))##0))##0) 
+      ## map_com_to_operators4 i j vs))
+"
+declare nth_nat.simps[simp]
+
+lemma com_to_operators_inv: 
+  "\<lbrakk> c \<noteq> SKIP ; L = com_to_operators c; l \<in>set L \<rbrakk> \<Longrightarrow> effect_of l \<noteq>[] \<and> (\<exists>x y. effect_of l!0 = (y,PCV x))"
+  apply (induct c arbitrary:l L rule: com_to_operators.induct )
+      apply (auto simp add:  Let_def split:if_splits  )
+  done
+  
+lemma sub_map_dec: "map_nat P xs = list_encode (map P (list_decode xs))"
+  using sub_map list_decode_inverse by metis
+
+
+lemma comm_encode_eq : "(comm_encode c1 = comm_encode c2) = (c1 = c2)"
+  apply (cases c2)
+  apply (induct c1 arbitrary:c2)
+          apply (auto simp add:prod_encode_eq)
+  apply (metis One_nat_def comm_encode.simps(2) comm_id list_encode.simps(1) list_encode.simps(2))
+  apply (metis comm_encode.simps(3) comm_id list_encode.simps(1) list_encode.simps(2))
+   apply (metis comm_encode.simps(4) comm_id list_encode.simps(1) list_encode.simps(2))
+  by (metis comm_encode.simps(5) comm_id cons0 cons_def list_encode.simps(2))
+
+
+  
+lemma list_encode_empty:"(list_encode l = 0) =(l = [])"
+  apply (auto)
+  using list_encode_eq by force
+
+lemma suc_eq: "(Suc i = Suc j) = (i=j) "
+  by simp
+
+lemma list_update_nat_zero: "list_update_nat 0 0 n = 0"
+  apply auto
+  done
+
+lemma sub_com_to_operators:
+"com_to_operators_nat (comm_encode c) = list_encode (map operator_encode (com_to_operators c))"
+  apply (induct rule:com_to_operators.induct)
+      apply (subst com_to_operators_nat.simps)
+      apply (auto simp only:sub_hd comm_encode.simps head.simps sub_cons cons0 sub_map )
+      apply simp
+       apply (subst com_to_operators_nat.simps)
+     apply (auto simp only:sub_hd comm_encode.simps head.simps sub_cons cons0 sub_map sub_nth com_to_operators.simps
+                                      nth.simps simp flip: domain_element_encode.simps  variable_encode.simps(2) sas_assignment_encode.simps comm_encode.simps(1) imp_assignment_encode.simps)
+     apply (auto simp add: operator_encode_def sas_assignment_list_encode_def 
+            sub_map list_encode_eq )[1]
+      apply (subst com_to_operators_nat.simps)
+     apply (auto simp only: sub_hd list_encode_eq suc_eq list_encode_empty comm_encode_eq head.simps sub_cons cons0 sub_map sub_map_dec sub_nth com_to_operators.simps
+                         sub_list_update sas_plus_operator.simps sas_assignment_list_encode_def list.map prod_encode_eq  nth.simps sub_pc_to_com Let_def comp_def operator_encode_def
+  domain_element_encode.simps  variable_encode.simps  sas_assignment_encode.simps
+    map_map list_encode_inverse sub_remdups  comm_encode.simps submap_com_to_operators
+  simp flip: comm_encode.simps(1) 
+                          del: list_encode.simps hd_nat_def cons_def pc_to_com_nat_def map_nat.simps nth_nat.simps list_update_nat.simps  com_to_operators_nat.simps split:if_splits)
+  apply (auto simp only:sub_pc_to_com simp flip:  sas_assignment_list_encode_def )
+    apply (auto simp only: sas_assignment_list_encode_def list.simps map_update 
+            sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps comm_encode.simps)
+   apply (subst com_to_operators_nat.simps)
+  using vname_inj
+   apply (auto simp only:sub_hd head.simps Let_def cons0 sub_cons sub_nth nth.simps sub_map_dec  bit_encode.simps 
+        vname_list_encode_def sub_remdups list_encode_inverse map_map comp_def
+sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps comm_encode.simps list.simps
+    remdups_map submap_com_to_operators2  submap_com_to_operators3
+   )
+   apply simp
+   apply (subst com_to_operators_nat.simps)
+  using vname_inj
+   apply (auto simp only:sub_hd  submap_com_to_operators2 head.simps Let_def cons0 sub_cons sub_nth nth.simps sub_map_dec  bit_encode.simps 
+        vname_list_encode_def sub_remdups list_encode_inverse map_map comp_def
+sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps comm_encode.simps list.simps
+    remdups_map submap_com_to_operators4
+   )
+  apply simp
+  done
+
+fun map_coms_to_operators :: "nat \<Rightarrow> nat" where 
+"map_coms_to_operators n = (if n = 0 then 0 else (com_to_operators_nat (hd_nat n)) ## map_coms_to_operators (tl_nat n))"
+ 
+lemma submap_coms_to_operators : 
+"map_coms_to_operators n  = map_nat com_to_operators_nat n "
+  apply (induct n rule:map_coms_to_operators.induct)
+  apply auto
+  done
+definition coms_to_operators_nat :: "nat \<Rightarrow> nat" where
+"coms_to_operators_nat cs = concat_nat (map_coms_to_operators cs)"
+
+lemma sub_coms_to_operators:
+    "coms_to_operators_nat (list_encode( map comm_encode cs)) = 
+          list_encode (map operator_encode (coms_to_operators cs)) "
+  apply (auto simp only: coms_to_operators_nat_def sub_map map_map comp_def
+        sub_com_to_operators submap_coms_to_operators )
+  apply (auto simp only: coms_to_operators_def sub_concat map_concat simp flip: comp_def[of "list_encode" "%x.(map operator_encode (com_to_operators x))"]
+            map_map)
+  apply (auto simp add: comp_def)
+  done
+
+
+
+definition imp_minus_minus_to_sas_plus_list::
+"com \<Rightarrow> (vname,bit) assignment list  \<Rightarrow> (vname,bit) assignment list \<Rightarrow> 
+      (variable,domain_element) sas_plus_list_problem" where 
+"imp_minus_minus_to_sas_plus_list c I G = (let cs = enumerate_subprograms c ; 
+  initial_vs = restrict_list I (enumerate_variables c) ;
+  goal_vs = restrict_list G (enumerate_variables c) ;
+  pc_d = map (\<lambda> i. PCV i) cs in
+    \<lparr> variables_ofl = PC # (map VN (enumerate_variables c)),
+      operators_ofl = coms_to_operators cs, 
+      initial_ofl = imp_minus_state_to_sas_plus_list (c, initial_vs),
+      goal_ofl = imp_minus_state_to_sas_plus_list (SKIP, goal_vs),
+      range_ofl = (PC, pc_d)#(map (\<lambda> v. (VN v, domain)) (enumerate_variables c))\<rparr>)"
+
+lemma sublist_imp_minus_minus_to_sas_plus:
+"list_problem_to_problem (imp_minus_minus_to_sas_plus_list c I G) = 
+    imp_minus_minus_to_sas_plus c (map_of I) (map_of G)"
+  apply (auto simp add:
+          imp_minus_minus_to_sas_plus_list_def list_problem_to_problem.simps
+          sub_restrict_list Let_def sas_plus_problem.simps sas_plus_list_problem.simps
+            sublist_imp_minus_state_to_sas_plus 
+            imp_minus_minus_to_sas_plus_def  )
+  done
+fun map_PCV :: "nat \<Rightarrow> nat" where 
+"map_PCV n = (if n = 0 then 0 else  (prod_encode(1, hd_nat n))## map_PCV (tl_nat n))"
+
+lemma submap_PCV : 
+"map_PCV n =  map_nat (\<lambda> i. prod_encode(1, i)) n "
+  apply (induct n rule: map_PCV.induct)
+  apply (auto)
+  done
+
+fun map_Suc :: "nat \<Rightarrow> nat" where 
+"map_Suc n = (if n = 0 then 0 else (Suc(hd_nat n)) ## (map_Suc (tl_nat n)))"
+
+lemma submap_Suc :
+"map_Suc n = map_nat Suc n"
+  apply (induct n rule:map_Suc.induct)
+  apply auto
+  done
+
+fun map_domain :: "nat\<Rightarrow> nat" where 
+"map_domain n = (if n = 0 then 0 else (prod_encode(Suc (hd_nat n), domain_nat)) ## map_domain (tl_nat n))"
+
+lemma submap_domain :
+"map_domain n = map_nat (\<lambda> v. (prod_encode(Suc v, domain_nat))) n"
+  apply (induct n rule:map_domain.induct)
+  apply auto
+  done
+
+definition imp_minus_minus_to_sas_plus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"imp_minus_minus_to_sas_plus_nat c I G = (let cs = enumerate_subprograms_nat c ; 
+  initial_vs = restrict_nat I (enumerate_variables_nat c) ;
+  goal_vs = restrict_nat G (enumerate_variables_nat c) ;
+  pc_d = map_PCV cs in
+   (0 ## (map_Suc (enumerate_variables_nat c)))## 
+      (coms_to_operators_nat cs) ## 
+      (imp_minus_state_to_sas_plus_nat (prod_encode (c, initial_vs)))##
+      (imp_minus_state_to_sas_plus_nat (prod_encode (0##0, goal_vs)))##
+      ((prod_encode(0, pc_d))##(map_domain (enumerate_variables_nat c)))##0 )"
+
+lemma subnat_imp_minus_minus_to_sas_plus:
+"imp_minus_minus_to_sas_plus_nat (comm_encode c) 
+            (imp_assignment_list_encode I) (imp_assignment_list_encode G) =
+ list_problem_encode (imp_minus_minus_to_sas_plus_list c I G)"
+  apply (auto simp only: imp_minus_minus_to_sas_plus_nat_def
+      sub_enumerate_subprograms sub_restrict_nat sub_enumerate_variables sub_map
+      sub_cons cons0 Let_def submap_PCV submap_Suc submap_domain
+)
+  apply (auto simp only: vname_list_encode_def sub_map sub_cons
+      sub_coms_to_operators sub_domain
+   subnat_imp_minus_state_to_sas_plus map_map comp_def
+        simp flip: comm_encode.simps(1) cilist_encode.simps variable_encode.simps(2))
+  apply (auto simp only: subnat_imp_minus_state_to_sas_plus list_problem_encode_def  sas_plus_list_problem.simps 
+              imp_minus_minus_to_sas_plus_list_def Let_def list.simps simp flip: comp_def map_map )
+  apply (auto simp only: domain_element_encode.simps sas_assignment_list_encode_def map_map[of "vdlist_encode"] map_map[of "domain_element_encode"] comp_def vdlist_encode.simps variable_encode.simps)
+  done
+
+lemma sub_imp_minus_minus_to_sas:
+"list_problem_to_problem (list_problem_decode (imp_minus_minus_to_sas_plus_nat (comm_encode c) 
+            (imp_assignment_list_encode I) (imp_assignment_list_encode G)))
+= imp_minus_minus_to_sas_plus c (map_of I) (map_of G)"
+  apply (auto simp only: subnat_imp_minus_minus_to_sas_plus sublist_imp_minus_minus_to_sas_plus list_problem_id)
+  done
+
+   
+  
+
+
+      
+        
+        
+
+
+    
+end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
new file mode 100644
index 00000000..85d79dff
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
@@ -0,0 +1,83 @@
+theory IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat
+  imports  IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations "../IMP-_To_IMP--/Primitives"
+begin
+
+
+definition imp_minus_state_to_sas_plus_list:: 
+      "(com * (vname*bit) list) \<Rightarrow> (variable*domain_element) list" where
+"imp_minus_state_to_sas_plus_list ci =(PC,PCV (fst ci))# 
+        map  (\<lambda>(x,y). (x, EV y)) (map (\<lambda>(x,y). (VN x, y)) (snd ci))"
+
+lemma inj_vn: "inj VN"
+  by (meson injI variable.inject)
+   
+lemma sublist_imp_minus_state_to_sas_plus_apply:
+  "map_of (imp_minus_state_to_sas_plus_list ci) k = 
+          imp_minus_state_to_sas_plus (cilist_to_map ci) k"
+  apply (cases ci)
+  apply (cases k)
+  apply (auto simp add: imp_minus_state_to_sas_plus_list_def imp_minus_state_to_sas_plus_def
+        map_comp_def map_of_map simp del:map_map)
+  subgoal for a b x
+    apply (cases "map_of b x")
+     apply auto
+    subgoal
+    proof -
+      assume "k = VN x" "map_of b x = None"
+      hence "\<forall>y. (x,y) \<notin> set b"
+        using weak_map_of_SomeI by force
+      hence "\<forall>y. (VN x, y) \<notin> set (map (\<lambda>(x, y). (VN x, y)) b)"
+        by auto
+      thus ?thesis
+        by (metis (no_types, lifting) imageE map_of_eq_None_iff prod.collapse) 
+    qed
+    using map_of_mapk_SomeI inj_vn by fast
+  done
+
+lemma sublist_imp_minus_state_to_sas_plus:
+  "map_of (imp_minus_state_to_sas_plus_list ci) = 
+          imp_minus_state_to_sas_plus (cilist_to_map ci)"
+  using sublist_imp_minus_state_to_sas_plus_apply by blast
+    
+fun map_impms_sp:: " nat \<Rightarrow> nat" where 
+"map_impms_sp n = (if n =0 then 0 else (prod_encode (Suc(fst_nat (hd_nat n)) , prod_encode(0,snd_nat (hd_nat n))))## map_impms_sp (tl_nat n))"
+
+lemma submap_immpms_sp:
+"map_impms_sp n = map_nat (\<lambda>x. prod_encode (Suc(fst_nat x) , prod_encode(0,snd_nat x)) ) n "
+  apply (induct n rule:map_impms_sp.induct)
+  apply auto
+  done
+definition imp_minus_state_to_sas_plus_nat :: "nat \<Rightarrow> nat" where
+"imp_minus_state_to_sas_plus_nat ci = (prod_encode (0,prod_encode(1,fst_nat ci)))##
+(map_impms_sp (snd_nat ci))"
+
+lemma subnat_imp_minus_state_to_sas_plus:
+"imp_minus_state_to_sas_plus_nat   (cilist_encode ci)
+  = list_encode (map sas_assignment_encode (imp_minus_state_to_sas_plus_list ci))  "
+  apply (cases ci)
+  apply (auto simp only: cilist_encode.simps imp_assignment_list_encode_def
+submap_immpms_sp
+      imp_minus_state_to_sas_plus_nat_def sub_cons cons0 sub_map sub_snd
+                snd_def sub_fst fst_def map_map comp_def imp_assignment_encode.simps 
+                   imp_minus_state_to_sas_plus_list_def list.map
+                          list_encode_eq
+                        split:prod.splits 
+                  simp flip: variable_encode.simps domain_element_encode.simps
+                            sas_assignment_encode.simps)
+  apply(auto simp add: prod_encode_eq sub_fst sub_snd)
+  done
+
+lemma sub_imp_minus_state_to_sas_plus:
+"sas_state_decode (imp_minus_state_to_sas_plus_nat (cilist_encode ci)) =
+      imp_minus_state_to_sas_plus (cilist_to_map ci)"
+  
+  apply (auto simp only: subnat_imp_minus_state_to_sas_plus
+      sas_state_decode_def list_encode_inverse map_map comp_def sas_assignment_id map_idI
+ sublist_imp_minus_state_to_sas_plus)
+  done
+
+
+
+  
+    
+end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy
new file mode 100644
index 00000000..91d9e9e3
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy	
@@ -0,0 +1,4 @@
+theory IMP_Minus_Minus_Subprograms_Nat
+  imports IMP_Minus_Minus_Subprograms "../IMP-_To_IMP--/Primitives"
+begin 
+end 
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
new file mode 100644
index 00000000..d8931054
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
@@ -0,0 +1,74 @@
+theory Binary_Arithmetic_Nat 
+  imports Binary_Arithmetic  Primitives
+begin
+
+
+fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_bit_of_num_nat x n  = (if x = 0 then (if n = 0 then 1 else 0) else
+                            if n = 0 then (if hd_nat x = 0 then 0 else 1) else
+                            nth_bit_of_num_nat (tl_nat x) (n-1)) "
+
+lemma sub_nth_bit_of_num: "nth_bit_of_num_nat (num_encode x) n = bit_encode (nth_bit_of_num x n)"
+     apply (subst nth_bit_of_num_nat.simps)
+  apply (induct x n rule:nth_bit_of_num.induct)
+       apply (simp_all (no_asm_simp)  only:sub_hd sub_tl num_encode_def
+       num_to_list.simps nth_bit_of_num.simps list_encode.simps tail.simps head.simps list_encode_eq
+   del: nth_bit_of_num_nat.simps   flip:list_encode.simps )
+     apply (simp_all only: flip: nth_bit_of_num_nat.simps num_encode_def)
+   apply auto
+  done
+
+lemma dom_nth_bit_nat:"nth_bit_nat a n = 0 \<or> nth_bit_nat a n = Suc 0"
+  apply (induction n arbitrary: a)
+   apply auto
+  done
+
+lemma sub_nth_bit : "nth_bit_nat a n = bit_encode (nth_bit a n)"
+  apply (cases "nth_bit_nat a n") 
+  apply (auto simp add: nth_bit_def )
+   using  dom_nth_bit_nat
+   by (metis Suc_inject old.nat.distinct(2))
+
+
+
+fun nth_carry_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_carry_nat n a b = (if n = 0 then (if (nth_bit_nat a 0 = 1 \<and> nth_bit_nat b 0 = 1) then 1 else 0)
+ else (if (nth_bit_nat a n = 1 \<and> nth_bit_nat b n = 1) 
+  \<or> ((nth_bit_nat a n = 1 \<or> nth_bit_nat b n = 1) \<and> nth_carry_nat (n-1) a b = 1) 
+  then 1 else 0) )"
+
+lemma sub_nth_carry: "nth_carry_nat n a b = bit_encode (nth_carry n a b)"
+  apply (induct n)
+  apply (auto simp add: sub_nth_bit)
+  done
+
+
+
+fun nth_carry_sub_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_carry_sub_nat n a b = (if n =0 then (if (nth_bit_nat a 0 = 0 \<and> nth_bit_nat b 0 = 1) then 1 else 0)
+else (if (nth_bit_nat a n = 0 \<and> ( nth_bit_nat b n = 1 \<or> nth_carry_sub_nat (n-1) a b = 1))
+    \<or> (nth_bit_nat a n = 1 \<and> (nth_bit_nat b n) = 1 \<and> nth_carry_sub_nat (n-1) a b = 1) then 1
+  else 0))"
+
+lemma sub_nth_carry_sub :"nth_carry_sub_nat n a b = bit_encode (nth_carry_sub n a b)"
+ apply (induct n)
+  apply (auto simp add: sub_nth_bit)
+  done
+
+
+
+fun bit_list_to_nat_nat:: "nat \<Rightarrow> nat" where
+"bit_list_to_nat_nat n = (if n =0 then 0 else if hd_nat n =0 then 2 *bit_list_to_nat_nat (tl_nat n)
+   else  2*bit_list_to_nat_nat (tl_nat n) + 1)" 
+
+lemma sub_bit_list_to_nat: "bit_list_to_nat_nat (list_encode (map bit_encode x)) = bit_list_to_nat x"
+  apply (induct x)
+   apply (simp)
+  apply (subst bit_list_to_nat_nat.simps)
+  apply (auto simp only: sub_hd sub_tl sub_tail_map tl_def 
+          sub_head_map bit_list_to_nat.simps split:bit.splits)
+   apply (auto)
+  done
+
+
+end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
new file mode 100644
index 00000000..5d0fd5e5
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
@@ -0,0 +1,366 @@
+theory Binary_Operations_Nat
+  imports Binary_Operations Primitives Binary_Arithmetic_Nat
+IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat "../IMP_Minus_Max_Constant_Nat"
+begin
+
+
+fun com_list_to_seq_nat:: "nat \<Rightarrow> nat" where
+"com_list_to_seq_nat n = (if n =0 then cons 0 0 else 
+cons 2 (cons (hd_nat n) (cons (com_list_to_seq_nat (tl_nat n)) 0)))"
+
+definition comm_list_encode :: "IMP_Minus_Minus_com list \<Rightarrow> nat" where
+"comm_list_encode xs = list_encode (map comm_encode xs) "
+
+definition comm_list_decode :: "nat \<Rightarrow> IMP_Minus_Minus_com list" where
+"comm_list_decode xs = map comm_decode (list_decode xs) "
+
+lemma [simp]: "comm_list_decode (comm_list_encode x) = x"
+  apply (auto simp add:comm_list_encode_def comm_list_decode_def )
+  by (metis comm_id comp_def map_idI)
+    
+lemma sub_com_list_to_seq:
+    "com_list_to_seq_nat (comm_list_encode xs) = comm_encode (com_list_to_seq xs)"
+  apply (induct xs)
+  apply (subst com_list_to_seq_nat.simps)
+   apply (auto simp only: comm_list_encode_def sub_cons cons0)
+   apply (simp add: cons0)
+  apply (subst com_list_to_seq_nat.simps)
+  apply (simp only:list.map cons0 sub_cons sub_hd sub_tl head.simps tail.simps
+        com_list_to_seq.simps comm_encode.simps)
+  apply auto
+  done
+
+
+fun binary_assign_constant_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"binary_assign_constant_nat n v x = (if n = 0 then cons 0 0 else cons 2 ( cons (cons 1 
+    (cons (var_bit_to_var_nat(prod_encode (v,n-1))) (cons (nth_bit_nat x (n-1)) 0 )))
+  (cons (binary_assign_constant_nat (n-1) v x)0) ) )"
+
+lemma  sub_binary_assign_constant:
+"binary_assign_constant_nat n (vname_encode v) x = comm_encode (binary_assign_constant n v x)"
+  apply (induct n)
+   apply(subst binary_assign_constant_nat.simps)
+   apply (simp only: cons0 binary_assign_constant.simps)
+   apply simp
+  apply(subst binary_assign_constant_nat.simps)
+  apply (simp only: cons0 binary_assign_constant.simps sub_cons sub_var_bit_to_var
+    comm_encode.simps  flip: vname_nat_encode.simps sub_nth_bit )
+  apply auto
+  done
+ 
+
+fun copy_var_to_operand_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"copy_var_to_operand_nat i op v = (if i =0 then 0 ## 0 else
+ (2 ## 
+    ( 3##((var_bit_to_var_nat(prod_encode(v,i-1))) ##0) ## (1 ## (operand_bit_to_var_nat(prod_encode(op,i-1)))##1##0 )
+## ( 1 ## (operand_bit_to_var_nat(prod_encode(op,i-1)))##0##0) ## 0)
+
+ ## (copy_var_to_operand_nat (i-1) op v) 
+  ## 0))
+"
+lemma sub_copy_var_to_operand:
+ "copy_var_to_operand_nat i (encode_char op) (vname_encode v) = comm_encode (copy_var_to_operand i op v)  "
+  apply (induct i)
+   apply (simp add: cons0)
+  apply (subst copy_var_to_operand_nat.simps)
+  apply (auto simp only: sub_cons cons0 sub_var_bit_to_var  sub_operand_bit_to_var
+ copy_var_to_operand.simps comm_encode.simps bit_encode.simps vname_list_encode_def
+simp flip:vname_nat_encode.simps char_nat_encode.simps )
+  apply auto
+  done
+
+
+fun copy_const_to_operand_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"copy_const_to_operand_nat i op x = (if i =0 then 0##0 else 
+2 ## (1 ## (operand_bit_to_var_nat (prod_encode (op,i-1))) ## (nth_bit_nat x (i-1)) ## 0) ## (copy_const_to_operand_nat (i-1) op x ) ## 0
+)"
+
+lemma sub_copy_const_to_operand:
+ "copy_const_to_operand_nat i (encode_char op) x = comm_encode (copy_const_to_operand i op x)  "
+ apply (induct i)
+   apply (simp add: cons0)
+  apply (subst copy_const_to_operand_nat.simps)
+  apply (auto simp only: sub_cons cons0 sub_var_bit_to_var  sub_operand_bit_to_var
+ copy_const_to_operand.simps comm_encode.simps sub_nth_bit
+simp flip:vname_nat_encode.simps char_nat_encode.simps )
+  apply auto
+  done
+ 
+
+definition copy_atom_to_operand_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"copy_atom_to_operand_nat n op a = ( if fst_nat a = 0 then  copy_var_to_operand_nat n op (snd_nat a)
+ else copy_const_to_operand_nat n op (snd_nat a))"
+
+lemma sub_copy_atom_to_operand: 
+"copy_atom_to_operand_nat n (encode_char op) (atomExp_encode a) = comm_encode (copy_atom_to_operand n op a)"
+  apply (auto simp only:copy_atom_to_operand_nat_def atomExp_encode.simps sub_fst sub_snd fst_def snd_def
+          copy_atom_to_operand_def
+sub_copy_const_to_operand sub_copy_var_to_operand split:atomExp.splits ) 
+   apply auto
+  done
+
+
+definition assign_var_carry_nat:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_var_carry_nat i v a b c = 
+2 ## (1 ## (var_bit_to_var_nat(prod_encode (v, i))) ##
+(if a + b + c = 1 \<or> a + b + c = 3 then 1 else 0) ## 0 ) ## (1##(vname_encode ''carry'')## (if a + b + c \<ge> 2 then 1 else 0) ## 0) ## 0 "
+
+lemma sub_assign_var_carry: 
+"assign_var_carry_nat i (vname_encode v) a b c = comm_encode(assign_var_carry i v a b c)"
+  apply (auto simp only: assign_var_carry_nat_def sub_var_bit_to_var cons0 sub_cons
+    assign_var_carry_def comm_encode.simps bit_encode.simps split:if_splits
+ simp flip: vname_nat_encode.simps)
+  done
+
+
+definition full_adder_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"full_adder_nat i v  = (let assign = assign_var_carry_nat i v; op_a = operand_bit_to_var_nat (prod_encode(encode_char(CHR ''a''), i));
+  op_b = operand_bit_to_var_nat (prod_encode(encode_char (CHR ''b''), i)) in 
+3##(op_a ## 0) ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 1 1 1) ## ( assign 1 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 1 0 1) ## ( assign 1 0 0) ## 0))##0)
+               ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 0 1 1) ## ( assign 0 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 0 0 1) ## ( assign 0 0 0) ## 0))##0)
+## 0
+ )"
+
+lemma sub_full_adder: "full_adder_nat i (vname_encode v) = comm_encode (full_adder i v)"
+  apply (auto simp only:full_adder_nat_def sub_assign_var_carry
+ vname_list_encode_def cons0 sub_cons sub_operand_bit_to_var full_adder_def comm_encode.simps
+   Let_def simp flip: char_nat_encode.simps)
+  apply auto
+  done
+
+fun map_adder :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_adder v n = (if n =0 then 0 else (full_adder_nat (hd_nat n) v) ## map_adder v (tl_nat n))"
+
+lemma sub_map_adder:
+  "map_adder v n = map_nat (\<lambda>i. full_adder_nat i v) n"
+  apply (induct v n rule:map_adder.induct)
+  apply (subst map_adder.simps)
+  apply auto
+  done
+ 
+definition adder_nat:: "nat \<Rightarrow> nat  \<Rightarrow> nat" where
+"adder_nat n v = 2 ## (com_list_to_seq_nat (map_adder v(list_less_nat n) )) ## (
+1## (vname_encode ''carry'') ## 0 ## 0
+) ## 0"
+
+thm "comp_apply"
+
+  
+lemma sub_adder: "adder_nat n (vname_encode v) = comm_encode (adder n v)"
+  apply (simp only: sub_map_adder adder_nat_def sub_list_less sub_map  cons0 sub_cons sub_com_list_to_seq
+      adder_def comm_encode.simps bit_encode.simps sub_full_adder extract_lambda flip: map_map 
+      comm_list_encode_def)
+  done
+
+definition binary_adder_nat:: "nat \<Rightarrow> nat \<Rightarrow>nat\<Rightarrow> nat \<Rightarrow> nat" where
+"binary_adder_nat n v a b = 2##(
+    copy_atom_to_operand_nat n (encode_char(CHR ''a'')) a)##(
+2##( copy_atom_to_operand_nat n (encode_char(CHR ''b'')) b)##(
+2##( adder_nat n v)##(
+2##(copy_atom_to_operand_nat n (encode_char(CHR ''a'')) (prod_encode(1,0)))##(
+  copy_atom_to_operand_nat n (encode_char(CHR ''b'')) (prod_encode(1,0)))##0 
+)##0
+)##0
+)##0"
+
+lemma sub_binary_adder:
+ "binary_adder_nat n (vname_encode v) (atomExp_encode a) (atomExp_encode b) =
+    comm_encode (binary_adder n v a b)"
+  apply (auto simp only:binary_adder_nat_def cons0 sub_cons binary_adder_def
+         sub_copy_atom_to_operand  comm_encode.simps sub_adder simp flip: atomExp_encode.simps)
+  done
+
+
+definition assign_var_carry_sub_nat:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_var_carry_sub_nat i v a b c = 
+2 ## (1 ## (var_bit_to_var_nat(prod_encode (v, i))) ##
+(if b + c = 0 \<or> b + c = 2 then (if a = 1 then 1 else 0)
+    else (if b + c = 1 \<and> a = 0 then 1 else 0))  ## 0 ) ## 
+(1##(vname_encode ''carry'')## (if a < b + c then 1 else 0) ## 0) ## 0 "
+
+lemma sub_assign_var_carry_sub: 
+"assign_var_carry_sub_nat i (vname_encode v) a b c = comm_encode(assign_var_carry_sub i v a b c)"
+  apply (auto simp only: assign_var_carry_sub_nat_def sub_var_bit_to_var cons0 sub_cons
+    assign_var_carry_sub_def comm_encode.simps bit_encode.simps split:if_splits
+ simp flip: vname_nat_encode.simps)
+  done
+
+
+definition full_subtractor_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"full_subtractor_nat i v  = (let assign = assign_var_carry_sub_nat i v; op_a = operand_bit_to_var_nat (prod_encode(encode_char(CHR ''a''), i));
+  op_b = operand_bit_to_var_nat (prod_encode(encode_char (CHR ''b''), i)) in 
+3##(op_a ## 0) ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 1 1 1) ## ( assign 1 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 1 0 1) ## ( assign 1 0 0) ## 0))##0)
+               ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 0 1 1) ## ( assign 0 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 0 0 1) ## ( assign 0 0 0) ## 0))##0)
+## 0
+ )"
+    
+lemma sub_full_subtractor: "full_subtractor_nat i (vname_encode v) = comm_encode (full_subtractor i v)"
+  apply (auto simp only:full_subtractor_nat_def sub_assign_var_carry_sub
+ vname_list_encode_def cons0 sub_cons sub_operand_bit_to_var full_subtractor_def comm_encode.simps
+   Let_def simp flip: char_nat_encode.simps)
+  apply auto
+  done
+
+definition underflow_handler_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"underflow_handler_nat n v = 3##((vname_encode ''carry'')## 0) ## (2##(1##(vname_encode ''carry'')##0##0)##(
+binary_assign_constant_nat n v 0
+)##0)## (0##0) ## 0"
+
+lemma sub_underflow_handler:
+ "underflow_handler_nat n (vname_encode v) = comm_encode (underflow_handler n v) "
+  apply (auto simp only:underflow_handler_nat_def cons0 sub_cons underflow_handler_def
+      bit_encode.simps comm_encode.simps vname_list_encode_def sub_binary_assign_constant )
+  apply auto
+  done
+
+fun map_full_subtractor :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_full_subtractor v n = (if n = 0 then 0 else (full_subtractor_nat(hd_nat n) v) ## map_full_subtractor v (tl_nat n))"
+
+lemma submap_full_subtractor: 
+  "map_full_subtractor v n = map_nat (\<lambda>i. full_subtractor_nat i v) n"
+  apply (induct v n rule : map_full_subtractor.induct)
+  apply (subst map_full_subtractor.simps)
+  apply (auto)
+  done
+  
+definition subtract_handle_underflow_nat:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"subtract_handle_underflow_nat n v = 2##
+  (com_list_to_seq_nat (map_full_subtractor v (list_less_nat n)))## 
+  (underflow_handler_nat n v) ## 0"
+
+lemma sub_subtract_underflow : 
+"subtract_handle_underflow_nat n (vname_encode v) = comm_encode ( subtract_handle_underflow n v)"
+  apply (auto simp only: submap_full_subtractor subtract_handle_underflow_nat_def cons0 sub_cons sub_com_list_to_seq sub_map
+sub_list_less sub_full_subtractor extract_lambda sub_underflow_handler
+ comm_encode.simps subtract_handle_underflow_def
+    simp flip:map_map comm_list_encode_def)
+  done
+
+
+
+definition binary_subtractor_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where
+"binary_subtractor_nat n v a b = 
+2 ## (copy_atom_to_operand_nat n (encode_char(CHR ''a'')) a) ## (
+2 ## (   copy_atom_to_operand_nat n (encode_char(CHR ''b'')) b) ## (
+2 ## (subtract_handle_underflow_nat n v) ##(
+2##(copy_atom_to_operand_nat n (encode_char(CHR ''a'')) (prod_encode(1,0)))##(
+  copy_atom_to_operand_nat n (encode_char(CHR ''b'')) (prod_encode(1,0)))##0 
+) ## 0
+) ## 0
+) ## 0"
+
+lemma sub_binary_subtractor:
+"binary_subtractor_nat n (vname_encode v) (atomExp_encode a) (atomExp_encode b) =
+    comm_encode (binary_subtractor n v a b)"
+  apply (auto simp only:binary_subtractor_nat_def cons0 sub_cons binary_subtractor_def
+         sub_copy_atom_to_operand  comm_encode.simps sub_adder sub_subtract_underflow
+ simp flip: atomExp_encode.simps)
+  done
+
+
+definition binary_parity_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"binary_parity_nat n v a  = (if fst_nat a \<noteq> 0 then  binary_assign_constant_nat n v (snd_nat a mod 2)
+else 2## (3 ## ((var_bit_to_var_nat(prod_encode(snd_nat a, 0))) ## 0) ## (binary_assign_constant_nat n v 1) 
+ ##( binary_assign_constant_nat n v 0) ## 0)## (
+2 ## (copy_atom_to_operand_nat n (encode_char (CHR ''a'')) a) ##
+ (copy_atom_to_operand_nat n (encode_char (CHR ''a'')) (prod_encode(1,0))) ## 0
+) ## 0 )"
+
+lemma sub_binary_parity:
+ "binary_parity_nat n (vname_encode v) (atomExp_encode a) = comm_encode(binary_parity n v a) "
+  apply (auto simp only: binary_parity_nat_def cons0 sub_cons sub_binary_assign_constant)
+  apply (cases a)
+    apply (auto simp add: sub_fst sub_snd )[1]
+  apply (auto simp only: sub_var_bit_to_var  sub_fst sub_snd snd_def fst_def
+ atomExp_encode.simps binary_parity.simps comm_encode.simps sub_copy_atom_to_operand
+ simp flip: vname_nat_encode.simps )
+  apply (auto simp only: sub_copy_atom_to_operand 
+        vname_list_encode_def simp flip:atomExp_encode.simps)
+  apply auto
+  done
+
+
+fun assign_shifted_bits_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_shifted_bits_nat i v = (if i = 0 then 0##0 else
+2##( 
+3##((operand_bit_to_var_nat(prod_encode (encode_char(CHR ''a''), i)))##0)##(
+1## (var_bit_to_var_nat (prod_encode(v, i-1)))## 1 ##0)##(
+1## (var_bit_to_var_nat (prod_encode(v, i-1)))## 0 ##0
+)##0)## (
+assign_shifted_bits_nat (i-1) v
+)##0
+)" 
+
+lemma sub_assign_shifted_bits:
+"assign_shifted_bits_nat i (vname_encode v) = comm_encode (assign_shifted_bits i v)"
+  apply (induct i)
+   apply (subst assign_shifted_bits_nat.simps)
+   apply  (simp only: cons0 comm_encode.simps assign_shifted_bits.simps)[1]
+   apply  simp
+    apply (subst assign_shifted_bits_nat.simps)
+  apply (auto simp only: cons0 sub_cons comm_encode.simps assign_shifted_bits.simps
+  sub_var_bit_to_var sub_operand_bit_to_var vname_list_encode_def
+      simp flip: vname_nat_encode.simps char_nat_encode.simps )
+  apply auto
+  done
+
+
+definition assign_shifted_bits_and_zero_most_significant_nat:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_shifted_bits_and_zero_most_significant_nat n v = 2 ## (assign_shifted_bits_nat (n - 1) v)##
+  (1 ## (var_bit_to_var_nat (prod_encode(v, n - 1)))##0##0) ## 0"
+
+lemma sub_assign_shifted_bits_and_zero_most_significant:
+" assign_shifted_bits_and_zero_most_significant_nat n (vname_encode v) =
+  comm_encode (assign_shifted_bits_and_zero_most_significant n v)"
+  apply (auto simp only: assign_shifted_bits_and_zero_most_significant_nat_def 
+       cons0 sub_cons sub_var_bit_to_var sub_assign_shifted_bits comm_encode.simps
+  assign_shifted_bits_and_zero_most_significant_def bit_encode.simps
+ simp flip: vname_nat_encode.simps )
+  done
+
+
+definition binary_right_shift_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"binary_right_shift_nat n v a = 2 ## (2 ## (copy_atom_to_operand_nat n (encode_char(CHR ''a'')) a) ##
+(assign_shifted_bits_and_zero_most_significant_nat n v) ## 0) ##
+    (copy_atom_to_operand_nat n (encode_char(CHR ''a'')) (prod_encode(1,0))) ## 0" 
+
+lemma sub_binary_right_shift:
+  "binary_right_shift_nat n (vname_encode v) (atomExp_encode a) = comm_encode (binary_right_shift n v a)"
+  apply (auto simp only: binary_right_shift_nat_def cons0 sub_cons sub_copy_atom_to_operand
+ sub_assign_shifted_bits_and_zero_most_significant comm_encode.simps
+binary_right_shift_def
+ simp flip: atomExp_encode.simps)
+  done
+
+
+definition assignment_to_binary_nat:: "nat \<Rightarrow> nat \<Rightarrow>nat \<Rightarrow> nat" where
+"assignment_to_binary_nat n v aexp = (if hd_nat aexp =0 then 
+   binary_adder_nat n v (nth_nat (Suc 0) aexp) (prod_encode (1,0))
+else if hd_nat aexp = 1 then binary_adder_nat n v (nth_nat (Suc 0) aexp) (nth_nat (Suc (Suc 0)) aexp)
+else if hd_nat aexp = 2 then binary_subtractor_nat n v (nth_nat (Suc 0) aexp) (nth_nat (Suc (Suc 0)) aexp)
+else if hd_nat aexp = 3 then binary_parity_nat n v (nth_nat (Suc 0) aexp)
+else  binary_right_shift_nat n v (nth_nat (Suc 0) aexp)
+)"
+
+lemma sub_assignment_to_binary:
+"assignment_to_binary_nat n (vname_encode v) (aexp_encode aexp) = 
+  comm_encode (assignment_to_binary n v aexp)"
+  apply (cases aexp)
+      apply (auto simp only: assignment_to_binary_nat_def aexp_encode.simps sub_hd head.simps 
+                  sub_binary_adder sub_binary_subtractor sub_binary_parity 
+                  sub_nth nth.simps
+        assignment_to_binary_def sub_binary_right_shift
+ simp flip: atomExp_encode.simps )
+      apply auto
+  done
+
+
+end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
new file mode 100644
index 00000000..c0da5bb4
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
@@ -0,0 +1,714 @@
+theory SAS_Plus_Plus_To_SAS_Plus_Nat
+  imports   Primitives SAS_Plus_Plus_To_SAS_Plus
+begin
+
+definition SAS_Plus_Plus_State_To_SAS_Plus_list:: 
+  "(dom \<times> (variable,domain_element) assignment list) \<Rightarrow> 
+        (var,dom) assignment list" where
+"SAS_Plus_Plus_State_To_SAS_Plus_list is = (Stage, fst is) # 
+ map (\<lambda>(x,y). (x,DE y)) (map (\<lambda>(x,y). (Var x, y)) (snd is))"
+
+lemma inj_var: "inj Var"
+  by (meson SAS_Plus_Plus_To_SAS_Plus.variable.inject inj_onI)
+
+lemma sublist_SAS_Plus_Plus_State_To_SAS_Plus_apply:
+  "map_of (SAS_Plus_Plus_State_To_SAS_Plus_list is) k =
+      SAS_Plus_Plus_State_To_SAS_Plus (islist_to_map is) k"
+  apply (cases "is")
+  apply (cases k)
+  apply (auto simp add: SAS_Plus_Plus_State_To_SAS_Plus_list_def  SAS_Plus_Plus_State_To_SAS_Plus_def
+        map_comp_def map_of_map simp del:map_map)
+  subgoal for a b x
+    apply (cases "map_of b x")
+     apply auto
+    subgoal
+    proof -
+      assume "k = Var x" "map_of b x = None"
+      hence "\<forall>y. (x,y) \<notin> set b"
+        using weak_map_of_SomeI by force
+      hence "\<forall>y. (Var x, y) \<notin> set (map (\<lambda>(x, y). (Var x, y)) b)"
+        by auto
+      thus ?thesis
+        by (metis (no_types, lifting) imageE map_of_eq_None_iff prod.collapse) 
+    qed
+    using map_of_mapk_SomeI inj_var by fast
+  done
+
+lemma sublist_SAS_Plus_Plus_State_To_SAS_Plus:
+  "map_of (SAS_Plus_Plus_State_To_SAS_Plus_list is) =
+      SAS_Plus_Plus_State_To_SAS_Plus (islist_to_map is)"
+  using sublist_SAS_Plus_Plus_State_To_SAS_Plus_apply by blast
+
+fun map_sasps :: "nat\<Rightarrow>nat" where 
+"map_sasps n = (if n = 0 then 0 else (prod_encode (Suc(fst_nat (hd_nat n)) , Suc(Suc(snd_nat (hd_nat n))) ))## map_sasps (tl_nat n))"
+lemma submap_sasps:
+ "map_sasps  n = map_nat (\<lambda>x. prod_encode (Suc(fst_nat x) , Suc(Suc(snd_nat x)) )) n"
+  apply (induct n rule:map_sasps.induct)
+  apply auto
+  done
+
+definition SAS_Plus_Plus_State_To_SAS_Plus_nat :: "nat \<Rightarrow> nat" where
+"SAS_Plus_Plus_State_To_SAS_Plus_nat is = (prod_encode (0,fst_nat is))##
+(map_sasps (snd_nat is))"
+
+lemma subnat_SAS_Plus_Plus_State_To_SAS_Plus:
+"SAS_Plus_Plus_State_To_SAS_Plus_nat(islist_encode is) =
+    sas_plus_assignment_list_encode (SAS_Plus_Plus_State_To_SAS_Plus_list is)"
+  apply (cases "is")
+  apply (auto simp only:sas_plus_assignment_list_encode_def)
+  apply (auto simp only: islist_encode.simps sas_assignment_list_encode_def
+      SAS_Plus_Plus_State_To_SAS_Plus_nat_def sub_cons cons0 sub_map sub_snd
+                snd_def sub_fst fst_def map_map comp_def sas_assignment_encode.simps 
+                   SAS_Plus_Plus_State_To_SAS_Plus_list_def list.map
+                          list_encode_eq submap_sasps
+                  simp flip: var_encode.simps dom_encode.simps
+                            sas_plus_assignment_encode.simps)
+  apply(auto simp add: prod_encode_eq sub_fst sub_snd sas_plus_assignment_list_encode_def comp_def
+          Case_def)
+  done
+
+lemma sub_SAS_Plus_Plus_State_To_SAS_Plus: 
+      "sas_plus_state_decode (SAS_Plus_Plus_State_To_SAS_Plus_nat(islist_encode is))
+        = SAS_Plus_Plus_State_To_SAS_Plus (islist_to_map is)"
+  using subnat_SAS_Plus_Plus_State_To_SAS_Plus sublist_SAS_Plus_Plus_State_To_SAS_Plus
+  by (simp add: sas_plus_assignment_list_id sas_plus_state_decode_def)
+
+fun map_var_de :: "nat \<Rightarrow> nat" where 
+"map_var_de n = (if n = 0 then 0 else (prod_encode(Suc (fst_nat (hd_nat n)), Suc (Suc(snd_nat (hd_nat n)))))## map_var_de (tl_nat n) )"
+
+lemma submap_var_de :
+"map_var_de n = map_nat (\<lambda> x. prod_encode(Suc (fst_nat x), Suc (Suc(snd_nat x)))) n"
+  apply (induct n rule: map_var_de.induct)
+  apply auto
+  done
+
+definition SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat:: 
+  "nat \<Rightarrow> nat" where
+"SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat op = 
+  ((prod_encode(0,0)) ## (map_var_de (nth_nat 0 op)))##
+   (( map_sasps  (nth_nat (Suc 0) op))) ## 0"
+
+lemma fst_sas_assignment : "fst_nat (sas_assignment_encode x) = variable_encode (fst x)"
+  apply (cases x)
+  apply (auto simp add:sub_fst)
+  done
+lemma snd_sas_assignment : "snd_nat (sas_assignment_encode x) = domain_element_encode (snd x)"
+  apply (cases x)
+  apply (auto simp add:sub_snd)
+  done
+lemma sub_SAS_Plus_Plus_Operator_To_SAS_Plus_Operator:
+  "SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat (operator_encode op) =
+    operator_plus_encode (SAS_Plus_Plus_Operator_To_SAS_Plus_Operator op)"
+  apply (auto simp only: submap_var_de
+          SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat_def 
+           operator_encode_def sub_nth nth.simps submap_sasps
+              sas_assignment_list_encode_def sub_map sub_cons cons0 map_map comp_def
+          SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_def
+          operator_plus_encode_def sas_plus_operator.simps
+            sas_plus_assignment_list_encode_def list.simps 
+            sas_plus_assignment_encode.simps var_encode.simps dom_encode.simps
+              fst_sas_assignment snd_sas_assignment
+         )
+  done
+
+
+definition initialization_operators_list::
+    "(variable, domain_element) sas_plus_list_problem \<Rightarrow> operator_plus list" where
+"initialization_operators_list  P = 
+  concat (map (\<lambda> v. (if v \<in> set (map fst (initial_ofl P)) then [] 
+    else map (\<lambda> y. \<lparr> precondition_of = [(Stage, Init)],  effect_of = [(Var v, DE y)]\<rparr>) 
+      (thef (map_list_find (range_ofl P) v)))) (variables_ofl P))"
+
+lemma dom_map_of : "dom (map_of x) = set ( map fst x)"
+  apply (induct x)
+   apply auto
+  apply force
+  done
+
+lemma sublist_initialization_operators:
+"initialization_operators_list  P = initialization_operators (list_problem_to_problem P)"
+  apply (auto simp only:initialization_operators_list_def initialization_operators_def 
+          dom_map_of sub_map_list_find[of "range_ofl P"] list_problem_to_problem.simps sas_plus_problem.simps) 
+  done
+
+fun map_inner :: "nat \<Rightarrow> nat\<Rightarrow>nat" where 
+"map_inner v n = (if n = 0 then 0 else ((((prod_encode (0, 1)))##0) ## ((prod_encode (Suc v, Suc (Suc (hd_nat n))))## 0) ## 0) ## map_inner v (tl_nat n) )"
+
+lemma submap_inner: 
+"map_inner v n =  map_nat (\<lambda> y. (((prod_encode (0, 1)))##0) ## ((prod_encode (Suc v, Suc (Suc y)))## 0) ## 0) n"
+  apply (induct v n rule:map_inner.induct)
+  apply auto
+  done
+
+fun map_fst :: "nat\<Rightarrow>nat" where 
+"map_fst n  = (if n =0 then 0 else (fst_nat (hd_nat n)) ## map_fst (tl_nat n))"
+
+lemma submap_fst :
+"map_fst n = map_nat fst_nat n"
+  apply (induct n rule:map_fst.induct)
+  apply auto
+  done
+function map_outer :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_outer P n = (if n =0 then 0 else (if elemof (hd_nat n) (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
+    else (map_inner (hd_nat n) 
+      (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## map_outer P (tl_nat n))"
+   apply  pat_completeness apply (auto simp only:) done
+termination by lexicographic_order
+
+lemma submap_outer: 
+"map_outer P n = map_nat (\<lambda> v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
+    else map_inner v 
+      (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v)))) n"
+  apply (induct P n rule:map_outer.induct)
+  by (metis (no_types, lifting) map_nat.elims map_outer.elims)
+
+definition initialization_operators_nat::
+    "nat \<Rightarrow> nat" where
+"initialization_operators_nat  P = 
+  concat_nat (map_outer P (nth_nat 0 P))"
+
+lemma simp_vdlist_encode: "vdlist_encode = prod_encode o (\<lambda>(x,y). (variable_encode x,list_encode (map domain_element_encode y)))"
+  by force
+
+lemma simp_sas_assignment_encode: "sas_assignment_encode = prod_encode o (\<lambda>(x,y). (variable_encode x,domain_element_encode y))"
+  by force
+
+lemma map_find_map:"inj f \<Longrightarrow> map_list_find  (map (\<lambda>(x, y). (f x, g (h y))) l) (f x) = 
+       (case map_list_find l x of None \<Rightarrow> None | Some y \<Rightarrow> Some (g (h y)))"
+  apply (induct l arbitrary:x)
+   apply (auto simp add:inj_def)
+  done
+
+lemma map_find_map2:"inj f \<Longrightarrow> map_list_find  (map (\<lambda>(x, y). (f x, g y)) l) (f x) = 
+       (case map_list_find l x of None \<Rightarrow> None | Some y \<Rightarrow> Some (g  y))"
+  apply (rule  map_find_map) apply auto
+  done
+
+lemma inj_map_set: "inj f \<Longrightarrow> (f x \<in> set (map f xs)) = ( x \<in> set xs)"
+  apply (auto simp add:inj_def)
+  done
+
+lemma sub_the_dec: "thef x  = list_decode (the_nat (list_option_encode x))"
+  apply (auto simp only: sub_the list_encode_inverse)
+  done
+
+lemma sub_thedec_spec: "thef (map_list_find (range_ofl P) x) =
+list_decode (the_nat (list_option_encode (map_list_find (range_ofl P) x)))
+"
+  using sub_the_dec by blast
+
+lemma thef_simps: "thef xs  = (case xs of None \<Rightarrow> [] | Some x \<Rightarrow> x)"
+  apply (cases xs)
+   apply (auto)
+  done
+
+lemma map_nat0:"map_nat f 0 = 0"
+  by auto
+thm "option.case_distrib"
+lemma subnat_initialization_operators:
+ "initialization_operators_nat (list_problem_encode P)
+  =  list_encode (map operator_plus_encode  (initialization_operators_list P)) "
+  apply (auto simp only: initialization_operators_nat_def list_problem_encode_def
+                sas_plus_list_problem.simps sub_nth nth.simps sas_assignment_list_encode_def submap_fst
+                      submap_inner submap_outer
+                          sub_map map_map comp_def fst_sas_assignment sub_elem_of cons0 sub_cons sub_the sub_map_list_find_nat
+                          )
+  apply (auto simp only:  simp_vdlist_encode sub_map_list_find_nat sub_the 
+      initialization_operators_list_def )
+  apply (auto simp only: map_map comp_def)
+  apply (simp only: flip: comp_def[of variable_encode fst] map_map)
+
+  using variable_inj   apply (auto simp only:  map_find_map inj_map_set if_distrib
+          list_encode.simps(1) list.simps)
+  apply (auto simp only: sub_map_list_find_nat map_find_map
+operator_plus_encode_def map_concat
+
+ simp flip: comp_def[of "prod_encode" "\<lambda>x.(case x of
+ (x, y) \<Rightarrow> (variable_encode x, list_encode (map domain_element_encode y)))"] map_map
+)
+  apply (auto simp only: map_map comp_def if_distrib list.simps operator_plus_encode_def
+            sas_plus_operator.simps sas_plus_assignment_list_encode_def
+            sas_plus_assignment_encode.simps option.case_distrib thefn.simps option_encode.simps
+the_nat.simps zero_diff diff_Suc_1 sub_map map_nat0 if_cancel
+ )
+  apply (auto simp only: simp flip: list_encode.simps if_distrib  option.case_distrib[of list_encode]
+       )
+  apply (auto simp only: list_encode.simps ) 
+  apply (auto simp only: sub_concat thef_simps simp flip: comp_def[of list_encode "(\<lambda>x. case map_list_find (range_ofl P) x of None \<Rightarrow> []
+                    | Some xa \<Rightarrow>
+                        if x \<in> set (map fst (initial_ofl P)) then []
+                        else map (\<lambda>xa. Suc (prod_encode
+    (Suc (prod_encode (prod_encode (0, 1), 0)),
+     Suc (prod_encode
+           (Suc (prod_encode
+                  (prod_encode
+                    (Suc (variable_encode x),
+                     Suc (Suc (domain_element_encode xa))),
+                   0)),
+            0)))))
+                              xa)"] map_map ) 
+  apply (simp only:One_nat_def)
+  apply (auto simp only:option.case_distrib list.simps if_cancel var_encode.simps dom_encode.simps)
+  done
+
+fun map_init_seq :: "nat \<Rightarrow> nat" where 
+"map_init_seq n = (if n = 0 then 0 else ((((prod_encode (0,1))##0) ## 
+      ((prod_encode(Suc (fst_nat (hd_nat n)), Suc (Suc (snd_nat (hd_nat n)))))##0) ##0)) ## map_init_seq (tl_nat n))"
+
+lemma submap_init_seq: 
+"map_init_seq n = map_nat (\<lambda>v. (((prod_encode (0,1))##0) ## 
+      ((prod_encode(Suc (fst_nat v), Suc (Suc (snd_nat v))))##0) ##0)) n"
+  apply (induct n rule:map_init_seq.induct)
+  apply auto
+  done
+
+definition initialization_sequence_nat:: "nat \<Rightarrow> nat" where
+  "initialization_sequence_nat vs = map_init_seq vs"
+
+lemma sub_initialization_sequence :
+  "initialization_sequence_nat (sas_assignment_list_encode vs) =
+      list_encode (map operator_plus_encode (initialization_sequence vs)) "
+  apply (auto simp only: submap_init_seq initialization_sequence_nat_def cons0
+              sub_cons sas_assignment_list_encode_def sub_map map_map comp_def
+                fst_sas_assignment snd_sas_assignment)
+  apply (auto simp only: initialization_sequence_def map_map comp_def
+                    sas_plus_assignment_list_encode_def
+              operator_plus_encode_def sas_plus_operator.simps simp flip: var_encode.simps 
+                    dom_encode.simps sas_plus_assignment_encode.simps)
+  apply auto
+  done
+
+
+
+definition initial_state_list:: 
+  "(variable, domain_element) sas_plus_list_problem \<Rightarrow> (var, dom) assignment list" where
+"initial_state_list P = SAS_Plus_Plus_State_To_SAS_Plus_list (Init, 
+  map (\<lambda>v. (v, case (map_list_find (initial_ofl P) v) of  Some val \<Rightarrow> val |
+        None \<Rightarrow> (the (map_list_find (range_ofl P) v)) ! 0 ) ) (variables_ofl P) 
+)"
+
+lemma sublist_initial_state_helper_apply: 
+" (\<lambda>v. if v \<in> set ((P)\<^sub>\<V>\<^sub>+)
+           then Some
+                 (case map_of ((P)\<^sub>I\<^sub>+) v of None \<Rightarrow> the (map_of (range_ofl P) v) ! 0
+                  | Some val \<Rightarrow> val)
+           else None) k = 
+ map_of
+       (map (\<lambda>v. (v, case map_of ((P)\<^sub>I\<^sub>+) v of
+                      None \<Rightarrow> the (map_of (range_ofl P) v) ! 0 | Some val \<Rightarrow> val))
+         ((P)\<^sub>\<V>\<^sub>+)) k
+"
+  apply (auto)
+  subgoal
+proof -
+  assume a1: "k \<in> set ((P)\<^sub>\<V>\<^sub>+)"
+  then have "set ((P)\<^sub>\<V>\<^sub>+) \<noteq> {}"
+    by force
+  then show "Some (case map_of ((P)\<^sub>I\<^sub>+) k of None \<Rightarrow> the (map_of (range_ofl P) k) ! 0 | Some a \<Rightarrow> a) = map_of (map (\<lambda>b. (b, case map_of ((P)\<^sub>I\<^sub>+) b of None \<Rightarrow> the (map_of (range_ofl P) b) ! 0 | Some a \<Rightarrow> a)) ((P)\<^sub>\<V>\<^sub>+)) k"
+    using a1 by (simp add: map_of_from_function_graph_is_some_if)
+qed
+  by (simp add: map_of_map_restrict)
+
+lemma sublist_initial_state_helper:
+"(\<lambda>v. if v \<in> set ((P)\<^sub>\<V>\<^sub>+)
+           then Some
+                 (case map_of ((P)\<^sub>I\<^sub>+) v of None \<Rightarrow> the (map_of (range_ofl P) v) ! 0
+                  | Some val \<Rightarrow> val)
+           else None)
+=  map_of
+       (map (\<lambda>v. (v, case map_of ((P)\<^sub>I\<^sub>+) v of
+                      None \<Rightarrow> the (map_of (range_ofl P) v) ! 0 | Some val \<Rightarrow> val))
+         ((P)\<^sub>\<V>\<^sub>+))
+"
+  using  sublist_initial_state_helper_apply by fast
+
+
+lemma sublist_initial_state:
+" map_of (initial_state_list P)  = initial_state (list_problem_to_problem P) "
+  apply (auto simp only:initial_state_list_def sublist_SAS_Plus_Plus_State_To_SAS_Plus
+  islist_to_map.simps map_of_map  sub_map_list_find sublist_initial_state_helper
+  initial_state_def list_problem_to_problem.simps sas_plus_problem.simps
+)
+  done
+
+lemma map_op:"a # xs = x \<Longrightarrow> map f x = f a # map f xs"
+  apply auto
+  done
+declare map_list_find_nat.simps [simp del]
+fun map_initial_state :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_initial_state P n = (if n = 0 then 0 else (prod_encode(hd_nat n, case (map_list_find_nat (nth_nat (Suc (Suc 0))  P) (hd_nat n)) of  Suc val \<Rightarrow> val |
+        0 \<Rightarrow> hd_nat (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## map_initial_state P (tl_nat n))"
+declare map_list_find_nat.simps [simp]
+
+lemma submap_initial_state:
+"map_initial_state P n  =  map_nat (\<lambda>v. prod_encode(v, case (map_list_find_nat (nth_nat (Suc (Suc 0))  P) v) of  Suc val \<Rightarrow> val |
+        0 \<Rightarrow> hd_nat (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))) ) n "
+  apply (induct P n rule:map_initial_state.induct)
+  apply auto
+  done
+
+definition initial_state_nat::
+  "nat \<Rightarrow> nat " where
+"initial_state_nat P = SAS_Plus_Plus_State_To_SAS_Plus_nat (prod_encode(1, 
+  map_initial_state P (nth_nat 0 P) 
+))"
+
+lemma option_encode_case: "(case option_encode x of 0 \<Rightarrow>  t | Suc y \<Rightarrow> f y) =
+ (case x of None \<Rightarrow> t | Some y \<Rightarrow> f y)  "
+  apply (cases x)
+   apply auto
+  done
+
+lemma some_case_unfold: "f a = Some y \<Longrightarrow> (case f a of None \<Rightarrow> None | Some t \<Rightarrow> Some (g t)) = Some (g y)"
+  apply auto
+  done
+
+
+lemma lambda_case_simplifier:
+assumes  "\<forall>x \<in> set (variables_ofl P). \<exists>t. map_list_find (range_ofl P) x = Some t \<and> t\<noteq>[]"
+shows
+" map (\<lambda>x. case map_list_find ((P)\<^sub>I\<^sub>+) x of
+                    None \<Rightarrow>
+                      prod_encode
+                       (variable_encode x,
+                        hd_nat
+                         (the_nat
+                           (option_encode
+                             (case map_list_find (range_ofl P) x of None \<Rightarrow> None
+                              | Some y \<Rightarrow>
+                                  Some
+                                   (list_encode (map domain_element_encode y))))))
+                    | Some xa \<Rightarrow>
+                        prod_encode (variable_encode x, domain_element_encode xa))
+           ((P)\<^sub>\<V>\<^sub>+) = 
+ map (\<lambda>x. case map_list_find ((P)\<^sub>I\<^sub>+) x of
+                    None \<Rightarrow>
+                      prod_encode
+                       (variable_encode x,
+                        hd_nat
+                         (the_nat
+                           (option_encode
+                             (Some
+                                   (list_encode (map domain_element_encode  (the (map_list_find (range_ofl P) x) )))))))
+                    | Some xa \<Rightarrow>
+                        prod_encode (variable_encode x, domain_element_encode xa))
+           ((P)\<^sub>\<V>\<^sub>+)
+"
+ using assms
+  apply (induct "((P)\<^sub>\<V>\<^sub>+)" arbitrary: P )
+   apply (simp add:  initial_state_list_def 
+  sas_assignment_list_encode_def 
+ flip:  subnat_SAS_Plus_Plus_State_To_SAS_Plus list_encode.simps(2))
+ subgoal for a x P
+    apply (auto simp add:eq_commute simp flip: list_encode.simps(2))
+    apply (cases "map_list_find (range_ofl P) a ")
+     apply simp
+   subgoal for t aa
+ apply (auto simp only:some_case_unfold option.case  option.the_def sub_thefn thefn.simps sub_hd
+              simp flip: sas_assignment_encode.simps )
+     done
+   subgoal for t aa
+     apply (metis (no_types, lifting) option.case_eq_if thef.simps(1) thef.simps(2))
+     done
+   done
+  done
+
+     
+lemma lambda_case_simplifier2:
+assumes  "\<forall>x \<in> set (variables_ofl P). \<exists>t. map_list_find (range_ofl P) x = Some t \<and> t\<noteq>[]"
+shows
+"map (\<lambda>x. case map_list_find ((P)\<^sub>I\<^sub>+) x of
+                    None \<Rightarrow>
+                      prod_encode
+                       (variable_encode x,
+                        head
+                         (map domain_element_encode
+                           (the (map_list_find (range_ofl P) x))))
+                    | Some xa \<Rightarrow>
+                        prod_encode (variable_encode x, domain_element_encode xa))
+           ((P)\<^sub>\<V>\<^sub>+)
+=
+map (\<lambda>x. case map_list_find ((P)\<^sub>I\<^sub>+) x of
+                    None \<Rightarrow>
+                      prod_encode
+                       (variable_encode x,
+                        domain_element_encode (hd (
+                           (the (map_list_find (range_ofl P) x)))))
+                    | Some xa \<Rightarrow>
+                        prod_encode (variable_encode x, domain_element_encode xa))
+           ((P)\<^sub>\<V>\<^sub>+)
+
+"
+ using assms
+  apply (induct "((P)\<^sub>\<V>\<^sub>+)" arbitrary: P )
+  apply auto
+  subgoal for a x P xa 
+    apply (cases "map_list_find (range_ofl P) xa")
+     apply auto
+    subgoal for aa
+      apply (metis option.sel sub_head_map)
+      done
+    done
+  done
+lemma lambda_case_simplifier3:
+assumes  "\<forall>x \<in> set (variables_ofl P). \<exists>t. map_list_find (range_ofl P) x = Some t \<and> t\<noteq>[]"
+shows
+"map (\<lambda>x. case map_list_find ((P)\<^sub>I\<^sub>+) x of
+                    None \<Rightarrow>
+                      prod_encode
+                       (variable_encode x,
+                        domain_element_encode (hd (
+                           (the (map_list_find (range_ofl P) x)))))
+                    | Some xa \<Rightarrow>
+                        prod_encode (variable_encode x, domain_element_encode xa))
+           ((P)\<^sub>\<V>\<^sub>+)
+
+=
+
+map (\<lambda>x. case map_list_find ((P)\<^sub>I\<^sub>+) x of
+                    None \<Rightarrow>
+                      prod_encode
+                       (variable_encode x,
+                        domain_element_encode (
+                           (the (map_list_find (range_ofl P) x))!0))
+                    | Some xa \<Rightarrow>
+                        prod_encode (variable_encode x, domain_element_encode xa))
+           ((P)\<^sub>\<V>\<^sub>+)
+
+"
+ using assms
+  apply (induct "((P)\<^sub>\<V>\<^sub>+)" arbitrary: P )
+  apply auto
+  subgoal for a x P xa 
+    apply (cases "map_list_find (range_ofl P) xa")
+     apply auto
+    subgoal for aa
+      apply (metis hd_conv_nth option.sel)   
+      done
+    done
+  done  
+
+
+lemma subnat_initial_state_helper:
+  assumes  "\<forall>x \<in> set (variables_ofl P). \<exists>t. map_list_find (range_ofl P) x = Some t \<and> t\<noteq>[]"
+  shows "initial_state_nat (list_problem_encode P)
+  = sas_plus_assignment_list_encode (initial_state_list P)"
+  apply (auto simp only: initial_state_nat_def
+ submap_initial_state
+  list_problem_encode_def sub_nth nth.simps sas_assignment_list_encode_def 
+  sas_assignment_encode.simps sub_map_list_find_nat sub_map map_map comp_def
+    simp_sas_assignment_encode simp_vdlist_encode
+)
+  thm "option.case"
+  apply (auto simp only: sub_map_list_find_nat  simp flip: comp_def map_map)
+  using variable_inj apply (auto simp only: comp_def map_find_map)
+  apply (auto simp add: map_find_map2 
+        option.case_distrib)
+  apply (auto simp only: option_encode_case sub_the Case_def option.case)
+  using assms apply (auto simp only: lambda_case_simplifier) 
+  apply (auto simp only:sub_thefn thefn.simps sub_hd initial_state_list_def
+        islist_encode.simps dom_encode.simps sas_assignment_list_encode_def
+          map_map comp_def sas_assignment_encode.simps option.case_distrib
+      simp flip: subnat_SAS_Plus_Plus_State_To_SAS_Plus )
+   apply (auto simp only: lambda_case_simplifier2 lambda_case_simplifier3) 
+  done
+
+lemma inv_subnat_initial_state:
+  assumes "is_valid_problem_sas_plus_plus (list_problem_to_problem P)"
+  shows  "\<forall>x \<in> set (variables_ofl P). \<exists>t. map_list_find (range_ofl P) x = Some t \<and> t\<noteq>[]"
+proof -
+  obtain P' where def: "P' = list_problem_to_problem P" by simp
+  then have "variables_of P' = variables_ofl P " by simp
+  moreover have "map_of (range_ofl P) = range_of P' " using def by simp
+  moreover have "\<forall>x \<in> set (variables_of P'). \<exists>t. (range_of P') x = Some t \<and> t \<noteq> []"
+    by (metis assms def is_valid_problem_sas_plus_plus_then(1) option.collapse range_of_not_empty)
+  ultimately show ?thesis by (metis sub_map_list_find)
+      
+qed
+
+lemma subnat_initial_state:
+  assumes "is_valid_problem_sas_plus_plus (list_problem_to_problem P)"
+  shows "initial_state_nat (list_problem_encode P)
+  = sas_plus_assignment_list_encode (initial_state_list P)"
+  using assms inv_subnat_initial_state subnat_initial_state_helper
+  by fast
+
+
+definition SAS_Plus_Plus_To_SAS_Plus_list:: "(variable,domain_element)sas_plus_list_problem \<Rightarrow> (var,dom)sas_plus_list_problem" where
+"SAS_Plus_Plus_To_SAS_Plus_list P = \<lparr> variables_ofl = Stage # (map Var ((P)\<^sub>\<V>\<^sub>+)),
+      operators_ofl = \<lparr> precondition_of = [(Stage, Init)], effect_of = [(Stage, NonInit)]\<rparr> 
+        # (initialization_operators_list P) 
+        @ (map SAS_Plus_Plus_Operator_To_SAS_Plus_Operator ((P)\<^sub>\<O>\<^sub>+)), 
+      initial_ofl = initial_state_list P ,
+      goal_ofl = SAS_Plus_Plus_State_To_SAS_Plus_list (NonInit, ((P)\<^sub>G\<^sub>+)),
+      range_ofl = (Stage, [Init,NonInit])# 
+           map  (\<lambda>(x,y). (x, map DE y)) (map (\<lambda>(x,y). (Var x, y)) (range_ofl P))\<rparr>"
+
+lemma sublist_SAS_Plus_Plus_To_SAS_Plus_helper_apply:
+"map_of ((Stage, [Init,NonInit])# 
+           map  (\<lambda>(x,y). (x, map DE y)) (map (\<lambda>(x,y). (Var x, y)) (range_ofl P))) k
+= 
+ (((\<lambda>x. Some (map DE x)) \<circ>\<^sub>m (map_of (range_ofl P)) 
+        \<circ>\<^sub>m (\<lambda>x. (case x of Var x \<Rightarrow> Some x | Stage \<Rightarrow> None)))(Stage \<mapsto> [Init, NonInit])) k 
+"
+  apply (cases k)
+   apply (auto simp add: map_of_map map_comp_def simp flip: map_map)
+  subgoal for x1
+    apply (cases "map_of (range_ofl P) x1")
+     apply (auto)
+    subgoal 
+    proof -
+      assume asm: "k = Var x1" " map_of (range_ofl P) x1 = None"
+      then have "\<forall>y. (x1,y) \<notin>  set (range_ofl P)" 
+        using weak_map_of_SomeI by force
+      then have "\<forall>y. (Var x1,y) \<notin> set (map (\<lambda>(x, y). (Var x, y)) (range_ofl P)) "
+        by auto
+      thus " map_of (map (\<lambda>(x, y). (Var x, y)) (range_ofl P)) (Var x1) = None"
+        by (meson map_of_SomeD thef.cases)
+    qed
+    subgoal for a
+    proof -
+      assume " k = Var x1"  "map_of (range_ofl P) x1 = Some a"
+      then  have " map_of (map (\<lambda>(x, y). (Var x, y)) (range_ofl P)) (Var x1) = Some a"
+        using map_of_mapk_SomeI inj_var by fast
+      thus ?thesis by blast
+    qed
+    done
+  done
+lemma sublist_SAS_Plus_Plus_To_SAS_Plus_helper:
+"map_of ((Stage, [Init,NonInit])# 
+           map  (\<lambda>(x,y). (x, map DE y)) (map (\<lambda>(x,y). (Var x, y)) (range_ofl P)))
+= 
+ (((\<lambda>x. Some (map DE x)) \<circ>\<^sub>m (map_of (range_ofl P)) 
+        \<circ>\<^sub>m (\<lambda>x. (case x of Var x \<Rightarrow> Some x | Stage \<Rightarrow> None)))(Stage \<mapsto> [Init, NonInit]))
+"
+  using sublist_SAS_Plus_Plus_To_SAS_Plus_helper_apply by fast
+
+       
+
+lemma sublist_SAS_Plus_Plus_To_SAS_Plus:
+" list_problem_to_problem (SAS_Plus_Plus_To_SAS_Plus_list P) = 
+    SAS_Plus_Plus_To_SAS_Plus (list_problem_to_problem P)"
+  apply (auto simp only: SAS_Plus_Plus_To_SAS_Plus_list_def list_problem_to_problem.simps
+  sas_plus_problem.simps sas_plus_list_problem.simps)
+  apply (auto simp only: sublist_initialization_operators
+   sublist_initial_state sublist_SAS_Plus_Plus_State_To_SAS_Plus
+        sublist_SAS_Plus_Plus_To_SAS_Plus_helper SAS_Plus_Plus_To_SAS_Plus_def
+        sas_plus_problem.simps list_problem_to_problem.simps islist_to_map.simps
+        
+)
+  done
+lemma fst_vdlist_simp:"fst_nat (vdlist_encode x) = variable_encode (fst x)"
+  apply (cases x)
+  apply (auto simp add: sub_fst)
+  done
+
+lemma snd_vdlist_simp: "snd_nat (vdlist_encode x) = list_encode (map domain_element_encode (snd x))"
+  apply (cases x)
+  apply (auto simp add:sub_snd)
+  done
+
+fun map_sasp_to_sas_op :: "nat \<Rightarrow> nat" where 
+"map_sasp_to_sas_op n = (if n = 0 then 0 else (SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat (hd_nat n)) ## map_sasp_to_sas_op (tl_nat n))"
+
+lemma submap_sasp_to_sas_op: 
+"map_sasp_to_sas_op n = map_nat SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat n "
+  apply (induct  n rule: map_sasp_to_sas_op.induct)
+  apply auto
+  done
+
+fun map_DE :: "nat \<Rightarrow> nat" where 
+"map_DE n = (if n = 0 then 0 else (Suc (Suc (hd_nat n))) ## map_DE (tl_nat n))"
+
+lemma submap_DE : "map_DE n =  map_nat (\<lambda>n. Suc (Suc n)) n"
+  apply (induct n rule:map_DE.induct)
+  apply auto
+  done
+
+fun map_var :: "nat \<Rightarrow> nat" where 
+"map_var n = (if n = 0 then 0 else ( prod_encode(Suc (fst_nat (hd_nat n)), snd_nat (hd_nat n))) ## map_var (tl_nat n) )"
+
+lemma submap_var :
+"map_var n = map_nat (\<lambda>n. prod_encode(Suc (fst_nat n), snd_nat n)) n"
+  apply (induct n rule:map_var.induct)
+  apply auto
+  done
+
+fun map_var_DE :: "nat \<Rightarrow> nat" where 
+"map_var_DE n = (if n = 0 then 0 else (prod_encode(fst_nat (hd_nat n), map_DE (snd_nat (hd_nat n)))) ## map_var_DE (tl_nat n))"
+
+lemma submap_var_DE:
+"map_var_DE n = map_nat  ( \<lambda>n. prod_encode(fst_nat n, map_DE (snd_nat n))) n"
+  apply (induct n rule: map_var_DE.induct)
+  apply auto
+  done
+fun map_Suc :: "nat\<Rightarrow> nat" where 
+"map_Suc n = (if n = 0 then 0 else ((Suc (hd_nat n)) ## map_Suc (tl_nat n)))"
+
+lemma submap_Suc : 
+"map_Suc n = map_nat Suc n"
+  apply (induct n rule:map_Suc.induct)
+  apply auto
+  done
+definition SAS_Plus_Plus_To_SAS_Plus_nat:: " nat \<Rightarrow> nat " where
+"SAS_Plus_Plus_To_SAS_Plus_nat P = ((0 ## (map_Suc (nth_nat 0 P)))##
+      ( append_nat ((((prod_encode(0,Suc 0))##0) ## ((prod_encode(0,0))##0) ## 0 ) 
+        ## (initialization_operators_nat P)) 
+        (map_sasp_to_sas_op (nth_nat (Suc 0) P))) ## 
+      (initial_state_nat P)  ##
+      (SAS_Plus_Plus_State_To_SAS_Plus_nat (prod_encode(0, (nth_nat (Suc (Suc (Suc 0))) P))))##
+      ((prod_encode(0, ((Suc 0) ## 0 ##0)))## 
+           map_var_DE (map_var (nth_nat (Suc (Suc (Suc (Suc 0)))) P))) ## 0 )"
+
+lemma lambda_equals: " (\<lambda>x. case x of
+                  (x1, x2) \<Rightarrow>
+                    prod_encode
+                     ((case x of (x1, x2) \<Rightarrow> Pair (Suc (variable_encode x1)))
+                       (list_encode
+                         (map (\<lambda>x. Suc (Suc (domain_element_encode x))) x2))))
+=
+      (\<lambda>x. case x of
+                  (x1, x2) \<Rightarrow>
+                    prod_encode
+                     (Suc (variable_encode x1),
+                      list_encode
+                       (map (\<lambda>x. Suc (Suc (domain_element_encode x))) x2)))
+"
+  apply auto
+  done
+lemma subnat_SAS_Plus_Plus_To_SAS_Plus:
+ assumes "is_valid_problem_sas_plus_plus (list_problem_to_problem P)"
+ shows "SAS_Plus_Plus_To_SAS_Plus_nat (list_problem_encode P)
+= list_problem_plus_encode (SAS_Plus_Plus_To_SAS_Plus_list P)"
+  using assms
+  apply (auto simp only: SAS_Plus_Plus_To_SAS_Plus_nat_def submap_Suc
+  cons0 sub_cons sub_nth nth.simps sub_map sub_append submap_DE submap_var submap_var_DE
+ submap_sasp_to_sas_op
+        subnat_initialization_operators subnat_initial_state
+ )
+  apply (auto simp only:  list_problem_encode_def sub_nth nth.simps sub_map 
+          sub_append map_map comp_def sub_SAS_Plus_Plus_Operator_To_SAS_Plus_Operator
+            sub_fst   fst_vdlist_simp  snd_vdlist_simp fst_def sub_snd snd_def
+          SAS_Plus_Plus_To_SAS_Plus_list_def sas_plus_list_problem.simps list_problem_plus_encode_def
+          list.simps sub_cons var_encode.simps operator_plus_encode_def sas_plus_operator.simps
+          sas_plus_assignment_list_encode_def   sas_plus_assignment_encode.simps dom_encode.simps
+          map_append
+ )
+  apply (auto simp only: subnat_SAS_Plus_Plus_State_To_SAS_Plus
+          simp flip: dom_encode.simps islist_encode.simps
+    
+)
+  apply (auto simp only: dom_encode.simps islist_encode.simps sas_plus_assignment_list_encode_def
+        vdlist_plus_encode.simps prod.case_distrib )
+  apply (auto simp add: comp_def  prod.case_distrib lambda_equals simp del:list_encode.simps)
+  done
+
+    
+
+
+
+
+  
+
+
+end
\ No newline at end of file

From 64ad1656ea5271ecbd48e9c2b6de823f4dcaa3b9 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Fri, 13 Aug 2021 17:27:29 +0200
Subject: [PATCH 005/103] refinement of the reduction to HOL_nat

---
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy | 1589 +++++++++++++++++
 1 file changed, 1589 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
new file mode 100644
index 00000000..20f8a6a9
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -0,0 +1,1589 @@
+theory Primitives
+  imports Main  "HOL-Library.Nat_Bijection" "../../../IMP-/Com" "../IMP_Minus_Minus_Com"
+ "HOL.String"
+ "Verified_SAT_Based_AI_Planning.SAT_Plan_Base"
+"Verified_SAT_Based_AI_Planning.STRIPS_Representation"
+ "../SAS_Plus_Plus" "HOL-Library.Mapping"
+"../SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus"
+"../IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations"
+
+begin 
+
+
+type_synonym sas_state = "(variable, domain_element) State_Variable_Representation.state"
+type_synonym imp_state =  "vname \<rightharpoonup> bit"
+
+lemma extract_lambda: "(\<lambda>i. f(g i v)) = f o (\<lambda>i .g i v)"
+  by auto
+
+lemma extract_lambda2: "(\<lambda>i .g i v) o f = (\<lambda>i. g (f i) v)"
+  by auto
+type_synonym IMP_Minus_com = Com.com
+type_synonym IMP_Minus_Minus_com = com
+
+definition encode_char :: "char \<Rightarrow> nat" where 
+"encode_char = of_char "
+
+definition decode_char :: "nat \<Rightarrow> char" where 
+"decode_char = char_of "
+lemma idcharorg: "decode_char o encode_char = id"
+  by (simp add: decode_char_def encode_char_def)
+lemma idchar:"encode_char x  = encode_char y \<Longrightarrow> x = y"
+  by (simp add: encode_char_def)
+
+definition fst_nat :: "nat \<Rightarrow> nat" where
+"fst_nat \<equiv> fst o prod_decode"
+definition snd_nat::"nat \<Rightarrow> nat" where
+"snd_nat \<equiv> snd o prod_decode"
+
+lemma sub_fst: "fst_nat (prod_encode p) = fst p"
+  by (simp add: fst_nat_def)
+
+lemma sub_snd: "snd_nat (prod_encode p) = snd p"
+  by (simp add: snd_nat_def)
+
+lemma "snd_nat xs \<le> xs"
+  apply (auto simp add:snd_nat_def)
+  by (metis le_prod_encode_2 prod.collapse prod_decode_inverse)
+lemma eq: "prod_encode (n,m) = (m+n) * (m+n+1) div 2 + n"
+  by (simp add: add.commute prod_encode_def triangle_def)
+
+
+definition hd_nat :: "nat \<Rightarrow> nat" where
+"hd_nat xs = fst_nat (xs-1)"
+definition tl_nat :: "nat \<Rightarrow> nat" where 
+"tl_nat xs = snd_nat (xs-1)"
+
+fun head :: "nat list \<Rightarrow> nat" where 
+"head [] = 0"|
+"head (x#xs) = x"
+
+fun tail :: "nat list \<Rightarrow> nat list" where
+"tail [] = []"|
+"tail (x#xs) = xs"
+
+lemma "xs = [] \<longleftrightarrow> list_encode xs = 0"
+  using list_encode_eq by force
+
+lemma sub_hd:"hd_nat (list_encode xs) = head xs"
+  apply (cases xs)
+   apply (auto simp add: hd_nat_def fst_nat_def)
+  apply (simp add: prod_decode_aux.simps prod_decode_def)
+done
+
+   
+
+lemma sub_tl :"tl_nat (list_encode xs) = list_encode (tail xs) "
+  apply (cases xs)
+   apply (auto simp add: tl_nat_def snd_nat_def)
+  apply (simp add: prod_decode_aux.simps prod_decode_def)
+  done
+
+lemma sub_head:" xs  \<noteq> [] \<Longrightarrow>head xs = hd xs"
+  apply (cases xs) 
+   apply (auto simp add: hd_nat_def)
+  done
+
+lemma sub_tail :" xs \<noteq> [] \<Longrightarrow> tail xs = tl xs"
+  apply (cases xs) 
+   apply (auto simp add: tl_nat_def)
+  done
+
+
+
+lemma [simp]: " tl_nat (Suc v) < Suc v"
+  apply (auto simp add:tl_nat_def snd_nat_def)
+  by (metis le_imp_less_Suc le_prod_encode_2 prod.exhaust_sel prod_decode_inverse)
+  
+
+lemma [simp]:  "0 < xs \<Longrightarrow> list_encode (tail (list_decode xs)) < xs"
+  by (metis (no_types, lifting) Suc_diff_1 Suc_le_eq Suc_le_mono case_prod_beta tail.simps(2) 
+ le_prod_encode_2 
+list_decode.simps(2) list_decode_inverse prod.exhaust_sel prod_decode_inverse)
+  
+lemma [simp]: "list_encode (tail (case prod_decode v of (x, y) \<Rightarrow> x # list_decode y)) < Suc v"
+  by (metis case_prod_beta tail.simps(2) le_imp_less_Suc le_prod_encode_2
+ list_decode_inverse prod.exhaust_sel prod_decode_inverse)
+
+fun length_nat :: "nat \<Rightarrow> nat" where 
+"length_nat 0 = 0"|
+"length_nat n = Suc (length_nat (tl_nat n))"
+
+lemma non_empty_positive : "list_encode (a #xs) > 0" by simp
+
+lemma sub_length : "length_nat (list_encode xs) = length xs"
+  apply (induct xs)
+   apply (auto)
+  using tl_nat_def  by (simp add: snd_nat_def) 
+  
+  
+    
+  
+
+definition cons :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"cons h t = Suc (prod_encode (h,t))"
+
+bundle cons_syntax
+begin
+notation cons ("_ ## _" [1000, 61] 61)
+end
+
+bundle no_cons_syntax
+begin
+no_notation cons ("_ ## _" [1000, 61] 61)
+end
+
+unbundle cons_syntax
+
+lemma sub_cons: "cons x (list_encode xs) = list_encode (x#xs)"
+  by (auto simp add:cons_def)
+lemma [simp]: "0 < xs \<Longrightarrow> tl_nat xs < xs"
+  by (metis (no_types, lifting) One_nat_def Suc_diff_1 Suc_diff_eq_diff_pred Suc_inject
+ add.left_neutral case_prod_beta comp_apply comp_def gr0_implies_Suc le_imp_less_Suc
+ le_prod_encode_2 lessI plus_nat.simps(1) prod.simps(2) prod_decode_def prod_encode_def
+ prod_encode_prod_decode_aux snd_nat_def split_conv tl_nat_def triangle_0)
+  
+fun takeWhile_nat :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where 
+"takeWhile_nat P xs = (let h = hd_nat xs; t = tl_nat xs in (if xs = 0 then 0 else (if P h
+            then cons h (takeWhile_nat P t) else 0)))"
+
+lemma sub_takeWhile:"takeWhile_nat P (list_encode xs) = list_encode (takeWhile P xs) "
+  apply (induct xs)
+   apply simp
+  by (smt cons_def head.simps(2) list.distinct(1) list_decode.simps(1) list_decode_inverse
+ list_encode.simps(2) list_encode_eq sub_hd sub_tl tail.simps(2) takeWhile.simps(2)
+ takeWhile_nat.simps)
+ 
+  
+  
+  
+fun dropWhile_nat :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where 
+"dropWhile_nat P xs = (let h = hd_nat xs; t = tl_nat xs in (if xs = 0 then 0 else (if P h
+            then dropWhile_nat P t else xs)))  "
+
+lemma sub_dropWhile: "dropWhile_nat P (list_encode xs) = list_encode (dropWhile P xs)"
+  apply (induct xs) 
+   apply simp
+  by (metis dropWhile.simps(2) dropWhile_nat.elims head.simps(2) 
+list_decode_inverse nat_less_le non_empty_positive sub_hd sub_tl tail.simps(2))
+  
+
+  
+
+fun option_decode :: "nat \<Rightarrow> nat option" where 
+"option_decode 0 = None"|
+"option_decode (Suc x) = Some x"
+
+fun option_encode :: "nat option \<Rightarrow> nat" where 
+"option_encode None = 0"|
+"option_encode (Some x) = Suc x"
+
+lemma [simp]: "option_encode (option_decode xs) = xs"
+  by (metis option_decode.elims option_encode.simps(1) option_encode.simps(2))
+
+lemma [simp]: "option_decode (option_encode xs) = xs"
+  by (metis option_decode.simps(1) option_decode.simps(2) option_encode.elims)
+  
+  
+definition some_nat :: "nat \<Rightarrow> nat" where 
+"some_nat = Suc"
+lemma sub_some [simp]: "some_nat x = option_encode (Some x)"
+  by (simp add: some_nat_def)
+  
+definition vname_encode :: "string \<Rightarrow> nat" where 
+"vname_encode v = list_encode (map encode_char v)"
+
+definition vname_decode :: "nat \<Rightarrow> string" where 
+"vname_decode v = map decode_char (list_decode v)"
+
+lemma vname_id: "vname_decode (vname_encode xs) = xs"
+  by (auto simp add: vname_encode_def vname_decode_def idcharorg)
+
+lemma vname_inj: "inj vname_encode" 
+  apply (auto simp add:inj_def)
+  by (metis vname_id)
+   
+definition vname_list_encode :: "string list \<Rightarrow> nat" where 
+"vname_list_encode l = list_encode (map vname_encode l)"
+
+definition vname_list_decode :: "nat \<Rightarrow> string list" where 
+"vname_list_decode n = map vname_decode (list_decode n)"
+
+lemma vname_list_id:"vname_list_decode (vname_list_encode x) = x"
+  by (auto simp add: vname_list_encode_def vname_list_decode_def map_idI vname_id)
+
+fun append_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"append_nat 0 ys = ys"|
+"append_nat xs ys = cons (hd_nat xs) (append_nat (tl_nat xs) ys)"
+
+lemma sub_append: "append_nat (list_encode xs) (list_encode ys) = list_encode (xs @ ys)"
+  apply(induct xs)
+   apply (auto simp only: append.simps sub_cons sub_hd sub_tl)
+   apply auto
+  by (metis Suc_eq_plus1 add.commute add_diff_cancel_left' comp_def cons_def 
+head.simps(2) prod.sel(2) prod_encode_inverse snd_nat_def 
+sub_cons sub_hd tl_nat_def)
+
+fun elemof :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"elemof e l = (if l = 0 then 0 else if hd_nat l = e then 1 else elemof e (tl_nat l))"
+
+lemma sub_elem_of: "elemof e (list_encode l) \<noteq> 0 =  (e \<in> set l)"
+  apply (induction l)
+   apply (subst elemof.simps)
+   apply(simp add: sub_hd sub_tl del:elemof.simps)
+  apply (subst elemof.simps)
+  apply (auto simp only: sub_hd sub_tl sub_tail sub_head head.simps tl_def list.distinct(2) 
+split:if_splits 
+        del:elemof.simps)
+           apply (auto)
+  done
+
+lemma sub_elem_of2: "(elemof e (list_encode l) = 0) =  (e \<notin> set l)"
+  using sub_elem_of by blast
+fun remdups_nat :: "nat \<Rightarrow> nat" where 
+"remdups_nat n = (if n=0 then 0 else if elemof (hd_nat n) (tl_nat n) \<noteq> 0 then remdups_nat (tl_nat n)
+                 else cons (hd_nat n) (remdups_nat (tl_nat n)))"
+
+lemma sub_remdups: "remdups_nat (list_encode xs) = list_encode (remdups xs)"
+  apply (subst remdups_nat.simps)
+  apply (induct xs)
+   apply (auto simp only: sub_hd sub_tl tail.simps head.simps sub_tail sub_head remdups.simps sub_elem_of
+        sub_cons)
+   apply auto[1]
+  by (smt less_numeral_extra(3) non_empty_positive remdups_nat.elims sub_cons 
+sub_elem_of sub_hd sub_tl)
+
+lemma prod_sum_less:"0< x \<Longrightarrow>(x,y) = prod_decode p  \<Longrightarrow> x+y < p"
+  by (smt Nat.add_0_right Suc_leI add.left_commute add.left_neutral add.right_neutral 
+add_Suc_right add_mono_thms_linordered_semiring(1) canonically_ordered_monoid_add_class.lessE
+ comm_monoid_add_class.add_0 le_imp_less_Suc le_prod_encode_2 not_le plus_nat.add_0 prod.simps(2) 
+prod_decode_inverse prod_encode_def prod_encode_def split_conv)
+
+lemma prod_sum_less2:"(x,y) = prod_decode p  \<Longrightarrow> x+y \<le> p"
+  by (metis le_prod_encode_2 less_add_same_cancel2 less_imp_le
+ linorder_neqE_nat not_add_less2 prod_decode_inverse prod_sum_less)
+
+lemma prod_snd_less:"0< x \<Longrightarrow>(x,y) = prod_decode p  \<Longrightarrow> y < p"
+  using prod_sum_less
+  by (metis add.commute add_lessD1)
+
+
+lemma prod_snd_less2:"(x,y) = prod_decode p  \<Longrightarrow> y \<le> p"
+  using prod_sum_less
+  by (metis le_prod_encode_2 prod_decode_inverse)
+
+
+lemma prod_fst_less2:"(x,y) = prod_decode p  \<Longrightarrow> x \<le> p"
+  using prod_sum_less
+  by (metis le_prod_encode_1 prod_decode_inverse)
+
+
+fun atomExp_encode :: "atomExp \<Rightarrow> nat" where 
+"atomExp_encode (V var) = prod_encode (0, vname_encode var)" | 
+"atomExp_encode (N n)   = prod_encode (1,n) "
+
+definition atomExp_decode :: "nat \<Rightarrow> atomExp" where 
+"atomExp_decode n = (case prod_decode n of (0,v) \<Rightarrow> V (vname_decode v) | (Suc 0,n) \<Rightarrow> N n)"
+
+lemma atomExp_id:"atomExp_decode (atomExp_encode x) = x"
+  apply (cases x)
+   apply (auto simp add: atomExp_decode_def vname_id)
+  done
+
+fun aexp_encode :: "aexp \<Rightarrow> nat" where 
+"aexp_encode (A a) = list_encode [0, atomExp_encode a]"|
+"aexp_encode (Plus a b) = list_encode [1,atomExp_encode a, atomExp_encode b]"|
+"aexp_encode (Sub a b) = list_encode  [2, atomExp_encode a, atomExp_encode b]"|
+"aexp_encode (Parity a) = list_encode [3, atomExp_encode a]"|
+"aexp_encode (RightShift a) = list_encode [4,atomExp_encode a]"
+
+fun aexp_decode :: "nat \<Rightarrow> aexp" where 
+"aexp_decode n = (case list_decode n of
+                    [0,a] \<Rightarrow> A (atomExp_decode a)|
+                    [Suc 0,a,b] \<Rightarrow> Plus (atomExp_decode a) (atomExp_decode b)|
+                    [Suc (Suc 0),a,b] \<Rightarrow> Sub (atomExp_decode a) (atomExp_decode b)|
+                    [Suc (Suc (Suc 0)),a] \<Rightarrow> Parity (atomExp_decode a)|
+                    [Suc (Suc (Suc (Suc 0))),a] \<Rightarrow> RightShift (atomExp_decode a) )"
+
+lemma aexp_id:"aexp_decode (aexp_encode x) = x"
+  apply (cases x)
+      apply (auto simp add: vname_id atomExp_id)
+  done
+
+lemma set_less_helper: "x \<in>set xs \<Longrightarrow> x < list_encode xs"
+  apply (induction xs)
+   apply (auto)
+  using le_imp_less_Suc le_prod_encode_1 apply blast
+  by (meson Suc_lessD le_imp_less_Suc le_prod_encode_2 less_trans_Suc)
+
+lemma set_less [simp]: "x \<in>set (list_decode n) \<Longrightarrow> x < n"   
+proof -
+  assume assms:"x \<in>set (list_decode n) "
+  obtain xs where "list_decode n = xs" by auto
+  then moreover have "n = list_encode xs" by auto 
+  thus ?thesis using assms by (auto simp add:set_less_helper)
+qed
+
+fun com_encode :: "IMP_Minus_com \<Rightarrow> nat" where 
+"com_encode (Com.com.SKIP) = list_encode [0]"|
+"com_encode (Com.com.Assign vname aexp) = list_encode [1,vname_encode vname, aexp_encode aexp]"|
+"com_encode (Com.com.Seq c1 c2) = list_encode [2,com_encode c1,com_encode c2]"|
+"com_encode (Com.com.If v c1 c2) = list_encode [3, vname_encode v,com_encode c1,com_encode c2]"|
+"com_encode (Com.com.While v c) = list_encode [4,vname_encode v, com_encode c]"
+
+fun com_decode :: "nat \<Rightarrow> Com.com" where 
+"com_decode n = (case list_decode n of
+                  [0] \<Rightarrow> Com.com.SKIP |
+                  [Suc 0,v,a] \<Rightarrow> Com.com.Assign (vname_decode v) (aexp_decode a)|
+                  [Suc (Suc 0),c1,c2] \<Rightarrow> Com.com.Seq (com_decode c1) (com_decode c2) |
+                  [Suc(Suc (Suc 0)),v,c1,c2] \<Rightarrow> Com.com.If (vname_decode v) (com_decode c1) (com_decode c2)|
+                  [Suc (Suc (Suc (Suc 0))),v,c] \<Rightarrow> Com.com.While  (vname_decode v) (com_decode c)
+)" 
+  
+lemma "com_decode (com_encode x) = x" 
+  apply (subst com_encode.simps com_decode.simps)
+  apply (induct x)
+  apply (auto simp add: vname_id aexp_id simp del:aexp_encode.simps aexp_decode.simps )
+  done
+
+fun bit_encode :: "bit \<Rightarrow> nat" where 
+"bit_encode Zero = 0"|
+"bit_encode One = 1"
+
+fun bit_decode :: "nat \<Rightarrow> bit" where 
+"bit_decode 0 = Zero"|
+"bit_decode (Suc 0) = One"
+
+lemma bit_id[simp]: "bit_decode (bit_encode x) = x"
+  by (cases x) auto
+
+
+fun comm_encode :: "com \<Rightarrow> nat" where 
+"comm_encode SKIP = list_encode [0]"|
+"comm_encode (Assign vname b) = list_encode [1,vname_encode vname, bit_encode b]"|
+"comm_encode (Seq c1 c2) = list_encode [2,comm_encode c1,comm_encode c2]"|
+"comm_encode (If v c1 c2) = list_encode [3, vname_list_encode v,comm_encode c1,comm_encode c2]"|
+"comm_encode (While v c) = list_encode [4,vname_list_encode v, comm_encode c]"
+
+fun comm_decode :: "nat \<Rightarrow> com" where 
+"comm_decode n = (case list_decode n of
+                  [0] \<Rightarrow> SKIP |
+                  [Suc 0,v,a] \<Rightarrow> Assign (vname_decode v) (bit_decode a)|
+                  [Suc (Suc 0),c1,c2] \<Rightarrow> Seq (comm_decode c1) (comm_decode c2) |
+                  [Suc(Suc (Suc 0)),v,c1,c2] \<Rightarrow> If (vname_list_decode v) (comm_decode c1) (comm_decode c2)|
+                  [Suc (Suc (Suc (Suc 0))),v,c] \<Rightarrow> While (vname_list_decode v) (comm_decode c)
+)" 
+
+lemma comm_id: "comm_decode (comm_encode x) = x" 
+  apply (subst comm_encode.simps comm_decode.simps)
+  apply (induct x)
+  apply (auto simp add:vname_id vname_list_id)
+  done
+
+fun nth :: "nat \<Rightarrow> nat list \<Rightarrow> nat" where 
+"nth n [] = 0"|
+"nth 0 (x#xs) = x"|
+"nth (Suc n) (x#xs) = nth n xs"
+
+fun nth_nat :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"nth_nat 0 x = hd_nat x "|
+"nth_nat (Suc n) x = nth_nat n (tl_nat x)"
+
+lemma sub_nth:"nth_nat n (list_encode xs) = nth n xs "
+  apply (induct n arbitrary:xs)
+   apply (auto simp only: nth_nat.simps sub_tl sub_hd)
+  apply (metis Primitives.nth.simps(1) Primitives.nth.simps(2) head.elims)
+  by (metis Primitives.nth.simps(1) Primitives.nth.simps(3) tail.elims)
+
+
+
+lemma pos_tl_less[termination_simp]: "x>0 \<Longrightarrow> tl_nat x < x"
+  apply (auto simp add:tl_nat_def snd_nat_def)
+  by (metis Suc_pred le_imp_less_Suc prod.exhaust_sel prod_snd_less2)
+
+lemma nth_less[simp]: "nth_nat n x \<le> x"
+  apply(induct n arbitrary:x)
+   apply(auto simp add:hd_nat_def tl_nat_def snd_nat_def)
+   apply (metis comp_def diff_le_self fst_nat_def le_less_trans le_prod_encode_1 not_le 
+prod.exhaust_sel prod_decode_inverse)
+  by (metis diff_le_self le_less_trans less_Suc_eq_le prod.exhaust_sel prod_snd_less2)
+
+   
+lemma [simp]: "x>0 \<Longrightarrow> nth_nat n x < x"
+  apply (induct n arbitrary:x)
+   apply (auto simp add:hd_nat_def fst_nat_def fst_def)
+   apply (metis Suc_pred case_prod_beta leI le_prod_encode_1 
+not_less_eq_eq prod.exhaust_sel prod_decode_inverse)
+  subgoal for n x
+    using pos_tl_less[of x] nth_less[of n "tl_nat x"]
+    by linarith
+  done
+lemma cons0:"cons a 0 = list_encode [a]"
+  by (metis list_encode.simps(1) sub_cons)
+
+fun map_nat :: "(nat\<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_nat f n= (if n =0 then 0 else cons (f (hd_nat n)) (map_nat f (tl_nat n)))"
+
+lemma sub_map:"map_nat f (list_encode xs) = list_encode (map f xs)"
+  apply (induct xs)
+   apply simp
+  apply (subst map_nat.simps)
+  apply (simp only: sub_hd head.simps sub_cons sub_tl tail.simps)
+  apply auto
+  done
+
+fun num_to_list:: "num \<Rightarrow> nat list" where
+"num_to_list (num.One) = []"|
+"num_to_list (num.Bit0 n) = 0#num_to_list n"|
+"num_to_list (num.Bit1 n) = 1#num_to_list n"
+
+fun list_to_num :: "nat list \<Rightarrow> num" where 
+"list_to_num [] = num.One"|
+"list_to_num (0#xs) = num.Bit0 (list_to_num xs)"|
+"list_to_num (Suc 0#xs) = num.Bit1 (list_to_num xs)"
+
+lemma list_to_num_id: "list_to_num (num_to_list n) = n"
+  apply (induct n)
+    apply auto
+  done
+
+definition num_encode :: "num \<Rightarrow> nat" where 
+"num_encode x = list_encode (num_to_list x) "
+
+definition num_decode :: "nat \<Rightarrow> num" where 
+"num_decode x = list_to_num (list_decode x)"
+
+lemma numid: "num_decode (num_encode x) = x"
+  apply (auto simp add:num_encode_def num_decode_def list_to_num_id)
+  done
+
+lemma sub_head_map: "v \<noteq> [] \<Longrightarrow> head (map f v) = f (hd v)"
+  apply (induct v)
+   apply auto
+  done
+
+lemma sub_tail_map : "tail (map f v) = map f (tl v)"
+  apply (induct v)
+   apply auto
+  done
+
+fun list_from_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"list_from_nat s n = (if n = 0 then 0 else cons s (list_from_nat (s+1) (n-1)))"
+
+lemma sub_list_from: "list_from_nat s n = list_encode [s..<s+n]"
+  apply (induct s n rule: list_from_nat.induct)
+  apply (simp)
+  apply (simp only: sub_cons list_encode_eq)
+  apply (simp add: upt_rec)
+  done
+
+definition list_less_nat :: "nat \<Rightarrow> nat" where
+"list_less_nat n = list_from_nat 0 n"
+
+lemma sub_list_less : "list_less_nat n = list_encode ([0..<n])"
+  apply (simp only: list_less_nat_def sub_list_from)
+  apply auto
+  done
+
+lemma comm_inj : "inj comm_encode"
+  apply (auto simp only: inj_def)
+  subgoal for c1 c2
+  apply (cases c2)
+  apply (induct c1 arbitrary: c2)
+          apply (auto simp only: comm_encode.simps list_encode_eq comm_encode.elims)
+  using comm_id apply (metis comm_encode.simps)
+  using comm_id apply (metis comm_encode.simps) 
+  using comm_id apply (metis comm_encode.simps) 
+  using comm_id apply (metis comm_encode.simps) 
+  done    
+  done
+
+lemma remdups_map : "inj f \<Longrightarrow> remdups (map f xs) = map f (remdups xs)"
+  apply (induct xs)
+   apply (auto simp add:inj_def)
+  done
+
+fun concat_nat :: "nat \<Rightarrow> nat" where
+"concat_nat n = (if n = 0 then 0 else append_nat (hd_nat n) (concat_nat (tl_nat n)))"
+
+lemma sub_concat : "concat_nat (list_encode (map list_encode xs)) = list_encode (concat xs)"
+  apply (induct xs)
+   apply simp
+  apply (subst concat_nat.simps)
+  apply (simp only: concat.simps sub_hd sub_tl)
+  apply (auto simp add:sub_append)
+  done
+lemma vname_list_encode_as_comp:"vname_list_encode = list_encode o (map vname_encode)"
+  by (auto simp add:fun_eq_iff vname_list_encode_def)
+
+
+
+fun domain_element_encode ::"domain_element \<Rightarrow> nat" where 
+"domain_element_encode (EV b) = prod_encode (0,bit_encode b)"|
+"domain_element_encode (PCV com) = prod_encode (1,comm_encode com)"
+
+fun domain_element_decode :: "nat \<Rightarrow> domain_element" where 
+"domain_element_decode n = (case prod_decode n of
+                            (0,b) \<Rightarrow> EV (bit_decode b)|
+                            (Suc 0 , com) \<Rightarrow> PCV (comm_decode com)) "
+
+lemma domain_element_id : "domain_element_decode (domain_element_encode x) = x"
+  apply (cases x)
+   apply (auto simp only:domain_element_encode.simps domain_element_decode.simps prod_encode_inverse
+      bit_id comm_id
+ )
+   apply auto
+  done
+
+fun variable_encode :: "variable \<Rightarrow> nat" where 
+"variable_encode PC = 0"|
+"variable_encode (VN vn) = Suc (vname_encode vn)"
+
+fun variable_decode :: "nat \<Rightarrow> variable" where 
+"variable_decode 0 = PC"|
+"variable_decode (Suc n) = VN (vname_decode n)"
+
+lemma variable_id : "variable_decode (variable_encode x) = x"
+  apply (cases x)
+   apply (auto simp add: vname_id)
+  done
+
+  
+lemma variable_inj : "inj variable_encode"
+  apply (auto simp add:inj_def)
+  subgoal for x y
+    apply (cases x)
+     apply (cases y)
+    subgoal for z t
+      apply (auto simp add:vname_inj)
+      using vname_inj inj_def apply metis
+      done
+     apply auto
+    apply (metis variable_decode.simps(1) variable_id)
+    done
+  done
+
+      
+fun sas_assignment_encode:: "variable * domain_element \<Rightarrow> nat" where 
+"sas_assignment_encode (v,d) = prod_encode (variable_encode v, domain_element_encode d)"
+
+fun sas_assignment_decode:: "nat \<Rightarrow> (variable * domain_element) " where
+"sas_assignment_decode n = (case prod_decode n of (v,d) \<Rightarrow> (variable_decode v, domain_element_decode d))"
+
+lemma  sas_assignment_id: "sas_assignment_decode (sas_assignment_encode x) = x"
+  apply (cases x)
+  apply (auto simp only:variable_id domain_element_id sas_assignment_decode.simps sas_assignment_encode.simps
+        prod_encode_inverse)
+  done
+
+fun someOf :: "'a option \<Rightarrow> 'a" where 
+"someOf (Some x) = x"
+
+
+definition map_to_list :: "('a,'b) map \<Rightarrow> ('a*'b) list" where 
+"map_to_list s \<equiv> (SOME l. map_of l = s)"
+
+lemma has_map:
+  fixes s
+  assumes "finite (dom s)"
+  shows "\<exists>l. map_of l = s "
+proof -
+  obtain n where n_def:"n = card (dom s)" by blast
+  then show  "\<exists>l. map_of l = s " using assms
+proof (induct n arbitrary:s)
+  case 0
+  then have "dom s ={}" using card_eq_0_iff by simp  
+  then show ?case  by simp
+next
+  case (Suc n)
+  hence "dom s  \<noteq> {}" using card_gt_0_iff
+    by force 
+  then obtain x where x_def: "x \<in> dom s" by blast
+  then obtain y where y_def: "s x = Some y" by fast
+  obtain s' where s'_def: "s' = s(x:=None)" by blast
+  hence dom':"dom s' = dom s - {x} " by simp
+  hence "card (dom s') = n" using x_def Suc by simp
+  moreover have "finite (dom s')" using dom' Suc(3) by simp
+  ultimately obtain l where "map_of l = s'" using Suc(1) by blast
+  then have "map_of ((x,y)#l) = s" using s'_def y_def by auto 
+  then show ?case by blast
+qed 
+qed
+
+lemma map_to_list_id: "finite (dom s) \<Longrightarrow> map_of (map_to_list s) = s "
+  using has_map
+  by (metis (mono_tags) map_to_list_def someI_ex)
+
+definition sas_state_encode ::"sas_state \<Rightarrow> nat" where
+"sas_state_encode xs = list_encode (map sas_assignment_encode (map_to_list xs)) "
+
+definition sas_state_decode :: "nat \<Rightarrow> sas_state" where
+"sas_state_decode n = map_of (map sas_assignment_decode (list_decode n)) "
+
+
+lemma sas_state_id : "finite (dom x) \<Longrightarrow> sas_state_decode (sas_state_encode x) = x"
+  apply (auto simp only: sas_state_encode_def sas_state_decode_def map_to_list_id comp_def
+      list_encode_inverse map_map sas_assignment_id)
+  apply (auto simp add: map_to_list_id)
+  done
+
+  
+
+
+fun imp_assignment_encode:: "vname * bit \<Rightarrow> nat" where 
+"imp_assignment_encode (v,d) = prod_encode (vname_encode v, bit_encode d)"
+
+fun imp_assignment_decode:: "nat \<Rightarrow> (vname * bit)" where
+"imp_assignment_decode n = (case prod_decode n of (v,d) \<Rightarrow> (vname_decode v, bit_decode d))"
+
+lemma  imp_assignment_id: "imp_assignment_decode (imp_assignment_encode x) = x"
+  apply (cases x)
+  apply (auto simp only:vname_id bit_id imp_assignment_decode.simps imp_assignment_encode.simps
+        prod_encode_inverse)
+  done
+
+definition imp_state_encode :: "imp_state \<Rightarrow> nat" where
+"imp_state_encode xs = list_encode (map imp_assignment_encode (map_to_list xs)) "
+
+definition imp_state_decode :: "nat \<Rightarrow> imp_state" where
+"imp_state_decode n = map_of (map imp_assignment_decode (list_decode n))"
+
+lemma imp_state_id : " finite (dom x) \<Longrightarrow> imp_state_decode (imp_state_encode x) = x"
+ apply (auto simp only: imp_state_encode_def imp_state_decode_def map_to_list_id comp_def
+      list_encode_inverse map_map imp_assignment_id)
+    apply (auto simp add: map_to_list_id)
+  done
+
+fun comm_imp_state_encode:: "(com * imp_state) \<Rightarrow> nat" where 
+"comm_imp_state_encode (c,i) = prod_encode (comm_encode c, imp_state_encode i)"
+
+fun comm_imp_state_decode :: "nat \<Rightarrow> (com*imp_state)" where 
+"comm_imp_state_decode n = (case prod_decode n of (c,i) \<Rightarrow> (comm_decode c, imp_state_decode i))"
+
+lemma comm_imp_state_id: 
+  "finite (dom (snd x)) \<Longrightarrow> comm_imp_state_decode (comm_imp_state_encode x) = x"
+  apply (cases x)
+  apply (auto simp only: comm_imp_state_encode.simps comm_imp_state_decode.simps comm_id imp_state_id prod_encode_inverse snd_def)
+  done
+
+definition imp_assignment_list_encode :: "(vname,bit)assignment list \<Rightarrow> nat" where
+"imp_assignment_list_encode xs = list_encode (map imp_assignment_encode xs)"
+
+definition imp_assignment_list_decode :: "nat \<Rightarrow> (vname,bit)assignment list" where
+"imp_assignment_list_decode xs = map imp_assignment_decode (list_decode xs)"
+
+lemma imp_assignment_list_id: "imp_assignment_list_decode (imp_assignment_list_encode x) = x"
+  apply (auto simp only:imp_assignment_list_decode_def imp_assignment_list_encode_def list_encode_inverse
+      imp_assignment_id map_map comp_def map_idI)
+  done
+
+
+fun cilist_encode :: "(com * (vname*bit) list) \<Rightarrow> nat" where 
+"cilist_encode (c,i) = prod_encode (comm_encode c, imp_assignment_list_encode i)"
+
+fun cilist_decode :: " nat \<Rightarrow> (com * (vname*bit) list)" where 
+"cilist_decode n = (case prod_decode n of (c,i) \<Rightarrow> 
+         (comm_decode c, imp_assignment_list_decode i))"
+
+lemma cilist_id: "cilist_decode(cilist_encode x) = x"
+  apply (cases x)
+  apply (auto simp only: cilist_decode.simps cilist_encode.simps prod_encode_inverse comm_id imp_assignment_list_id)
+  done
+
+fun cilist_to_map:: "(com*(vname*bit) list) \<Rightarrow> (com*imp_state) " where
+"cilist_to_map (c,i) = (c,map_of i)"
+
+
+
+type_synonym operator = "(variable, domain_element) sas_plus_operator"
+type_synonym problem = "(variable, domain_element) sas_plus_problem"
+
+definition sas_assignment_list_encode :: "(variable,domain_element)assignment list \<Rightarrow> nat" where
+"sas_assignment_list_encode xs =list_encode (map sas_assignment_encode xs)"
+
+definition sas_assignment_list_decode :: "nat \<Rightarrow> (variable,domain_element)assignment list" where
+"sas_assignment_list_decode xs = map sas_assignment_decode (list_decode xs)"
+
+lemma sas_assignment_list_id: "sas_assignment_list_decode (sas_assignment_list_encode x) = x"
+  apply (auto simp only:sas_assignment_list_decode_def sas_assignment_list_encode_def list_encode_inverse
+      sas_assignment_id map_map comp_def map_idI)
+  done
+
+
+definition operator_encode :: "operator \<Rightarrow> nat" where 
+"operator_encode op = list_encode [sas_assignment_list_encode (precondition_of op),
+                                    sas_assignment_list_encode (effect_of op)] "
+
+definition operator_decode :: " nat \<Rightarrow> operator" where 
+"operator_decode n =  ( case list_decode n of  [p,e] \<Rightarrow> 
+                       \<lparr>precondition_of = sas_assignment_list_decode p,
+                        effect_of = sas_assignment_list_decode e \<rparr> )  "
+
+lemma operator_id : " operator_decode (operator_encode x) = x"
+  apply (auto simp add:operator_decode_def operator_encode_def sas_assignment_list_id)
+  done
+
+fun list_update_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"list_update_nat l n v = (if l =0 then 0 else if n=0 then (v##tl_nat l) else (hd_nat l) ##
+               list_update_nat (tl_nat l) (n-1) v)"
+
+lemma sub_list_update : 
+      "list_update_nat (list_encode l) n v = list_encode (list_update l n v) "
+  apply (induct l arbitrary:n)
+  apply (subst list_update_nat.simps)
+  apply (auto simp only: sub_hd sub_head sub_tl sub_cons list_encode_eq split:if_splits list.splits 
+            simp flip: list_encode.simps)
+  apply ( simp  (no_asm) only: sub_head sub_tail list_encode.simps list_update_def)
+  apply simp
+   apply simp
+  apply (subst list_update_nat.simps)
+   apply (auto simp only: sub_hd sub_head sub_tl sub_cons list_encode_eq split:if_splits list.splits 
+            simp flip: list_encode.simps)
+   apply simp
+  apply (simp only: head.simps sub_cons )
+  by (metis One_nat_def Suc_pred list_encode.simps(1) list_update_code(3) neq0_conv sub_cons tail.simps(2))
+
+fun restrict_list :: "(vname,bit) assignment list \<Rightarrow> vname list \<Rightarrow> (vname,bit) assignment list" where 
+"restrict_list [] s = []" |
+"restrict_list ((x,y)#xs) s = (if x \<in> set s then (x,y) # (restrict_list xs s) else restrict_list xs s)"
+
+lemma sub_restrict_list_helper: 
+  "map_of (restrict_list xs s) t = restrict_map (map_of xs) (set s) t"
+  apply (induct xs)
+   apply (auto simp add:snd_def  restrict_map_def)
+  done
+
+lemma sub_restrict_list: 
+"map_of (restrict_list xs s) = restrict_map (map_of xs) (set s)"
+  using sub_restrict_list_helper by fast
+
+record  ('variable, 'domain) sas_plus_list_problem =
+  variables_ofl :: "'variable list" ("(_\<^sub>\<V>\<^sub>+)" [1000] 999)
+  operators_ofl :: "('variable, 'domain) sas_plus_operator list" ("(_\<^sub>\<O>\<^sub>+)" [1000] 999)
+  initial_ofl :: "('variable, 'domain) assignment list" ("(_\<^sub>I\<^sub>+)" [1000] 999)
+  goal_ofl :: "('variable, 'domain) assignment list" ("(_\<^sub>G\<^sub>+)" [1000] 999)
+  range_ofl :: "('variable, 'domain list) assignment list"
+
+fun vdlist_encode :: "(variable, domain_element list) assignment \<Rightarrow> nat" where 
+"vdlist_encode (x,y) = prod_encode (variable_encode x,list_encode (map domain_element_encode y))"
+
+fun vdlist_decode ::  "nat \<Rightarrow> (variable, domain_element list) assignment" where 
+"vdlist_decode n = (case prod_decode n of (x,y) \<Rightarrow> (variable_decode x, map domain_element_decode (list_decode y)))"
+
+lemma vdlist_id: "vdlist_decode (vdlist_encode x) = x"
+  apply (cases x)
+  apply (simp add: comp_def variable_id domain_element_id del:domain_element_decode.simps)
+  done
+
+fun list_problem_to_problem ::
+  "('v,'d) sas_plus_list_problem \<Rightarrow>('v,'d)sas_plus_problem"
+  where   " list_problem_to_problem x =
+        \<lparr> variables_of = variables_ofl x,
+          operators_of = operators_ofl x,
+          initial_of = map_of (initial_ofl x),
+          goal_of = map_of (goal_ofl x),
+          range_of = map_of (range_ofl x)
+       \<rparr>"
+
+definition list_problem_encode ::
+    "(variable,domain_element) sas_plus_list_problem \<Rightarrow>nat" where 
+"list_problem_encode x = list_encode [list_encode (map variable_encode (variables_ofl x)),
+                                      list_encode (map operator_encode (operators_ofl x)),
+                                      sas_assignment_list_encode (initial_ofl x),
+                                       sas_assignment_list_encode (goal_ofl x),
+                                       list_encode (map vdlist_encode (range_ofl x)) ] "
+
+definition list_problem_decode ::"nat \<Rightarrow> (variable,domain_element) sas_plus_list_problem" where 
+"list_problem_decode x = (case list_decode x of 
+[var,op,i,g,r]  \<Rightarrow> \<lparr>           variables_ofl = map variable_decode (list_decode var),
+                               operators_ofl = map operator_decode (list_decode op),
+                               initial_ofl = sas_assignment_list_decode i,
+                               goal_ofl = sas_assignment_list_decode g,
+                               range_ofl = map vdlist_decode (list_decode r) \<rparr> )"
+
+lemma list_problem_id : 
+      "list_problem_decode (list_problem_encode x) = x"
+  apply (auto simp only:list_problem_encode_def list_problem_decode_def list_encode_inverse)
+  apply (auto simp add: comp_def variable_id operator_id sas_assignment_list_id vdlist_id simp del: vdlist_decode.simps)
+  done
+
+declare elemof.simps [simp del]
+
+fun restrict_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"restrict_nat l s = (if l = 0 then 0 else (let t = restrict_nat (tl_nat l) s in (if elemof (fst_nat (hd_nat l)) s \<noteq> 0 then 
+    (hd_nat l)## t else t))) "
+declare elemof.simps [simp]
+
+lemma sub_restrict_nat:
+  "restrict_nat (imp_assignment_list_encode l) (vname_list_encode s) = imp_assignment_list_encode (restrict_list l s)"
+  apply (simp only: vname_list_encode_def)
+  apply (induct l)
+   apply (simp add: imp_assignment_list_encode_def)
+  subgoal for x l
+    apply (cases x)
+  apply (subst restrict_nat.simps)
+    apply (auto simp only:  sub_cons restrict_list.simps list_encode_eq sub_tl  imp_assignment_list_encode_def sub_tail_map Let_def sub_fst sub_hd sub_head_map list.simps  head.simps imp_assignment_encode.simps fst_def tail.simps non_empty_positive  split:if_splits 
+  simp flip: list_encode.simps 
+)
+     apply (auto simp only: list_encode.simps sub_elem_of2)
+     apply simp
+    apply (metis imageE set_map vname_id)
+    done    
+  done
+
+type_synonym  var = "variable SAS_Plus_Plus_To_SAS_Plus.variable"
+type_synonym  dom = "domain_element SAS_Plus_Plus_To_SAS_Plus.domain_element"
+type_synonym  sas_plus_state = "(var,dom)  State_Variable_Representation.state"
+fun var_encode :: "var \<Rightarrow> nat" where 
+"var_encode Stage = 0 " |
+"var_encode (Var v) = Suc (variable_encode v)"
+
+fun var_decode :: "nat \<Rightarrow> var" where 
+"var_decode 0 = Stage"|
+"var_decode (Suc v) = (Var (variable_decode v))"
+
+lemma var_id: "var_decode (var_encode x) = x"
+  apply (cases x)
+   apply (auto simp add:variable_id)
+  done
+
+fun dom_encode :: "dom \<Rightarrow> nat" where 
+"dom_encode NonInit = 0"|
+"dom_encode Init = Suc 0"|
+"dom_encode (DE d) = Suc (Suc (domain_element_encode d))"
+
+fun dom_decode :: "nat \<Rightarrow> dom" where 
+"dom_decode 0 = NonInit"|
+"dom_decode (Suc 0) = Init"|
+"dom_decode (Suc (Suc d)) = DE (domain_element_decode d)"
+
+lemma dom_id : "dom_decode (dom_encode x) = x"
+ apply (cases x)
+   apply (auto simp add:domain_element_id simp del: domain_element_decode.simps)
+  done
+
+fun sas_plus_assignment_encode:: "(var,dom) assignment \<Rightarrow> nat" where 
+  "sas_plus_assignment_encode (v,d) = prod_encode(var_encode v, dom_encode d)"
+
+fun sas_plus_assignment_decode:: " nat \<Rightarrow> (var,dom) assignment" where 
+  "sas_plus_assignment_decode n = (case prod_decode n of (v,d) \<Rightarrow> 
+                                (var_decode v, dom_decode d))"
+
+lemma sas_plus_assignment_id: 
+      "sas_plus_assignment_decode (sas_plus_assignment_encode x) = x"
+  apply (cases x)
+  apply (auto simp add:var_id dom_id)
+  done
+
+definition sas_plus_assignment_list_encode ::  "(var,dom) assignment list \<Rightarrow> nat "
+  where "sas_plus_assignment_list_encode x = list_encode (map sas_plus_assignment_encode x)"
+
+definition sas_plus_assignment_list_decode ::  "nat \<Rightarrow> (var,dom) assignment list"
+  where "sas_plus_assignment_list_decode x = map sas_plus_assignment_decode (list_decode x)"
+
+lemma sas_plus_assignment_list_id:
+    "sas_plus_assignment_list_decode ( sas_plus_assignment_list_encode x) = x"
+  apply (auto simp add: sas_plus_assignment_list_encode_def  sas_plus_assignment_list_decode_def comp_def
+        sas_plus_assignment_id  simp del: sas_plus_assignment_decode.simps)
+  done
+
+fun islist_encode :: "(dom \<times> (variable,domain_element) assignment list) \<Rightarrow> nat" where 
+"islist_encode (i,s) = prod_encode (dom_encode i, sas_assignment_list_encode s)"
+
+fun islist_decode :: "nat \<Rightarrow> (dom \<times> (variable,domain_element) assignment list)" where 
+"islist_decode n = (case prod_decode n of (i,s) \<Rightarrow> 
+         (dom_decode i, sas_assignment_list_decode s))"
+
+lemma islist_id: "islist_decode(islist_encode x) = x"
+  apply (cases x)
+  apply (auto simp only: islist_decode.simps islist_encode.simps prod_encode_inverse dom_id sas_assignment_list_id)
+  done
+
+fun islist_to_map:: "(dom \<times> (variable,domain_element) assignment list) \<Rightarrow> (dom \<times> sas_state) " where
+"islist_to_map (i,s) = (i,map_of s)"
+
+definition sas_plus_state_decode :: "nat \<Rightarrow> sas_plus_state" where
+"sas_plus_state_decode x = map_of (sas_plus_assignment_list_decode x)"
+
+type_synonym operator_plus = "(var, dom) sas_plus_operator"
+type_synonym problem_plus = "(var, dom) sas_plus_problem"
+
+definition operator_plus_encode :: "operator_plus \<Rightarrow> nat" where 
+"operator_plus_encode op = list_encode [sas_plus_assignment_list_encode (precondition_of op),
+                                    sas_plus_assignment_list_encode (effect_of op)] "
+
+definition operator_plus_decode :: " nat \<Rightarrow> operator_plus" where 
+"operator_plus_decode n =  ( case list_decode n of  [p,e] \<Rightarrow> 
+                       \<lparr>precondition_of = sas_plus_assignment_list_decode p,
+                        effect_of = sas_plus_assignment_list_decode e \<rparr> )  "
+
+lemma operator_plus_id : " operator_plus_decode (operator_plus_encode x) = x"
+  apply (auto simp add:operator_plus_decode_def operator_plus_encode_def sas_plus_assignment_list_id)
+  done
+
+fun the_nat :: "nat \<Rightarrow> nat" where 
+ "the_nat x = x-1"
+
+fun list_option_encode :: " nat list option \<Rightarrow> nat" where 
+"list_option_encode None = 0"|
+"list_option_encode (Some x) = Suc (list_encode x)"
+
+fun list_option_decode :: "nat \<Rightarrow>  nat list option" where 
+"list_option_decode 0 = None"|
+"list_option_decode (Suc x) = Some (list_decode x)"
+
+lemma list_option_id:"list_option_decode (list_option_encode x) = x"
+  apply (cases x)
+   apply (auto)
+  done
+
+lemma sub_the: " the_nat (list_option_encode x) = list_encode (thef x)"
+  apply (cases x)
+   apply (auto)
+  done  
+
+fun thefn :: "nat option \<Rightarrow> nat" where 
+"thefn None = 0"|
+"thefn (Some x) = x"
+
+lemma sub_the2: "the_nat (option_encode  x) = thefn x" 
+  apply (cases x)
+  apply auto
+  done
+  
+
+fun map_list_find ::"('a,'b) assignment list \<Rightarrow>'a \<Rightarrow> 'b option" where
+"map_list_find [] _ = None "|
+"map_list_find ((x,y)#xs) a = (if x =a then Some y else map_list_find xs a )"
+
+lemma sub_map_list_find: "map_list_find xs a = (map_of xs) a"
+  apply (induct xs)
+   apply auto
+  done
+
+fun map_list_find_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_list_find_nat xs a = (if xs = 0 then 0 else if fst_nat (hd_nat xs) = a then some_nat (snd_nat (hd_nat xs))  
+  else map_list_find_nat (tl_nat xs) a) "
+
+lemma sub_map_list_find_nat:
+      "map_list_find_nat (list_encode (map prod_encode xs)) a =
+        option_encode (map_list_find xs a)"
+  apply (induct xs)
+   apply simp
+  apply (subst  map_list_find_nat.simps)
+  apply (auto simp only: list.simps sub_hd head.simps sub_fst fst_def sub_snd snd_def sub_some sub_tl tail.simps
+        map_list_find.simps )
+  apply auto
+  done
+
+fun vdlist_plus_encode :: "(var, dom list) assignment \<Rightarrow> nat" where 
+"vdlist_plus_encode (x,y) = prod_encode (var_encode x,list_encode (map dom_encode y))"
+
+fun vdlist_plus_decode ::  "nat \<Rightarrow> (var, dom list) assignment" where 
+"vdlist_plus_decode n = (case prod_decode n of (x,y) \<Rightarrow> (var_decode x, map dom_decode (list_decode y)))"
+
+lemma vdlist_plus_id: "vdlist_plus_decode (vdlist_plus_encode x) = x"
+  apply (cases x)
+  apply (simp add: comp_def var_id dom_id del:domain_element_decode.simps)
+  done
+
+definition list_problem_plus_encode ::
+    "(var,dom) sas_plus_list_problem \<Rightarrow>nat" where 
+"list_problem_plus_encode x = list_encode [list_encode (map var_encode (variables_ofl x)),
+                                      list_encode (map operator_plus_encode (operators_ofl x)),
+                                      sas_plus_assignment_list_encode (initial_ofl x),
+                                       sas_plus_assignment_list_encode (goal_ofl x),
+                                       list_encode (map vdlist_plus_encode (range_ofl x)) ] "
+
+definition list_problem_plus_decode ::"nat \<Rightarrow> (var,dom) sas_plus_list_problem" where 
+"list_problem_plus_decode x = (case list_decode x of 
+[var,op,i,g,r]  \<Rightarrow> \<lparr>           variables_ofl = map var_decode (list_decode var),
+                               operators_ofl = map operator_plus_decode (list_decode op),
+                               initial_ofl = sas_plus_assignment_list_decode i,
+                               goal_ofl = sas_plus_assignment_list_decode g,
+                               range_ofl = map vdlist_plus_decode (list_decode r) \<rparr> )"
+
+lemma list_problem_plus_id : 
+      "list_problem_plus_decode (list_problem_plus_encode x) = x"
+  apply (auto simp only:list_problem_plus_encode_def list_problem_plus_decode_def list_encode_inverse)
+  apply (auto simp add: comp_def var_id operator_plus_id sas_plus_assignment_list_id vdlist_plus_id simp del: vdlist_plus_decode.simps)
+  done
+
+
+
+lemma sub_thefn: "the_nat (option_encode x) =thefn x"
+  apply (cases x)
+   apply (auto)
+  done
+
+definition fun_of :: "(vname,nat) assignment list \<Rightarrow> vname \<Rightarrow> nat" where 
+"fun_of x v =  (case (map_of x) v of None \<Rightarrow> 0 | Some x \<Rightarrow> x)"
+
+fun fun_list_find :: "('a,nat) assignment list \<Rightarrow> 'a \<Rightarrow> nat" where 
+"fun_list_find [] _ = 0"|
+"fun_list_find ((x,y)#xs) a = (if x= a then y else fun_list_find xs a)"
+
+lemma sub_fun_list_find:"fun_list_find xs a = fun_of xs a"
+  apply(induct xs)
+   apply (auto simp add:fun_of_def)
+  done
+
+fun fun_list_find_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"fun_list_find_nat xs a  = (if xs = 0 then 0 else if fst_nat (hd_nat xs) = a then snd_nat (hd_nat xs) else fun_list_find_nat (tl_nat xs) a) "
+
+
+lemma sub_fun_list_find_nat :
+ "fun_list_find_nat (list_encode (map prod_encode xs)) a = fun_list_find xs a"
+  apply (induct xs)
+   apply simp
+  apply (subst fun_list_find_nat.simps)
+  apply (auto simp only: list.simps list_encode_eq 
+        sub_hd head.simps sub_fst fst_def sub_snd snd_def sub_tl tail.simps 
+
+simp flip: list_encode.simps
+        
+ )
+  apply auto
+  done
+
+fun impm_assignment_encode :: "(vname,nat) assignment \<Rightarrow> nat" where 
+"impm_assignment_encode (v,n) = prod_encode (vname_encode v, n)"
+
+fun impm_assignment_decode :: " nat \<Rightarrow> (vname,nat) assignment" where 
+"impm_assignment_decode  x =  (case prod_decode x of (v,n) \<Rightarrow> (vname_decode v, n))"
+
+lemma impm_assignment_id:"impm_assignment_decode (impm_assignment_encode x) = x"
+  by (cases x) (auto simp add:vname_id)
+
+definition impm_assignment_list_encode ::  "(vname,nat) assignment list \<Rightarrow> nat" where 
+"impm_assignment_list_encode x = list_encode (map impm_assignment_encode x)"
+
+definition impm_assignment_list_decode ::  "nat \<Rightarrow> (vname,nat) assignment list" where 
+"impm_assignment_list_decode x = map impm_assignment_decode ( list_decode x)"
+
+lemma impm_assignment_list_id: 
+  "impm_assignment_list_decode (impm_assignment_list_encode x) = x"
+  apply (auto simp add: impm_assignment_list_decode_def  impm_assignment_list_encode_def)
+  apply (auto simp only: comp_def impm_assignment_id)
+  apply auto
+  done
+
+fun bit_option_encode :: "bit option \<Rightarrow> nat" where 
+"bit_option_encode None = 0"|
+"bit_option_encode (Some x) = Suc (bit_encode x)"
+
+fun bit_option_decode :: "nat \<Rightarrow> bit option" where 
+"bit_option_decode 0 = None"|
+"bit_option_decode (Suc n ) = Some (bit_decode n)"
+
+lemma bit_option_id : "bit_option_decode (bit_option_encode x) = x"
+  apply (cases x)
+   apply auto
+  done
+
+lemma inj_fun_list_find : "inj f \<Longrightarrow> fun_list_find (map (\<lambda>(x,y). (f x, y) ) xs) (f x) =
+fun_list_find xs x
+"
+  apply ( induct xs)
+   apply (auto simp add:inj_def)
+  done
+
+lemma inj_fun_list_find_plus : "inj f \<Longrightarrow> fun_list_find (map (\<lambda>(x,y). (f x, g y) ) xs) (f x) =
+fun_list_find (map (\<lambda>(x,y). (x , g y)) xs) x
+"
+  apply ( induct xs)
+   apply (auto simp add:inj_def)
+  done
+
+fun max_list :: "nat list \<Rightarrow> nat" where 
+"max_list [] = 0"|
+"max_list (x#xs) = max x (max_list xs)"
+
+fun max_list_nat :: "nat \<Rightarrow> nat" where 
+"max_list_nat xs = (if xs = 0 then 0 else max (hd_nat xs) (max_list_nat (tl_nat xs)))"
+
+lemma sub_max_list_nat: "max_list_nat (list_encode xs) = max_list xs"
+  apply (induct xs)
+  apply simp
+  apply (subst max_list_nat.simps)
+  apply (auto simp only: sub_tl tail.simps sub_hd head.simps)
+  apply auto
+  done
+
+lemma sub_max_list: "xs \<noteq> [] \<Longrightarrow> max_list xs = Max (set xs)"
+  apply (cases xs)
+    apply (auto simp add: Max.set_eq_fold )
+  apply (induct xs)
+   apply (auto)
+  using Max_insert
+  by (metis List.finite_set Max_singleton empty_iff list.set(1) list.set_intros(1)
+ list.simps(15) max_0R max_list.elims) 
+
+
+
+fun del :: "('a,'b) assignment list \<Rightarrow> 'a \<Rightarrow>  ('a,'b) assignment list" where 
+"del [] _ = []"|
+"del ((x,y)#xs) a = (if x = a then del xs a else (x,y)# del xs a)"
+
+fun del_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"del_nat xs a = (if xs =0 then 0 else if fst_nat (hd_nat xs) = a then del_nat (tl_nat xs) a else cons
+(hd_nat xs)  (del_nat (tl_nat xs) a) )"
+lemma sub_del: "del_nat (list_encode (map prod_encode xs)) a = list_encode (map prod_encode (del xs a))"
+  apply (induct xs)
+   apply simp
+  apply (subst del_nat.simps)
+  apply (simp only: sub_fst sub_hd sub_tl sub_cons list.simps head.simps tail.simps)
+  subgoal for ax xs
+    apply (cases ax)
+    apply auto
+    done
+  done
+
+lemma [termination_simp]:"length (del xs x) < Suc (length xs)"
+  apply (induct xs)
+   apply auto
+  done
+
+lemma del_correct: "\<forall>(x,y) \<in> set (del xs a). x \<noteq> a"
+  apply (induct xs)
+  apply auto
+  by (smt case_prod_conv set_ConsD)
+
+lemma del_correct_corr: " a \<noteq> x \<Longrightarrow> map_of (del xs a) x = map_of xs x"
+  apply (induct xs)
+   apply (auto split:if_splits)
+  done
+fun nub :: "('a,'b) assignment list \<Rightarrow> ('a,'b) assignment list" where 
+"nub [] = [] "|
+"nub ((x,y)#xs) = (x,y) # nub (del xs x) "
+
+lemma del_shorter : "length (del xs a) \<le> length xs"
+  apply (induct xs)
+   apply auto
+  done
+function nub_nat :: "nat \<Rightarrow> nat" where 
+"nub_nat xs = (if xs = 0 then 0 else (hd_nat xs) ## nub_nat (del_nat xs (fst_nat (hd_nat xs))))"
+  by pat_completeness auto
+termination
+  apply (relation "measure length_nat")
+   apply simp
+  apply (auto simp del: del_nat.simps)
+  subgoal for xs
+  proof -
+    assume asm:"0 < xs"
+    obtain ys where ys_def: "ys = map prod_decode (list_decode xs)" by simp
+    then have t:"xs = list_encode (map prod_encode ys)"
+      by (auto simp add: comp_def)
+    moreover have "ys \<noteq> []" using ys_def asm t by force
+    ultimately show  ?thesis  apply (auto simp only: t sub_del sub_length  length_map  sub_hd)
+      apply (auto simp add: sub_head_map sub_fst)
+      apply (cases ys)
+       apply auto
+      subgoal for a b xs
+        using del_shorter[of xs a] by simp
+      done
+  qed
+  done
+
+lemma sub_nub: "nub_nat (list_encode( map prod_encode xs)) = list_encode (map prod_encode (nub xs))"
+  apply (induct xs rule:nub.induct)
+   apply simp
+  apply (subst nub_nat.simps)
+  apply (auto simp only: sub_hd sub_cons  sub_del )
+  apply (auto simp add: sub_fst list_encode_eq sub_cons  simp del:nub_nat.simps list_encode.simps(2) simp flip: list_encode.simps(1))
+  done
+
+lemma del_includes: "set (del xs x) \<subseteq> set xs"
+  apply (induct xs)
+   apply (auto split:if_splits)
+  done
+
+lemma nub_includes: "set (nub xs) \<subseteq> set xs"
+  apply (induct xs rule: nub.induct)
+   apply (auto)
+  using del_includes apply fast
+   using del_includes apply fast  
+  done
+  
+lemma nub_correct : "distinct (map fst (nub xs))"
+  apply (induct xs rule:nub.induct)
+   apply auto
+  using nub_includes del_correct by fastforce 
+
+lemma map_of_nub_apply:"map_of (nub xs) x = map_of xs x"
+  apply (induct xs rule:nub.induct)
+   apply (auto simp add: del_correct_corr)
+  done
+lemma map_of_nub:"map_of (nub xs)  = map_of xs "
+  using map_of_nub_apply by fast
+
+
+definition ran_list :: "('a,'b) assignment list \<Rightarrow> 'b list" where 
+"ran_list xs = map snd (nub xs)"
+
+definition ran_nat :: "nat \<Rightarrow> nat" where 
+"ran_nat xs = map_nat snd_nat (nub_nat xs)"
+
+lemma sub_ran_nat : "ran_nat (list_encode (map prod_encode  xs)) = list_encode (ran_list xs) "
+  apply (auto simp only: ran_nat_def ran_list_def sub_nub sub_map map_map comp_def sub_snd)
+  done
+
+lemma sub_ran_list_helper : "distinct (map fst xs) \<Longrightarrow> 
+set (map snd xs) = ran (map_of xs)"
+  apply (induct xs)
+   apply (auto)
+    apply (meson fun_upd_same ranI)
+  apply (auto simp add: map_of_eq_None_iff)
+  done
+
+lemma sub_ran_list : "set (ran_list xs) = ran (map_of xs)"
+  apply (simp only:ran_list_def sub_ran_list_helper[of "nub xs"] nub_correct[of xs] map_of_nub ) 
+  done
+
+lemma ran_list_pre:"I \<noteq> [] \<Longrightarrow> ran_list I \<noteq> []"
+  apply (cases I)
+  apply (auto simp add:ran_list_def )
+  done
+lemma del_inj: "inj f \<Longrightarrow>del (map (\<lambda>(a, y). (f a, y)) I) (f a) = map (\<lambda>(a, y). (f a, y)) ( del I a) "
+  apply (induct I)
+   apply (auto simp add:inj_def)
+  done
+lemma nub_inj : "inj f \<Longrightarrow> nub (map (\<lambda>(a, y). (f a, y)) I) = map (\<lambda>(a, y). (f a, y)) (nub I)"
+  apply (induct I rule:nub.induct)
+   apply (auto simp add:inj_def del_inj)
+  done
+lemma ran_inj: "inj f \<Longrightarrow>ran_list (map (\<lambda>(a, y). (f a, y)) I) = ran_list I"
+  apply (induct I)
+   apply (auto simp add:ran_list_def inj_def nub_inj del_inj)
+  done
+
+lemma sub_restrict_apply: "map_of (map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,f x)) xs))) k  = (f |` set xs) k"
+  apply (induct xs)
+   apply auto
+  apply (metis restrict_in restrict_out)
+   apply (simp add: restrict_map_def)
+  apply(simp add: restrict_map_def)
+  done
+
+lemma sub_restrict: "map_of (map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,f x)) xs))) = (f |` set xs) "
+  using sub_restrict_apply by fast
+
+fun filter_nat ::"(nat\<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_nat f xs = (if xs = 0 then 0 else if f (hd_nat xs) then (hd_nat xs) ## (filter_nat f (tl_nat xs)) else (filter_nat f (tl_nat xs))) "
+
+lemma sub_filter: "filter_nat f (list_encode xs) = list_encode (filter f xs)"
+  apply (induct xs)
+  apply (simp)
+  apply (subst filter_nat.simps)
+  apply (auto simp only: sub_hd head.simps sub_tl tail.simps sub_cons )
+  apply auto
+  done
+
+lemma sub_restrict_map_nat: "map_nat (\<lambda>n. prod_encode(fst_nat n, the_nat (snd_nat n))) (filter_nat (\<lambda>n . snd_nat n \<noteq> 0) (map_nat (\<lambda>x. prod_encode(x,option_encode (f x))) (list_encode xs)))
+  = list_encode (map prod_encode (map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,f x)) xs))))"
+  apply (induct xs)
+   apply simp
+  apply (auto simp only: sub_map list.simps sub_fst sub_filter sub_the)
+  apply (auto simp add: sub_snd list_encode_eq sub_fst simp del: list_encode.simps)
+  using option_encode.elims by blast
+
+fun bit_option_to_option ::"bit option \<Rightarrow> nat option" where 
+"bit_option_to_option None = None"|
+"bit_option_to_option (Some x) = Some (bit_encode x)"
+
+lemma bit_option_encode_simps: "bit_option_encode = option_encode o bit_option_to_option"
+  apply (auto simp add:comp_def)
+  by (metis bit_option_encode.elims bit_option_encode.simps(2) bit_option_to_option.elims option.simps(3)
+ option_encode.elims some_nat_def sub_some)
+
+lemma inj_var: "inj var_encode"
+  apply (auto simp add:inj_def)
+  by (metis var_id)
+
+lemma inj_map_list_find : "inj f \<Longrightarrow> map_list_find (map (\<lambda>(x,y). (f x, g y)) s) (f x) =
+map_list_find (map (\<lambda>(x,y). (x, g y)) s) x"
+  apply (induct s)
+   apply (auto simp add:inj_def)
+  done
+
+lemma map_list_find_map:"map_list_find s x = Some y  \<Longrightarrow> map_list_find (map (\<lambda>(x,y). (x , f y)) s) x = Some (f y)"
+  apply (induct s arbitrary: x y)
+   apply auto
+  done
+lemma map_list_find_map_none: "( map_list_find (map (\<lambda>(x,y). (x , f y)) s) x = None) = (map_list_find s x = None)"
+  apply (induct s arbitrary: x )
+   apply auto
+  done
+
+fun bool_encode :: "bool \<Rightarrow> nat" where 
+"bool_encode False = 0"|
+"bool_encode True = 1"
+
+fun bool_decode :: "nat \<Rightarrow> bool" where 
+"bool_decode 0 = False"|
+"bool_decode (Suc x ) = True"
+
+lemma bool_id : "bool_decode (bool_encode x) = x"
+  by (cases x) auto
+
+fun strips_assignment_encode :: "((var,dom) assignment,bool) assignment \<Rightarrow> nat" where 
+"strips_assignment_encode (s,b) = prod_encode (sas_plus_assignment_encode s , bool_encode b)"
+
+fun strips_assignment_decode :: "nat \<Rightarrow> ((var,dom) assignment,bool) assignment" where 
+"strips_assignment_decode n = (case prod_decode n of (s,b) \<Rightarrow> 
+(sas_plus_assignment_decode s , bool_decode b))"
+
+lemma strips_assignment_id : "strips_assignment_decode (strips_assignment_encode x) = x"
+  apply (cases x)
+  apply (auto simp add:var_id dom_id bool_id)
+  done
+
+definition strips_assignment_list_encode :: "((var,dom) assignment,bool) assignment list \<Rightarrow> nat" where 
+"strips_assignment_list_encode  x = list_encode (map strips_assignment_encode x)"
+
+definition strips_assignment_list_decode :: "nat \<Rightarrow> ((var,dom) assignment,bool) assignment list" where 
+"strips_assignment_list_decode  x = map strips_assignment_decode (list_decode x)"
+
+lemma strips_assignment_list_id: "strips_assignment_list_decode (strips_assignment_list_encode x) = x"
+  apply (auto simp add: strips_assignment_list_encode_def strips_assignment_list_decode_def
+ )
+  apply (auto simp only:         comp_def strips_assignment_id)
+  apply auto
+  done
+
+lemma sas_plus_simp: "sas_plus_assignment_encode = prod_encode o (\<lambda>(v,d). (var_encode v, dom_encode d))"
+  by auto
+
+lemma option_encode_0 : "(option_encode x = 0) = (x = None)"
+  apply (cases x)
+   apply auto
+  done
+
+lemma sas_plus_list_simp: "sas_plus_assignment_list_encode = list_encode o (map sas_plus_assignment_encode)"
+  apply (auto simp add:comp_def sas_plus_assignment_list_encode_def)
+  done
+
+lemma fst_sas_simp : "fst_nat (sas_plus_assignment_encode x ) = var_encode (fst x)"
+  apply (cases x)
+  apply (auto simp add:sub_fst)
+  done
+
+lemma snd_sas_simp : "snd_nat (sas_plus_assignment_encode x ) = dom_encode (snd x)"
+  apply (cases x)
+  apply (auto simp add:sub_snd)
+  done
+
+    
+lemma dom_inj : "inj dom_encode"
+  apply (auto simp add:inj_def)
+  by (metis dom_id)
+    
+lemma dom_inj_simp : "(dom_encode a = dom_encode b) = (a=b)"
+  using dom_inj inj_def by metis
+
+fun strips_operator_encode :: "(var,dom) assignment strips_operator \<Rightarrow> nat" where 
+"strips_operator_encode op = list_encode [sas_plus_assignment_list_encode (strips_operator.precondition_of op),
+                                         sas_plus_assignment_list_encode (strips_operator.add_effects_of op),
+                                         sas_plus_assignment_list_encode (strips_operator.delete_effects_of op)]"
+
+
+fun strips_operator_decode :: "nat \<Rightarrow> (var,dom) assignment strips_operator " where 
+"strips_operator_decode n = (case list_decode n of [pre,add,delete] \<Rightarrow>
+      \<lparr>strips_operator.precondition_of = sas_plus_assignment_list_decode pre, 
+        strips_operator.add_effects_of =  sas_plus_assignment_list_decode add,
+        strips_operator.delete_effects_of =  sas_plus_assignment_list_decode delete \<rparr>)
+"
+
+lemma strips_operator_id: "strips_operator_decode (strips_operator_encode x) = x"
+  apply (auto simp add: sas_plus_assignment_list_id)
+  done
+
+record  ('variable) strips_list_problem =
+  variables_of :: "'variable list" ("(_\<^sub>\<V>)" [1000] 999)
+  operators_of :: "'variable strips_operator list" ("(_\<^sub>\<O>)" [1000] 999)
+  initial_of :: "('variable,bool) assignment list" ("(_\<^sub>I)" [1000] 999)
+  goal_of :: "('variable,bool) assignment list" ("(_\<^sub>G)" [1000] 999)
+
+fun strips_list_problem_to_problem ::
+ "('variable) strips_list_problem \<Rightarrow> ('variable)strips_problem" where 
+"strips_list_problem_to_problem P = 
+\<lparr>
+  strips_problem.variables_of = variables_of P,
+  operators_of = operators_of P,
+  initial_of = map_of (initial_of P),
+  goal_of = map_of (goal_of P)
+ \<rparr>"
+
+definition strips_operator_list_encode :: " (var,dom) assignment strips_operator list \<Rightarrow> nat" where 
+" strips_operator_list_encode xs = list_encode (map  strips_operator_encode xs)"
+
+definition strips_operator_list_decode :: " nat \<Rightarrow> (var,dom) assignment strips_operator list" where 
+" strips_operator_list_decode n = map  strips_operator_decode (list_decode n)"
+
+lemma strips_operator_list_id:
+"  strips_operator_list_decode ( strips_operator_list_encode x) = x"
+  apply (auto simp only:  strips_operator_list_decode_def  strips_operator_list_encode_def
+comp_def list_encode_inverse map_map strips_operator_id)
+  apply auto 
+  done
+
+fun strips_list_problem_encode :: "((var,dom) assignment) strips_list_problem \<Rightarrow> nat" where 
+"strips_list_problem_encode P = list_encode 
+[sas_plus_assignment_list_encode(variables_of P),
+strips_operator_list_encode (operators_of P),
+strips_assignment_list_encode (initial_of P),
+strips_assignment_list_encode (goal_of P)
+]"
+
+fun strips_list_problem_decode :: "nat \<Rightarrow> ((var,dom) assignment) strips_list_problem" where 
+"strips_list_problem_decode n = (case list_decode n of
+[vs,ops,I,gs] \<Rightarrow> \<lparr>
+  variables_of  = sas_plus_assignment_list_decode vs,
+  operators_of  = strips_operator_list_decode ops,
+  initial_of =  strips_assignment_list_decode I,
+  goal_of = strips_assignment_list_decode gs
+ \<rparr> )"
+
+lemma  strips_list_problem_id:
+"strips_list_problem_decode (strips_list_problem_encode x) = x"
+  apply (auto simp add:sas_plus_assignment_list_id strips_operator_list_id strips_assignment_list_id )
+  done
+
+fun sat_variable_encode :: "sat_plan_variable \<Rightarrow> nat" where 
+"sat_variable_encode (State x y) = list_encode [0,x,y]"|
+"sat_variable_encode (Operator x y) = list_encode [1,x,y]"
+
+fun sat_variable_decode :: "nat \<Rightarrow> sat_plan_variable" where 
+"sat_variable_decode n = (case list_decode n of [0,x,y] \<Rightarrow> State x y | [Suc 0, x ,y] \<Rightarrow> Operator x y)"
+
+lemma sat_variable_id :
+"sat_variable_decode(sat_variable_encode x) = x"
+  apply (cases x)
+   apply (auto)
+  done
+
+fun sat_formula_encode :: "sat_plan_formula \<Rightarrow> nat" where 
+"sat_formula_encode Bot = list_encode [0] "|
+"sat_formula_encode (Atom v) = list_encode [1, sat_variable_encode v] "|
+"sat_formula_encode (Not v) = list_encode[2, sat_formula_encode v]"|
+"sat_formula_encode (And a b) = list_encode[3,sat_formula_encode a,sat_formula_encode b]"|
+"sat_formula_encode (Or a b) = list_encode[4,sat_formula_encode a,sat_formula_encode b]"|
+"sat_formula_encode (Imp a b) = list_encode[5,sat_formula_encode a,sat_formula_encode b]"
+
+fun sat_formula_decode :: "nat \<Rightarrow> sat_plan_formula" where 
+"sat_formula_decode n =  (case list_decode n of
+  [0] \<Rightarrow> Bot|
+  [Suc 0,v] \<Rightarrow> Atom (sat_variable_decode v)|
+  [Suc (Suc 0),v] \<Rightarrow> Not (sat_formula_decode v)|
+  [Suc (Suc (Suc 0)),a,b] \<Rightarrow> And (sat_formula_decode a) (sat_formula_decode b)|
+  [Suc (Suc (Suc (Suc 0))),a,b] \<Rightarrow> Or (sat_formula_decode a) (sat_formula_decode b)|
+  [Suc (Suc (Suc (Suc (Suc 0)))),a,b] \<Rightarrow> Imp (sat_formula_decode a) (sat_formula_decode b)
+) "
+
+lemma sat_formula_id : 
+"sat_formula_decode (sat_formula_encode x) = x"
+  apply (induct x)
+  apply (auto simp add: sat_variable_id simp del: sat_variable_decode.simps)
+  done
+
+fun bool_option_encode :: "bool option \<Rightarrow> nat" where 
+"bool_option_encode None = 0"|
+"bool_option_encode (Some b) = Suc (bool_encode b)"
+
+fun bool_option_decode :: "nat \<Rightarrow> bool option" where 
+"bool_option_decode 0 = None"|
+"bool_option_decode (Suc b) = Some (bool_decode b)"
+
+lemma bool_option_id :
+"bool_option_decode (bool_option_encode b) = b"
+  apply (cases b)
+   apply (auto simp add:bool_id)
+  done
+
+fun index_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"index_nat xs a = (if xs = 0 then 0 else if hd_nat xs = a then 0 else 1 + index_nat (tl_nat xs) a)"
+
+lemma sub_index:
+"inj f \<Longrightarrow> index_nat (list_encode (map f xs)) (f a) = index xs a"
+  apply (induct xs)
+   apply simp
+  apply (subst index_nat.simps)
+  apply (auto simp add: sub_hd list_encode_eq sub_tl inj_def 
+          simp del:index_nat.simps simp flip:list_encode.simps)
+  done
+
+definition sat_formula_list_encode :: "sat_plan_formula list \<Rightarrow>nat" where 
+"sat_formula_list_encode xs = list_encode (map sat_formula_encode xs)"
+
+definition sat_formula_list_decode :: "nat \<Rightarrow> sat_plan_formula list" where 
+"sat_formula_list_decode n = map sat_formula_decode (list_decode n)"
+
+lemma sat_formula_list_id: 
+"sat_formula_list_decode (sat_formula_list_encode x) = x"
+  apply (auto simp add:sat_formula_list_decode_def sat_formula_list_encode_def)
+  using sat_formula_id 
+  by (simp add: map_idI)
+
+fun BigAnd_nat:: "nat \<Rightarrow> nat" where 
+"BigAnd_nat xs = (if xs=0 then 2##(0##0)##0 else 3##(hd_nat xs)##(BigAnd_nat (tl_nat xs))##0)"
+
+lemma sub_BigAnd:
+"BigAnd_nat (sat_formula_list_encode xs) = sat_formula_encode (BigAnd xs)"
+  apply (induct xs)
+  apply (simp add:sat_formula_list_encode_def sub_cons cons0  flip:list_encode.simps)
+  apply (subst BigAnd_nat.simps)
+  apply (auto simp add:sat_formula_list_encode_def sub_hd sub_tl sub_cons cons0 list_encode_eq simp flip:list_encode.simps
+simp del:BigAnd_nat.simps)
+  done
+
+fun BigOr_nat:: "nat \<Rightarrow> nat" where 
+"BigOr_nat xs = (if xs=0 then (0##0) else 4##(hd_nat xs)##(BigOr_nat (tl_nat xs))##0)"
+
+lemma sub_BigOr:
+"BigOr_nat (sat_formula_list_encode xs) = sat_formula_encode (BigOr xs)"
+  apply (induct xs)
+  apply (simp add:sat_formula_list_encode_def sub_cons cons0  flip:list_encode.simps)
+  apply (subst BigOr_nat.simps)
+  apply (auto simp add:sat_formula_list_encode_def sub_hd sub_tl sub_cons cons0 list_encode_eq simp flip:list_encode.simps
+simp del:BigOr_nat.simps)
+  done
+
+lemma strips_simp:"strips_assignment_encode = prod_encode o (\<lambda>(s,b). (sas_plus_assignment_encode s, bool_encode b))"
+  apply (auto)
+  done
+
+fun map_pair :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_pair x xs = (if xs = 0 then 0 else (prod_encode (x,hd_nat xs)) ## map_pair x (tl_nat xs))"
+
+lemma submap_pair:
+"map_pair (f x) (list_encode (map g xs)) = list_encode ( map (\<lambda>(x,y). prod_encode (f x, g y)) (map (Pair x) xs)) "
+  apply (induct xs)
+   apply simp
+  apply (subst map_pair.simps)
+  apply (auto simp add: sub_cons cons0 sub_hd sub_tl 
+list_encode_eq simp del: map_pair.simps
+simp flip: list_encode.simps 
+)
+  done
+fun product_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"product_nat xs ys = (if xs = 0 then 0 else append_nat (map_pair (hd_nat xs) ys) (product_nat (tl_nat xs) ys))"
+
+lemma sub_product:
+"product_nat (list_encode (map f xs)) (list_encode (map g ys)) 
+= list_encode (map (\<lambda>(x,y). prod_encode (f x, g y)) (List.product xs ys))"
+  apply (induct xs)
+   apply simp
+  apply (subst product_nat.simps)
+  apply (auto simp only: submap_pair list.simps sub_tl tail.simps sub_append map_map comp_def
+sub_hd head.simps)
+  apply (auto simp add: list_encode_eq)
+  done
+lemma sub_elem_of_inj: "inj f \<Longrightarrow> (elemof (f e) (list_encode (map f l)) \<noteq> 0) = (e \<in> set l)"
+  apply (induct l)
+   apply simp
+  apply (subst elemof.simps)
+  apply (auto simp add: inj_def 
+      list_encode_eq sub_hd sub_tl simp del:elemof.simps simp flip: list_encode.simps)
+  done
+
+end
\ No newline at end of file

From 7055c43d2e4aac4e44157e0876baf056caf2dd73 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Tue, 17 Aug 2021 18:54:29 +0200
Subject: [PATCH 006/103] slightly cleaned up proofs

---
 IMP-/Memory.thy | 83 +++++++++++++++++++++----------------------------
 1 file changed, 35 insertions(+), 48 deletions(-)

diff --git a/IMP-/Memory.thy b/IMP-/Memory.thy
index c3d3e889..1ecae973 100644
--- a/IMP-/Memory.thy
+++ b/IMP-/Memory.thy
@@ -154,10 +154,9 @@ proof (induction c1 s1 c2 s2 rule: small_step_induct)
       case (V x2)
       then show ?thesis
         using \<open>finite (range s)\<close> Parity
-        apply(auto simp only: intro!: Max_insert_le_when)
-        apply auto
-        apply(rule le_trans[where ?j="s x2"])
-        by(auto simp add: numeral_2_eq_2 intro!: trans_le_add1)
+        by(fastforce simp add: numeral_2_eq_2 
+                     intro!: trans_le_add1 Max_insert_le_when
+                     intro: le_trans[where ?j="s x2"])
     qed
   next
     case (RightShift x1)
@@ -172,10 +171,9 @@ proof (induction c1 s1 c2 s2 rule: small_step_induct)
       case (V x2)
       then show ?thesis
         using \<open>finite (range s)\<close> RightShift
-        apply(auto simp only: intro!: Max_insert_le_when)
-        apply auto
-        apply(rule le_trans[where ?j="s x2"])
-        by(auto simp add: numeral_2_eq_2 intro!: trans_le_add1)
+        by(fastforce simp add: numeral_2_eq_2 
+                     intro!: trans_le_add1 Max_insert_le_when 
+                     intro: le_trans[where ?j="s x2"])
     qed
   qed
 next
@@ -213,54 +211,43 @@ text \<open> We show that there always is a linear bound for the memory consumpt
 lemma linear_bound: "(c1, s1) \<Rightarrow>\<^bsup>t\<^esup> s2 \<Longrightarrow> finite (range s1)
   \<Longrightarrow> is_memory_bound c1 s1 ((num_variables c1) 
       * (t + bit_length (max 1 (max (Max (range s1)) (max_constant c1)))))"
-  apply (simp only: is_memory_bound_def)
-proof
+proof -
   let ?b = "(num_variables c1) 
       * (t + bit_length (max 1 (max (Max (range s1)) (max_constant c1))))"
 
   assume "(c1, s1) \<Rightarrow>\<^bsup>t\<^esup> s2" "finite (range s1)"
-  fix t'
-  show "\<forall>c' s'.
-             (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s') \<longrightarrow>
-             state_memory c' s' \<le> ?b"
-  proof
-    fix c'
-    show "\<forall>s'. (c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s') \<longrightarrow>
-               state_memory c' s' \<le> ?b"
-    proof 
-      fix s'
-      show "(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s') \<longrightarrow>
-               state_memory c' s' \<le> ?b"
-      proof
-        assume "(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')"
-
-        hence "finite (range s')"
-          using \<open>finite (range s1)\<close> finite_range_stays_finite
-          by auto
-
-        have "Max (range s') \<le> (2 ^ t') * (max (Max (range s1)) (max_constant c1))"
-          using Max_increase \<open>(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')\<close> \<open>finite (range s1)\<close> 
-          by auto
-        also have "... \<le> (2 ^ t) * (max (Max (range s1)) (max_constant c1))"
-          using small_step_cant_run_longer_than_big_step
-            \<open>(c1, s1) \<Rightarrow>\<^bsup>t\<^esup> s2\<close> \<open>(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')\<close>
-          by simp
-
-        finally have "state_memory c' s' \<le> num_variables c' 
+
+  have "(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s') \<Longrightarrow> state_memory c' s' \<le> ?b" for t' c' s'
+  proof -
+    assume "(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')"
+
+    hence "finite (range s')"
+      using \<open>finite (range s1)\<close> finite_range_stays_finite
+      by auto
+
+    have "Max (range s') \<le> (2 ^ t') * (max (Max (range s1)) (max_constant c1))"
+      using Max_increase \<open>(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')\<close> \<open>finite (range s1)\<close> 
+      by auto
+    also have "... \<le> (2 ^ t) * (max (Max (range s1)) (max_constant c1))"
+      using small_step_cant_run_longer_than_big_step
+        \<open>(c1, s1) \<Rightarrow>\<^bsup>t\<^esup> s2\<close> \<open>(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')\<close>
+      by simp
+
+    finally have "state_memory c' s' \<le> num_variables c' 
           * bit_length ((2 ^ t) * (max (Max (range s1)) (max_constant c1)))" 
-          using Max_register_bounds_state_memory[OF \<open>finite (range s')\<close>]
-          by (meson bit_length_monotonic dual_order.trans mult_le_cancel1)
-        also have "... \<le>  num_variables c' 
+      using Max_register_bounds_state_memory[OF \<open>finite (range s')\<close>]
+      by (meson bit_length_monotonic dual_order.trans mult_le_cancel1)
+    also have "... \<le>  num_variables c' 
           * bit_length ((2 ^ t) * (max 1 (max (Max (range s1)) (max_constant c1))))"
-          using bit_length_monotonic
-          by simp          
+      using bit_length_monotonic
+      by simp          
 
-        finally show "state_memory c' s' \<le> ?b"
-          using num_variables_not_increasing[OF \<open>(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')\<close>] order_trans
-          by(fastforce simp: bit_length_of_power_of_two)
-      qed
-    qed
+    finally show "state_memory c' s' \<le> ?b"
+      using num_variables_not_increasing[OF \<open>(c1, s1) \<rightarrow>\<^bsup>t'\<^esup> (c', s')\<close>] order_trans
+      by(fastforce simp: bit_length_of_power_of_two)
   qed
+
+  thus ?thesis by(auto simp: is_memory_bound_def)
 qed
 
 end

From 365d121684a55c26353ca641ce2c144f12c8bc96 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Tue, 17 Aug 2021 22:17:16 +0200
Subject: [PATCH 007/103] push everything to work on remote

---
 .../IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy    |   5 +-
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy  |  13 +++
 .../IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy      | 107 ++++++++++++++++--
 3 files changed, 110 insertions(+), 15 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
index 4a265478..7cfb0b46 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
@@ -118,9 +118,6 @@ lemma map_le_IMP_Minus_State_To_IMP_Minus_Minus_2:
 
 
 
-lemma foo :
-  assumes "p I"
-  shows "q (sat_decode (Imp_minus_to_sat_nat (imp_encode I) (r_encode r)))"
 lemma IMP_Minus_to_SAS_Plus_correctness:
   assumes
     "I \<subseteq>\<^sub>m Some \<circ> s1" 
@@ -342,7 +339,7 @@ proof -
         \<open>(?I|` set (enumerate_variables ?c')) \<subseteq>\<^sub>m s1\<close>
         less_le_trans[OF initial_state_element_less_two_to_the_max_input_bits[where ?c=c and ?r=r]]
         \<open>I v = Some y\<close> bit_at_index_geq_max_input_bits_is_zero_in_initial_state \<open>finite (ran I)\<close>
-      by(auto si mp add: map_comp_def 
+      by(auto simp add: map_comp_def 
            power_add 
           algebra_simps nth_append bit_list_to_nat_eq_nat_iff
           IMP_Minus_State_To_IMP_Minus_Minus_partial_def map_le_def
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
index 41d2b828..f0cd2669 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
@@ -94,6 +94,19 @@ proof-
     by(auto intro: SAS_Plus_to_IMP_Minus_correctness)
 qed
 
+definition foo :: "nat \<Rightarrow> nat" where 
+"foo x = 0"
+
+ definition f :: "nat \<Rightarrow> sat_plan_formula" where
+    "f x =
+      (let I = (Map.empty)(''input'' \<mapsto> x); 
+          G = (Map.empty)(''input'' \<mapsto> 0);
+          guess_range = x + 1 + 2 * 2 ^ (p_cer (bit_length x));
+          max_bits = max_input_bits c I guess_range
+      in
+        \<Phi>\<^sub>\<forall> (\<phi> prob_with_noop (IMP_Minus_to_SAS_Plus c I guess_range G (t' x)))
+           100 * (max_bits + (t' x) + 1) * ((t' x) - 1) +
+             (max_bits + (t' x) + 2) * (num_variables c + 2) + 52)"
 
 lemma main_lemma_hol:
   fixes c pt p_cer in_lang
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
index 577c0df1..65966f6a 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
@@ -12,13 +12,23 @@ lemma sublist_possible_assignments_for:
   apply (auto simp add: sub_map_list_find possible_assignments_for_list_def possible_assignments_for_def )
   done
 
+fun map_prodWith :: " nat \<Rightarrow> nat \<Rightarrow>  nat" where 
+"map_prodWith v n = (if n = 0 then 0 else (prod_encode(v,hd_nat n)) ## map_prodWith v (tl_nat n)) "
+
+lemma submap_prodWith :
+"map_prodWith v n = map_nat (\<lambda>a. prod_encode (v,a)) n"
+  apply (induct v n rule:map_prodWith.induct)
+  apply auto
+  done
+
 definition possible_assignments_for_nat
   :: "nat \<Rightarrow> nat \<Rightarrow> nat" 
-  where "possible_assignments_for_nat P v \<equiv> map_nat (\<lambda>a. prod_encode(v, a)) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"
+  where "possible_assignments_for_nat P v \<equiv> map_prodWith v (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"
 
 lemma vdlist_plus_simp:"vdlist_plus_encode = prod_encode o (\<lambda>(v,d). (var_encode v, list_encode (map dom_encode d)))"
   apply auto
   done
+
 lemma subnat_possible_assignments_for_pre:
   assumes "v \<in> set (variables_ofl P)"
   assumes " v \<in> set (variables_ofl P ) \<Longrightarrow> map_list_find  (range_ofl P)  v \<noteq> None"
@@ -27,7 +37,8 @@ lemma subnat_possible_assignments_for_pre:
 = sas_plus_assignment_list_encode (possible_assignments_for_list P v)"
   using inj_var assms
   apply auto
-  apply (auto simp only: possible_assignments_for_nat_def
+  apply (auto simp only: possible_assignments_for_nat_def 
+submap_prodWith
               list_problem_plus_encode_def sub_nth nth.simps
 sub_map_list_find_nat  inj_map_list_find[of var_encode]
             option_encode.simps the_nat.simps diff_Suc_1
@@ -117,12 +128,44 @@ state_to_strips_state (list_problem_to_problem P) (map_of s)"
 state_to_strips_state_def sublist_possible_assignments_for)
   done
 
+declare map_list_find_nat.simps [simp del]
+fun  map_find_eq:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_find_eq s n = 
+(if n = 0 then 0 else (prod_encode(hd_nat n, if the_nat (map_list_find_nat s (fst_nat (hd_nat n))) = snd_nat (hd_nat n) then 1 else 0)) ## map_find_eq s (tl_nat n))"
+
+
+lemma submap_find_eq: 
+"map_find_eq s n =  map_nat (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) n "
+  apply (induct s n rule: map_find_eq.induct)
+  apply (auto simp del:map_list_find_nat.simps)
+  done
+
+fun filter_defined :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \<noteq> 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))"
+
+lemma subfilter_defined :
+"filter_defined s n = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) n "
+  apply (induct s n rule: filter_defined.induct)
+  apply auto
+  done
+
+fun map_possible_assignments_for :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_possible_assignments_for s n = (if n = 0 then 0 else (possible_assignments_for_nat s (hd_nat n))
+## map_possible_assignments_for s (tl_nat n) ) "
+
+lemma submap_possible_assignments_for:
+"map_possible_assignments_for s n = map_nat (possible_assignments_for_nat s) n "
+  apply (induct s n rule:map_possible_assignments_for.induct)
+  apply auto
+  done
+
+
+
 definition state_to_strips_state_nat
   :: "nat \<Rightarrow>nat \<Rightarrow>nat" 
   where "state_to_strips_state_nat \<Psi> s 
-    \<equiv> let defined = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) (nth_nat 0 \<Psi>) in
-      map_nat (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) 
-        (concat_nat (map_nat (possible_assignments_for_nat \<Psi>)  defined))"
+    \<equiv> let defined = filter_defined s (nth_nat 0 \<Psi>) in
+      map_find_eq s (concat_nat (map_possible_assignments_for \<Psi> defined))"
 
 
 lemma subnat_state_to_strips_state_map:
@@ -143,7 +186,9 @@ lemma subnat_state_to_strips_state:
   assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
   shows "state_to_strips_state_nat (list_problem_plus_encode P) (sas_plus_assignment_list_encode s)
 = strips_assignment_list_encode (state_to_strips_state_list P s)"
-  apply (auto simp only:state_to_strips_state_nat_def list_problem_plus_encode_def sub_nth nth.simps)
+  apply (auto simp only:state_to_strips_state_nat_def subfilter_defined
+submap_possible_assignments_for      
+submap_find_eq list_problem_plus_encode_def sub_nth nth.simps)
   apply (auto simp only: simp flip: list_problem_plus_encode_def)
   apply (auto simp only:       sub_filter  sas_plus_assignment_list_encode_def sas_plus_simp sub_map_list_find_nat option_encode_0
                     filter_map
@@ -198,12 +243,40 @@ lemma sub_operator_for : "operator_for_nat (sas_plus_assignment_list_encode pre)
   done
 
 
+fun filter_diff_snd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_diff_snd n xs = (if xs = 0 then 0 else if (hd_nat xs) \<noteq> snd_nat n then (hd_nat xs) ## filter_diff_snd n (tl_nat xs) else filter_diff_snd n (tl_nat xs))"
+
+lemma subfilter_diff_snd :
+"filter_diff_snd n xs = filter_nat ((\<noteq>) (snd_nat n)) xs"
+  apply (induct n xs rule:filter_diff_snd.induct)
+  apply (auto)
+  done
+fun map_prod_fst :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_prod_fst n xs = (if xs = 0 then 0 else (prod_encode(fst_nat n,hd_nat xs)) ## map_prod_fst n (tl_nat xs))"
+
+lemma submap_prod_fst:
+"map_prod_fst n xs =  map_nat (\<lambda>a'. prod_encode(fst_nat n, a')) xs"
+  apply (induct n xs rule: map_prod_fst.induct)
+  apply (auto)
+  done
+
+fun map_sasp_op_to_strips:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+" map_sasp_op_to_strips P xs = (if xs=0 then 0 else (
+ map_prod_fst (hd_nat xs) (filter_diff_snd (hd_nat xs) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (fst_nat (hd_nat xs))
+)))) ##  map_sasp_op_to_strips P (tl_nat xs)) "
+
+lemma submap_sasp_op_to_strips:
+"map_sasp_op_to_strips P xs = map_nat (\<lambda>n. map_prod_fst n (filter_diff_snd n (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P ) (fst_nat n))))) xs "
+  apply (induct P xs rule: map_sasp_op_to_strips.induct)
+  apply auto
+  done
+
 definition sasp_op_to_strips_nat
   :: "nat \<Rightarrow>nat \<Rightarrow> nat " 
   where "sasp_op_to_strips_nat \<Psi> op \<equiv> let
       pre = nth_nat 0 op
       ; add = nth_nat (Suc 0)  op
-      ; delete = concat_nat (map_nat (\<lambda>n. map_nat (\<lambda>a'. prod_encode(fst_nat n, a')) (filter_nat ((\<noteq>) (snd_nat n)) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) \<Psi> ) (fst_nat n))))) (nth_nat (Suc 0) op))
+      ; delete = concat_nat (map_sasp_op_to_strips \<Psi>  (nth_nat (Suc 0) op))
     in operator_for_nat pre add delete"
 
 
@@ -274,7 +347,8 @@ lemma subnat_sasp_op_to_strips_pre:
 = 
 strips_operator_encode (sasp_op_to_strips_list P op)"
   apply (auto simp only:sasp_op_to_strips_nat_def operator_plus_encode_def sub_nth nth.simps
-          list_problem_plus_encode_def sub_map_list_find_nat vdlist_plus_simp
+subfilter_diff_snd  submap_sasp_op_to_strips  submap_prod_fst         
+list_problem_plus_encode_def sub_map_list_find_nat vdlist_plus_simp
 sas_plus_assignment_list_encode_def sub_map 
 
  simp flip: map_map )
@@ -362,12 +436,22 @@ lemma subnat_problem_for:
   apply (auto simp only: problem_for_nat_def sub_cons cons0 problem_for_list_def
 strips_list_problem_encode.simps strips_list_problem.simps) done
 
+fun maps_sasp_op_to_strips :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"maps_sasp_op_to_strips P xs = (if xs =0 then 0 else (sasp_op_to_strips_nat P (hd_nat xs)) 
+## maps_sasp_op_to_strips P (tl_nat xs))"
+
+lemma sub_maps_sasp_op_to_strips:
+"maps_sasp_op_to_strips P xs = map_nat (sasp_op_to_strips_nat P) xs"
+  apply (induct P xs rule:maps_sasp_op_to_strips.induct)
+  apply (auto)
+  done
+
 definition sas_plus_problem_to_strips_problem_nat
   :: "nat\<Rightarrow>nat" 
   ("\<phi> _ " 99)
   where "sas_plus_problem_to_strips_problem_nat \<Psi> \<equiv> let 
-      vs =  concat_nat (map_nat (possible_assignments_for_nat \<Psi>)(nth_nat 0 \<Psi>))
-      ; ops = map_nat (sasp_op_to_strips_nat \<Psi>) (nth_nat (Suc 0) \<Psi>)
+      vs =  concat_nat (map_possible_assignments_for \<Psi>(nth_nat 0 \<Psi>))
+      ; ops = maps_sasp_op_to_strips \<Psi> (nth_nat (Suc 0) \<Psi>)
       ; I = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc 0)) \<Psi>)
       ; G = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc (Suc 0))) \<Psi>)
     in problem_for_nat vs ops I G"
@@ -395,7 +479,8 @@ lemma subnat_sas_plus_problem_to_strips_problem:
   shows "sas_plus_problem_to_strips_problem_nat (list_problem_plus_encode P)
  =  strips_list_problem_encode (sas_plus_problem_to_strips_problem_list P)"
   apply (auto simp only: sas_plus_problem_to_strips_problem_nat_def
-list_problem_plus_encode_def sub_nth nth.simps 
+list_problem_plus_encode_def sub_nth nth.simps submap_possible_assignments_for 
+ sub_maps_sasp_op_to_strips
 )
   using assms  apply (auto simp only: sub_map
               subnat_possible_assignments_for map_map comp_def 

From 5a844e0cfde966e1cb5c9f6b7dea88290dcc4ed3 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Tue, 17 Aug 2021 22:58:19 +0200
Subject: [PATCH 008/103] ROOT file

---
 ROOT | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 ROOT

diff --git a/ROOT b/ROOT
new file mode 100644
index 00000000..3724850b
--- /dev/null
+++ b/ROOT
@@ -0,0 +1,4 @@
+session Poly_Reductions_Base = HOL + sessions NREST "HOL-Real_Asymp" Landau_Symbols
+
+theories 
+Polynomial_Growth_Functions Polynomial_Reductions
\ No newline at end of file

From 3f31fc82696a04e7e1dc91109457c28afdd8c919 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Wed, 18 Aug 2021 22:27:27 +0200
Subject: [PATCH 009/103] forgot to add file

---
 ...IMP_Minus_Minus_State_Translations_nat.thy | 392 ++++++++++++++++++
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      |  65 +++
 2 files changed, 457 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
new file mode 100644
index 00000000..8f121906
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
@@ -0,0 +1,392 @@
+theory IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat
+  imports   IMP_Minus_To_IMP_Minus_Minus_State_Translations Primitives Binary_Arithmetic_Nat
+begin
+
+ 
+fun dropWhile_char:: "nat \<Rightarrow> nat" where 
+"dropWhile_char n = (if n = 0 then 0 else if hd_nat n =encode_char(CHR ''#'') then dropWhile_char (tl_nat n) else n)"
+lemma subdropWhile_char :
+"dropWhile_char v =  dropWhile_nat (\<lambda>i. i = encode_char (CHR ''#'')) v"
+  apply (induct v rule:dropWhile_char.induct)
+  apply (auto)
+  done
+
+fun takeWhile_char:: "nat \<Rightarrow> nat" where 
+"takeWhile_char n = (if n = 0 then 0 else if hd_nat n =encode_char(CHR ''#'') then (hd_nat n) ## takeWhile_char (tl_nat n) else 0)"
+lemma subtakeWhile_char :
+"takeWhile_char v =  takeWhile_nat (\<lambda>i. i = encode_char (CHR ''#'')) v"
+  apply (induct v rule:takeWhile_char.induct)
+  apply (auto)
+  apply metis
+  done
+
+
+definition var_to_var_bit_nat :: "nat \<Rightarrow> nat" where
+"var_to_var_bit_nat v = (if length_nat v > 0 then (if hd_nat v = encode_char (CHR ''#'') 
+  then (let t = dropWhile_char v; 
+  l = length_nat (takeWhile_char v) - 1 in
+  (if length_nat t > 0 \<and> hd_nat t = encode_char(CHR ''$'') then some_nat (prod_encode(tl_nat t, l))
+   else 0))
+  else 0)
+  else 0)"
+
+fun vname_nat_encode :: "vname*nat \<Rightarrow> nat" where 
+"vname_nat_encode (v,n) = prod_encode (vname_encode v, n)"
+
+fun vname_nat_decode :: "nat \<Rightarrow> vname*nat" where 
+"vname_nat_decode n = (let (v,x) = prod_decode n in (vname_decode v ,x))"
+
+lemma vne [simp]: "vname_nat_decode (vname_nat_encode x) = x"
+proof auto
+have "\<forall>p. \<exists>cs n. (cs, n) = p \<and> prod_encode (vname_encode cs, n) = vname_nat_encode p"
+  by simp
+  then show "(case prod_decode (vname_nat_encode x) of (n, x) \<Rightarrow> (vname_decode n, x)) = x"
+    by (metis case_prod_conv idcharorg list.map_id list_encode_inverse
+        map_map prod_encode_inverse vname_decode_def vname_encode_def)
+qed
+  
+  
+fun vname_nat_option_encode :: "(vname* nat) option \<Rightarrow> nat" where 
+"vname_nat_option_encode None = 0"|
+"vname_nat_option_encode (Some x) = some_nat (vname_nat_encode x)"
+
+fun vname_nat_option_decode :: "nat \<Rightarrow> (vname* nat) option" where 
+"vname_nat_option_decode 0 = None"|
+"vname_nat_option_decode (Suc n) = Some (vname_nat_decode n)" 
+
+lemma [simp] :"vname_nat_option_decode (vname_nat_option_encode x) = x"
+  using vne
+  by (metis option.exhaust some_nat_def vname_nat_option_decode.simps(1)
+ vname_nat_option_decode.simps(2) vname_nat_option_encode.simps(1) vname_nat_option_encode.simps(2))
+
+
+
+
+lemma lambda_encode_char: "(\<lambda>i. i = encode_char x) \<circ> encode_char = (\<lambda>i. i = x)"
+  by (auto simp add: comp_apply idchar)
+
+lemma sub_var_to_var_bit: "var_to_var_bit_nat (vname_encode v) = vname_nat_option_encode (var_to_var_bit v)"
+  apply(auto simp only:  subtakeWhile_char subdropWhile_char var_to_var_bit_nat_def vname_encode_def sub_length sub_hd sub_dropWhile
+ sub_takeWhile Let_def sub_some sub_tl  var_to_var_bit_def sub_head_map sub_tail_map sub_head 
+     List.dropWhile_map List.takeWhile_map length_greater_0_conv lambda_encode_char length_map  vname_nat_option_encode.simps vname_nat_encode.simps split:if_splits ) 
+  apply (auto simp add: idcharorg idchar)
+  done
+
+fun n_hashes_nat :: "nat \<Rightarrow> nat" where 
+"n_hashes_nat 0 = 0" |
+"n_hashes_nat (Suc n) = cons (encode_char (CHR ''#'')) (n_hashes_nat n)"
+
+lemma sub_n_hashes : "n_hashes_nat n = vname_encode (n_hashes n)"
+  apply (induct n)
+   apply (auto simp only:vname_encode_def n_hashes_nat.simps n_hashes.simps sub_cons)
+   apply auto 
+  done
+
+
+definition var_bit_to_var_nat:: "nat \<Rightarrow> nat" where
+"var_bit_to_var_nat vk = append_nat (append_nat (n_hashes_nat (snd_nat vk + 1)) 
+    (vname_encode ''$'')) (fst_nat vk)" 
+thm "vname_nat_encode.simps"
+lemma sub_var_bit_to_var :
+"var_bit_to_var_nat (vname_nat_encode vk) = vname_encode (var_bit_to_var vk)"
+  apply (cases vk)
+  apply (auto simp only: var_bit_to_var_nat_def sub_snd vname_nat_encode.simps sub_n_hashes 
+vname_encode_def sub_append sub_fst fst_def var_bit_to_var_def)
+  by simp
+
+
+
+lemma [simp]:" 0 < snd_nat p \<Longrightarrow> prod_encode (fst_nat p, snd_nat p - Suc 0) < p"
+proof -
+  assume a:"0 < snd_nat p"
+  obtain x y where  "prod_decode p = (x,y)"
+    by fastforce 
+  hence xy_def: "p = prod_encode (x,y)"
+    by (metis prod_decode_inverse) 
+  thus ?thesis
+    using a apply (auto simp add: sub_fst sub_snd xy_def)
+    by (smt Suc_pred \<open>prod_decode p = (x, y)\<close>
+ add.commute add.right_neutral add_Suc add_le_cancel_left 
+cancel_comm_monoid_add_class.diff_cancel lessI less_eq_nat.simps(1) less_le_trans 
+not_le prod_decode_aux.simps prod_encode_def prod_encode_prod_decode_aux split_conv)
+qed    
+    
+fun operand_bit_to_var_nat:: "nat \<Rightarrow> nat" where 
+"operand_bit_to_var_nat p  = (if snd_nat p = 0 then cons (fst_nat p) 0 else cons (fst_nat p) 
+(operand_bit_to_var_nat (prod_encode (fst_nat p, snd_nat p - 1))))"
+
+fun char_nat_encode ::"char * nat \<Rightarrow> nat " where 
+"char_nat_encode (x,n) = prod_encode (encode_char x,n) "
+
+fun char_nat_decode ::" nat \<Rightarrow> (char * nat) " where 
+"char_nat_decode p = (let (x,n) = prod_decode p in (decode_char x,n))"
+
+lemma [simp]: "char_nat_decode (char_nat_encode x) = x"
+  apply (auto simp add:idcharorg)
+  by (metis case_prod_beta char_nat_encode.simps comp_apply id_apply idcharorg 
+prod.exhaust_sel prod.sel(1) prod_encode_inverse snd_conv)
+
+
+lemma sub_operand_bit_to_var:
+ "operand_bit_to_var_nat (char_nat_encode p) = vname_encode (operand_bit_to_var p)"
+  apply (cases p)
+  subgoal for a b
+    apply (induct b arbitrary:p)
+   apply (subst operand_bit_to_var_nat.simps)
+     apply (auto simp only: char_nat_encode.simps sub_fst sub_snd sub_cons
+ fst_def operand_bit_to_var.simps vname_encode_def )
+     apply (simp add:cons_def)
+    apply (subst operand_bit_to_var_nat.simps)
+     apply (auto simp only: char_nat_encode.simps sub_fst sub_snd sub_cons
+ fst_def operand_bit_to_var.simps vname_encode_def )
+    by (simp add: sub_cons)
+  done
+
+
+
+
+definition var_to_operand_bit_nat:: "nat \<Rightarrow> nat" where
+"var_to_operand_bit_nat v = (if v \<noteq> 0 \<and> v = (operand_bit_to_var_nat
+     (prod_encode(hd_nat v, length_nat v - 1))) 
+  then some_nat (prod_encode(hd_nat v, length_nat v - 1)) else 0)" 
+
+fun char_nat_option_encode :: "(char*nat) option \<Rightarrow> nat" where 
+"char_nat_option_encode None = 0"|
+"char_nat_option_encode (Some x) = Suc (char_nat_encode x)"
+
+fun char_nat_option_decode :: "nat \<Rightarrow> (char*nat) option" where
+"char_nat_option_decode 0 = None"|
+"char_nat_option_decode(Suc n) = Some (char_nat_decode n)"
+
+lemma [simp]: "char_nat_option_decode (char_nat_option_encode x) = x"
+  apply (cases x)
+   apply (auto simp add: idcharorg)
+  by (metis hd_map hd_of_operand_bit_to_var idcharorg list.map_id
+ map_is_Nil_conv map_map operand_bit_to_var_non_empty)
+
+lemma sub_head_enc_map: "vname_encode v \<noteq> 0 \<Longrightarrow> head ( map encode_char v) = encode_char (hd v)"
+  apply (auto simp add:vname_encode_def list_encode_eq 
+          simp flip: list_encode.simps)
+  using sub_head_map sub_head 
+  by (metis Nil_is_map_conv list.map_sel(1))
+
+lemma list_encode_non_empty: "(list_encode xs = 0) = (xs = [])"
+  using list_encode_eq by fastforce
+    
+lemma sub_var_to_operand_bit: 
+"var_to_operand_bit_nat (vname_encode v) = char_nat_option_encode (var_to_operand_bit v)"
+  apply (simp only: var_to_operand_bit_nat_def vname_encode_def sub_hd sub_length length_map
+      sub_head_enc_map var_to_operand_bit_def  sub_operand_bit_to_var sub_some flip: char_nat_encode.simps)
+  using sub_head_enc_map list_encode_non_empty map_is_Nil_conv  sub_operand_bit_to_var
+  by (smt char_nat_encode.simps char_nat_option_encode.simps(1) char_nat_option_encode.simps(2) 
+option_encode.simps(2) vname_encode_def vname_id)
+
+
+definition IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list:: 
+  "(vname,val) assignment list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> vname \<Rightarrow> bit option" where
+"IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list s n a b v =  
+  (case var_to_var_bit v of 
+  Some (v', k) \<Rightarrow> if k < n then Some (nth_bit (fun_list_find s v') k) else None |
+  None \<Rightarrow> (case var_to_operand_bit v of 
+    Some (CHR ''a'', k) \<Rightarrow> if k < n then Some (nth_bit a k) else None |
+    Some (CHR ''b'', k) \<Rightarrow> if k < n then Some (nth_bit b k) else None | 
+    _ \<Rightarrow> (if v = ''carry'' then Some Zero else None)))"
+
+lemma sublist_IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b:
+  " IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list s n a b v
+  =  IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b (fun_of s) n a b v"
+  apply (auto simp only:  IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list_def
+      sub_fun_list_find IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_def
+)
+  done
+
+definition IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat \<Rightarrow> nat" where
+"IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat s n a b v =  
+ ( if  var_to_var_bit_nat v \<noteq> 0 then 
+ ( let v' = fst_nat (var_to_var_bit_nat v -1) ; k = snd_nat (var_to_var_bit_nat v -1) in
+     if k < n then some_nat (nth_bit_nat (fun_list_find_nat  s v') k) else 0) 
+  else ( let  v' = fst_nat (var_to_operand_bit_nat v -1) ; k = snd_nat (var_to_operand_bit_nat v -1)
+             in if var_to_operand_bit_nat v \<noteq> 0 \<and> v' = encode_char( CHR ''a'') then 
+if k < n then Suc (nth_bit_nat a k) else 0 else if  var_to_operand_bit_nat v \<noteq> 0 \<and> v' = encode_char( CHR ''b'') 
+then if k < n then Suc (nth_bit_nat b k) else 0 else  
+   (if v = vname_encode (''carry'') then Suc 0 else 0)))"
+
+lemma impm_assignment_simp:"impm_assignment_encode = prod_encode o (\<lambda>(x,y).(vname_encode x,y))"
+  apply auto
+  done
+lemma vname_inj_simp: "(vname_encode x = vname_encode y) = (x=y)"
+  using vname_inj  apply (auto simp add:inj_def)
+  done
+lemma char_inj_simp: "(encode_char x = encode_char y) = (x=y)"
+  using idchar  apply (auto simp add:inj_def)
+  done
+
+lemma vname_nat_option_encode_0: "(vname_nat_option_encode x = 0) = (x = None)"
+  apply (cases x)
+   apply auto
+  done
+lemma bit_option_encode_0: "(bit_option_encode x = 0) = (x = None)"
+  apply (cases x)
+   apply auto
+  done
+
+lemma char_nat_option_encode_0: "(char_nat_option_encode x = 0) = (x = None)"
+  apply (cases x)
+   apply auto
+  done
+lemma subnat_IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b:
+"IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat (impm_assignment_list_encode s) n a b (vname_encode v)
+= 
+  bit_option_encode (IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list  s n a b v)
+"
+  apply (cases "var_to_var_bit v")
+     apply (cases "var_to_operand_bit v")
+  apply (auto simp add: IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat_def 
+      sub_var_to_var_bit)
+  
+      
+  using vname_inj  apply (auto simp only:Let_def sub_snd snd_def sub_fst fst_def sub_nth_bit  diff_Suc_1 vname_nat_option_encode.simps option_encode.simps sub_some vname_nat_encode.simps
+IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list_def   
+    impm_assignment_list_encode_def impm_assignment_simp  sub_var_to_operand_bit sub_fun_list_find_nat
+        inj_fun_list_find  vname_inj_simp split:if_splits
+  simp flip: One_nat_def map_map)
+  apply (auto simp add:sub_snd sub_fst bit_option_encode_0 vname_nat_option_encode_0 char_nat_option_encode_0 char_inj_simp)
+  apply (smt char.case char.exhaust option.distinct(1))
+  apply (smt char.case char.exhaust option.distinct(1))
+  done
+
+
+definition IMP_Minus_State_To_IMP_Minus_Minus_partial_list:: 
+  "(vname, nat) assignment list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> vname \<Rightarrow> bit option" where
+"IMP_Minus_State_To_IMP_Minus_Minus_partial_list s n r v = (case var_to_var_bit v of 
+  Some (v', k) \<Rightarrow> if k \<ge> r then Some Zero else 
+  (if k < n then map_list_find (map (\<lambda>(x,y). (x,nth_bit y k)) s) v' else None) |
+  None \<Rightarrow> (case var_to_operand_bit v of 
+    Some (CHR ''a'', k) \<Rightarrow> if k < n then Some Zero else None |
+    Some (CHR ''b'', k) \<Rightarrow> if k < n then Some Zero else None | 
+    _ \<Rightarrow> (if v = ''carry'' then Some Zero else None)))"
+
+lemma sub_lambda_partial: "((\<lambda>x. Some (nth_bit x k)) \<circ>\<^sub>m map_of s) v' = 
+              map_list_find (map (\<lambda>(x,y). (x,nth_bit y k)) s) v' "
+  apply (induct s)
+   apply (auto simp add:map_comp_def)
+  done
+
+lemma sublist_IMP_Minus_State_To_IMP_Minus_Minus_partial:
+"IMP_Minus_State_To_IMP_Minus_Minus_partial_list s n r v =
+IMP_Minus_State_To_IMP_Minus_Minus_partial (map_of s) n r v"
+  apply (auto simp only:IMP_Minus_State_To_IMP_Minus_Minus_partial_list_def
+IMP_Minus_State_To_IMP_Minus_Minus_partial_def
+sub_lambda_partial)
+  done
+
+fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial k n = 
+(if n =0 then 0 else (prod_encode(fst_nat (hd_nat n),nth_bit_nat (snd_nat (hd_nat n)) k)) ##  map_IMP_Minus_State_To_IMP_Minus_Minus_partial k (tl_nat n))"
+lemma submap_IMP_Minus_State_To_IMP_Minus_Minus_partial:
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial k s = map_nat (\<lambda>n. prod_encode(fst_nat n,nth_bit_nat (snd_nat n) k)) s"
+  apply (induct k s rule:map_IMP_Minus_State_To_IMP_Minus_Minus_partial.induct)
+  apply (auto)
+  done
+
+definition IMP_Minus_State_To_IMP_Minus_Minus_partial_nat:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_State_To_IMP_Minus_Minus_partial_nat s n r v = (
+let p = var_to_var_bit_nat v ; v' = fst_nat (p-1) ; k = snd_nat (p-1)
+in  if p \<noteq> 0 then  if k \<ge> r then Suc 0 else 
+  (if k < n then map_list_find_nat (map_IMP_Minus_State_To_IMP_Minus_Minus_partial k s) v' else 0) else
+      (let po = var_to_operand_bit_nat v ; vo = fst_nat (po-1) ; ko = snd_nat (po-1) in
+if po \<noteq> 0 \<and> vo = encode_char CHR ''a'' then  if ko < n then Suc 0 else 0 else if 
+po \<noteq> 0 \<and> vo = encode_char CHR ''b''then if ko < n then Suc 0 else 0 else 
+(if v = vname_encode ''carry'' then Suc 0 else 0)))"
+
+lemma snd_nat_0 :"snd_nat 0 = 0"
+  apply (auto simp add:snd_nat_def prod_decode_def prod_decode_aux.simps)
+  done
+lemma fst_nat_0 :"fst_nat 0 = 0"
+  apply (auto simp add:fst_nat_def prod_decode_def prod_decode_aux.simps)
+  done
+lemma fst_impm:"fst_nat (impm_assignment_encode x) = vname_encode (fst x)"
+  apply (cases x)
+  apply (auto simp add:sub_fst)
+  done
+
+lemma snd_impm:"snd_nat (impm_assignment_encode x) = snd x"
+  apply (cases x)
+  apply (auto simp add:sub_snd)
+  done
+
+
+  
+
+lemma subnat_IMP_Minus_State_To_IMP_Minus_Minus_partial:
+"IMP_Minus_State_To_IMP_Minus_Minus_partial_nat (impm_assignment_list_encode s) n r (vname_encode v)
+=
+bit_option_encode (IMP_Minus_State_To_IMP_Minus_Minus_partial_list s n r v)"
+  apply (cases "var_to_var_bit v")
+  apply (cases "var_to_operand_bit v")
+  apply (auto simp add:IMP_Minus_State_To_IMP_Minus_Minus_partial_nat_def
+      impm_assignment_list_encode_def  vname_nat_option_encode_0 )
+  apply (auto simp only: submap_IMP_Minus_State_To_IMP_Minus_Minus_partial)
+   apply (auto simp only:  Let_def sub_map sub_var_to_var_bit
+vname_inj_simp vname_nat_option_encode.simps zero_diff sub_snd sub_fst
+)
+     apply (auto simp only: snd_nat_0 fst_nat_0 sub_map_list_find_nat simp flip: comp_def [of 
+prod_encode "\<lambda>n.(fst_nat n,nth_bit_nat (snd_nat n) _ )"] map_map )
+     apply (auto simp only: map_map comp_def fst_impm snd_impm sub_nth_bit)
+     apply (auto simp add: IMP_Minus_State_To_IMP_Minus_Minus_partial_list_def sub_fst 
+sub_var_to_operand_bit fst_nat_0 bit_option_encode_0)
+                      apply (auto simp add:char_inj_simp sub_snd )
+    apply (smt char.case char.exhaust)
+   apply (smt char.case char.exhaust)
+  apply (induct s)
+   apply (auto simp add:vname_inj_simp)
+  done
+
+definition IMP_Minus_State_To_IMP_Minus_Minus_list:: "(vname,nat) assignment list \<Rightarrow> nat \<Rightarrow> vname \<Rightarrow> bit option" where
+"IMP_Minus_State_To_IMP_Minus_Minus_list s n v
+  = IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list s n 0 0 v"
+
+lemma sublist_IMP_Minus_State_To_IMP_Minus_Minus:
+"IMP_Minus_State_To_IMP_Minus_Minus_list s n v =
+IMP_Minus_State_To_IMP_Minus_Minus (fun_of s) n v"
+  apply (auto simp add: IMP_Minus_State_To_IMP_Minus_Minus_list_def  IMP_Minus_State_To_IMP_Minus_Minus_def
+        sublist_IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b)
+  done
+
+definition IMP_Minus_State_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_State_To_IMP_Minus_Minus_nat s n v
+  = IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat s n 0 0 v"
+
+lemma subnat_IMP_Minus_State_To_IMP_Minus_Minus:
+"IMP_Minus_State_To_IMP_Minus_Minus_nat (impm_assignment_list_encode s) n (vname_encode v) =
+bit_option_encode (IMP_Minus_State_To_IMP_Minus_Minus_list s n v)"
+  apply (auto simp add:IMP_Minus_State_To_IMP_Minus_Minus_nat_def IMP_Minus_State_To_IMP_Minus_Minus_list_def
+subnat_IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b
+)
+  done
+
+
+  
+    
+      
+      
+ 
+
+
+
+
+
+    
+
+    
+
+
+
+ 
+
+  
+  
+  
+end 
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
new file mode 100644
index 00000000..01f7e665
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -0,0 +1,65 @@
+theory IMP_Minus_To_IMP_Minus_Minus_nat 
+  imports  IMP_Minus_To_IMP_Minus_Minus  "../IMP_Minus_Max_Constant_Nat" "Binary_Operations_Nat"
+begin
+
+
+fun map_var_bit_to_var:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_var_bit_to_var v n = (if n =0 then 0 else (var_bit_to_var_nat (prod_encode (v,hd_nat n)))## map_var_bit_to_var v (tl_nat n)  )"
+
+lemma submap_var_bit_to_var :
+"map_var_bit_to_var v n =  map_nat (\<lambda>i. var_bit_to_var_nat (prod_encode (v,i))) n "
+  apply (induct v n rule:map_var_bit_to_var.induct)
+  apply auto
+  done
+
+definition var_bit_list_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"var_bit_list_nat n v = map_var_bit_to_var v (list_less_nat n)"
+
+lemma sub_var_bit_list: "var_bit_list_nat n (vname_encode v) = vname_list_encode (var_bit_list n v)"
+  apply (simp only: submap_var_bit_to_var  var_bit_list_nat_def var_bit_list_def sub_var_bit_to_var sub_map sub_list_less
+        vname_list_encode_def
+ flip: vname_nat_encode.simps )
+  apply auto
+  by (metis comp_apply)
+
+
+declare nth_nat.simps[simp del]
+fun IMP_Minus_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_To_IMP_Minus_Minus_nat c n = (if c =0 \<or> hd_nat c = 0 then  0##0
+else if hd_nat c = 1 then assignment_to_binary_nat n (nth_nat (Suc 0) c) (nth_nat (Suc (Suc 0)) c)
+else if hd_nat c = 2 then
+2 ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc 0) c) n) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## 0
+else if hd_nat c = 3 then
+3 ## (var_bit_list_nat n (nth_nat (Suc 0) c)) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc (Suc(Suc 0))) c) n) ## 0
+else 
+4 ## (var_bit_list_nat n (nth_nat (Suc 0) c)) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## 0
+)"
+declare nth_nat.simps[simp]
+
+lemma sub_IMP_Minus_To_IMP_Minus_Minus:
+"IMP_Minus_To_IMP_Minus_Minus_nat (com_encode c) n = comm_encode (IMP_Minus_To_IMP_Minus_Minus c n)"
+  apply(induct c)
+      apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
+      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
+                sub_assignment_to_binary cons0)
+      apply simp
+       apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
+      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
+                sub_assignment_to_binary cons0)
+     apply simp
+      apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
+      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
+                sub_assignment_to_binary cons0 sub_cons)
+    apply simp
+   apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
+      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
+                sub_assignment_to_binary cons0 sub_cons sub_var_bit_list)
+   apply simp
+ apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
+      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
+                sub_assignment_to_binary cons0 sub_cons sub_var_bit_list)
+  apply simp
+  done
+
+
+end
\ No newline at end of file

From fe19cd21ffc61a27c225d94a5901adcf3a4c74b6 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Wed, 18 Aug 2021 22:30:44 +0200
Subject: [PATCH 010/103] reduction no longer existentially quantified +
 refined called functions to HOL-computable

---
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy |  4 +-
 .../IMP_Minus_Max_Constant_Nat.thy            |  2 +-
 .../IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy    |  2 +-
 .../IMP_Minus_To_SAS_Plus_Nat.thy             |  2 +-
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy  | 63 +++++++------------
 5 files changed, 29 insertions(+), 44 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index 71325e0e..5f53a71d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -1,12 +1,12 @@
 theory IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat
-  imports Primitives IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat  IMP_Minus_Minus_Subprograms_Nat
+  imports "../IMP-_To_IMP--/Primitives" IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat  IMP_Minus_Minus_Subprograms_Nat
  IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction  
 begin                               
 definition domain_nat :: "nat" where
 "domain_nat = list_encode [prod_encode(0,0), prod_encode(0,1)]"
 
 lemma sub_domain: "domain_nat = list_encode (map domain_element_encode domain)"
-  apply (auto simp add:domain_nat_def domain_def)
+  apply (auto simp add:domain_nat_def)
   done
 
 definition pc_to_com_nat :: "nat\<Rightarrow> nat" where
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index bc85eec2..6dc33f09 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -1,6 +1,6 @@
 theory IMP_Minus_Max_Constant_Nat
   imports "HOL-Library.Nat_Bijection"
- Primitives  IMP_Minus_Max_Constant 
+  "IMP-_To_IMP--/Primitives"  IMP_Minus_Max_Constant 
 begin
 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
index 7cfb0b46..b2fb8233 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
@@ -339,7 +339,7 @@ proof -
         \<open>(?I|` set (enumerate_variables ?c')) \<subseteq>\<^sub>m s1\<close>
         less_le_trans[OF initial_state_element_less_two_to_the_max_input_bits[where ?c=c and ?r=r]]
         \<open>I v = Some y\<close> bit_at_index_geq_max_input_bits_is_zero_in_initial_state \<open>finite (ran I)\<close>
-      by(auto simp add: map_comp_def 
+      by(auto si mp add: map_comp_def 
            power_add 
           algebra_simps nth_append bit_list_to_nat_eq_nat_iff
           IMP_Minus_State_To_IMP_Minus_Minus_partial_def map_le_def
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
index 85e6fd4f..5e6dccec 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
@@ -1,4 +1,4 @@
-theory IMP_Minus_To_SAS_Plus_Nat imports Primitives IMP_Minus_To_SAS_Plus IMP_Minus_Max_Constant_Nat
+theory IMP_Minus_To_SAS_Plus_Nat imports  "IMP-_To_IMP--/Primitives" IMP_Minus_To_SAS_Plus IMP_Minus_Max_Constant_Nat
 "IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat" "SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat" 
     "IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat"
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
index f0cd2669..8c313475 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
@@ -94,19 +94,19 @@ proof-
     by(auto intro: SAS_Plus_to_IMP_Minus_correctness)
 qed
 
-definition foo :: "nat \<Rightarrow> nat" where 
-"foo x = 0"
+definition t' ::"(nat \<Rightarrow> nat) \<Rightarrow> (nat\<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat"
+  where "t' pt p_cer x = (make_mono pt) (bit_length x + (make_mono p_cer) (bit_length x)) + 1"
 
- definition f :: "nat \<Rightarrow> sat_plan_formula" where
-    "f x =
+ definition imp_to_sat :: "Com.com \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> (nat\<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> sat_plan_formula" where
+    "imp_to_sat c pt p_cer x =
       (let I = (Map.empty)(''input'' \<mapsto> x); 
           G = (Map.empty)(''input'' \<mapsto> 0);
           guess_range = x + 1 + 2 * 2 ^ (p_cer (bit_length x));
           max_bits = max_input_bits c I guess_range
       in
-        \<Phi>\<^sub>\<forall> (\<phi> prob_with_noop (IMP_Minus_to_SAS_Plus c I guess_range G (t' x)))
-           100 * (max_bits + (t' x) + 1) * ((t' x) - 1) +
-             (max_bits + (t' x) + 2) * (num_variables c + 2) + 52)"
+        \<Phi>\<^sub>\<forall> (\<phi> prob_with_noop (IMP_Minus_to_SAS_Plus c I guess_range G (t' pt p_cer x)))
+           100 * (max_bits + (t' pt p_cer x) + 1) * ((t' pt p_cer  x) - 1) +
+             (max_bits + (t' pt p_cer x) + 2) * (num_variables c + 2) + 52)"
 
 lemma main_lemma_hol:
   fixes c pt p_cer in_lang
@@ -133,12 +133,12 @@ lemma main_lemma_hol:
                          s' ''input'' = in_lang x"
   assumes verifier_has_registers:
     "''input'' \<in> set (IMP_Minus_Max_Constant.all_variables c)"
-  shows "\<exists>imp_to_sat t_red s_red.
+  shows "\<exists>t_red s_red.
          poly t_red 
        \<and> poly s_red
-       \<and> (\<forall>x. \<exists>f.  bit_length (encode_sat f) \<le> s_red ( bit_length x ) \<and> imp_to_sat x = f
+       \<and> (\<forall>x. \<exists>f.  bit_length (encode_sat f) \<le> s_red ( bit_length x ) \<and> imp_to_sat c pt p_cer x = f
                    \<and> (Sema.sat {f}  \<longleftrightarrow> in_lang x = 0))"
-proof-
+proof -
   define t''::"(char list \<Rightarrow> nat) \<Rightarrow> nat" where
     "t'' s = (make_mono pt) (bit_length (s ''input''))" for s
 
@@ -149,11 +149,8 @@ proof-
 
 
   text\<open>Upper bound on the time\<close>
-  define t'::"nat \<Rightarrow> nat"
-    where "t' x \<equiv> (make_mono pt) (bit_length x + (make_mono p_cer) (bit_length x)) + 1" for x
 
-
-  have t_bound_2: "\<exists>s' t. t \<le> t' x \<and> (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'"
+  have t_bound_2: "\<exists>s' t. t \<le> t' pt p_cer  x \<and> (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'"
     if "s ''input'' = x"
     for s x
   proof-    
@@ -162,10 +159,10 @@ proof-
       "t \<le> pt (bit_length (s ''input''))"
       using verifier_tbounded
       by blast+
-    have "t'' s \<le> t' (s ''input'')"
+    have "t'' s \<le> t' pt p_cer (s ''input'')"
       by (auto simp: t'_def t''_def le_make_mono order_trans
                intro!: le_SucI monoD[OF mono_make_mono])
-    hence "t \<le> t' (s ''input'')"
+    hence "t \<le> t' pt p_cer (s ''input'')"
       using t_bound \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s'\<close>
       by (smt bigstepT_the_cost less_le_trans not_le)
     thus ?thesis
@@ -173,19 +170,7 @@ proof-
       by auto
   qed
 
-  define f where
-    "f x \<equiv>
-      let I = (Map.empty)(''input'' \<mapsto> x); 
-          G = (Map.empty)(''input'' \<mapsto> 0);
-          guess_range = x + 1 + 2 * 2 ^ (p_cer (bit_length x));
-          max_bits = max_input_bits c I guess_range
-      in
-        \<Phi>\<^sub>\<forall> (\<phi> prob_with_noop (IMP_Minus_to_SAS_Plus c I guess_range G (t' x)))
-           100 * (max_bits + (t' x) + 1) * ((t' x) - 1) +
-             (max_bits + (t' x) + 2) * (num_variables c + 2) + 52"
-    for x::nat
-
-  have "Sema.sat {f x}"
+  have "Sema.sat {imp_to_sat c pt p_cer x}"
     if init: "in_lang x = 0"
     for x
   proof-
@@ -198,10 +183,10 @@ proof-
             "s' ''input'' = in_lang x"
       using verifier_terminates(1)[of x s, OF init]
       by auto
-    moreover hence "t'' (s(''certificate'' := z)) \<le> t' x"
+    moreover hence "t'' (s(''certificate'' := z)) \<le> t' pt p_cer x"
       by (auto simp: \<open>s ''input'' = x\<close> t'_def t''_def bit_length_def le_make_mono order_trans
                intro!: le_SucI monoD[OF mono_make_mono])
-    hence "t \<le> t' x"
+    hence "t \<le> t' pt p_cer x"
       using t_bound \<open>(c, s(''certificate'' := z)) \<Rightarrow>\<^bsup> t \<^esup> s'\<close>
       by (smt bigstepT_the_cost less_le_trans not_le)
     moreover have "[''input'' \<mapsto> x] \<subseteq>\<^sub>m Some \<circ> s(''certificate'' := z)"
@@ -212,8 +197,8 @@ proof-
       using \<open>bit_length z \<le> p_cer (bit_length x)\<close>
       apply(simp add: bit_length_def)
       by (metis le_iff_add log_exp2_ge mult.commute not_less power_of_two_increase_exponent_le)
-    ultimately have "\<exists>\<A>. \<A> \<Turnstile> f x"
-      unfolding Sema.sat_def f_def Let_def
+    ultimately have "\<exists>\<A>. \<A> \<Turnstile> imp_to_sat c pt p_cer x"
+      unfolding Sema.sat_def imp_to_sat_def Let_def
       by (fastforce simp add: s_def bit_length_def map_le_def init
                     intro!: while_program_has_model[of _ "s(''certificate'' := z)" _ _ s' _ t])
     thus ?thesis
@@ -221,20 +206,20 @@ proof-
   qed
 
   moreover have "in_lang x = 0"
-    if "Sema.sat {f x}"
+    if "Sema.sat {imp_to_sat c pt p_cer x}"
     for x
   proof-
-    obtain \<A> where "\<A> \<Turnstile> f x"
-      using \<open>Sema.sat {f x}\<close>
+    obtain \<A> where "\<A> \<Turnstile> imp_to_sat c pt p_cer x"
+      using \<open>Sema.sat {imp_to_sat c pt p_cer x}\<close>
       by (auto simp: Sema.sat_def)
-    hence "\<exists>s1 s2 t''. t'' \<le> t' x \<and> [''input'' \<mapsto> x] \<subseteq>\<^sub>m Some \<circ> s1 \<and>
+    hence "\<exists>s1 s2 t''. t'' \<le> t' pt p_cer  x \<and> [''input'' \<mapsto> x] \<subseteq>\<^sub>m Some \<circ> s1 \<and>
                        [''input'' \<mapsto> 0] \<subseteq>\<^sub>m Some \<circ> s2 \<and> (c, s1) \<Rightarrow>\<^bsup> t'' \<^esup> s2"
       apply(intro if_there_is_model_then_program_terminates 
                     [where \<A> = \<A> and r = "x + 1 + 2 * 2 ^ (p_cer (bit_length x))"])
       using verifier_has_registers
-      by (auto simp: map_le_def f_def Let_def intro: t_bound_2 )
+      by (auto simp: map_le_def imp_to_sat_def Let_def intro: t_bound_2 )
     then obtain s1 s2 t'' 
-      where "t'' \<le> t' x" "[''input'' \<mapsto> x] \<subseteq>\<^sub>m Some \<circ> s1"
+      where "t'' \<le> t' pt p_cer x" "[''input'' \<mapsto> x] \<subseteq>\<^sub>m Some \<circ> s1"
             "[''input'' \<mapsto> 0] \<subseteq>\<^sub>m Some \<circ> s2" "(c, s1) \<Rightarrow>\<^bsup> t'' \<^esup> s2"
       by auto
     moreover hence "s2 ''input'' = 0" "s1 ''input'' = x"

From b4c26f526e607e91a8dd208e241986962c13c7cd Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Wed, 18 Aug 2021 22:51:11 +0200
Subject: [PATCH 011/103] forgot to add file

---
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     | 162 ++++++++++++++++++
 1 file changed, 162 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
new file mode 100644
index 00000000..07e4123a
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -0,0 +1,162 @@
+theory IMP_Minus_To_SAT_Nat 
+  imports IMP_Minus_To_SAS_Plus_Nat IMP_Minus_To_SAT SAT_Plan_Base_Nat "IMP-_To_IMP--/Primitives"  
+begin
+
+fun poly_of :: "nat*nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"poly_of (a,0) x = a"|
+"poly_of (a,Suc n) x = x * poly_of (a,n) x"
+
+lemma mono_poly_of: "mono (poly_of p)"
+  apply (auto simp add:incseq_def)
+  apply (cases p)
+  subgoal for m n a b
+    apply auto
+    apply(induct b arbitrary: p)
+     apply auto
+    using mult_le_mono by presburger
+  done
+
+lemma make_mono_mono_apply:"mono f \<Longrightarrow> make_mono f x = f x"
+  apply(induct x)
+   apply (auto simp add:incseq_def make_mono_def)
+  by (simp add: antisym)
+
+lemma make_mono_mono: "mono f \<Longrightarrow> make_mono f =f"
+  using make_mono_mono_apply by blast
+
+lemma sub_make_mono: "make_mono (poly_of p) = poly_of p"
+  using mono_poly_of  make_mono_mono
+  by presburger 
+      
+
+definition t'_pair :: "(nat*nat) \<Rightarrow> (nat*nat) \<Rightarrow> nat \<Rightarrow> nat" where 
+"t'_pair pt p_cer x = poly_of pt (bit_length x + poly_of p_cer (bit_length x)) + 1"
+
+lemma subpair_t':
+"t'_pair pt p_cer x = t' (poly_of pt) (poly_of p_cer) x"
+  apply (auto simp add: t'_pair_def t'_def sub_make_mono)
+  done
+lemma [termination_simp]: "0 < snd_nat p \<Longrightarrow> prod_encode (fst_nat p, snd_nat p - Suc 0) < p"
+proof-
+  assume asm: "0 < snd_nat p"
+  obtain a b where "p = prod_encode(a,b)"
+    by (metis prod_decode_aux.cases prod_decode_inverse)
+  thus ?thesis using asm apply (auto simp add:sub_fst sub_snd) apply (auto simp add: prod_encode_def)
+    by (metis Groups.add_ac(2) Suc_pred add_diff_cancel_left' le_add1 linorder_not_less not_less_eq_eq plus_nat.simps(2) triangle_Suc)
+qed
+  
+fun poly_of_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"poly_of_nat p x = (if snd_nat p = 0 then fst_nat p else x * poly_of_nat (prod_encode (fst_nat p,snd_nat p -1)) x)"
+
+lemma sub_poly_of: "poly_of_nat (prod_encode p) x = poly_of p x"
+  apply (cases p)
+  apply (auto simp only:)
+  subgoal for a b
+    apply (induct b arbitrary:p)
+     apply (subst poly_of_nat.simps)
+    apply (auto simp add: sub_fst sub_snd simp del:poly_of_nat.simps)
+     apply (subst poly_of_nat.simps)
+    apply (auto simp add: sub_fst sub_snd simp del:poly_of_nat.simps)
+    done
+  done
+
+definition t'_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"t'_nat pt p_cer x = poly_of_nat pt (bit_length x + poly_of_nat p_cer (bit_length x)) + 1"
+
+lemma subnat_t': 
+"t'_nat (prod_encode pt) (prod_encode p_cer) x = t'_pair pt p_cer x"
+  apply (auto simp only:t'_nat_def t'_pair_def sub_poly_of)
+  done
+
+definition "empty_sasp_action_nat \<equiv> (0 ## 0 ## 0)"
+lemma sub_empty_sasp_action: "empty_sasp_action_nat = operator_plus_encode empty_sasp_action"
+  apply (auto simp only:cons0 sub_cons 
+        empty_sasp_action_nat_def empty_sasp_action_def operator_plus_encode_def list_encode_eq
+            sas_plus_assignment_list_encode_def
+        simp flip: list_encode.simps)
+   apply auto
+  done
+
+definition
+  "prob_with_noop_list \<Pi> \<equiv>
+     \<lparr> variables_ofl = variables_ofl \<Pi>,
+      operators_ofl = empty_sasp_action # operators_ofl \<Pi>, 
+      initial_ofl = initial_ofl \<Pi>,
+      goal_ofl = goal_ofl \<Pi>,
+      range_ofl = range_ofl \<Pi>\<rparr>"
+
+lemma sublist_prob_with_noop: 
+"list_problem_to_problem (prob_with_noop_list \<Pi>) = prob_with_noop  (list_problem_to_problem \<Pi>)"
+  apply (auto simp add: prob_with_noop_list_def prob_with_noop_def)
+  done
+
+definition encode_interfering_operator_pair_exclusion_list
+  :: "'variable strips_list_problem
+    \<Rightarrow> nat
+    \<Rightarrow> 'variable strips_operator
+    \<Rightarrow> 'variable strips_operator
+    \<Rightarrow> sat_plan_variable formula"
+  where "encode_interfering_operator_pair_exclusion_list \<Pi> k op\<^sub>1 op\<^sub>2
+    \<equiv> let ops = operators_of \<Pi> in
+      \<^bold>\<not>(Atom (Operator k (index ops op\<^sub>1)))
+      \<^bold>\<or> \<^bold>\<not>(Atom (Operator k (index ops op\<^sub>2)))"
+
+lemma sublist_encode_interfering_operator_pair_exclusion:
+"encode_interfering_operator_pair_exclusion_list \<Pi> k op\<^sub>1 op\<^sub>2
+= encode_interfering_operator_pair_exclusion (strips_list_problem_to_problem \<Pi>) k op\<^sub>1 op\<^sub>2
+"
+  apply (auto simp add:encode_interfering_operator_pair_exclusion_list_def 
+encode_interfering_operator_pair_exclusion_def)
+  done
+
+
+definition encode_interfering_operator_exclusion_list
+  :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula"
+  where "encode_interfering_operator_exclusion_list \<Pi> t \<equiv> let
+      ops = operators_of \<Pi>
+      ; interfering = filter (\<lambda>(op\<^sub>1, op\<^sub>2). index ops op\<^sub>1 \<noteq> index ops op\<^sub>2
+        \<and> are_operators_interfering op\<^sub>1 op\<^sub>2) (List.product ops ops)
+    in BigAnd (concat (map (\<lambda>(op\<^sub>1, op\<^sub>2). map (\<lambda>k. encode_interfering_operator_pair_exclusion_list \<Pi> k op\<^sub>1 op\<^sub>2)
+      [0..<t]) interfering ))"
+
+lemma sublist_encode_interfering_operator_exclusion:
+"encode_interfering_operator_exclusion_list \<Pi> t
+= encode_interfering_operator_exclusion (strips_list_problem_to_problem \<Pi>) t "
+  apply (auto simp add:encode_interfering_operator_exclusion_list_def
+encode_interfering_operator_exclusion_def
+    sub_foldr sublist_encode_interfering_operator_pair_exclusion
+)
+  done
+
+definition encode_problem_with_operator_interference_exclusion_list
+  :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula"
+  where "encode_problem_with_operator_interference_exclusion_list \<Pi> t
+    \<equiv> encode_initial_state_list \<Pi>
+      \<^bold>\<and> (encode_operators_list \<Pi> t
+      \<^bold>\<and> (encode_all_frame_axioms_list \<Pi> t
+      \<^bold>\<and> (encode_interfering_operator_exclusion_list \<Pi> t
+      \<^bold>\<and> (encode_goal_state_list \<Pi> t))))"
+
+lemma sublist_encode_problem_with_operator_interference_exclusion:
+"encode_problem_with_operator_interference_exclusion_list \<Pi> t
+= encode_problem_with_operator_interference_exclusion (strips_list_problem_to_problem \<Pi>) t"
+  apply (auto simp only: encode_problem_with_operator_interference_exclusion_list_def 
+encode_problem_with_operator_interference_exclusion_def
+    sublist_encode_initial_state sublist_encode_operators sublist_encode_all_frame_axioms
+    sublist_encode_interfering_operator_exclusion
+    sublist_encode_goal_state
+)
+  done
+
+ definition imp_to_sat_list :: "Com.com \<Rightarrow> (nat*nat) \<Rightarrow> (nat*nat) \<Rightarrow> nat \<Rightarrow> sat_plan_formula" where
+    "imp_to_sat_list c pt p_cer x =
+      (let I = [(''input'', x)]; 
+          G = [(''input'',0)];
+          guess_range = x + 1 + 2 * 2 ^ (poly_of p_cer (bit_length x));
+          max_bits = max_input_bits c I guess_range
+      in
+        \<Phi>\<^sub>\<forall> (\<phi> prob_with_noop (IMP_Minus_to_SAS_Plus c I guess_range G (t'_pair pt p_cer x)))
+           100 * (max_bits + (t'_pair pt p_cer x) + 1) * ((t'_pair pt p_cer x) - 1) +
+             (max_bits + (t'_pair pt p_cer x) + 2) * (num_variables c + 2) + 52)"
+
+end
\ No newline at end of file

From 297eef8e784bc3b5e7553d8669f16e4d23a8dadd Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Thu, 19 Aug 2021 19:34:35 +0200
Subject: [PATCH 012/103] implemented and verified multiplication in IMP-

---
 IMP-/Big_StepT.thy      |  23 ++++++
 IMP-/Multiplication.thy | 163 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 186 insertions(+)
 create mode 100644 IMP-/Multiplication.thy

diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 1468835d..d09e784a 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -107,6 +107,29 @@ done
 lemma bigstep_det: "(c1, s) \<Rightarrow>\<^bsup> p1 \<^esup> t1 \<Longrightarrow> (c1, s) \<Rightarrow>\<^bsup> p \<^esup> t \<Longrightarrow> p1=p \<and> t1=t"
   using big_step_t_determ2 by simp
 
+lemma seq_assign_t_simp:
+  "((c ;; x ::= a, s) \<Rightarrow>\<^bsup> Suc(Suc t) \<^esup>  s') 
+  \<longleftrightarrow> (\<exists>s''. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<and> s' = s''(x := aval a s''))"
+proof
+  assume "(c;; x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc t) \<^esup> s'"
+  then obtain s'' where "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''" by auto
+  have "s' = s''(x := aval a s'')" using \<open>(c;; x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc t) \<^esup> s'\<close>
+    using bigstep_det \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''\<close> 
+    by blast
+  thus "\<exists>s''. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<and> s' = s''(x := aval a s'')"
+    using \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''\<close> 
+    by blast
+qed auto
+
+lemma seq_assign_t_intro: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<Longrightarrow> s' = s''(x := aval a s'')
+  \<Longrightarrow>(c ;; x ::= a, s) \<Rightarrow>\<^bsup> Suc(Suc t) \<^esup>  s'"
+  using seq_assign_t_simp 
+  by auto
+
+lemma seq_is_noop[simp]: "(SKIP, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<longleftrightarrow> (t = Suc 0 \<and> s = s')" by auto
+
+lemma seq_skip[simp]: "(c ;; SKIP, s) \<Rightarrow>\<^bsup>Suc t\<^esup> s' \<longleftrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s'" by auto
+
 subsection "Progress property"
 text "every command costs time"
 lemma bigstep_progress: "(c, s) \<Rightarrow>\<^bsup> p \<^esup> t \<Longrightarrow> p > 0"
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
new file mode 100644
index 00000000..5500e1f3
--- /dev/null
+++ b/IMP-/Multiplication.thy
@@ -0,0 +1,163 @@
+\<^marker>\<open>creator Florian Kessler\<close>
+
+theory Multiplication
+  imports Big_Step_Small_Step_Equivalence "HOL-Library.Discrete"
+begin
+
+definition IMP_max_a_min_b where "IMP_max_a_min_b = 
+  ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
+  IF ''c'' \<noteq>0 
+  THEN
+    (SKIP ;; SKIP ;;
+     SKIP ;; SKIP ;;
+     SKIP ;; SKIP ;;
+     ''c'' ::= A (N 0))
+  ELSE
+    (''c'' ::= A (V ''a'') ;;
+    ''a'' ::= A (V ''b'') ;;
+    ''b'' ::= A (V ''c'') ;;
+    ''c'' ::= A (N 0))"
+
+lemma IMP_max_a_min_b_correct: 
+    "(IMP_max_a_min_b, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := max (s ''a'') (s ''b''),
+                                   ''b'' := min (s ''a'') (s ''b''), ''c'' := 0)" 
+proof(cases "(s ''a'') \<le> (s ''b'')")
+  case True
+  then show ?thesis
+    apply(auto simp: IMP_max_a_min_b_def numeral_eq_Suc
+        intro!: Seq[OF Big_StepT.Assign Big_StepT.IfFalse])
+    by(auto simp: assign_t_simp fun_eq_iff intro!: Seq)
+next
+  case False
+  then show ?thesis 
+    apply(auto simp: IMP_max_a_min_b_def numeral_eq_Suc seq_assign_t_simp 
+        intro!: Seq[OF Big_StepT.Assign Big_StepT.IfTrue])
+    by (auto simp: fun_eq_iff)
+qed
+
+definition mul_iteration where
+"mul_iteration = 
+  ''d'' ::= ((V ''b'') \<doteq>1) ;;
+  IF ''d'' \<noteq>0
+  THEN 
+    ''c'' ::= ((V ''c'') \<oplus> (V ''a''))
+  ELSE
+    (SKIP ;; SKIP) ;;
+  ''a'' ::= ((V ''a'') \<oplus> (V ''a'')) ;;
+  ''b'' ::= ((V ''b'') \<then>) ;;
+  ''d'' ::= A (N 0)"
+
+lemma terminates_in_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' = s'' \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s''"
+  by simp
+
+lemma mul_iteration_effect:
+  "(mul_iteration, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := 2 * s ''a'',
+                               ''b'' := s ''b'' div 2,
+                               ''c'' := (if s ''b'' mod 2 \<noteq> 0 then s ''c'' + s ''a'' else s ''c''),
+                               ''d'' := 0)"
+proof (cases "s ''b'' mod 2 \<noteq> 0")
+  case True
+  then show ?thesis
+    apply(simp only: mul_iteration_def)
+    apply(rule terminates_in_state_intro)
+    (* Why does it work only with intro? *)
+    apply(force simp: fun_eq_iff numeral_eq_Suc
+        intro: terminates_in_state_intro
+        intro!: Big_StepT.IfTrue)
+    by(auto simp: fun_eq_iff numeral_eq_Suc)
+next
+  case False
+  then show ?thesis
+  by(force simp: mul_iteration_def fun_eq_iff numeral_eq_Suc 
+        intro: terminates_in_state_intro)
+qed
+
+lemma mul_iteration_invariant:
+  assumes "s ''c'' + s ''a'' * s ''b'' = x * y" "(mul_iteration, s) \<Rightarrow>\<^bsup>t\<^esup> s'"
+  shows "s' ''c'' + s' ''a'' * s' ''b'' = x * y"
+proof -
+  have "s' = s(''a'' := 2 * s ''a'',
+               ''b'' := s ''b'' div 2,
+               ''c'' := (if s ''b'' mod 2 \<noteq> 0 then s ''c'' + s ''a'' else s ''c''),
+               ''d'' := 0)"
+    using bigstep_det mul_iteration_effect \<open>(mul_iteration, s) \<Rightarrow>\<^bsup>t\<^esup> s'\<close>
+    by blast
+  thus ?thesis
+    using \<open>s ''c'' + s ''a'' * s ''b'' = x * y\<close>[symmetric]
+    apply(auto simp: algebra_simps)
+    by (smt (z3) add_mult_distrib2 mod_mult_div_eq mult.assoc mult.commute mult_numeral_1 
+        numeral_1_eq_Suc_0)
+qed
+
+lemma mul_loop_correct:
+  assumes "s ''b'' = k"
+  shows "(WHILE ''b'' \<noteq>0 DO mul_iteration, s) 
+    \<Rightarrow>\<^bsup>12 * (if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')) + 2\<^esup> 
+    s(''a'' := s ''a'' * (2 :: nat) ^(if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')),
+      ''b'' := 0,
+      ''c'' := s ''c'' + s ''a'' * s ''b'',
+      ''d'' := (if s ''b'' = 0 then s ''d'' else 0))"
+  using assms
+proof(induction k arbitrary: s rule: less_induct )
+  case (less x)
+  thus ?case
+  proof (cases x)
+  next
+    case (Suc nat)
+    hence "s ''b'' \<noteq> 0" 
+      using \<open>s ''b'' = x\<close> 
+      by simp
+
+    let ?s' = "s(''a'' := 2 * s ''a'',
+                 ''b'' := s ''b'' div 2,
+                 ''c'' := (if s ''b'' mod 2 \<noteq> 0 then s ''c'' + s ''a'' else s ''c''),
+                 ''d'' := 0)"
+    let ?s'' = "?s'(''a'' := ?s' ''a'' 
+                      * (2 :: nat)^(if ?s' ''b'' = 0 then 0 else 1 + Discrete.log (?s' ''b'')),
+                  ''b'' := 0,
+                  ''c'' := ?s' ''c'' + ?s' ''a'' * ?s' ''b'',
+                  ''d'' := (if ?s' ''b'' = 0 then ?s' ''d'' else 0))"
+
+    have remaining_iterations: "(WHILE ''b'' \<noteq>0 DO mul_iteration, ?s') 
+      \<Rightarrow>\<^bsup>12 * (if ?s' ''b'' = 0 then 0 else 1 + Discrete.log (?s' ''b'')) + 2\<^esup> ?s''"
+      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> 
+      by (fastforce intro!: less.IH[where ?y = "x div 2"])
+
+    have s''_is_goal: "?s'' = 
+    s(''a'' := s ''a'' * (2 :: nat) ^(if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')),
+      ''b'' := 0,
+      ''c'' := s ''c'' + s ''a'' * s ''b'',
+      ''d'' := (if s ''b'' = 0 then s ''d'' else 0))"
+      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> 
+      apply(auto simp: fun_eq_iff)
+        apply (metis Discrete.log.simps One_nat_def div_less log_half neq0_conv power_Suc)
+       apply presburger
+      by (smt (z3) One_nat_def add.commute add_left_cancel add_mult_distrib2 
+          mult.commute mult_2 mult_Suc numeral_2_eq_2 odd_two_times_div_two_succ)
+
+    show ?thesis
+      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> \<open>s ''b'' \<noteq> 0\<close> log_rec remaining_iterations s''_is_goal
+      by (fastforce simp: Euclidean_Division.div_eq_0_iff
+          intro!: mul_iteration_effect Big_StepT.WhileTrue[
+            OF _ mul_iteration_effect
+            terminates_in_state_intro[OF remaining_iterations s''_is_goal]])
+  qed (force intro: terminates_in_state_intro)
+qed
+
+definition IMP_minus_mul where "IMP_minus_mul =
+  ''c'' ::= A (N 0) ;;
+  WHILE ''b'' \<noteq>0 DO mul_iteration ;;
+  ''a'' ::= A (N 0) ;;
+  ''d'' ::= A (N 0)" 
+
+lemma IMP_minus_mul_correct: 
+  shows "(IMP_minus_mul, s) 
+    \<Rightarrow>\<^bsup>12 * (if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')) + 8\<^esup> 
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := s ''a'' * s ''b'',
+      ''d'' := 0)"
+  using mul_loop_correct
+  by(force simp: IMP_minus_mul_def
+           intro!: terminates_in_state_intro[OF Seq[OF Seq[OF Seq]]])
+end
\ No newline at end of file

From 48b1bdcf645fd6f7199c0b86773c22b0c3c3130f Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Thu, 19 Aug 2021 21:27:04 +0200
Subject: [PATCH 013/103] refinement to HOL_nat + main_lemma_hol_nat

---
 ...IMP_Minus_Minus_State_Translations_nat.thy |   8 +-
 .../IMP_Minus_Max_Constant_Nat.thy            |  39 +--
 .../IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy    |   3 +-
 .../IMP_Minus_To_SAS_Plus_Nat.thy             | 127 +++-----
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     | 295 +++++++++++++++++-
 .../SAS_Plus_Plus_To_SAS_Plus_Nat.thy         |   6 +-
 6 files changed, 346 insertions(+), 132 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
index 8f121906..7dd16e5f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
@@ -260,8 +260,8 @@ IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_list_def
 definition IMP_Minus_State_To_IMP_Minus_Minus_partial_list:: 
   "(vname, nat) assignment list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> vname \<Rightarrow> bit option" where
 "IMP_Minus_State_To_IMP_Minus_Minus_partial_list s n r v = (case var_to_var_bit v of 
-  Some (v', k) \<Rightarrow> if k \<ge> r then Some Zero else 
-  (if k < n then map_list_find (map (\<lambda>(x,y). (x,nth_bit y k)) s) v' else None) |
+  Some (v', k) \<Rightarrow> if k \<ge> n then None else 
+  (if k < r then map_list_find (map (\<lambda>(x,y). (x,nth_bit y k)) s) v' else Some Zero) |
   None \<Rightarrow> (case var_to_operand_bit v of 
     Some (CHR ''a'', k) \<Rightarrow> if k < n then Some Zero else None |
     Some (CHR ''b'', k) \<Rightarrow> if k < n then Some Zero else None | 
@@ -294,8 +294,8 @@ definition IMP_Minus_State_To_IMP_Minus_Minus_partial_nat::
   "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
 "IMP_Minus_State_To_IMP_Minus_Minus_partial_nat s n r v = (
 let p = var_to_var_bit_nat v ; v' = fst_nat (p-1) ; k = snd_nat (p-1)
-in  if p \<noteq> 0 then  if k \<ge> r then Suc 0 else 
-  (if k < n then map_list_find_nat (map_IMP_Minus_State_To_IMP_Minus_Minus_partial k s) v' else 0) else
+in  if p \<noteq> 0 then  if k \<ge> n then 0 else 
+  (if k < r then map_list_find_nat (map_IMP_Minus_State_To_IMP_Minus_Minus_partial k s) v' else Suc 0) else
       (let po = var_to_operand_bit_nat v ; vo = fst_nat (po-1) ; ko = snd_nat (po-1) in
 if po \<noteq> 0 \<and> vo = encode_char CHR ''a'' then  if ko < n then Suc 0 else 0 else if 
 po \<noteq> 0 \<and> vo = encode_char CHR ''b''then if ko < n then Suc 0 else 0 else 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 6dc33f09..218e731c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -4,9 +4,6 @@ theory IMP_Minus_Max_Constant_Nat
 begin
 
 
-fun atomExp_to_constant:: "atomExp \<Rightarrow> nat" where
-"atomExp_to_constant (V var) = 0" |
-"atomExp_to_constant (N val) = val"
 
 definition atomExp_to_constant_nat:: "nat \<Rightarrow> nat" where 
 "atomExp_to_constant_nat n = (if fst_nat n = 0 then 0 else snd_nat n)"
@@ -17,13 +14,6 @@ lemma sub_atomExp_to_constant[simp]: "atomExp_to_constant_nat (atomExp_encode x)
   done
 
 
-fun aexp_max_constant:: "AExp.aexp \<Rightarrow> nat" where
-"aexp_max_constant (A a) = atomExp_to_constant a" |
-"aexp_max_constant (Plus a b) = max (atomExp_to_constant a) (atomExp_to_constant b)" |
-"aexp_max_constant (Sub a b) = max (atomExp_to_constant a) (atomExp_to_constant b)" |
-"aexp_max_constant (Parity a) = atomExp_to_constant a" | 
-"aexp_max_constant (RightShift a) = atomExp_to_constant a"
-
 fun aexp_max_constant_nat:: "nat \<Rightarrow> nat" where
 "aexp_max_constant_nat n = (if hd_nat n \<le>2 \<and> 1 \<le> hd_nat n 
 then max (atomExp_to_constant_nat (nth_nat (Suc 0) n)) (atomExp_to_constant_nat (nth_nat (Suc (Suc 0)) n))
@@ -38,14 +28,6 @@ lemma sub_aexp_max_constant:"aexp_max_constant_nat (aexp_encode x) = aexp_max_co
   done
 
   
-      
-fun max_constant :: "Com.com \<Rightarrow> nat" where
-"max_constant (Com.com.SKIP) = 0" |
-"max_constant (Com.com.Assign vname aexp) = aexp_max_constant aexp" |
-"max_constant (Com.com.Seq c1  c2) = max (max_constant c1) (max_constant c2)" |         
-"max_constant (Com.com.If  _ c1 c2) = max (max_constant c1) (max_constant c2)"  |   
-"max_constant (Com.com.While _ c) = max_constant c"
-
 lemma fst_less [simp]: "n >0 \<Longrightarrow>fst_nat n < n"
   apply (auto simp add:fst_nat_def)
   by (metis fst_conv leI le_add1 le_less_trans prod_decode_aux.cases prod_sum_less)
@@ -79,9 +61,7 @@ lemma sub_max_constant:"max_constant_nat (com_encode c) = max_constant c"
       apply auto
   done
 
-fun atomExp_var:: "atomExp \<Rightarrow> vname list" where
-"atomExp_var (V var) = [ var ]" |
-"atomExp_var (N val) = []"
+
 
 fun atomExp_var_nat:: "nat \<Rightarrow> nat" where
 "atomExp_var_nat n = (if fst_nat n = 0 then cons (snd_nat n) 0 else 0)"
@@ -93,12 +73,6 @@ lemma sub_atomExp_var: "atomExp_var_nat (atomExp_encode x) = vname_list_encode (
    apply (auto simp add:vname_list_encode_def cons_def sub_fst sub_snd prod_encode_eq)
   done
 
-fun aexp_vars:: "AExp.aexp \<Rightarrow> vname list" where
-"aexp_vars (A a) = atomExp_var a" |
-"aexp_vars (Plus a b) = (atomExp_var a) @ (atomExp_var b)" |
-"aexp_vars (Sub a b) = (atomExp_var a) @ (atomExp_var b)" |
-"aexp_vars (Parity a) = atomExp_var a" |
-"aexp_vars (RightShift a) = atomExp_var a"
 
 definition aexp_vars_nat:: "nat \<Rightarrow> nat" where
 "aexp_vars_nat n =  ( if hd_nat n = 1 \<or> hd_nat n = 2 then
@@ -112,12 +86,7 @@ lemma sub_aexp_vars : "aexp_vars_nat (aexp_encode x) = vname_list_encode (aexp_v
       apply auto
   done
 
-fun all_variables :: "Com.com \<Rightarrow> vname list" where
-"all_variables (Com.com.SKIP) = []" |
-"all_variables (Com.com.Assign v aexp) = v # aexp_vars aexp" |
-"all_variables (Com.com.Seq c1 c2) = all_variables c1 @ all_variables c2" |
-"all_variables (Com.com.If v c1 c2) = [ v ] @ all_variables c1 @ all_variables c2" |
-"all_variables (Com.com.While v c) = [ v ] @ all_variables c"
+
 
 declare nth_nat.simps[simp del]
 fun all_variables_nat :: "nat \<Rightarrow> nat" where
@@ -166,8 +135,6 @@ lemma sub_all_variables: "all_variables_nat (com_encode x ) = vname_list_encode
 
     
    
-definition num_variables:: "Com.com \<Rightarrow> nat" where
-"num_variables c = length (remdups (all_variables c))" 
 
 definition num_variables_nat :: "nat \<Rightarrow> nat" where 
 "num_variables_nat n = length_nat (remdups_nat (all_variables_nat n))"
@@ -179,7 +146,7 @@ lemma [simp]: "remdups (map (vname_encode) x) = map vname_encode (remdups x)"
   apply (induction x)
   using vname_encode_eq by auto
    
-lemma "num_variables_nat (com_encode c) = num_variables c"
+lemma sub_num_variables:"num_variables_nat (com_encode c) = num_variables c"
   apply (auto simp only:num_variables_nat_def sub_all_variables sub_remdups vname_list_encode_def
         sub_length num_variables_def)
   apply (induct "all_variables c"  arbitrary:c)
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
index b2fb8233..7d5865a0 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
@@ -339,6 +339,7 @@ proof -
         \<open>(?I|` set (enumerate_variables ?c')) \<subseteq>\<^sub>m s1\<close>
         less_le_trans[OF initial_state_element_less_two_to_the_max_input_bits[where ?c=c and ?r=r]]
         \<open>I v = Some y\<close> bit_at_index_geq_max_input_bits_is_zero_in_initial_state \<open>finite (ran I)\<close>
+      sorry
       by(auto si mp add: map_comp_def 
            power_add 
           algebra_simps nth_append bit_list_to_nat_eq_nat_iff
@@ -428,5 +429,5 @@ proof -
   show ?thesis using \<open>t'' \<le> t\<close> \<open>(c, ?s1') \<Rightarrow>\<^bsup>t''\<^esup> s2''\<close> \<open>I \<subseteq>\<^sub>m Some \<circ> ?s1'\<close> \<open>G \<subseteq>\<^sub>m Some \<circ> s2''\<close>
     by auto
 qed
-
+ 
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
index 5e6dccec..2495278a 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
@@ -4,9 +4,6 @@ theory IMP_Minus_To_SAS_Plus_Nat imports  "IMP-_To_IMP--/Primitives" IMP_Minus_T
 
 begin
 
-definition max_input_bits:: "IMP_Minus_com \<Rightarrow> (vname \<rightharpoonup> nat) \<Rightarrow> nat \<Rightarrow> nat" where
-"max_input_bits c I r = 
-  bit_length (max (max (Max (ran I)) r) (max_constant c))" 
 
 definition max_input_bits_list :: "IMP_Minus_com \<Rightarrow> (vname,nat) assignment list \<Rightarrow> nat \<Rightarrow> nat" where 
 " max_input_bits_list c I r = 
@@ -86,17 +83,6 @@ IMP_Minus_initial_to_IMP_Minus_Minus_list_def subnat_IMP_Minus_State_To_IMP_Minu
 
 
 
-definition IMP_Minus_to_SAS_Plus:: "IMP_Minus_com \<Rightarrow> (vname \<rightharpoonup> nat) \<Rightarrow> nat \<Rightarrow> (vname \<rightharpoonup> nat) 
-  \<Rightarrow>  nat \<Rightarrow> SAS_problem" where
-"IMP_Minus_to_SAS_Plus c I r G t = (let 
-  guess_range = max_input_bits c I r;
-  n = t + guess_range + 1;
-  c' = IMP_Minus_To_IMP_Minus_Minus c n;
-  I' = IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range
-    |` (set (enumerate_variables c')) ;
-  G' = (IMP_Minus_State_To_IMP_Minus_Minus_partial G n n) |` (set (enumerate_variables c')) in 
-  SAS_Plus_Plus_To_SAS_Plus (imp_minus_minus_to_sas_plus c' I' G'))"
-
 definition IMP_Minus_to_SAS_Plus_list:: "IMP_Minus_com \<Rightarrow> (vname, nat) assignment list \<Rightarrow> nat \<Rightarrow> (vname, nat) assignment list 
   \<Rightarrow>  nat \<Rightarrow> (var,dom) sas_plus_list_problem" where
 "IMP_Minus_to_SAS_Plus_list c I r G t = (let 
@@ -104,7 +90,7 @@ definition IMP_Minus_to_SAS_Plus_list:: "IMP_Minus_com \<Rightarrow> (vname, nat
   n = t + guess_range + 1;
   c' = IMP_Minus_To_IMP_Minus_Minus c n;
   I' = 
-map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,IMP_Minus_initial_to_IMP_Minus_Minus_list I n guess_range x)) (enumerate_variables c')))
+map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,IMP_Minus_State_To_IMP_Minus_Minus_partial_list I n guess_range x)) (enumerate_variables c')))
 ;
 
   G' = map (\<lambda>(x,y). (x, the y)) (filter (\<lambda>(x,y) . y \<noteq> None) (map (\<lambda>x. (x,IMP_Minus_State_To_IMP_Minus_Minus_partial_list G n n x)) (enumerate_variables c')))
@@ -128,21 +114,21 @@ simp flip:sublist_IMP_Minus_initial_to_IMP_Minus_Minus)
   done
 
 fun map_IMP_Minus_initial_to_IMP_Minus_Minus:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
-"map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n x  =(if x = 0 then 0 else (prod_encode(hd_nat x, IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range (hd_nat x)))## map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n (tl_nat x))"
+"map_IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range x  =(if x = 0 then 0 else (prod_encode(hd_nat x, IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range (hd_nat x)))## map_IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range (tl_nat x))"
 
 lemma submap_IMP_Minus_initial_to_IMP_Minus_Minus:
-"map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n x = map_nat (\<lambda>x. prod_encode(x, IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range x))x"
-  apply (induct I guess_range n x rule:map_IMP_Minus_initial_to_IMP_Minus_Minus.induct)
+"map_IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range x = map_nat (\<lambda>x. prod_encode(x, IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range x))x"
+  apply (induct I n guess_range  x rule:map_IMP_Minus_initial_to_IMP_Minus_Minus.induct)
   apply auto
   done
 
-fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n x = (if x =0 then 0 else 
-( prod_encode(hd_nat x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat G n n (hd_nat x)))## map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n (tl_nat x) )"
+fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial I n guess_range x = (if x =0 then 0 else 
+( prod_encode(hd_nat x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat I n guess_range (hd_nat x)))## map_IMP_Minus_State_To_IMP_Minus_Minus_partial I n guess_range (tl_nat x) )"
 
 lemma submap_IMP_Minus_State_To_IMP_Minus_Minus_partial :
-"map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n x = map_nat (\<lambda>x. prod_encode(x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat G n n x)) x "
-  apply(induct G n x rule: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.induct)
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial I n guess_range x = map_nat (\<lambda>x. prod_encode(x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat I n guess_range x)) x "
+  apply(induct I  n guess_range x rule: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.induct)
   apply auto
   done
 
@@ -170,10 +156,10 @@ definition IMP_Minus_to_SAS_Plus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat
   n = t + guess_range + 1;
   c' = IMP_Minus_To_IMP_Minus_Minus_nat c n;
   I' = 
-map_prod_the (filter_none (map_IMP_Minus_initial_to_IMP_Minus_Minus I guess_range n (enumerate_variables_nat c')))
+map_prod_the (filter_none (map_IMP_Minus_State_To_IMP_Minus_Minus_partial I n guess_range (enumerate_variables_nat c')))
 ;
 
-  G' = map_prod_the (filter_none (map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n (enumerate_variables_nat c')))
+  G' = map_prod_the (filter_none (map_IMP_Minus_State_To_IMP_Minus_Minus_partial G n n (enumerate_variables_nat c')))
  in
   SAS_Plus_Plus_To_SAS_Plus_nat (imp_minus_minus_to_sas_plus_nat c' I' G'))"
 
@@ -224,13 +210,15 @@ subnat_IMP_Minus_initial_to_IMP_Minus_Minus
 
  thef_bit_option_lambda
 
+imp_assignment_list_encode_def
 
  simp flip: imp_assignment_encode.simps)
   apply (auto simp only:
 subnat_SAS_Plus_Plus_To_SAS_Plus
- subnat_imp_minus_minus_to_sas_plus simp flip:comp_def[of imp_assignment_encode "\<lambda>x.(x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                               (t + max_input_bits_list c I r + 1)
-                               (max_input_bits_list c I r) x))" ]
+ subnat_imp_minus_minus_to_sas_plus simp flip:comp_def[of imp_assignment_encode "\<lambda>x.(x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list I                             
+(t + max_input_bits_list c I r + 1)
+(max_input_bits_list c I r)  
+                                x))" ]
 comp_def[of imp_assignment_encode "\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
                                (t + max_input_bits_list c I r + 1)
                                (t + max_input_bits_list c I r + 1) x))" ]
@@ -239,84 +227,57 @@ comp_def[of imp_assignment_encode "\<lambda>x. (x, the (IMP_Minus_State_To_IMP_M
 imp_assignment_list_encode_def
 )
 proof -
-  let ?P = "imp_minus_minus_to_sas_plus_list
-         (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
-         (map (\<lambda>x. (x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                              (t + max_input_bits_list c I r + 1)
-                              (max_input_bits_list c I r) x)))
+  let ?P = "imp_minus_minus_to_sas_plus_list (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
+         (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list I
+                              (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r) x)))
            (filter
-             (\<lambda>x. IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                    (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r)
-                    x \<noteq>
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list I (t + max_input_bits_list c I r + 1)
+                    (max_input_bits_list c I r) x \<noteq>
                    None)
-             (enumerate_variables
-               (IMP_Minus_To_IMP_Minus_Minus c
-                 (t + max_input_bits_list c I r + 1)))))
+             (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1)))))
          (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
-                              (t + max_input_bits_list c I r + 1)
-                              (t + max_input_bits_list c I r + 1) x)))
+                              (t + max_input_bits_list c I r + 1) (t + max_input_bits_list c I r + 1) x)))
            (filter
-             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
-                    (t + max_input_bits_list c I r + 1)
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G (t + max_input_bits_list c I r + 1)
                     (t + max_input_bits_list c I r + 1) x \<noteq>
                    None)
-             (enumerate_variables
-               (IMP_Minus_To_IMP_Minus_Minus c
-                 (t + max_input_bits_list c I r + 1)))))"
+             (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1)))))"
   have "is_valid_problem_sas_plus_plus (list_problem_to_problem ?P)"
     by (auto simp only:sublist_imp_minus_minus_to_sas_plus  imp_minus_minus_to_sas_plus_valid)
-  thus "SAS_Plus_Plus_To_SAS_Plus_nat
+  thus " SAS_Plus_Plus_To_SAS_Plus_nat
      (list_problem_encode
-       (imp_minus_minus_to_sas_plus_list
-         (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
-         (map (\<lambda>x. (x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                              (t + max_input_bits_list c I r + 1)
-                              (max_input_bits_list c I r) x)))
+       (imp_minus_minus_to_sas_plus_list (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
+         (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list I
+                              (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r) x)))
            (filter
-             (\<lambda>x. IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                    (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r)
-                    x \<noteq>
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list I (t + max_input_bits_list c I r + 1)
+                    (max_input_bits_list c I r) x \<noteq>
                    None)
-             (enumerate_variables
-               (IMP_Minus_To_IMP_Minus_Minus c
-                 (t + max_input_bits_list c I r + 1)))))
+             (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1)))))
          (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
-                              (t + max_input_bits_list c I r + 1)
-                              (t + max_input_bits_list c I r + 1) x)))
+                              (t + max_input_bits_list c I r + 1) (t + max_input_bits_list c I r + 1) x)))
            (filter
-             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
-                    (t + max_input_bits_list c I r + 1)
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G (t + max_input_bits_list c I r + 1)
                     (t + max_input_bits_list c I r + 1) x \<noteq>
                    None)
-             (enumerate_variables
-               (IMP_Minus_To_IMP_Minus_Minus c
-                 (t + max_input_bits_list c I r + 1))))))) =
+             (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))))))) =
     list_problem_plus_encode
      (SAS_Plus_Plus_To_SAS_Plus_list
-       (imp_minus_minus_to_sas_plus_list
-         (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
-         (map (\<lambda>x. (x, the (IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                              (t + max_input_bits_list c I r + 1)
-                              (max_input_bits_list c I r) x)))
+       (imp_minus_minus_to_sas_plus_list (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))
+         (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list I
+                              (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r) x)))
            (filter
-             (\<lambda>x. IMP_Minus_initial_to_IMP_Minus_Minus_list I
-                    (t + max_input_bits_list c I r + 1) (max_input_bits_list c I r)
-                    x \<noteq>
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list I (t + max_input_bits_list c I r + 1)
+                    (max_input_bits_list c I r) x \<noteq>
                    None)
-             (enumerate_variables
-               (IMP_Minus_To_IMP_Minus_Minus c
-                 (t + max_input_bits_list c I r + 1)))))
+             (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1)))))
          (map (\<lambda>x. (x, the (IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
-                              (t + max_input_bits_list c I r + 1)
-                              (t + max_input_bits_list c I r + 1) x)))
+                              (t + max_input_bits_list c I r + 1) (t + max_input_bits_list c I r + 1) x)))
            (filter
-             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G
-                    (t + max_input_bits_list c I r + 1)
+             (\<lambda>x. IMP_Minus_State_To_IMP_Minus_Minus_partial_list G (t + max_input_bits_list c I r + 1)
                     (t + max_input_bits_list c I r + 1) x \<noteq>
                    None)
-             (enumerate_variables
-               (IMP_Minus_To_IMP_Minus_Minus c
-                 (t + max_input_bits_list c I r + 1)))))))"
+             (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1)))))))"
     by (auto simp only: subnat_SAS_Plus_Plus_To_SAS_Plus)
 qed
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
index 07e4123a..fbfdb82d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -1,5 +1,6 @@
 theory IMP_Minus_To_SAT_Nat 
-  imports IMP_Minus_To_SAS_Plus_Nat IMP_Minus_To_SAT SAT_Plan_Base_Nat "IMP-_To_IMP--/Primitives"  
+  imports IMP_Minus_To_SAS_Plus_Nat IMP_Minus_To_SAT SAT_Plan_Base_Nat SAS_Plus_Strips_Nat
+ "IMP-_To_IMP--/Primitives"  
 begin
 
 fun poly_of :: "nat*nat \<Rightarrow> nat \<Rightarrow> nat" where 
@@ -90,6 +91,20 @@ lemma sublist_prob_with_noop:
   apply (auto simp add: prob_with_noop_list_def prob_with_noop_def)
   done
 
+definition prob_with_noop_nat :: "nat \<Rightarrow> nat" where 
+  "prob_with_noop_nat p = (nth_nat 0 p) ## ( empty_sasp_action_nat ##  (nth_nat (Suc 0) p))
+## (tl_nat (tl_nat p))"
+
+lemma subnat_prob_with_noop: 
+"prob_with_noop_nat (list_problem_plus_encode p) = 
+ list_problem_plus_encode (prob_with_noop_list p)"
+  apply (auto simp only: prob_with_noop_nat_def sub_cons list_problem_plus_encode_def
+            sub_tl tail.simps sub_nth nth.simps prob_with_noop_list_def sas_plus_list_problem.simps
+            sub_empty_sasp_action)
+  apply auto
+  done
+
+
 definition encode_interfering_operator_pair_exclusion_list
   :: "'variable strips_list_problem
     \<Rightarrow> nat
@@ -109,6 +124,75 @@ lemma sublist_encode_interfering_operator_pair_exclusion:
 encode_interfering_operator_pair_exclusion_def)
   done
 
+definition encode_interfering_operator_pair_exclusion_nat
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_interfering_operator_pair_exclusion_nat p k o1 o2
+    \<equiv> let ops = nth_nat (Suc 0)  p in
+     4 ## (2 ## (1 ## (1 ## k ## (index_nat ops o1)## 0) ## 0) ## 0)
+      ## (2 ## (1 ## (1  ## k ## (index_nat ops o2) ## 0) ## 0) ## 0) ## 0"
+
+lemma subnat_encode_interfering_operator_pair_exclusion:
+"encode_interfering_operator_pair_exclusion_nat (strips_list_problem_encode p) k
+ (strips_operator_encode o1) (strips_operator_encode o2) = 
+sat_formula_encode (encode_interfering_operator_pair_exclusion_list p k o1 o2)"
+  using inj_strips_op
+  apply(auto simp only: encode_interfering_operator_pair_exclusion_nat_def
+    strips_list_problem_encode.simps sub_nth nth.simps strips_operator_list_encode_def
+      sub_index Let_def sub_cons cons0 encode_interfering_operator_pair_exclusion_list_def
+ simp flip: sat_variable_encode.simps sat_formula_encode.simps
+)
+  done
+
+
+declare elemof.simps [simp del]
+fun list_inter :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"list_inter xs ys = (if xs = 0 then 0 
+else if elemof (hd_nat xs) ys \<noteq> 0 then 1 else list_inter (tl_nat xs) ys)"
+
+lemma list_encode_pos:"(list_encode xs > 0) = (xs \<noteq> []) "
+  using list_encode_empty by force
+
+lemma sub_list_inter:
+"inj f \<Longrightarrow> list_inter (list_encode (map f xs)) (list_encode (map f ys)) \<noteq> 0 
+= list_ex (\<lambda>v. list_ex ((=) v) xs ) ys"
+  apply (induct xs)
+   apply (simp)
+   apply (induct ys)
+    apply simp
+   apply simp
+  apply (subst list_inter.simps)
+  apply (simp add: sub_hd sub_tl tail.simps  head.simps list.simps list_encode_empty list_encode_pos
+      del:list_encode.simps list_inter.simps)
+  using sub_elem_of_inj[of f] apply (auto simp  del:list_encode.simps list_inter.simps)
+  apply (metis (no_types, lifting) Bex_set) 
+    apply (metis (no_types, lifting) Bex_set)
+  using Bex_set apply fastforce
+ using sub_elem_of_inj[of f]
+  by (smt (z3) Bex_set)
+    
+
+
+
+definition are_operators_interfering_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"are_operators_interfering_nat o1 o2 \<equiv>
+if list_inter (nth_nat (Suc (Suc 0)) o1) (nth_nat 0 o2) \<noteq> 0  \<or> 
+    list_inter (nth_nat 0 o1) (nth_nat (Suc (Suc 0)) o2) \<noteq> 0 then 1 else 0 "
+
+lemma sub_are_operators_interfering:
+"(are_operators_interfering_nat (strips_operator_encode o1) (strips_operator_encode o2) > 0) =
+ (are_operators_interfering o1 o2)"
+  using inj_sasp
+  apply (auto simp only: are_operators_interfering_nat_def strips_operator_encode.simps
+          sub_nth nth.simps sas_plus_assignment_list_encode_def
+            sub_list_inter are_operators_interfering_def)
+    apply auto
+  apply presburger
+  done
+  
 
 definition encode_interfering_operator_exclusion_list
   :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula"
@@ -128,6 +212,42 @@ encode_interfering_operator_exclusion_def
 )
   done
 
+definition encode_interfering_operator_exclusion_nat
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_interfering_operator_exclusion_nat \<Pi> t \<equiv> let
+      ops = nth_nat (Suc 0) \<Pi>
+      ; interfering = filter_nat (\<lambda>n. index_nat ops (fst_nat n) \<noteq> index_nat ops (snd_nat n)
+        \<and> are_operators_interfering_nat (fst_nat n) (snd_nat n) \<noteq> 0 ) (product_nat ops ops)
+    in BigAnd_nat (concat_nat (map_nat (\<lambda>n. map_nat (\<lambda>k. encode_interfering_operator_pair_exclusion_nat \<Pi> k (fst_nat n) (snd_nat n))
+      (list_less_nat t) ) interfering ))"
+lemma subnat_encode_interfering_operator_exclusion :
+"encode_interfering_operator_exclusion_nat (strips_list_problem_encode p) t =
+sat_formula_encode (encode_interfering_operator_exclusion_list p t)"
+  using inj_strips_op
+  apply (auto simp only: encode_interfering_operator_exclusion_nat_def 
+strips_list_problem_encode.simps sub_nth nth.simps Let_def strips_operator_list_encode_def
+sub_product sub_filter filter_map
+         )
+  apply (auto simp add: Fun.comp_def prod.case_eq_if sub_fst sub_snd simp del: list_encode.simps 
+          BigAnd_nat.simps concat_nat.simps index_nat.simps strips_operator_encode.simps
+        map_nat.simps simp flip: strips_operator_list_encode_def  strips_list_problem_encode.simps)
+  apply (auto simp only:  strips_operator_list_encode_def sub_index sub_are_operators_interfering
+      sub_map map_map Fun.comp_def  prod.case_eq_if  sub_fst sub_snd fst_conv snd_conv sub_list_less
+            subnat_encode_interfering_operator_pair_exclusion
+            )
+  apply (auto simp only: sub_concat  simp flip: Fun.comp_def[of list_encode "\<lambda>x. 
+    (map (\<lambda>k. sat_formula_encode
+                (encode_interfering_operator_pair_exclusion_list p k (fst x) (snd x)))
+                       [0..<t])" ] map_map map_concat)
+  apply (auto simp only: simp flip: Fun.comp_def[of sat_formula_encode 
+            "\<lambda>k. encode_interfering_operator_pair_exclusion_list p k (fst _) (snd _)"] map_map
+)
+  apply (auto simp only: case_prod_beta' sub_BigAnd encode_interfering_operator_exclusion_list_def split_comp_eq 
+      Let_def simp flip: Fun.comp_def[of "map sat_formula_encode"
+"\<lambda>x. (map (\<lambda>k. encode_interfering_operator_pair_exclusion_list p k (fst x) (snd x))
+                       [0..<t])"] map_map map_concat sat_formula_list_encode_def split_comp_eq)
+  done
+
 definition encode_problem_with_operator_interference_exclusion_list
   :: "'variable strips_list_problem \<Rightarrow> nat \<Rightarrow> sat_plan_variable formula"
   where "encode_problem_with_operator_interference_exclusion_list \<Pi> t
@@ -137,6 +257,25 @@ definition encode_problem_with_operator_interference_exclusion_list
       \<^bold>\<and> (encode_interfering_operator_exclusion_list \<Pi> t
       \<^bold>\<and> (encode_goal_state_list \<Pi> t))))"
 
+definition encode_problem_with_operator_interference_exclusion_nat
+  :: "nat\<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_problem_with_operator_interference_exclusion_nat \<Pi> t
+    \<equiv> 3 ## (encode_initial_state_nat \<Pi>)
+      ## (3 ## (encode_operators_nat \<Pi> t)
+      ## (3 ## (encode_all_frame_axioms_nat \<Pi> t)
+      ## (3 ## (encode_interfering_operator_exclusion_nat \<Pi> t)
+      ## (encode_goal_state_nat \<Pi> t) ## 0) ## 0 )## 0) ## 0"
+
+lemma subnat_encode_problem_with_operator_interference_exclusion:
+"encode_problem_with_operator_interference_exclusion_nat (strips_list_problem_encode \<Pi>) t =
+sat_formula_encode (encode_problem_with_operator_interference_exclusion_list \<Pi> t)"
+  apply (auto simp only:encode_problem_with_operator_interference_exclusion_nat_def
+    sub_cons cons0 subnat_encode_initial_state subnat_encode_operators subnat_encode_all_frame_axioms
+subnat_encode_interfering_operator_exclusion subnat_encode_goal_state simp flip: sat_formula_encode.simps
+    encode_problem_with_operator_interference_exclusion_list_def
+)
+  done
+
 lemma sublist_encode_problem_with_operator_interference_exclusion:
 "encode_problem_with_operator_interference_exclusion_list \<Pi> t
 = encode_problem_with_operator_interference_exclusion (strips_list_problem_to_problem \<Pi>) t"
@@ -153,10 +292,156 @@ encode_problem_with_operator_interference_exclusion_def
       (let I = [(''input'', x)]; 
           G = [(''input'',0)];
           guess_range = x + 1 + 2 * 2 ^ (poly_of p_cer (bit_length x));
-          max_bits = max_input_bits c I guess_range
+          max_bits = max_input_bits_list c I guess_range
       in
-        \<Phi>\<^sub>\<forall> (\<phi> prob_with_noop (IMP_Minus_to_SAS_Plus c I guess_range G (t'_pair pt p_cer x)))
-           100 * (max_bits + (t'_pair pt p_cer x) + 1) * ((t'_pair pt p_cer x) - 1) +
-             (max_bits + (t'_pair pt p_cer x) + 2) * (num_variables c + 2) + 52)"
+        encode_problem_with_operator_interference_exclusion_list 
+        (sas_plus_problem_to_strips_problem_list (prob_with_noop_list (IMP_Minus_to_SAS_Plus_list c I guess_range G (t'_pair pt p_cer x))))
+           (100 * (max_bits + (t'_pair pt p_cer x) + 1) * ((t'_pair pt p_cer x) - 1) +
+             (max_bits + (t'_pair pt p_cer x) + 2) * (num_variables c + 2) + 52))"
+
+lemma sublist_imp_to_sat:
+"imp_to_sat_list c pt p_cer x 
+= imp_to_sat c (poly_of pt) (poly_of p_cer) x"
+  apply (auto simp only: imp_to_sat_list_def sublist_encode_problem_with_operator_interference_exclusion
+              sublist_sas_plus_problem_to_strips_problem sublist_prob_with_noop  sublist_max_input_bits
+                  subpair_t' imp_to_sat_def Let_def)
+  using sublist_IMP_Minus_to_SAS_Plus[of " [(''input'', x)]"] sublist_max_input_bits[of " [(''input'', x)]"]
+  apply (auto)
+  done
+
+lemma poly_poly_of:"poly (poly_of p)"
+  apply(cases p)
+  subgoal for a b
+  proof (induct b arbitrary:p)
+    case 0
+    then have "poly_of p = (\<lambda>_.a)" using poly_of.simps(1) by presburger
+    then show ?case by auto
+  next
+    case (Suc b)
+    then obtain p' where p'_def: "p' = poly_of (a,b)" by blast
+    then have "poly p'" using Suc by simp
+    moreover have "poly_of p = (\<lambda>x. (p' x *x))" using Suc p'_def by force
+    ultimately show ?case apply auto
+      using poly_linear poly_mult by presburger
+  qed
+  done
+
+lemma main_lemma_hol_list:
+  fixes c pt p_cer in_lang
+  assumes verifier_tbounded:
+  (*Mohammad: I don't think we need the time to bounded by the cert length since the cert length
+              is bounded by input length.*)
+    "\<And>s. \<exists>t s'. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
+                   t \<le> poly_of pt (bit_length (s ''input''))"
+  assumes verifier_terminates: 
+          (*"\<And>x z. \<forall>s. s ''input'' = x \<and> s ''certificate'' = z \<longrightarrow>
+                         (\<exists>t s'. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<and> s' ''input'' = in_lang x)"*)
+          (*Mohammad: The TM needs no access to the certificate since it is non-deterministic, i.e. it can
+            assume it is guessed.*)
+          (*Mohammad: The computation output should depend on the state, otherwise the theorem
+                      statement does not hold*)
+          (*Mohammad: We need to specify what it means for c to be a verifier for the certificates*)
+          "\<And>x s. \<lbrakk>in_lang x = 0 ; s ''input'' = x\<rbrakk> \<Longrightarrow>
+                    (\<exists>z t s'. bit_length z \<le> poly_of p_cer (bit_length x) \<and>
+                              (c, s(''certificate'' := z)) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
+                              s' ''input'' = in_lang x)"
+          "\<And>x s s' t. \<lbrakk>in_lang x \<noteq> 0; s ''input'' = x; (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'\<rbrakk> \<Longrightarrow>
+                         s' ''input'' = in_lang x"
+  assumes verifier_has_registers:
+    "''input'' \<in> set (IMP_Minus_Max_Constant.all_variables c)"
+  shows "\<exists>t_red s_red.
+         poly t_red 
+       \<and> poly s_red
+       \<and> (\<forall>x. \<exists>f.  bit_length (encode_sat f) \<le> s_red ( bit_length x ) \<and> imp_to_sat_list c pt p_cer x = f
+                   \<and> (Sema.sat {f}  \<longleftrightarrow> in_lang x = 0))"
+  using main_lemma_hol poly_poly_of assms  by (auto simp add: sublist_imp_to_sat) 
+
+ definition imp_to_sat_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+    "imp_to_sat_nat c pt p_cer x =
+      (let I = (prod_encode (vname_encode ''input'', x)) ## 0; 
+          G = (prod_encode (vname_encode ''input'', 0)) ## 0;
+          guess_range = x + 1 + 2 * 2 ^ (poly_of_nat p_cer (bit_length x));
+          max_bits = max_input_bits_nat c I guess_range
+      in
+        encode_problem_with_operator_interference_exclusion_nat 
+        (sas_plus_problem_to_strips_problem_nat (prob_with_noop_nat (IMP_Minus_to_SAS_Plus_nat c I guess_range G (t'_nat pt p_cer x))))
+           (100 * (max_bits + (t'_nat pt p_cer x) + 1) * ((t'_nat pt p_cer x) - 1) +
+             (max_bits + (t'_nat pt p_cer x) + 2) * (num_variables_nat c + 2) + 52))"
+lemma unfold_map_signleton:"[f x] = map f [x]"
+  apply auto
+  done
+
+lemma subnat_imp_to_sat:
+"imp_to_sat_nat (com_encode c) (prod_encode pt) (prod_encode p_cer) x =
+sat_formula_encode (imp_to_sat_list c pt p_cer x)  "
+  apply (auto simp only: imp_to_sat_nat_def Let_def
+    cons0 sub_cons  unfold_map_signleton[of impm_assignment_encode] 
+sub_poly_of subnat_max_input_bits subnat_t' sub_num_variables subnat_IMP_Minus_to_SAS_Plus
+subnat_prob_with_noop subnat_encode_problem_with_operator_interference_exclusion
+simp flip: impm_assignment_encode.simps  impm_assignment_list_encode_def
+)
+proof -
+  let ?P = "IMP_Minus_to_SAS_Plus_list c [(''input'', x)]
+              (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) [(''input'', 0)]
+              (t'_pair pt p_cer x)"
+  let ?P'= "IMP_Minus_to_SAS_Plus c (map_of [(''input'', x)])
+              (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) (map_of [(''input'', 0)])
+              (t'_pair pt p_cer x)"
+  have "list_problem_to_problem ?P = ?P'" using sublist_IMP_Minus_to_SAS_Plus by blast
+  hence "is_valid_problem_sas_plus (list_problem_to_problem ?P)" using valid_problem by presburger
+  hence "is_valid_problem_sas_plus (prob_with_noop (list_problem_to_problem ?P))" using noops_valid
+    by fast
+  hence "is_valid_problem_sas_plus (list_problem_to_problem (prob_with_noop_list ?P))"
+    using sublist_prob_with_noop by metis
+  thus " encode_problem_with_operator_interference_exclusion_nat
+     (\<phi> list_problem_plus_encode
+          (prob_with_noop_list
+            (IMP_Minus_to_SAS_Plus_list c [(''input'', x)]
+              (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) [(''input'', 0)]
+              (t'_pair pt p_cer x))) )
+     (100 *
+      (max_input_bits_list c [(''input'', x)] (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) +
+       t'_pair pt p_cer x +
+       1) *
+      (t'_pair pt p_cer x - 1) +
+      (max_input_bits_list c [(''input'', x)] (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) +
+       t'_pair pt p_cer x +
+       2) *
+      (num_variables c + 2) +
+      52) =
+    sat_formula_encode (imp_to_sat_list c pt p_cer x)"
+    apply (auto simp only: subnat_sas_plus_problem_to_strips_problem Let_def
+          subnat_encode_problem_with_operator_interference_exclusion imp_to_sat_list_def )
+    done
+       
+qed 
+
+lemma inj_formula : "inj sat_formula_encode" 
+  apply (auto simp add: inj_def)
+  using sat_formula_id by metis
+
+lemma inj_formula_simp : "(sat_formula_encode x = sat_formula_encode y) = (x=y)"
+  using inj_formula by (auto simp add:inj_def)
+lemma main_lemma_hol_nat:
+  fixes c pt p_cer in_lang
+  assumes verifier_tbounded:
+    "\<And>s. \<exists>t s'. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
+                   t \<le> poly_of pt (bit_length (s ''input''))"
+  assumes verifier_terminates: 
+          "\<And>x s. \<lbrakk>in_lang x = 0 ; s ''input'' = x\<rbrakk> \<Longrightarrow>
+                    (\<exists>z t s'. bit_length z \<le> poly_of p_cer (bit_length x) \<and>
+                              (c, s(''certificate'' := z)) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
+                              s' ''input'' = in_lang x)"
+          "\<And>x s s' t. \<lbrakk>in_lang x \<noteq> 0; s ''input'' = x; (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'\<rbrakk> \<Longrightarrow>
+                         s' ''input'' = in_lang x"
+  assumes verifier_has_registers:
+    "''input'' \<in> set (IMP_Minus_Max_Constant.all_variables c)"
+  shows "\<exists>t_red s_red.
+         poly t_red 
+       \<and> poly s_red
+       \<and> (\<forall>x. \<exists>f.  bit_length (encode_sat f) \<le> s_red ( bit_length x ) \<and> imp_to_sat_nat (com_encode c) (prod_encode pt) (prod_encode p_cer) x = sat_formula_encode f
+                   \<and> (Sema.sat {f}  \<longleftrightarrow> in_lang x = 0))"
+  using assms main_lemma_hol_list by (auto simp add:subnat_imp_to_sat inj_formula_simp)
+
 
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
index c0da5bb4..aa44c61b 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
@@ -1,5 +1,5 @@
 theory SAS_Plus_Plus_To_SAS_Plus_Nat
-  imports   Primitives SAS_Plus_Plus_To_SAS_Plus
+  imports   "../IMP-_To_IMP--/Primitives" SAS_Plus_Plus_To_SAS_Plus
 begin
 
 definition SAS_Plus_Plus_State_To_SAS_Plus_list:: 
@@ -518,9 +518,9 @@ lemma inv_subnat_initial_state:
   shows  "\<forall>x \<in> set (variables_ofl P). \<exists>t. map_list_find (range_ofl P) x = Some t \<and> t\<noteq>[]"
 proof -
   obtain P' where def: "P' = list_problem_to_problem P" by simp
-  then have "variables_of P' = variables_ofl P " by simp
+  then have "sas_plus_problem.variables_of P' = variables_ofl P " by simp
   moreover have "map_of (range_ofl P) = range_of P' " using def by simp
-  moreover have "\<forall>x \<in> set (variables_of P'). \<exists>t. (range_of P') x = Some t \<and> t \<noteq> []"
+  moreover have "\<forall>x \<in> set (sas_plus_problem.variables_of P'). \<exists>t. (range_of P') x = Some t \<and> t \<noteq> []"
     by (metis assms def is_valid_problem_sas_plus_plus_then(1) option.collapse range_of_not_empty)
   ultimately show ?thesis by (metis sub_map_list_find)
       

From 68133e270d8265cb1f9a76fcf719fbe9fa36d2a3 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Thu, 19 Aug 2021 23:13:37 +0200
Subject: [PATCH 014/103] transformed higher order functions into independent
 instances

---
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     | 38 ++++++++++++++++---
 1 file changed, 33 insertions(+), 5 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
index 8e4b317e..6a8249e6 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -211,20 +211,48 @@ encode_interfering_operator_exclusion_def
     sub_foldr sublist_encode_interfering_operator_pair_exclusion
 )
   done
+fun filter_interfering:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_interfering ops xs = (if xs = 0 then 0 else if index_nat ops (fst_nat (hd_nat xs)) \<noteq> index_nat ops (snd_nat (hd_nat xs))
+        \<and> are_operators_interfering_nat (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)) \<noteq> 0 then (hd_nat xs) ## filter_interfering ops (tl_nat xs) else  filter_interfering ops (tl_nat xs))"
+
+lemma subfilter_interfering:
+"filter_interfering ops xs = filter_nat (\<lambda>n. index_nat ops (fst_nat n) \<noteq> index_nat ops (snd_nat n)
+        \<and> are_operators_interfering_nat (fst_nat n) (snd_nat n) \<noteq> 0 ) xs"
+  apply (induct ops xs rule:filter_interfering.induct)
+  apply (auto simp del:index_nat.simps)
+  done
+fun map_encode_interfering :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_interfering p n xs = (if xs = 0 then 0 else (encode_interfering_operator_pair_exclusion_nat p (hd_nat xs) (fst_nat n) (snd_nat n)) 
+## map_encode_interfering p n (tl_nat xs))"
+lemma submap_encode_interfering: 
+"map_encode_interfering p n xs = map_nat (\<lambda>k. encode_interfering_operator_pair_exclusion_nat p k (fst_nat n) (snd_nat n)) xs "
+  apply (induct p n xs rule: map_encode_interfering.induct)
+  apply auto
+  done
+
+fun map_map_encode_interfering :: "nat \<Rightarrow>nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_map_encode_interfering \<Pi> t xs = (if xs = 0 then 0 else 
+(map_encode_interfering  \<Pi> (hd_nat xs) (list_less_nat t)) ## map_map_encode_interfering \<Pi> t (tl_nat xs) 
+) "
+lemma submap_map_encode_interfering:
+"map_map_encode_interfering \<Pi> t xs = map_nat (\<lambda>n. map_encode_interfering  \<Pi> n
+      (list_less_nat t) ) xs "
+  apply (induct  \<Pi> t xs rule: map_map_encode_interfering.induct)
+  apply auto
+  done
 
 definition encode_interfering_operator_exclusion_nat
   :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "encode_interfering_operator_exclusion_nat \<Pi> t \<equiv> let
       ops = nth_nat (Suc 0) \<Pi>
-      ; interfering = filter_nat (\<lambda>n. index_nat ops (fst_nat n) \<noteq> index_nat ops (snd_nat n)
-        \<and> are_operators_interfering_nat (fst_nat n) (snd_nat n) \<noteq> 0 ) (product_nat ops ops)
-    in BigAnd_nat (concat_nat (map_nat (\<lambda>n. map_nat (\<lambda>k. encode_interfering_operator_pair_exclusion_nat \<Pi> k (fst_nat n) (snd_nat n))
-      (list_less_nat t) ) interfering ))"
+      ; interfering = filter_interfering ops (product_nat ops ops)
+    in BigAnd_nat (concat_nat (map_map_encode_interfering \<Pi> t interfering ))"
 lemma subnat_encode_interfering_operator_exclusion :
 "encode_interfering_operator_exclusion_nat (strips_list_problem_encode p) t =
 sat_formula_encode (encode_interfering_operator_exclusion_list p t)"
   using inj_strips_op
-  apply (auto simp only: encode_interfering_operator_exclusion_nat_def 
+  apply (auto simp only: encode_interfering_operator_exclusion_nat_def
+subfilter_interfering submap_encode_interfering submap_map_encode_interfering
 strips_list_problem_encode.simps sub_nth nth.simps Let_def strips_operator_list_encode_def
 sub_product sub_filter filter_map
          )

From 44924416e3840ecafaf923dca77af860d6b49b78 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Sun, 22 Aug 2021 16:52:27 +0200
Subject: [PATCH 015/103] started refinment to HOL-tail

---
 .../IMP-_To_IMP--/Binary_Arithmetic.thy       |   9 +
 .../IMP-_To_IMP--/Binary_Arithmetic_Nat.thy   | 213 +++++++++++-
 .../IMP-_To_IMP--/Binary_Operations_Nat.thy   |  84 ++++-
 ...IMP_Minus_Minus_State_Translations_nat.thy | 302 +++++++++++++++++-
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy |  17 +
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     |   2 +-
 6 files changed, 616 insertions(+), 11 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy
index 3883990f..8f77abef 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy
@@ -14,6 +14,15 @@ fun nth_bit_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "nth_bit_nat x 0 = x mod 2" |
 "nth_bit_nat x (Suc n) = nth_bit_nat (x div 2) n"
 
+fun nth_bit_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_bit_tail x 0 = x mod 2" |
+"nth_bit_tail x (Suc n) = nth_bit_nat (x div 2) n"
+
+lemma subtail_nth_bit: "nth_bit_tail x n = nth_bit_nat x n"
+  apply(induct n)
+   apply auto
+  done
+
 lemma nth_bit_nat_is_right_shift: "nth_bit_nat x n = (x div 2 ^ n) mod 2"
   apply(induction n arbitrary: x)
   by(auto simp:  div_mult2_eq)
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
index d8931054..d98dc1a4 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
@@ -8,6 +8,12 @@ fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
                             if n = 0 then (if hd_nat x = 0 then 0 else 1) else
                             nth_bit_of_num_nat (tl_nat x) (n-1)) "
 
+definition nth_bit_of_num_tail ::"nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_bit_of_num_tail x n =  nth_bit_of_num_nat x n"
+
+lemma subtail_nth_bit_of_num :"nth_bit_of_num_tail x n =  nth_bit_of_num_nat x n"
+  using nth_bit_of_num_tail_def by simp
+
 lemma sub_nth_bit_of_num: "nth_bit_of_num_nat (num_encode x) n = bit_encode (nth_bit_of_num x n)"
      apply (subst nth_bit_of_num_nat.simps)
   apply (induct x n rule:nth_bit_of_num.induct)
@@ -37,6 +43,47 @@ fun nth_carry_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
   \<or> ((nth_bit_nat a n = 1 \<or> nth_bit_nat b n = 1) \<and> nth_carry_nat (n-1) a b = 1) 
   then 1 else 0) )"
 
+fun nth_carry_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where 
+"nth_carry_acc acc diff n a b = (if diff = 0 then acc else 
+if diff>n then (if (nth_bit_tail a 0 = 1 \<and> nth_bit_tail b 0 = 1) then nth_carry_acc 1 n n a b
+   else  nth_carry_acc 0 n n a b )
+else (if (nth_bit_tail a (n-diff+1) = 1 \<and> nth_bit_tail b (n-diff+1) = 1) 
+  \<or> ((nth_bit_tail a (n-diff+1) = 1 \<or> nth_bit_tail b (n-diff+1) = 1) \<and> (acc = 1)) 
+  then nth_carry_acc 1 (diff-1) n a b else nth_carry_acc 0 (diff-1) n a b))"
+
+lemma nth_carry_step:"diff < n \<Longrightarrow> nth_carry_acc (nth_carry_nat (n- Suc diff) a b ) (Suc diff) n a b 
+=  nth_carry_acc (nth_carry_nat (n-diff) a b) diff n a b "
+  apply (subst (1) nth_carry_acc.simps )
+  apply (auto simp add: Suc_diff_Suc subtail_nth_bit
+            simp del: nth_carry_acc.simps nth_bit_nat.simps nth_carry_nat.simps simp flip: One_nat_def) 
+  apply (auto  simp add: subtail_nth_bit)
+  done
+
+
+lemma nth_carry_induct:"diff \<le>n \<Longrightarrow> nth_carry_acc (nth_carry_nat (n-diff) a b) diff n a b
+= nth_carry_nat n a b"
+  apply (induct diff)
+  apply simp
+   apply (auto simp add: nth_carry_step simp del:nth_carry_acc.simps nth_carry_nat.simps )
+  done
+
+lemma nth_carry_base:"nth_carry_nat 0 a b = (if (nth_bit_nat a 0 = 1 \<and> nth_bit_nat b 0 = 1) 
+            then 1 else 0)" 
+  apply auto
+  done
+
+definition nth_carry_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_carry_tail n a b = nth_carry_acc 0 (Suc n) n a b"
+
+lemma subtail_nth_carry:
+"nth_carry_tail n a b
+= nth_carry_nat n a b"
+  apply (auto simp only: nth_carry_tail_def)
+  apply (subst nth_carry_acc.simps)
+  using nth_carry_induct[of n n a b] nth_carry_base subtail_nth_bit
+   apply (auto simp add:  simp del:nth_carry_acc.simps nth_carry_nat.simps nth_bit_nat.simps )
+  done
+
 lemma sub_nth_carry: "nth_carry_nat n a b = bit_encode (nth_carry n a b)"
   apply (induct n)
   apply (auto simp add: sub_nth_bit)
@@ -45,17 +92,57 @@ lemma sub_nth_carry: "nth_carry_nat n a b = bit_encode (nth_carry n a b)"
 
 
 fun nth_carry_sub_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_carry_sub_nat n a b = (if n =0 then (if (nth_bit_nat a 0 = 0 \<and> nth_bit_nat b 0 = 1) then 1 else 0)
-else (if (nth_bit_nat a n = 0 \<and> ( nth_bit_nat b n = 1 \<or> nth_carry_sub_nat (n-1) a b = 1))
-    \<or> (nth_bit_nat a n = 1 \<and> (nth_bit_nat b n) = 1 \<and> nth_carry_sub_nat (n-1) a b = 1) then 1
-  else 0))"
+"nth_carry_sub_nat n a b = (if n =0 
+    then (if (nth_bit_nat a 0 = 0 \<and> nth_bit_nat b 0 = 1) 
+            then 1 else 0)
+    else (if (nth_bit_nat a n = 0 \<and> ( nth_bit_nat b n = 1 \<or> nth_carry_sub_nat (n-1) a b = 1))
+                \<or> (nth_bit_nat a n = 1 \<and> (nth_bit_nat b n) = 1 \<and> nth_carry_sub_nat (n-1) a b = 1)
+           then 1
+            else 0))"
 
-lemma sub_nth_carry_sub :"nth_carry_sub_nat n a b = bit_encode (nth_carry_sub n a b)"
- apply (induct n)
-  apply (auto simp add: sub_nth_bit)
+fun nth_carry_sub_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_carry_sub_acc acc diff n a b = (if diff = 0 then acc else 
+(if diff > n 
+    then (if (nth_bit_tail a 0 = 0 \<and> nth_bit_tail b 0 = 1) 
+            then nth_carry_sub_acc 1 n n a b  else nth_carry_sub_acc 0 n n a b)
+    else (if (nth_bit_tail a (n-diff+1) = 0 \<and> ( nth_bit_tail b (n-diff+1) = 1 \<or> acc = 1))
+                \<or> (nth_bit_tail a (n-diff+1) = 1 \<and> (nth_bit_tail b (n-diff+1) ) = 1 \<and> acc = 1)
+           then  nth_carry_sub_acc 1 (diff -1) n a b
+            else nth_carry_sub_acc 0 (diff - 1) n a b))
+)  "
+
+
+lemma nth_carry_sub_step:"diff < n \<Longrightarrow> nth_carry_sub_acc (nth_carry_sub_nat (n- Suc diff) a b ) (Suc diff) n a b 
+=  nth_carry_sub_acc (nth_carry_sub_nat (n-diff) a b) diff n a b "
+  apply (subst (1) nth_carry_sub_acc.simps )
+  apply (subst (1) nth_carry_sub_nat.simps)
+  apply (auto simp add: Suc_diff_Suc subtail_nth_bit 
+            simp del: nth_carry_sub_acc.simps nth_bit_nat.simps nth_carry_sub_nat.simps simp flip: One_nat_def)
+  apply (metis One_nat_def  nth_carry_sub_nat.elims)
+  apply auto
+  done
+lemma nth_carry_sub_induct:"diff \<le>n \<Longrightarrow> nth_carry_sub_acc (nth_carry_sub_nat (n-diff) a b) diff n a b
+= nth_carry_sub_nat n a b"
+  apply (induct diff)
+  apply simp
+   apply (auto simp add: nth_carry_sub_step simp del:nth_carry_sub_acc.simps nth_carry_sub_nat.simps )
+  done
+lemma nth_carry_sub_base:"nth_carry_sub_nat 0 a b = (if (nth_bit_nat a 0 = 0 \<and> nth_bit_nat b 0 = 1) 
+            then 1 else 0)" 
+  apply auto
   done
 
+definition nth_carry_sub_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_carry_sub_tail n a b = nth_carry_sub_acc 0 (Suc n) n a b"
 
+lemma subtail_nth_carry_sub:
+"nth_carry_sub_tail n a b
+= nth_carry_sub_nat n a b"
+  apply (auto simp only: nth_carry_sub_tail_def)
+  apply (subst nth_carry_sub_acc.simps)
+  using nth_carry_sub_induct[of n n a b] nth_carry_sub_base subtail_nth_bit
+   apply (auto simp add:  simp del:nth_carry_sub_acc.simps nth_carry_sub_nat.simps nth_bit_nat.simps )
+  done
 
 fun bit_list_to_nat_nat:: "nat \<Rightarrow> nat" where
 "bit_list_to_nat_nat n = (if n =0 then 0 else if hd_nat n =0 then 2 *bit_list_to_nat_nat (tl_nat n)
@@ -69,6 +156,118 @@ lemma sub_bit_list_to_nat: "bit_list_to_nat_nat (list_encode (map bit_encode x))
           sub_head_map bit_list_to_nat.simps split:bit.splits)
    apply (auto)
   done
+fun bit_list_to_nat_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"bit_list_to_nat_acc acc n = (if n =0 then acc else if hd_nat n =0 then bit_list_to_nat_acc (2*acc) (tl_nat n)
+   else  bit_list_to_nat_acc (2*acc +1) (tl_nat n))"
+
+
+fun reverse_nat_acc :: "nat \<Rightarrow>nat \<Rightarrow> nat" where 
+"reverse_nat_acc acc n = (if n = 0 then acc else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"
+
+lemma sub_reverse_nat_acc:"reverse_nat_acc (list_encode acc) (list_encode n) = list_encode (rev n @ acc) "
+  apply(induct n arbitrary: acc)
+  apply simp
+  apply(subst reverse_nat_acc.simps)
+  apply(auto simp only:sub_hd head.simps sub_tl tail.simps sub_cons rev.simps)
+  apply auto
+  done
+
+definition reverse_nat :: "nat \<Rightarrow> nat" where 
+"reverse_nat n = reverse_nat_acc 0 n"
+
+lemma sub_reverse:"reverse_nat (list_encode n) = list_encode (rev n)"
+  apply(auto simp only: reverse_nat_def )
+  using sub_reverse_nat_acc list_encode.simps(1) 
+  by (metis append_Nil2)
+lemma reverse_nat_0:"(reverse_nat 0 =0)" by (auto simp add:reverse_nat_def)
+
+lemma append_rev_nat:"append_nat (reverse_nat (Suc v)) xs = append_nat (reverse_nat (tl_nat (Suc v))) ((hd_nat (Suc v)) ## xs)"
+proof-
+  obtain ys where xs_def: "Suc v = list_encode ys" 
+    by (metis list_decode_inverse)
+  then moreover obtain a ys' where xs_def_cons : "ys = a#ys'"
+    by (metis list_encode.elims nat.simps(3))
+  moreover obtain xs_list where "xs = list_encode xs_list"  by (metis list_decode_inverse)
+  ultimately show ?thesis by (auto simp add: sub_reverse sub_tl sub_hd sub_cons 
+          sub_append simp del: list_encode.simps)
+qed
+lemma append_cons_nat_0 : "append_nat xs (a ## ys) \<noteq> 0"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  moreover obtain xs' where xs_def_cons : "xs = list_encode xs'"
+   by (metis list_decode_inverse)
+  ultimately show ?thesis by (auto simp add: sub_reverse sub_tl sub_hd sub_cons 
+          sub_append list_encode_eq simp flip: list_encode.simps)
+qed
+lemma cons_Nil:"xs ## ys \<noteq> 0"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons 
+          list_encode_eq simp flip: list_encode.simps)
+qed
+lemma tl_cons: "tl_nat (a##ys) = ys"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons sub_tl
+          list_encode_eq simp flip: list_encode.simps)
+qed
+
+lemma hd_cons: "hd_nat (a##ys) = a"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons sub_hd
+          list_encode_eq simp flip: list_encode.simps)
+qed
+lemma rev_rev_nat: "reverse_nat (reverse_nat ys) = ys"
+ proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons sub_reverse sub_hd
+          list_encode_eq simp flip: list_encode.simps)
+qed
+lemma bit_list_to_nat_induct: "bit_list_to_nat_nat (append_nat (reverse_nat ys) xs) = bit_list_to_nat_acc (bit_list_to_nat_nat xs) ys"
+  apply(induct ys arbitrary:xs rule: length_nat.induct)
+  apply (auto simp only: reverse_nat_0 append_nat.simps)
+  apply(subst bit_list_to_nat_acc.simps)
+   apply(auto simp del: bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps 
+          simp add: append_rev_nat )
+  apply(subst(2) bit_list_to_nat_acc.simps)
+     apply(auto simp del: bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps cons_def
+          simp add: append_rev_nat )
+     apply(subst bit_list_to_nat_nat.simps)
+          apply(auto simp del:   bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps cons_def
+          simp add: append_cons_nat_0 cons_Nil tl_cons hd_cons)
+  apply(subst bit_list_to_nat_nat.simps)
+ apply(auto simp del:   bit_list_to_nat_nat.simps bit_list_to_nat_acc.simps cons_def
+          simp add: append_cons_nat_0 cons_Nil tl_cons hd_cons)
+  done
+
+lemma append_nat_0: "append_nat ys 0 = ys"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_append sub_hd
+          list_encode_eq simp flip: list_encode.simps)
+qed
+
+lemma bit_list_to_nat_inverse: 
+"bit_list_to_nat_nat (append_nat ys xs) = bit_list_to_nat_acc (bit_list_to_nat_nat xs) (reverse_nat ys)"
+  using rev_rev_nat bit_list_to_nat_induct by metis
+
+definition bit_list_to_nat_tail :: "nat \<Rightarrow> nat" where 
+"bit_list_to_nat_tail ys =  bit_list_to_nat_acc 0 (reverse_nat ys)"
+
+lemma subtail_bit_list_to_nat:
+" bit_list_to_nat_tail ys = bit_list_to_nat_nat ys"
+  using bit_list_to_nat_inverse [of ys 0] append_nat_0 
+  by (auto simp add: bit_list_to_nat_tail_def)
+
+
 
 
+  
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
index 5d0fd5e5..75a36260 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
@@ -5,8 +5,39 @@ begin
 
 
 fun com_list_to_seq_nat:: "nat \<Rightarrow> nat" where
-"com_list_to_seq_nat n = (if n =0 then cons 0 0 else 
-cons 2 (cons (hd_nat n) (cons (com_list_to_seq_nat (tl_nat n)) 0)))"
+"com_list_to_seq_nat n = (if n =0 then  0 ## 0 else 
+ 2 ## ((hd_nat n) ## ((com_list_to_seq_nat (tl_nat n)) ## 0)))"
+
+fun com_list_to_seq_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"com_list_to_seq_acc acc n = (if n = 0 then  acc 
+else com_list_to_seq_acc ( 2 ## ((hd_nat n) ## (acc ## 0))) (tl_nat n))"
+
+lemma com_list_to_seq_induct: "com_list_to_seq_nat (append_nat (reverse_nat ys) xs) =
+       com_list_to_seq_acc  (com_list_to_seq_nat xs) ys"
+  apply(induct ys arbitrary:xs rule: length_nat.induct)
+    apply (auto simp only: reverse_nat_0 append_nat.simps)
+  apply(subst com_list_to_seq_acc.simps)
+   apply(auto simp del:com_list_to_seq_acc.simps com_list_to_seq_nat.simps 
+          simp add: append_rev_nat )
+  apply(subst (2) com_list_to_seq_acc.simps )
+     apply(auto simp del:com_list_to_seq_acc.simps com_list_to_seq_nat.simps 
+          simp add: append_rev_nat )
+  apply(subst com_list_to_seq_nat.simps)
+       apply(auto simp del:com_list_to_seq_acc.simps com_list_to_seq_nat.simps 
+          simp add: append_rev_nat cons_Nil hd_cons tl_cons )
+  done
+
+lemma com_list_to_seq_rev: "com_list_to_seq_nat (append_nat ys xs) =
+       com_list_to_seq_acc  (com_list_to_seq_nat xs) (reverse_nat ys)"
+  using rev_rev_nat com_list_to_seq_induct by metis
+
+definition  com_list_to_seq_tail :: "nat \<Rightarrow> nat" where 
+"com_list_to_seq_tail ys = com_list_to_seq_acc  (0##0) (reverse_nat ys) "
+lemma subtail_com_list_to_seq: "com_list_to_seq_nat ys=
+       com_list_to_seq_acc  (0##0) (reverse_nat ys)"
+  using  com_list_to_seq_rev[of ys 0]  append_nat_0 
+  by(auto)
+
 
 definition comm_list_encode :: "IMP_Minus_Minus_com list \<Rightarrow> nat" where
 "comm_list_encode xs = list_encode (map comm_encode xs) "
@@ -36,6 +67,28 @@ fun binary_assign_constant_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Righ
     (cons (var_bit_to_var_nat(prod_encode (v,n-1))) (cons (nth_bit_nat x (n-1)) 0 )))
   (cons (binary_assign_constant_nat (n-1) v x)0) ) )"
 
+fun binary_assign_constant_acc:: " nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"binary_assign_constant_acc acc diff n v x = (if diff = 0 then acc else
+binary_assign_constant_acc  (cons 2 ( cons (cons 1 
+    (cons (var_bit_to_var_tail(prod_encode (v,n-diff))) (cons (nth_bit_tail x (n-diff)) 0 )))
+  (cons acc 0) )) (diff-1) n v x )"
+
+lemma binary_assign_constant_induct: 
+  "diff \<le>n \<Longrightarrow>
+ binary_assign_constant_acc (binary_assign_constant_nat (n- diff) v x)  diff n v x
+= binary_assign_constant_nat n v x"
+  apply(induct diff)
+  apply (auto simp add: subtail_nth_bit subtail_var_bit_to_var)
+  done
+
+definition  binary_assign_constant_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"binary_assign_constant_tail n v x = binary_assign_constant_acc (0##0) n n v x "
+lemma subtail_binary_assign_constant:
+"binary_assign_constant_tail n v x = binary_assign_constant_nat n v x"
+  using binary_assign_constant_induct[of n n v x]
+  apply (auto simp add:binary_assign_constant_tail_def)
+  done
+
 lemma  sub_binary_assign_constant:
 "binary_assign_constant_nat n (vname_encode v) x = comm_encode (binary_assign_constant n v x)"
   apply (induct n)
@@ -58,6 +111,33 @@ fun copy_var_to_operand_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightar
  ## (copy_var_to_operand_nat (i-1) op v) 
   ## 0))
 "
+fun copy_var_to_operand_acc ::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"copy_var_to_operand_acc acc diff i op v = (if diff = 0 then acc 
+else copy_var_to_operand_acc  (2 ## 
+    ( 3##((var_bit_to_var_tail(prod_encode(v,i-diff))) ##0) ## (1 ## (operand_bit_to_var_tail(prod_encode(op,i-diff)))##1##0 )
+## ( 1 ## (operand_bit_to_var_tail(prod_encode(op,i-diff)))##0##0) ## 0)
+
+ ## acc ## 0) (diff-1) i op v )"
+
+lemma copy_var_to_operand_induct :
+" diff \<le> i \<Longrightarrow> copy_var_to_operand_acc (copy_var_to_operand_nat (i-diff) op v) diff i op v 
+= copy_var_to_operand_nat i op v"
+  apply(induct diff)
+   apply (auto simp add:subtail_var_bit_to_var subtail_operand_bit_to_var
+simp del:  operand_bit_to_var_nat.simps  )
+  done
+
+definition copy_var_to_operand_tail :: "nat => nat => nat => nat" where 
+"copy_var_to_operand_tail i op v = copy_var_to_operand_acc (0 ## 0) i i op v"
+
+lemma subtail_copy_var_to_operand:
+"copy_var_to_operand_tail i op v  
+= copy_var_to_operand_nat i op v"
+  using copy_var_to_operand_induct [of i i op v]
+  apply(auto simp add: copy_var_to_operand_tail_def)
+  done
+
+
 lemma sub_copy_var_to_operand:
  "copy_var_to_operand_nat i (encode_char op) (vname_encode v) = comm_encode (copy_var_to_operand i op v)  "
   apply (induct i)
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
index 7dd16e5f..b2bef113 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
@@ -20,6 +20,82 @@ lemma subtakeWhile_char :
   apply metis
   done
 
+fun takeWhile_char_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"takeWhile_char_acc acc n = (if n=0 then acc else if hd_nat n =encode_char(CHR ''#'') then takeWhile_char_acc ((hd_nat n) ## acc) (tl_nat n) else acc)"
+lemma takeWhile_char_append : "takeWhile_char xs = xs \<Longrightarrow>
+ takeWhile_char (append_nat xs ys) = append_nat xs (takeWhile_char ys)"
+proof -
+  assume "takeWhile_char xs =xs"
+  moreover obtain xs' ys' where "xs =list_encode xs'"  "ys = list_encode ys'"
+    by (metis list_decode_inverse)
+  ultimately show ?thesis by (auto simp del:takeWhile_char.simps takeWhile_nat.simps 
+          simp add: subtakeWhile_char sub_takeWhile sub_append list_encode_eq )
+qed
+lemma append_nat_cons: "append_nat xs (a ## ys) = append_nat (append_nat xs (a##0)) ys"
+proof -
+obtain xs' ys' where "xs =list_encode xs'"  "ys = list_encode ys'"
+  by (metis list_decode_inverse)
+  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
+          sub_append)
+qed
+lemma takeWhile_char_extend:"takeWhile_char xs =xs \<Longrightarrow>takeWhile_char (append_nat xs ((encode_char CHR ''#'') ## 0))
+= append_nat xs ((encode_char CHR ''#'') ## 0)"
+proof -
+assume "takeWhile_char xs =xs"
+moreover obtain xs' where "xs =list_encode xs'" 
+  by (metis list_decode_inverse)
+  ultimately show ?thesis by(auto simp del:append_nat.simps takeWhile_char.simps takeWhile_nat.simps
+              list_encode.simps simp add: cons0 sub_cons  subtakeWhile_char sub_takeWhile
+                list_encode_eq
+          sub_append)
+qed
+lemma reverse_append_nat:
+    "reverse_nat (append_nat xs ys) = append_nat (reverse_nat ys) (reverse_nat xs)"
+proof - 
+obtain xs' ys' where "xs =list_encode xs'"  "ys = list_encode ys'"
+  by (metis list_decode_inverse)
+  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
+          sub_append sub_reverse)
+qed
+lemma reverse_singleton_nat:
+"reverse_nat (a ## 0) = a ## 0" by(auto simp add: cons0 sub_reverse simp del:list_encode.simps) 
+lemma append_singleton_nat : 
+"append_nat (a##0) xs = a ## xs"
+proof - 
+  obtain xs' where "xs = list_encode xs'"
+ by (metis list_decode_inverse)
+  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
+          sub_append )
+qed
+lemma takeWhile_char_induct: " takeWhile_char xs = xs \<Longrightarrow>
+takeWhile_char (append_nat xs ys) = 
+reverse_nat (takeWhile_char_acc (reverse_nat (takeWhile_char xs)) ys) "
+  apply (induct ys arbitrary:xs rule:length_nat.induct)
+   apply (auto simp del: takeWhile_char_acc.simps takeWhile_char.simps simp add: append_nat_0 )
+   apply (simp add: rev_rev_nat)
+  apply(auto simp only: takeWhile_char_append)
+  apply(subst takeWhile_char.simps)
+  apply(auto  simp del: takeWhile_char_acc.simps takeWhile_char.simps )
+  subgoal for v xs
+    apply(subst append_nat_cons[of xs])
+    apply(auto simp add: takeWhile_char_extend simp del: takeWhile_char_acc.simps takeWhile_char.simps )
+    apply(subst (2) takeWhile_char_acc.simps)
+    apply(auto simp add: reverse_append_nat  reverse_singleton_nat append_singleton_nat
+            simp del: takeWhile_char_acc.simps takeWhile_char.simps)
+    done
+  apply(subst takeWhile_char_acc.simps)
+    apply(auto simp add:append_nat_0  rev_rev_nat
+            simp del: takeWhile_char_acc.simps takeWhile_char.simps)
+  done
+definition takeWhile_char_tail:: "nat \<Rightarrow> nat" where
+"takeWhile_char_tail ys = reverse_nat (takeWhile_char_acc 0 ys)  "
+lemma subtail_takeWhile_char: "
+takeWhile_char_tail ys = takeWhile_char ys"
+  using  takeWhile_char_induct[of 0]
+  apply (auto simp del:takeWhile_char_acc.simps takeWhile_char.simps simp add:
+ reverse_nat_0 takeWhile_char_tail_def)
+  apply auto
+  done
 
 definition var_to_var_bit_nat :: "nat \<Rightarrow> nat" where
 "var_to_var_bit_nat v = (if length_nat v > 0 then (if hd_nat v = encode_char (CHR ''#'') 
@@ -30,6 +106,18 @@ definition var_to_var_bit_nat :: "nat \<Rightarrow> nat" where
   else 0)
   else 0)"
 
+definition var_to_var_bit_tail :: "nat \<Rightarrow> nat" where
+"var_to_var_bit_tail v = (if length_nat v > 0 then (if hd_nat v = encode_char (CHR ''#'') 
+  then (let t = dropWhile_char v; 
+  l = length_nat (takeWhile_char_tail v) - 1 in
+  (if length_nat t > 0 \<and> hd_nat t = encode_char(CHR ''$'') then some_nat (prod_encode(tl_nat t, l))
+   else 0))
+  else 0)
+  else 0)"
+lemma subtail_var_to_var_bit:
+"var_to_var_bit_tail v = var_to_var_bit_nat v"
+  by (auto simp only:var_to_var_bit_tail_def var_to_var_bit_nat_def subtail_takeWhile_char)
+
 fun vname_nat_encode :: "vname*nat \<Rightarrow> nat" where 
 "vname_nat_encode (v,n) = prod_encode (vname_encode v, n)"
 
@@ -81,12 +169,51 @@ lemma sub_n_hashes : "n_hashes_nat n = vname_encode (n_hashes n)"
    apply (auto simp only:vname_encode_def n_hashes_nat.simps n_hashes.simps sub_cons)
    apply auto 
   done
+fun n_hashes_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"n_hashes_acc acc 0  = acc" |
+"n_hashes_acc acc (Suc n) = n_hashes_acc ((encode_char (CHR ''#'')) ## acc) n"
+lemma Suc_plus:"Suc(m+n) = Suc m + n "
+  by simp
+lemma n_hashes_dashes: 
+"reverse_nat (n_hashes_nat (Suc m)) = (encode_char CHR ''#'') ## reverse_nat (n_hashes_nat m)"
+  apply(auto simp add: sub_cons sub_reverse sub_n_hashes vname_encode_def 
+list_encode_eq
+simp del:list_encode.simps)
+  apply(induct m)
+   apply auto
+  done
+
+lemma n_hashes_induct: "
+n_hashes_nat (m+n) = reverse_nat (n_hashes_acc (reverse_nat (n_hashes_nat m)) n) "
+  apply(induct n arbitrary:m)
+  apply(simp add: rev_rev_nat)
+  apply(auto simp add:rev_rev_nat 
+ simp del:n_hashes_acc.simps n_hashes_nat.simps)
+  subgoal for n m
+    apply(auto simp only: Suc_plus[of m n] n_hashes_acc.simps n_hashes_dashes)
+    done
+  done
+
+definition n_hashes_tail::"nat \<Rightarrow> nat" where 
+"n_hashes_tail n = reverse_nat (n_hashes_acc 0 n)"
 
+lemma subtail_n_hashes:
+"n_hashes_tail n = n_hashes_nat n"
+  using  n_hashes_induct[of 0 n]
+  by (auto simp del: n_hashes_acc.simps simp add:reverse_nat_0 n_hashes_tail_def)
 
 definition var_bit_to_var_nat:: "nat \<Rightarrow> nat" where
 "var_bit_to_var_nat vk = append_nat (append_nat (n_hashes_nat (snd_nat vk + 1)) 
     (vname_encode ''$'')) (fst_nat vk)" 
-thm "vname_nat_encode.simps"
+
+definition var_bit_to_var_tail:: "nat \<Rightarrow> nat" where
+"var_bit_to_var_tail vk = append_nat (append_nat (n_hashes_tail (snd_nat vk + 1)) 
+    (vname_encode ''$'')) (fst_nat vk)" 
+lemma subtail_var_bit_to_var:
+"var_bit_to_var_tail vk = var_bit_to_var_nat vk"
+  apply(auto simp only: var_bit_to_var_nat_def var_bit_to_var_tail_def subtail_n_hashes)
+  done
+
 lemma sub_var_bit_to_var :
 "var_bit_to_var_nat (vname_nat_encode vk) = vname_encode (var_bit_to_var vk)"
   apply (cases vk)
@@ -115,6 +242,45 @@ fun operand_bit_to_var_nat:: "nat \<Rightarrow> nat" where
 "operand_bit_to_var_nat p  = (if snd_nat p = 0 then cons (fst_nat p) 0 else cons (fst_nat p) 
 (operand_bit_to_var_nat (prod_encode (fst_nat p, snd_nat p - 1))))"
 
+fun operand_bit_to_var_acc:: " nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"operand_bit_to_var_acc acc p  = (if snd_nat p = 0 then acc else 
+(operand_bit_to_var_acc ((fst_nat p) ## acc) (prod_encode (fst_nat p, snd_nat p - 1))))"
+
+lemma operand_bit_to_var_induct: 
+"operand_bit_to_var_nat (prod_encode (c,n+m)) = 
+operand_bit_to_var_acc (operand_bit_to_var_nat (prod_encode (c,n))) (prod_encode (c,m))"
+  apply(induct m arbitrary:n)
+   apply(subst operand_bit_to_var_acc.simps)
+   apply(auto simp add: sub_fst sub_snd 
+          simp del: operand_bit_to_var_nat.simps operand_bit_to_var_acc.simps)
+  subgoal for m n
+    apply(auto simp only: Suc_plus [of n m])
+       apply(subst (2) operand_bit_to_var_acc.simps)
+          apply(auto simp add: rev_rev_nat sub_fst sub_snd 
+          simp del: operand_bit_to_var_nat.simps operand_bit_to_var_acc.simps)
+    apply(subst operand_bit_to_var_nat.simps)
+    apply(auto simp add: rev_rev_nat sub_fst sub_snd 
+          simp del: operand_bit_to_var_nat.simps operand_bit_to_var_acc.simps)
+    done
+  done
+
+definition operand_bit_to_var_tail :: "nat \<Rightarrow> nat" where 
+"operand_bit_to_var_tail p = operand_bit_to_var_acc (cons (fst_nat p) 0) p "
+lemma subtail_operand_bit_to_var: 
+"operand_bit_to_var_tail p = operand_bit_to_var_nat p "
+proof - 
+  obtain c m where "p = prod_encode (c,m)"
+    by (metis operand_bit_to_var_acc.cases prod_decode_inverse)
+  thus ?thesis using  operand_bit_to_var_induct[of c 0 m] apply (auto simp add:sub_fst
+operand_bit_to_var_tail_def 
+              simp del:operand_bit_to_var_nat.simps
+operand_bit_to_var_acc.simps )
+    apply(subst operand_bit_to_var_nat.simps)
+    apply (auto simp add:sub_fst sub_snd simp del:operand_bit_to_var_nat.simps
+operand_bit_to_var_acc.simps )
+    done
+qed
+
 fun char_nat_encode ::"char * nat \<Rightarrow> nat " where 
 "char_nat_encode (x,n) = prod_encode (encode_char x,n) "
 
@@ -150,6 +316,17 @@ definition var_to_operand_bit_nat:: "nat \<Rightarrow> nat" where
      (prod_encode(hd_nat v, length_nat v - 1))) 
   then some_nat (prod_encode(hd_nat v, length_nat v - 1)) else 0)" 
 
+definition var_to_operand_bit_tail:: "nat \<Rightarrow> nat" where
+"var_to_operand_bit_tail v = (if v \<noteq> 0 \<and> v = (operand_bit_to_var_tail
+     (prod_encode(hd_nat v, length_nat v - 1))) 
+  then some_nat (prod_encode(hd_nat v, length_nat v - 1)) else 0)" 
+
+lemma subtail_var_to_operand_bit: 
+"var_to_operand_bit_tail v =var_to_operand_bit_nat v"
+  apply(auto simp only:var_to_operand_bit_tail_def var_to_operand_bit_nat_def
+subtail_operand_bit_to_var)
+  done
+
 fun char_nat_option_encode :: "(char*nat) option \<Rightarrow> nat" where 
 "char_nat_option_encode None = 0"|
 "char_nat_option_encode (Some x) = Suc (char_nat_encode x)"
@@ -212,6 +389,27 @@ if k < n then Suc (nth_bit_nat a k) else 0 else if  var_to_operand_bit_nat v \<n
 then if k < n then Suc (nth_bit_nat b k) else 0 else  
    (if v = vname_encode (''carry'') then Suc 0 else 0)))"
 
+definition IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_tail:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat \<Rightarrow> nat" where
+"IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_tail s n a b v =  
+ ( if  var_to_var_bit_tail v \<noteq> 0 then 
+ ( let v' = fst_nat (var_to_var_bit_tail v -1) ; k = snd_nat (var_to_var_bit_tail v -1) in
+     if k < n then some_nat (nth_bit_tail (fun_list_find_tail  s v') k) else 0) 
+  else ( let  v' = fst_nat (var_to_operand_bit_tail v -1) ; k = snd_nat (var_to_operand_bit_tail v -1)
+             in if var_to_operand_bit_tail v \<noteq> 0 \<and> v' = encode_char( CHR ''a'') then 
+if k < n then Suc (nth_bit_tail a k) else 0 else if  var_to_operand_bit_tail v \<noteq> 0 \<and> v' = encode_char( CHR ''b'') 
+then if k < n then Suc (nth_bit_tail b k) else 0 else  
+   (if v = vname_encode (''carry'') then Suc 0 else 0)))"
+
+lemma subtail_IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b:
+"IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_tail s n a b v 
+= IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat s n a b v"
+  apply(auto simp only:
+      IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_tail_def
+      IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat_def
+      subtail_var_to_operand_bit subtail_nth_bit subtail_var_to_var_bit subtail_fun_list_find)
+  done
+
 lemma impm_assignment_simp:"impm_assignment_encode = prod_encode o (\<lambda>(x,y).(vname_encode x,y))"
   apply auto
   done
@@ -284,12 +482,81 @@ sub_lambda_partial)
 fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_IMP_Minus_State_To_IMP_Minus_Minus_partial k n = 
 (if n =0 then 0 else (prod_encode(fst_nat (hd_nat n),nth_bit_nat (snd_nat (hd_nat n)) k)) ##  map_IMP_Minus_State_To_IMP_Minus_Minus_partial k (tl_nat n))"
+
+fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat  \<Rightarrow> nat" where 
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc acc k n
+= (if n = 0 then acc else map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc (
+(prod_encode(fst_nat (hd_nat n),nth_bit_nat (snd_nat (hd_nat n)) k))## acc) k (tl_nat n))"
+
+
 lemma submap_IMP_Minus_State_To_IMP_Minus_Minus_partial:
 "map_IMP_Minus_State_To_IMP_Minus_Minus_partial k s = map_nat (\<lambda>n. prod_encode(fst_nat n,nth_bit_nat (snd_nat n) k)) s"
   apply (induct k s rule:map_IMP_Minus_State_To_IMP_Minus_Minus_partial.induct)
   apply (auto)
   done
 
+lemma map_IMP_Minus_state_append:
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial k (append_nat xs ys)
+= append_nat (map_IMP_Minus_State_To_IMP_Minus_Minus_partial k xs) 
+(map_IMP_Minus_State_To_IMP_Minus_Minus_partial k ys)"
+proof -
+  obtain xs' ys' where  "xs = list_encode xs'" "ys = list_encode ys'"
+    by (metis list_decode_inverse)
+  thus ?thesis 
+    apply( auto simp del:map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps list_encode.simps
+map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps map_nat.simps simp add:
+    submap_IMP_Minus_State_To_IMP_Minus_Minus_partial sub_map sub_append)
+    done
+qed
+lemma append_nat_Suc: 
+"append_nat xs (Suc v) = append_nat (append_nat xs ((hd_nat (Suc v))##0)) (tl_nat (Suc v))"
+proof -
+  obtain xs' v' where "xs =list_encode xs'" "Suc v = list_encode v'"
+    by (metis list_decode_inverse)
+  then moreover obtain a ys where "v' = a # ys" 
+    by (metis Zero_neq_Suc list_encode.elims)
+  ultimately show ?thesis apply(auto simp add:sub_append  sub_hd cons0 
+              sub_tl simp del:list_encode.simps) done
+qed
+
+lemma map_IMP_Minus_State_To_IMP_Minus_Minus_partial_induct:
+" map_IMP_Minus_State_To_IMP_Minus_Minus_partial k (append_nat xs ys) = reverse_nat(
+map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc (reverse_nat (map_IMP_Minus_State_To_IMP_Minus_Minus_partial k xs)) k ys)"
+  apply(induct ys arbitrary:xs rule:length_nat.induct)
+   apply(auto simp add: append_nat_0 simp del: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps
+        map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+   apply(subst map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+     apply(auto simp add: rev_rev_nat append_nat_Suc simp del: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps
+        map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+  apply(subst (2)  map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+  apply(auto simp add: rev_rev_nat append_nat_Suc map_IMP_Minus_state_append
+        reverse_append_nat simp del: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps
+        map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+  apply(subst  map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps)
+    apply(auto simp add: cons_Nil reverse_singleton_nat simp del: list_encode.simps map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps
+        map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+    apply(auto simp add: sub_hd cons0 sub_tl simp del: list_encode.simps map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps
+        map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+  apply(auto simp only: list_encode.simps)
+  apply(subst  map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps)
+    apply(auto simp add: reverse_singleton_nat append_singleton_nat  simp del: list_encode.simps map_IMP_Minus_State_To_IMP_Minus_Minus_partial.simps
+        map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps)
+  done
+
+definition map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+" map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail k ys  = reverse_nat(
+map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc 0 k ys)"
+
+lemma subtail_map_IMP_Minus_State_To_IMP_Minus_Minus_partial:
+"  map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail k ys = 
+map_IMP_Minus_State_To_IMP_Minus_Minus_partial k ys"
+  using map_IMP_Minus_State_To_IMP_Minus_Minus_partial_induct[of k 0 ys]
+  apply (auto simp add: reverse_nat_0 map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail_def     
+            simp del:map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps 
+       )
+  done
+
+
 definition IMP_Minus_State_To_IMP_Minus_Minus_partial_nat:: 
   "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
 "IMP_Minus_State_To_IMP_Minus_Minus_partial_nat s n r v = (
@@ -301,6 +568,27 @@ if po \<noteq> 0 \<and> vo = encode_char CHR ''a'' then  if ko < n then Suc 0 el
 po \<noteq> 0 \<and> vo = encode_char CHR ''b''then if ko < n then Suc 0 else 0 else 
 (if v = vname_encode ''carry'' then Suc 0 else 0)))"
 
+definition IMP_Minus_State_To_IMP_Minus_Minus_partial_tail:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_State_To_IMP_Minus_Minus_partial_tail s n r v = (
+let p = var_to_var_bit_tail v ; v' = fst_nat (p-1) ; k = snd_nat (p-1)
+in  if p \<noteq> 0 then  if k \<ge> n then 0 else 
+  (if k < r then map_list_find_tail (map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail k s) v' else Suc 0) else
+      (let po = var_to_operand_bit_tail v ; vo = fst_nat (po-1) ; ko = snd_nat (po-1) in
+if po \<noteq> 0 \<and> vo = encode_char CHR ''a'' then  if ko < n then Suc 0 else 0 else if 
+po \<noteq> 0 \<and> vo = encode_char CHR ''b''then if ko < n then Suc 0 else 0 else 
+(if v = vname_encode ''carry'' then Suc 0 else 0)))"
+
+lemma subtail_IMP_Minus_State_To_IMP_Minus_Minus_partial:
+"IMP_Minus_State_To_IMP_Minus_Minus_partial_tail s n r v = 
+IMP_Minus_State_To_IMP_Minus_Minus_partial_nat s n r v"
+  apply(auto simp only: IMP_Minus_State_To_IMP_Minus_Minus_partial_tail_def
+     IMP_Minus_State_To_IMP_Minus_Minus_partial_nat_def
+      subtail_map_list_find subtail_var_to_operand_bit subtail_var_to_var_bit
+      subtail_map_IMP_Minus_State_To_IMP_Minus_Minus_partial
+)
+  done
+
 lemma snd_nat_0 :"snd_nat 0 = 0"
   apply (auto simp add:snd_nat_def prod_decode_def prod_decode_aux.simps)
   done
@@ -359,6 +647,18 @@ definition IMP_Minus_State_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rig
 "IMP_Minus_State_To_IMP_Minus_Minus_nat s n v
   = IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_nat s n 0 0 v"
 
+definition IMP_Minus_State_To_IMP_Minus_Minus_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_State_To_IMP_Minus_Minus_tail s n v
+  = IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_tail s n 0 0 v"
+
+lemma subtail_IMP_Minus_State_To_IMP_Minus_Minus:
+"IMP_Minus_State_To_IMP_Minus_Minus_tail s n v = 
+IMP_Minus_State_To_IMP_Minus_Minus_nat s n v"
+  apply(auto simp only: IMP_Minus_State_To_IMP_Minus_Minus_tail_def 
+IMP_Minus_State_To_IMP_Minus_Minus_nat_def
+        subtail_IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b)
+  done
+
 lemma subnat_IMP_Minus_State_To_IMP_Minus_Minus:
 "IMP_Minus_State_To_IMP_Minus_Minus_nat (impm_assignment_list_encode s) n (vname_encode v) =
 bit_option_encode (IMP_Minus_State_To_IMP_Minus_Minus_list s n v)"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index 20f8a6a9..adba2e80 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -965,6 +965,16 @@ fun map_list_find_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "map_list_find_nat xs a = (if xs = 0 then 0 else if fst_nat (hd_nat xs) = a then some_nat (snd_nat (hd_nat xs))  
   else map_list_find_nat (tl_nat xs) a) "
 
+fun map_list_find_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_list_find_tail xs a = (if xs = 0 then 0 else if fst_nat (hd_nat xs) = a then some_nat (snd_nat (hd_nat xs))  
+  else map_list_find_nat (tl_nat xs) a) "
+
+lemma subtail_map_list_find:
+"map_list_find_tail xs a = map_list_find_nat xs a"
+  apply(induct xs a rule: map_list_find_nat.induct)
+  apply auto
+  done
+
 lemma sub_map_list_find_nat:
       "map_list_find_nat (list_encode (map prod_encode xs)) a =
         option_encode (map_list_find xs a)"
@@ -1031,6 +1041,13 @@ lemma sub_fun_list_find:"fun_list_find xs a = fun_of xs a"
 fun fun_list_find_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "fun_list_find_nat xs a  = (if xs = 0 then 0 else if fst_nat (hd_nat xs) = a then snd_nat (hd_nat xs) else fun_list_find_nat (tl_nat xs) a) "
 
+fun fun_list_find_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"fun_list_find_tail xs a  = (if xs = 0 then 0 else if fst_nat (hd_nat xs) = a then snd_nat (hd_nat xs) else fun_list_find_tail (tl_nat xs) a) "
+
+lemma subtail_fun_list_find: "fun_list_find_tail xs a = fun_list_find_nat xs a"
+  apply(induct xs a rule: fun_list_find_tail.induct)
+  apply auto
+  done
 
 lemma sub_fun_list_find_nat :
  "fun_list_find_nat (list_encode (map prod_encode xs)) a = fun_list_find xs a"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
index 6a8249e6..b9e02516 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -451,7 +451,7 @@ lemma inj_formula : "inj sat_formula_encode"
 lemma inj_formula_simp : "(sat_formula_encode x = sat_formula_encode y) = (x=y)"
   using inj_formula by (auto simp add:inj_def)
 lemma main_lemma_hol_nat:
-  fixes c pt p_cer in_lang
+  fixes c and pt::"nat*nat" and p_cer::"nat*nat" and in_lang
   assumes verifier_tbounded:
     "\<And>s. \<exists>t s'. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
                    t \<le> poly_of pt (bit_length (s ''input''))"

From 93e3b5efad08c272ecafa51e1bc28c086104915a Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Sat, 28 Aug 2021 11:12:03 +0200
Subject: [PATCH 016/103] refinement to tail-rec, started general pattern for
 IMP- to IMP--

---
 .../IMP_Minus_Minus_Subprograms_Nat.thy       |  64 +++
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy | 107 ++++-
 ...o_SAS_Plus_Plus_State_Translations_Nat.thy |  28 ++
 .../IMP-_To_IMP--/Binary_Arithmetic_Nat.thy   |  74 ----
 .../IMP-_To_IMP--/Binary_Operations_Nat.thy   | 349 ++++++++++++++-
 ...IMP_Minus_Minus_State_Translations_nat.thy |  37 +-
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      |  93 ++++
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy | 407 +++++++++++++++++-
 .../SAS_Plus_Plus_To_SAS_Plus_Nat.thy         | 315 +++++++++++++-
 .../IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy      | 231 +++++++++-
 Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy |  80 ++++
 11 files changed, 1652 insertions(+), 133 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
index b0e5258b..0f9e425d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
@@ -6,20 +6,62 @@ begin
 fun map_all_subprograms:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_all_subprograms c n = (if n =0 then 0 else (2## (hd_nat n) ## (nth_nat (Suc (Suc 0)) c ) ## 0) ## map_all_subprograms c (tl_nat n) )"
 
+fun map_all_subprograms_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms_acc c acc n = (if n =0 then acc else map_all_subprograms_acc c ((2## (hd_nat n) ## (nth_nat (Suc (Suc 0)) c ) ## 0) ## acc ) (tl_nat n) )"
+
+lemma map_all_subprograms_induct:
+"map_all_subprograms_acc c acc n = map_acc (\<lambda>c'. 2## c' ## (nth_nat (Suc (Suc 0)) c ) ## 0) acc n"
+  apply(induct c acc n rule: map_all_subprograms_acc.induct)
+  apply(auto)
+  done
+
+definition map_all_subprograms_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms_tail c n = reverse_nat (map_all_subprograms_acc c 0 n)"
+
 lemma submap_all_subprograms:
   "map_all_subprograms c n = map_nat (\<lambda>c'. 2## c' ## (nth_nat (Suc (Suc 0)) c ) ## 0) n"
   apply (induct c n rule: map_all_subprograms.induct)
   apply auto
   done
 
+lemma subtail_map_all_subprograms:
+"map_all_subprograms_tail c n = map_all_subprograms c n"
+  using submap_all_subprograms map_all_subprograms_tail_def  map_all_subprograms_induct[of c 0 n]
+  subtail_map by presburger
+
+
+
 fun map_all_subprograms2:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_all_subprograms2 c n = (if n =0 then 0 else ( 2## (hd_nat n) ## c ## 0) ## map_all_subprograms2 c (tl_nat n) )"
+
+
 lemma submap_all_subprograms2:
 "map_all_subprograms2 c n = map_nat (\<lambda>x. 2## x ## c ## 0) n"
   apply (induct c n rule: map_all_subprograms2.induct)
   apply auto
   done
 
+fun map_all_subprograms2_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms2_acc  c acc n = (if n =0 then acc else 
+map_all_subprograms2_acc c (( 2## (hd_nat n) ## c ## 0) ## acc) (tl_nat n) )"
+
+lemma  map_all_subprograms2_induct:
+" map_all_subprograms2_acc c acc n = map_acc  (\<lambda>x. 2## x ## c ## 0) acc n"
+  apply(induct c acc n rule:map_all_subprograms2_acc.induct)
+  apply auto
+  done
+
+definition map_all_subprograms2_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms2_tail c n = reverse_nat (map_all_subprograms2_acc c 0 n)"
+
+lemma subtail_map_all_subprograms2:
+"map_all_subprograms2_tail c n = map_all_subprograms2 c n"
+  using submap_all_subprograms2 map_all_subprograms2_tail_def  map_all_subprograms2_induct[of c 0 n]
+  subtail_map by presburger
+
+
+
+
 declare nth_nat.simps[simp del]
 fun all_subprograms_nat :: "nat \<Rightarrow> nat" where
 "all_subprograms_nat c  = (if c=0 \<or> hd_nat c = 0 then (0##0)##0 else
@@ -69,6 +111,10 @@ fun all_variables_nat :: "nat \<Rightarrow>nat" where
 if hd_nat n = 1 then (nth_nat (Suc 0) n) ## 0 else
 nth_nat (Suc 0) n )"
 
+definition all_variables_tail where "all_variables_tail = all_variables_nat"
+
+lemma subtail_all_variables : "all_variables_tail = all_variables_nat" using  all_variables_tail_def by meson
+
 lemma sub_all_variables: "all_variables_nat (comm_encode c) = vname_list_encode (all_variables c)"
   apply (cases c)
       apply (auto simp only:all_variables_nat.simps sub_hd comm_encode.simps head.simps 
@@ -78,11 +124,29 @@ lemma sub_all_variables: "all_variables_nat (comm_encode c) = vname_list_encode
 
 fun map_all_variables:: "nat \<Rightarrow> nat" where 
 "map_all_variables n = (if n =0 then 0 else (all_variables_nat (hd_nat n)) ## map_all_variables (tl_nat n) )"
+
+fun map_all_variables_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_variables_acc acc n = (if n =0 then acc else map_all_variables_acc ((all_variables_tail (hd_nat n)) ## acc) (tl_nat n) )"
+
 lemma submap_all_variables:
 "map_all_variables n = map_nat all_variables_nat n"
   apply (induct n rule:map_all_variables.induct)
   apply auto
   done
+lemma  map_all_variables_induct:
+" map_all_variables_acc acc n = map_acc all_variables_nat acc n"
+  apply(induct acc n rule: map_all_variables_acc.induct)
+  apply (auto simp add: subtail_all_variables )
+  done
+
+definition map_all_variables_tail :: "nat \<Rightarrow> nat" where 
+" map_all_variables_tail n = reverse_nat (map_all_variables_acc 0 n)"
+
+lemma subtail_map_all_variables:
+" map_all_variables_tail n  =  map_all_variables n "
+  using map_all_variables_tail_def  map_all_variables_induct[of 0 n]
+  submap_all_variables subtail_map by presburger
+
 
 definition enumerate_variables_nat :: "nat \<Rightarrow> nat" where
 "enumerate_variables_nat c =
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index 5f53a71d..8b85edc0 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -5,6 +5,10 @@ begin
 definition domain_nat :: "nat" where
 "domain_nat = list_encode [prod_encode(0,0), prod_encode(0,1)]"
 
+definition domain_tail :: "nat " where "domain_tail = domain_nat"
+
+lemma subtail_domain  : "domain_tail = domain_nat" using domain_tail_def by auto
+
 lemma sub_domain: "domain_nat = list_encode (map domain_element_encode domain)"
   apply (auto simp add:domain_nat_def)
   done
@@ -13,6 +17,12 @@ definition pc_to_com_nat :: "nat\<Rightarrow> nat" where
 "pc_to_com_nat l =(if fst_nat(snd_nat(hd_nat l)) = 1 then snd_nat (snd_nat (hd_nat l)) 
                   else  0##0)"
 
+definition pc_to_com_tail ::" nat \<Rightarrow> nat" where 
+"pc_to_com_tail l = pc_to_com_nat l"
+
+lemma subtail_pc_to_com:
+"pc_to_com_tail l = pc_to_com_nat l" using pc_to_com_tail_def by auto
+
 lemma sub_pc_to_com :
   "pc_to_com_nat (sas_assignment_list_encode l) = comm_encode (pc_to_com l)"
   apply (cases l)
@@ -39,6 +49,27 @@ fun map_com_to_operators:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow
 ## map_com_to_operators c c2 (tl_nat n)
 )"
 
+fun map_com_to_operators_acc:: " nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_com_to_operators_acc c c2 acc n = (if n = 0 then acc else map_com_to_operators_acc c c2 
+ ((let c1' = pc_to_com_tail (nth_nat (Suc 0) (hd_nat n)) in  
+        (list_update_tail (nth_nat 0 (hd_nat n)) 0 (prod_encode (0,prod_encode(1,c))))##
+        (list_update_tail (nth_nat (Suc 0) (hd_nat n)) 0 (prod_encode(0, prod_encode(1, 2 ##c1'##c2##0))))##0 )
+## acc) (tl_nat n)
+)"
+
+lemma map_com_to_operators_induct:
+"map_com_to_operators_acc c c2 acc n = map_acc(\<lambda> op. 
+    (let c1' = pc_to_com_nat (nth_nat (Suc 0) op) in  
+        (list_update_nat (nth_nat 0 op) 0 (prod_encode (0,prod_encode(1,c))))##
+        (list_update_nat (nth_nat (Suc 0) op) 0 (prod_encode(0, prod_encode(1, 2 ##c1'##c2##0))))##0 ))
+acc n "
+  apply(induct c c2 acc n rule:map_com_to_operators_acc.induct)
+  apply(auto simp add: subtail_pc_to_com subtail_list_update)
+  done
+
+definition map_com_to_operators_tail :: "nat => nat => nat => nat" where 
+"map_com_to_operators_tail c c2 n =  reverse_nat (map_com_to_operators_acc c c2 0 n)"
+
 lemma submap_com_to_operators:
 "map_com_to_operators c c2 n =
  map_nat (\<lambda> op. 
@@ -49,19 +80,48 @@ lemma submap_com_to_operators:
   apply (induct c c2 n rule:map_com_to_operators.induct)
   apply auto
   done
+
+lemma subtail_map_com_to_operators:
+"map_com_to_operators_tail c c2 n = map_com_to_operators c c2 n"
+  using  submap_com_to_operators  map_com_to_operators_tail_def
+ map_com_to_operators_induct subtail_map by presburger
+
 fun map_com_to_operators2 :: "nat \<Rightarrow> nat" where 
 " map_com_to_operators2 n = (if n = 0 then 0 else (prod_encode(Suc (hd_nat n), prod_encode(0,0)))##  map_com_to_operators2 (tl_nat n))"
 
+
 lemma submap_com_to_operators2: 
 " map_com_to_operators2 n =  map_nat (\<lambda>v. prod_encode(Suc v, prod_encode(0,0))) n"
   apply (induct n rule:map_com_to_operators2.induct)
   apply auto
   done
 
+fun map_com_to_operators2_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+" map_com_to_operators2_acc acc n = (if n = 0 then acc else map_com_to_operators2_acc
+((prod_encode(Suc (hd_nat n), prod_encode(0,0)))## acc )(tl_nat n))"
+
+lemma map_com_to_operators2_induct: 
+"map_com_to_operators2_acc acc n = map_acc (\<lambda>v. prod_encode(Suc v, prod_encode(0,0))) acc n"
+  apply(induct acc n rule:map_com_to_operators2_acc.induct)
+apply auto
+  done
+
+definition map_com_to_operators2_tail :: "nat => nat" where 
+"map_com_to_operators2_tail n =  reverse_nat (map_com_to_operators2_acc 0 n)"
+
+lemma subtail_map_com_to_operators2:
+"map_com_to_operators2_tail  n = map_com_to_operators2 n"
+  using  submap_com_to_operators2  map_com_to_operators2_tail_def
+ map_com_to_operators2_induct subtail_map by presburger
+
 fun  map_com_to_operators3 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_com_to_operators3 i c1 n  = (if n =0 then 0 else ((((prod_encode(0, i))## (prod_encode(Suc (hd_nat n), prod_encode(0,1)))##0)## 
          ((prod_encode(0, prod_encode(1, c1)))##0)## 0)) ##map_com_to_operators3 i c1 (tl_nat n))"
 
+fun  map_com_to_operators3_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_com_to_operators3_acc  i c1 acc n  = (if n =0 then acc else map_com_to_operators3_acc  i c1  (((((prod_encode(0, i))## (prod_encode(Suc (hd_nat n), prod_encode(0,1)))##0)## 
+         ((prod_encode(0, prod_encode(1, c1)))##0)## 0)) ##acc) (tl_nat n))"
+
 lemma submap_com_to_operators3:
 "map_com_to_operators3 i c1 n = map_nat (\<lambda> v. 
       ( ((prod_encode(0, i))## (prod_encode(Suc v, prod_encode(0,1)))##0)## 
@@ -69,18 +129,53 @@ lemma submap_com_to_operators3:
   apply (induct i c1 n rule:map_com_to_operators3.induct)
   apply auto
   done
+lemma map_com_to_operators3_induct:
+"map_com_to_operators3_acc  i c1 acc n = map_acc  (\<lambda> v. 
+      ( ((prod_encode(0, i))## (prod_encode(Suc v, prod_encode(0,1)))##0)## 
+         ((prod_encode(0, prod_encode(1, c1)))##0)## 0)) acc n"
+  apply(induct  i c1 acc n  rule:map_com_to_operators3_acc.induct)
+  apply auto
+  done
+
+definition map_com_to_operators3_tail :: " nat \<Rightarrow> nat \<Rightarrow> nat => nat" where 
+"map_com_to_operators3_tail i c1 n =  reverse_nat (map_com_to_operators3_acc i c1 0 n)"
+
+lemma subtail_map_com_to_operators3:
+"map_com_to_operators3_tail i c1 n = map_com_to_operators3 i c1 n"
+  using  submap_com_to_operators3  map_com_to_operators3_tail_def
+ map_com_to_operators3_induct subtail_map by presburger
 
 fun  map_com_to_operators4 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where 
-"map_com_to_operators4 i j n = (if n=0 then 0 else (( (((prod_encode(0, i)) ## (prod_encode (Suc (hd_nat n), prod_encode(0,1) )) ##0)) ## 
-         (((prod_encode(0, j))##0) ## 0 ))) ## map_com_to_operators4 i j (tl_nat n))"
+"map_com_to_operators4 i j n = (if n=0 then 0 else ((((prod_encode(0, i)) ## (prod_encode (Suc (hd_nat n), prod_encode(0,1) )) ##0)) ## 
+         (((prod_encode(0, j))##0) ## 0 )) ## map_com_to_operators4 i j (tl_nat n))"
 
 lemma submap_com_to_operators4:
 "map_com_to_operators4 i j n =  map_nat (\<lambda> v. 
-      ( (((prod_encode(0, i)) ## (prod_encode (Suc v, prod_encode(0,1) )) ##0)) ## 
-         (((prod_encode(0, j))##0) ## 0 ))) n "
+       (((prod_encode(0, i)) ## (prod_encode (Suc v, prod_encode(0,1) )) ##0)) ## 
+         (((prod_encode(0, j))##0) ## 0 )) n "
   apply (induct i j n rule:map_com_to_operators4.induct)
   apply auto
   done
+fun  map_com_to_operators4_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where 
+"map_com_to_operators4_acc i j acc n = (if n=0 then acc else map_com_to_operators4_acc i j  (((((prod_encode(0, i)) ## (prod_encode (Suc (hd_nat n), prod_encode(0,1) )) ##0)) ## 
+         (((prod_encode(0, j))##0) ## 0 )) ## acc) (tl_nat n))"
+
+lemma map_com_to_operators4_induct:
+"map_com_to_operators4_acc i j acc n = map_acc(\<lambda> v. 
+      ( (((prod_encode(0, i)) ## (prod_encode (Suc v, prod_encode(0,1) )) ##0)) ## 
+         (((prod_encode(0, j))##0) ## 0 ))) acc n"
+  apply(induct i j acc n rule:map_com_to_operators4_acc.induct)
+  apply auto
+  done
+
+
+definition map_com_to_operators4_tail :: " nat \<Rightarrow> nat \<Rightarrow> nat => nat" where 
+"map_com_to_operators4_tail i j n =  reverse_nat (map_com_to_operators4_acc i j 0 n)"
+
+lemma subtail_map_com_to_operators4:
+"map_com_to_operators4_tail i j n = map_com_to_operators4 i j n"
+  using  submap_com_to_operators4  map_com_to_operators4_tail_def
+ map_com_to_operators4_induct subtail_map by presburger
 
 fun com_to_operators_nat :: "nat \<Rightarrow> nat" where
 "com_to_operators_nat c = (if c = 0 \<or> hd_nat c = 0 then 0 else 
@@ -108,6 +203,7 @@ else (let i = prod_encode(1,c) ;  vs = nth_nat (Suc 0) c ; c' = nth_nat (Suc (Su
         (((prod_encode(0, k))##0))##0) 
       ## map_com_to_operators4 i j vs))
 "
+
 declare nth_nat.simps[simp]
 
 lemma com_to_operators_inv: 
@@ -183,7 +279,8 @@ sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps co
 
 fun map_coms_to_operators :: "nat \<Rightarrow> nat" where 
 "map_coms_to_operators n = (if n = 0 then 0 else (com_to_operators_nat (hd_nat n)) ## map_coms_to_operators (tl_nat n))"
- 
+
+
 lemma submap_coms_to_operators : 
 "map_coms_to_operators n  = map_nat com_to_operators_nat n "
   apply (induct n rule:map_coms_to_operators.induct)
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
index 85d79dff..d83ae1f2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
@@ -42,15 +42,43 @@ lemma sublist_imp_minus_state_to_sas_plus:
 fun map_impms_sp:: " nat \<Rightarrow> nat" where 
 "map_impms_sp n = (if n =0 then 0 else (prod_encode (Suc(fst_nat (hd_nat n)) , prod_encode(0,snd_nat (hd_nat n))))## map_impms_sp (tl_nat n))"
 
+fun map_impms_sp_acc:: " nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_impms_sp_acc acc n = (if n = 0 then acc else map_impms_sp_acc ((prod_encode (Suc(fst_nat (hd_nat n)) , prod_encode(0,snd_nat (hd_nat n))))  ## acc) (tl_nat n) )"
+
+lemma map_impms_sp_induct:
+"map_impms_sp_acc acc n = map_acc (\<lambda>x. prod_encode (Suc(fst_nat x) , prod_encode(0,snd_nat x)) ) acc n"
+  apply(induct acc n rule: map_impms_sp_acc.induct)
+  apply auto
+  done
+
+definition map_impms_sp_tail :: "nat \<Rightarrow> nat" where
+"map_impms_sp_tail n = reverse_nat (map_impms_sp_acc 0 n)"
+
 lemma submap_immpms_sp:
 "map_impms_sp n = map_nat (\<lambda>x. prod_encode (Suc(fst_nat x) , prod_encode(0,snd_nat x)) ) n "
   apply (induct n rule:map_impms_sp.induct)
   apply auto
   done
+
+lemma subtail_map_impms_sp:
+"map_impms_sp_tail n = map_impms_sp n"
+  using subtail_map map_impms_sp_tail_def map_impms_sp_induct submap_immpms_sp
+  by presburger
+
 definition imp_minus_state_to_sas_plus_nat :: "nat \<Rightarrow> nat" where
 "imp_minus_state_to_sas_plus_nat ci = (prod_encode (0,prod_encode(1,fst_nat ci)))##
 (map_impms_sp (snd_nat ci))"
 
+definition imp_minus_state_to_sas_plus_tail :: "nat \<Rightarrow> nat" where
+"imp_minus_state_to_sas_plus_tail ci = (prod_encode (0,prod_encode(1,fst_nat ci)))##
+(map_impms_sp_tail (snd_nat ci))"
+
+lemma subtail_imp_minus_state_to_sas_plus:
+"imp_minus_state_to_sas_plus_tail ci = imp_minus_state_to_sas_plus_nat ci"
+  apply(auto simp only: imp_minus_state_to_sas_plus_nat_def imp_minus_state_to_sas_plus_tail_def
+      subtail_map_impms_sp)
+  done
+
 lemma subnat_imp_minus_state_to_sas_plus:
 "imp_minus_state_to_sas_plus_nat   (cilist_encode ci)
   = list_encode (map sas_assignment_encode (imp_minus_state_to_sas_plus_list ci))  "
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
index d98dc1a4..26f25fa2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
@@ -161,74 +161,7 @@ fun bit_list_to_nat_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
    else  bit_list_to_nat_acc (2*acc +1) (tl_nat n))"
 
 
-fun reverse_nat_acc :: "nat \<Rightarrow>nat \<Rightarrow> nat" where 
-"reverse_nat_acc acc n = (if n = 0 then acc else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"
 
-lemma sub_reverse_nat_acc:"reverse_nat_acc (list_encode acc) (list_encode n) = list_encode (rev n @ acc) "
-  apply(induct n arbitrary: acc)
-  apply simp
-  apply(subst reverse_nat_acc.simps)
-  apply(auto simp only:sub_hd head.simps sub_tl tail.simps sub_cons rev.simps)
-  apply auto
-  done
-
-definition reverse_nat :: "nat \<Rightarrow> nat" where 
-"reverse_nat n = reverse_nat_acc 0 n"
-
-lemma sub_reverse:"reverse_nat (list_encode n) = list_encode (rev n)"
-  apply(auto simp only: reverse_nat_def )
-  using sub_reverse_nat_acc list_encode.simps(1) 
-  by (metis append_Nil2)
-lemma reverse_nat_0:"(reverse_nat 0 =0)" by (auto simp add:reverse_nat_def)
-
-lemma append_rev_nat:"append_nat (reverse_nat (Suc v)) xs = append_nat (reverse_nat (tl_nat (Suc v))) ((hd_nat (Suc v)) ## xs)"
-proof-
-  obtain ys where xs_def: "Suc v = list_encode ys" 
-    by (metis list_decode_inverse)
-  then moreover obtain a ys' where xs_def_cons : "ys = a#ys'"
-    by (metis list_encode.elims nat.simps(3))
-  moreover obtain xs_list where "xs = list_encode xs_list"  by (metis list_decode_inverse)
-  ultimately show ?thesis by (auto simp add: sub_reverse sub_tl sub_hd sub_cons 
-          sub_append simp del: list_encode.simps)
-qed
-lemma append_cons_nat_0 : "append_nat xs (a ## ys) \<noteq> 0"
-proof-
-  obtain ys' where xs_def: "ys = list_encode ys'" 
-    by (metis list_decode_inverse)
-  moreover obtain xs' where xs_def_cons : "xs = list_encode xs'"
-   by (metis list_decode_inverse)
-  ultimately show ?thesis by (auto simp add: sub_reverse sub_tl sub_hd sub_cons 
-          sub_append list_encode_eq simp flip: list_encode.simps)
-qed
-lemma cons_Nil:"xs ## ys \<noteq> 0"
-proof-
-  obtain ys' where xs_def: "ys = list_encode ys'" 
-    by (metis list_decode_inverse)
-  then show ?thesis by (auto simp add: sub_cons 
-          list_encode_eq simp flip: list_encode.simps)
-qed
-lemma tl_cons: "tl_nat (a##ys) = ys"
-proof-
-  obtain ys' where xs_def: "ys = list_encode ys'" 
-    by (metis list_decode_inverse)
-  then show ?thesis by (auto simp add: sub_cons sub_tl
-          list_encode_eq simp flip: list_encode.simps)
-qed
-
-lemma hd_cons: "hd_nat (a##ys) = a"
-proof-
-  obtain ys' where xs_def: "ys = list_encode ys'" 
-    by (metis list_decode_inverse)
-  then show ?thesis by (auto simp add: sub_cons sub_hd
-          list_encode_eq simp flip: list_encode.simps)
-qed
-lemma rev_rev_nat: "reverse_nat (reverse_nat ys) = ys"
- proof-
-  obtain ys' where xs_def: "ys = list_encode ys'" 
-    by (metis list_decode_inverse)
-  then show ?thesis by (auto simp add: sub_cons sub_reverse sub_hd
-          list_encode_eq simp flip: list_encode.simps)
-qed
 lemma bit_list_to_nat_induct: "bit_list_to_nat_nat (append_nat (reverse_nat ys) xs) = bit_list_to_nat_acc (bit_list_to_nat_nat xs) ys"
   apply(induct ys arbitrary:xs rule: length_nat.induct)
   apply (auto simp only: reverse_nat_0 append_nat.simps)
@@ -246,13 +179,6 @@ lemma bit_list_to_nat_induct: "bit_list_to_nat_nat (append_nat (reverse_nat ys)
           simp add: append_cons_nat_0 cons_Nil tl_cons hd_cons)
   done
 
-lemma append_nat_0: "append_nat ys 0 = ys"
-proof-
-  obtain ys' where xs_def: "ys = list_encode ys'" 
-    by (metis list_decode_inverse)
-  then show ?thesis by (auto simp add: sub_append sub_hd
-          list_encode_eq simp flip: list_encode.simps)
-qed
 
 lemma bit_list_to_nat_inverse: 
 "bit_list_to_nat_nat (append_nat ys xs) = bit_list_to_nat_acc (bit_list_to_nat_nat xs) (reverse_nat ys)"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
index 75a36260..c718563f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
@@ -33,9 +33,10 @@ lemma com_list_to_seq_rev: "com_list_to_seq_nat (append_nat ys xs) =
 
 definition  com_list_to_seq_tail :: "nat \<Rightarrow> nat" where 
 "com_list_to_seq_tail ys = com_list_to_seq_acc  (0##0) (reverse_nat ys) "
+
 lemma subtail_com_list_to_seq: "com_list_to_seq_nat ys=
-       com_list_to_seq_acc  (0##0) (reverse_nat ys)"
-  using  com_list_to_seq_rev[of ys 0]  append_nat_0 
+      com_list_to_seq_tail ys"
+  using  com_list_to_seq_rev[of ys 0]  append_nat_0  com_list_to_seq_tail_def 
   by(auto)
 
 
@@ -155,6 +156,28 @@ fun copy_const_to_operand_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Righ
 2 ## (1 ## (operand_bit_to_var_nat (prod_encode (op,i-1))) ## (nth_bit_nat x (i-1)) ## 0) ## (copy_const_to_operand_nat (i-1) op x ) ## 0
 )"
 
+fun copy_const_to_operand_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"copy_const_to_operand_acc acc diff i op x = (if diff =0 then acc  else copy_const_to_operand_acc
+(2 ## (1 ## (operand_bit_to_var_tail (prod_encode (op,i-diff))) ## (nth_bit_tail x (i-diff)) ## 0) ## acc ## 0
+) (diff-1) i op x )"
+
+lemma copy_const_to_operand_induct:
+"diff\<le>i \<Longrightarrow>copy_const_to_operand_acc (copy_const_to_operand_nat (i-diff) op x) diff i op x =
+copy_const_to_operand_nat i op x"
+  apply(induct diff)
+   apply(auto simp add: subtail_operand_bit_to_var subtail_nth_bit)
+  done
+
+definition copy_const_to_operand_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"copy_const_to_operand_tail i op x = copy_const_to_operand_acc (0##0) i i op x"
+
+lemma subtail_copy_const_to_operand:
+"copy_const_to_operand_tail i op x = 
+copy_const_to_operand_nat i op x "
+  using copy_const_to_operand_induct [of i i op x]
+  apply(auto simp add:copy_const_to_operand_tail_def)
+  done
+
 lemma sub_copy_const_to_operand:
  "copy_const_to_operand_nat i (encode_char op) x = comm_encode (copy_const_to_operand i op x)  "
  apply (induct i)
@@ -171,6 +194,14 @@ definition copy_atom_to_operand_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \
 "copy_atom_to_operand_nat n op a = ( if fst_nat a = 0 then  copy_var_to_operand_nat n op (snd_nat a)
  else copy_const_to_operand_nat n op (snd_nat a))"
 
+definition copy_atom_to_operand_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"copy_atom_to_operand_tail n op a = ( if fst_nat a = 0 then  copy_var_to_operand_tail n op (snd_nat a)
+ else copy_const_to_operand_nat n op (snd_nat a))"
+
+lemma subtail_copy_atom_to_operand: "copy_atom_to_operand_tail n op a = copy_atom_to_operand_nat n op a"
+  apply (simp only: copy_atom_to_operand_tail_def copy_atom_to_operand_nat_def
+subtail_copy_var_to_operand  ) done
+
 lemma sub_copy_atom_to_operand: 
 "copy_atom_to_operand_nat n (encode_char op) (atomExp_encode a) = comm_encode (copy_atom_to_operand n op a)"
   apply (auto simp only:copy_atom_to_operand_nat_def atomExp_encode.simps sub_fst sub_snd fst_def snd_def
@@ -186,6 +217,19 @@ definition assign_var_carry_nat::
 2 ## (1 ## (var_bit_to_var_nat(prod_encode (v, i))) ##
 (if a + b + c = 1 \<or> a + b + c = 3 then 1 else 0) ## 0 ) ## (1##(vname_encode ''carry'')## (if a + b + c \<ge> 2 then 1 else 0) ## 0) ## 0 "
 
+definition assign_var_carry_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"  where 
+"assign_var_carry_tail i v a b c = 
+2 ## (1 ## (var_bit_to_var_tail(prod_encode (v, i))) ##
+(if a + b + c = 1 \<or> a + b + c = 3 then 1 else 0) ## 0 ) ## (1##(vname_encode ''carry'')## (if a + b + c \<ge> 2 then 1 else 0) ## 0) ## 0 "
+
+
+lemma subtail_assign_var_carry: 
+"assign_var_carry_tail  i v a b c = assign_var_carry_nat  i v a b c"
+  apply (auto simp  only: assign_var_carry_tail_def assign_var_carry_nat_def 
+        subtail_var_bit_to_var)
+  done
+
+
 lemma sub_assign_var_carry: 
 "assign_var_carry_nat i (vname_encode v) a b c = comm_encode(assign_var_carry i v a b c)"
   apply (auto simp only: assign_var_carry_nat_def sub_var_bit_to_var cons0 sub_cons
@@ -204,6 +248,22 @@ definition full_adder_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 ## 0
  )"
 
+definition full_adder_tail ::  "nat \<Rightarrow> nat \<Rightarrow> nat"  where 
+"full_adder_tail i v  = (let assign = assign_var_carry_tail i v; op_a = operand_bit_to_var_tail (prod_encode(encode_char(CHR ''a''), i));
+  op_b = operand_bit_to_var_tail (prod_encode(encode_char (CHR ''b''), i)) in 
+3##(op_a ## 0) ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 1 1 1) ## ( assign 1 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 1 0 1) ## ( assign 1 0 0) ## 0))##0)
+               ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 0 1 1) ## ( assign 0 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 0 0 1) ## ( assign 0 0 0) ## 0))##0)
+## 0
+ )"
+
+
+lemma subtail_full_adder: "full_adder_tail i v = full_adder_nat i v" 
+  apply(auto simp only: Let_def full_adder_tail_def 
+          full_adder_nat_def subtail_assign_var_carry subtail_operand_bit_to_var )
+  done
+
 lemma sub_full_adder: "full_adder_nat i (vname_encode v) = comm_encode (full_adder i v)"
   apply (auto simp only:full_adder_nat_def sub_assign_var_carry
  vname_list_encode_def cons0 sub_cons sub_operand_bit_to_var full_adder_def comm_encode.simps
@@ -214,19 +274,72 @@ lemma sub_full_adder: "full_adder_nat i (vname_encode v) = comm_encode (full_add
 fun map_adder :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_adder v n = (if n =0 then 0 else (full_adder_nat (hd_nat n) v) ## map_adder v (tl_nat n))"
 
+fun map_adder_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_adder_acc acc v n = (if n =0 then acc else map_adder_acc ((full_adder_tail (hd_nat n) v)##acc)
+    v (tl_nat n)) "
+
 lemma sub_map_adder:
   "map_adder v n = map_nat (\<lambda>i. full_adder_nat i v) n"
   apply (induct v n rule:map_adder.induct)
   apply (subst map_adder.simps)
   apply auto
   done
- 
+
+lemma map_adder_append:
+"map_adder v (append_nat xs ys) = append_nat (map_adder v xs) (map_adder v ys)"
+proof -
+  obtain xs' ys' where "xs= list_encode xs'" "ys = list_encode ys'"
+    by (metis list_decode_inverse)
+  thus ?thesis apply (auto simp add:sub_append sub_map_adder sub_map simp del:map_adder.simps 
+map_nat.simps) done
+qed
+
+lemma map_adder_induct: "
+reverse_nat (map_adder v (append_nat xs ys)) = 
+map_adder_acc (reverse_nat (map_adder v xs)) v ys
+  "
+  apply(induct ys arbitrary:xs rule:length_nat.induct)
+   apply(auto simp add: append_nat_0 append_nat_Suc  simp del: map_adder.simps map_adder_acc.simps)
+   apply simp
+  apply(subst (2) map_adder_acc.simps)
+  apply(auto simp add: map_adder_append 
+          reverse_append_nat subtail_full_adder  simp del: map_adder.simps map_adder_acc.simps)
+  apply(subst map_adder.simps)
+ apply(auto simp add:cons_Nil simp del:list_encode.simps map_adder.simps map_adder_acc.simps)
+  apply(auto simp add:cons0 sub_hd sub_tl 
+              simp del:list_encode.simps map_adder.simps map_adder_acc.simps)
+   apply(auto simp add: reverse_cons_nat 
+              simp del: map_adder.simps map_adder_acc.simps)  
+      apply(subst map_adder.simps)
+    apply(auto simp add: reverse_nat_0 append_singleton_nat
+              simp del: map_adder.simps map_adder_acc.simps)  
+  done
+
+definition map_adder_tail  where 
+"map_adder_tail v n = reverse_nat (map_adder_acc 0 v n) "
+
+lemma subtail_map_adder : 
+"map_adder_tail v n = map_adder v n"
+  using map_adder_induct[of v 0 n]  append_nat_0
+  apply (auto simp add: map_adder_tail_def simp  del: map_adder.simps map_adder_acc.simps)
+  using rev_rev_nat 
+  by (metis map_adder.simps reverse_nat_0)
+
+
 definition adder_nat:: "nat \<Rightarrow> nat  \<Rightarrow> nat" where
 "adder_nat n v = 2 ## (com_list_to_seq_nat (map_adder v(list_less_nat n) )) ## (
 1## (vname_encode ''carry'') ## 0 ## 0
 ) ## 0"
 
-thm "comp_apply"
+definition adder_tail:: "nat \<Rightarrow> nat  \<Rightarrow> nat"  
+  where "adder_tail n v = 2 ## (com_list_to_seq_tail (map_adder_tail v(list_less_tail n) )) ## (
+1## (vname_encode ''carry'') ## 0 ## 0
+) ## 0"
+lemma subtail_adder: "adder_tail n v =adder_nat n v" 
+  apply(auto simp only: adder_tail_def adder_nat_def subtail_com_list_to_seq subtail_map_adder
+          subtail_list_less)
+  done
+
 
   
 lemma sub_adder: "adder_nat n (vname_encode v) = comm_encode (adder n v)"
@@ -246,6 +359,23 @@ definition binary_adder_nat:: "nat \<Rightarrow> nat \<Rightarrow>nat\<Rightarro
 )##0
 )##0"
 
+definition binary_adder_tail:: "nat \<Rightarrow> nat \<Rightarrow>nat\<Rightarrow> nat \<Rightarrow> nat" where
+"binary_adder_tail n v a b = 2##(
+    copy_atom_to_operand_tail n (encode_char(CHR ''a'')) a)##(
+2##( copy_atom_to_operand_tail n (encode_char(CHR ''b'')) b)##(
+2##( adder_tail n v)##(
+2##(copy_atom_to_operand_tail n (encode_char(CHR ''a'')) (prod_encode(1,0)))##(
+  copy_atom_to_operand_tail n (encode_char(CHR ''b'')) (prod_encode(1,0)))##0 
+)##0
+)##0
+)##0"
+
+lemma subtail_binary_adder:
+"binary_adder_tail n v a b  = binary_adder_nat n v a b "
+  apply(auto simp only: binary_adder_nat_def binary_adder_tail_def subtail_copy_atom_to_operand
+        subtail_adder)
+  done
+
 lemma sub_binary_adder:
  "binary_adder_nat n (vname_encode v) (atomExp_encode a) (atomExp_encode b) =
     comm_encode (binary_adder n v a b)"
@@ -262,6 +392,21 @@ definition assign_var_carry_sub_nat::
     else (if b + c = 1 \<and> a = 0 then 1 else 0))  ## 0 ) ## 
 (1##(vname_encode ''carry'')## (if a < b + c then 1 else 0) ## 0) ## 0 "
 
+definition assign_var_carry_sub_tail:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_var_carry_sub_tail i v a b c = 
+2 ## (1 ## (var_bit_to_var_tail (prod_encode (v, i))) ##
+(if b + c = 0 \<or> b + c = 2 then (if a = 1 then 1 else 0)
+    else (if b + c = 1 \<and> a = 0 then 1 else 0))  ## 0 ) ## 
+(1##(vname_encode ''carry'')## (if a < b + c then 1 else 0) ## 0) ## 0 "
+
+lemma subtail_assign_var_carry_sub:
+"assign_var_carry_sub_tail i v a b c = assign_var_carry_sub_nat i v a b c"
+  apply(auto simp only: assign_var_carry_sub_tail_def assign_var_carry_sub_nat_def
+          subtail_var_bit_to_var)
+  done
+
+
 lemma sub_assign_var_carry_sub: 
 "assign_var_carry_sub_nat i (vname_encode v) a b c = comm_encode(assign_var_carry_sub i v a b c)"
   apply (auto simp only: assign_var_carry_sub_nat_def sub_var_bit_to_var cons0 sub_cons
@@ -279,6 +424,23 @@ definition full_subtractor_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
                                                        (3 ## (op_b ## 0) ## (assign 0 0 1) ## ( assign 0 0 0) ## 0))##0)
 ## 0
  )"
+
+definition full_subtractor_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"full_subtractor_tail i v  = (let assign = assign_var_carry_sub_tail i v; op_a = operand_bit_to_var_tail (prod_encode(encode_char(CHR ''a''), i));
+  op_b = operand_bit_to_var_tail (prod_encode(encode_char (CHR ''b''), i)) in 
+3##(op_a ## 0) ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 1 1 1) ## ( assign 1 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 1 0 1) ## ( assign 1 0 0) ## 0))##0)
+               ##(3##((vname_encode ''carry'') ## 0)## (3 ## (op_b ## 0) ## (assign 0 1 1) ## ( assign 0 1 0) ## 0)##(
+                                                       (3 ## (op_b ## 0) ## (assign 0 0 1) ## ( assign 0 0 0) ## 0))##0)
+## 0
+ )"
+
+lemma subtail_full_subtractor:
+"full_subtractor_tail i v = full_subtractor_nat i v"
+  apply(auto simp only: full_subtractor_tail_def full_subtractor_nat_def
+        subtail_assign_var_carry_sub subtail_operand_bit_to_var Let_def)
+  done
+
     
 lemma sub_full_subtractor: "full_subtractor_nat i (vname_encode v) = comm_encode (full_subtractor i v)"
   apply (auto simp only:full_subtractor_nat_def sub_assign_var_carry_sub
@@ -292,6 +454,17 @@ definition underflow_handler_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" whe
 binary_assign_constant_nat n v 0
 )##0)## (0##0) ## 0"
 
+definition underflow_handler_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"underflow_handler_tail n v = 3##((vname_encode ''carry'')## 0) ## (2##(1##(vname_encode ''carry'')##0##0)##(
+binary_assign_constant_tail n v 0
+)##0)## (0##0) ## 0"
+
+lemma subtail_underflow_handler:
+"underflow_handler_tail n v = underflow_handler_nat n v"
+  apply(auto simp only: underflow_handler_tail_def underflow_handler_nat_def
+subtail_binary_assign_constant
+) done
+
 lemma sub_underflow_handler:
  "underflow_handler_nat n (vname_encode v) = comm_encode (underflow_handler n v) "
   apply (auto simp only:underflow_handler_nat_def cons0 sub_cons underflow_handler_def
@@ -302,19 +475,78 @@ lemma sub_underflow_handler:
 fun map_full_subtractor :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_full_subtractor v n = (if n = 0 then 0 else (full_subtractor_nat(hd_nat n) v) ## map_full_subtractor v (tl_nat n))"
 
+
 lemma submap_full_subtractor: 
   "map_full_subtractor v n = map_nat (\<lambda>i. full_subtractor_nat i v) n"
   apply (induct v n rule : map_full_subtractor.induct)
   apply (subst map_full_subtractor.simps)
   apply (auto)
   done
-  
+
+fun map_full_subtractor_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_full_subtractor_acc acc v n = (if n =0 then acc else map_full_subtractor_acc ((full_subtractor_tail (hd_nat n) v)##acc)
+    v (tl_nat n)) "
+
+lemma map_full_subtractor_append:
+"map_full_subtractor v (append_nat xs ys) = append_nat (map_full_subtractor v xs) (map_full_subtractor v ys)"
+proof -
+  obtain xs' ys' where "xs= list_encode xs'" "ys = list_encode ys'"
+    by (metis list_decode_inverse)
+  thus ?thesis apply (auto simp add:sub_append submap_full_subtractor sub_map simp del:map_full_subtractor.simps 
+map_nat.simps) done
+qed
+
+lemma map_full_subtractor_induct: "
+reverse_nat (map_full_subtractor v (append_nat xs ys)) = 
+map_full_subtractor_acc (reverse_nat (map_full_subtractor v xs)) v ys
+  "
+  apply(induct ys arbitrary:xs rule:length_nat.induct)
+   apply(auto simp add: append_nat_0 append_nat_Suc  simp del: map_full_subtractor.simps map_full_subtractor_acc.simps)
+   apply simp
+  apply(subst (2) map_full_subtractor_acc.simps)
+  apply(auto simp add: map_full_subtractor_append 
+          reverse_append_nat subtail_full_subtractor  simp del: map_full_subtractor.simps map_full_subtractor_acc.simps)
+  apply(subst map_full_subtractor.simps)
+ apply(auto simp add:cons_Nil simp del:list_encode.simps map_full_subtractor.simps map_full_subtractor_acc.simps)
+  apply(auto simp add:cons0 sub_hd sub_tl 
+              simp del:list_encode.simps map_full_subtractor.simps map_full_subtractor_acc.simps)
+   apply(auto simp add: reverse_cons_nat 
+              simp del: map_full_subtractor.simps map_full_subtractor_acc.simps)  
+      apply(subst map_full_subtractor.simps)
+    apply(auto simp add: reverse_nat_0 append_singleton_nat
+              simp del: map_adder.simps map_adder_acc.simps)  
+  done
+
+definition map_full_subtractor_tail  where 
+"map_full_subtractor_tail v n = reverse_nat (map_full_subtractor_acc 0 v n) "
+
+lemma subtail_map_full_subtractor : 
+"map_full_subtractor_tail v n = map_full_subtractor v n"
+  using map_full_subtractor_induct[of v 0 n]  append_nat_0
+  apply (auto simp add: map_full_subtractor_tail_def simp  del: map_full_subtractor.simps map_full_subtractor_acc.simps)
+  using rev_rev_nat 
+  by (metis map_full_subtractor.simps reverse_nat_0)
+
 definition subtract_handle_underflow_nat:: 
   "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "subtract_handle_underflow_nat n v = 2##
   (com_list_to_seq_nat (map_full_subtractor v (list_less_nat n)))## 
   (underflow_handler_nat n v) ## 0"
 
+definition subtract_handle_underflow_tail:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"subtract_handle_underflow_tail n v = 2##
+  (com_list_to_seq_tail (map_full_subtractor_tail v (list_less_tail n)))## 
+  (underflow_handler_tail n v) ## 0"
+
+lemma subtail_subtract_handle_underflow:
+" subtract_handle_underflow_tail n v =  subtract_handle_underflow_nat n v"
+  apply( auto simp only: subtract_handle_underflow_tail_def 
+          subtract_handle_underflow_nat_def 
+          subtail_com_list_to_seq subtail_map_full_subtractor subtail_list_less 
+            subtail_underflow_handler)
+  done
+
 lemma sub_subtract_underflow : 
 "subtract_handle_underflow_nat n (vname_encode v) = comm_encode ( subtract_handle_underflow n v)"
   apply (auto simp only: submap_full_subtractor subtract_handle_underflow_nat_def cons0 sub_cons sub_com_list_to_seq sub_map
@@ -336,6 +568,23 @@ definition binary_subtractor_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Ri
 ) ## 0
 ) ## 0"
 
+definition binary_subtractor_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>nat" where
+"binary_subtractor_tail n v a b = 
+2 ## (copy_atom_to_operand_tail n (encode_char(CHR ''a'')) a) ## (
+2 ## (   copy_atom_to_operand_tail n (encode_char(CHR ''b'')) b) ## (
+2 ## (subtract_handle_underflow_tail n v) ##(
+2##(copy_atom_to_operand_tail n (encode_char(CHR ''a'')) (prod_encode(1,0)))##(
+  copy_atom_to_operand_tail n (encode_char(CHR ''b'')) (prod_encode(1,0)))##0 
+) ## 0
+) ## 0
+) ## 0"
+
+lemma subtail_binary_subtractor: 
+"binary_subtractor_tail n v a b = binary_subtractor_nat n v a b  "
+  apply(auto simp only: binary_subtractor_tail_def binary_subtractor_nat_def
+        subtail_copy_atom_to_operand subtail_subtract_handle_underflow)
+  done
+
 lemma sub_binary_subtractor:
 "binary_subtractor_nat n (vname_encode v) (atomExp_encode a) (atomExp_encode b) =
     comm_encode (binary_subtractor n v a b)"
@@ -353,6 +602,22 @@ else 2## (3 ## ((var_bit_to_var_nat(prod_encode(snd_nat a, 0))) ## 0) ## (binary
  (copy_atom_to_operand_nat n (encode_char (CHR ''a'')) (prod_encode(1,0))) ## 0
 ) ## 0 )"
 
+definition binary_parity_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"binary_parity_tail n v a  = (if fst_nat a \<noteq> 0 then  binary_assign_constant_tail n v (snd_nat a mod 2)
+else 2## (3 ## ((var_bit_to_var_tail(prod_encode(snd_nat a, 0))) ## 0) ## (binary_assign_constant_tail n v 1) 
+ ##( binary_assign_constant_tail n v 0) ## 0)## (
+2 ## (copy_atom_to_operand_tail n (encode_char (CHR ''a'')) a) ##
+ (copy_atom_to_operand_tail n (encode_char (CHR ''a'')) (prod_encode(1,0))) ## 0
+) ## 0 )"
+
+
+lemma subtail_binary_parity:
+"binary_parity_tail n v a = binary_parity_nat n v a"
+  apply(auto simp only: binary_parity_tail_def binary_parity_nat_def
+              subtail_var_bit_to_var subtail_binary_assign_constant
+               subtail_copy_atom_to_operand)
+  done
+
 lemma sub_binary_parity:
  "binary_parity_nat n (vname_encode v) (atomExp_encode a) = comm_encode(binary_parity n v a) "
   apply (auto simp only: binary_parity_nat_def cons0 sub_cons sub_binary_assign_constant)
@@ -378,6 +643,42 @@ assign_shifted_bits_nat (i-1) v
 )##0
 )" 
 
+fun assign_shifted_bits_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_shifted_bits_acc acc diff i v = (if diff  = 0 then acc else assign_shifted_bits_acc (
+2##( 
+3##((operand_bit_to_var_tail (prod_encode (encode_char(CHR ''a''), i-diff +1 )))##0)##(
+1## (var_bit_to_var_tail (prod_encode(v, i-diff)))## 1 ##0)##(
+1## (var_bit_to_var_tail (prod_encode(v, i-diff)))## 0 ##0
+)##0)## (
+acc
+)##0) (diff-1) i v
+)"
+
+lemma assign_shifted_bits_induct:
+"diff \<le> i \<Longrightarrow>assign_shifted_bits_acc (assign_shifted_bits_nat (i-diff) v) diff i v = 
+assign_shifted_bits_nat i v"
+  apply(induct diff)
+   apply simp
+  apply(subst assign_shifted_bits_acc.simps)
+  apply(auto simp add: subtail_operand_bit_to_var 
+subtail_var_bit_to_var
+simp del: assign_shifted_bits_acc.simps assign_shifted_bits_nat.simps operand_bit_to_var_nat.simps)
+  apply(subst (asm) assign_shifted_bits_nat.simps)
+ apply(auto simp add:
+simp del: assign_shifted_bits_acc.simps assign_shifted_bits_nat.simps operand_bit_to_var_nat.simps)
+  using Suc_diff_Suc Suc_le_lessD apply presburger
+  done
+
+definition assign_shifted_bits_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"assign_shifted_bits_tail i v = assign_shifted_bits_acc (0##0) i i v"
+
+lemma subtail_assign_shifted_bits:
+"assign_shifted_bits_tail i v =assign_shifted_bits_nat i v "
+  apply(auto simp only: assign_shifted_bits_tail_def)
+  using assign_shifted_bits_induct[of i i v]
+  apply auto
+  done
+
 lemma sub_assign_shifted_bits:
 "assign_shifted_bits_nat i (vname_encode v) = comm_encode (assign_shifted_bits i v)"
   apply (induct i)
@@ -397,6 +698,18 @@ definition assign_shifted_bits_and_zero_most_significant_nat::
 "assign_shifted_bits_and_zero_most_significant_nat n v = 2 ## (assign_shifted_bits_nat (n - 1) v)##
   (1 ## (var_bit_to_var_nat (prod_encode(v, n - 1)))##0##0) ## 0"
 
+definition assign_shifted_bits_and_zero_most_significant_tail:: 
+  "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"assign_shifted_bits_and_zero_most_significant_tail n v = 2 ## (assign_shifted_bits_tail (n - 1) v)##
+  (1 ## (var_bit_to_var_tail (prod_encode(v, n - 1)))##0##0) ## 0"
+
+lemma subtail_assign_shifted_bits_and_zero_most_significant:
+" assign_shifted_bits_and_zero_most_significant_tail n v =  assign_shifted_bits_and_zero_most_significant_nat n v "
+  apply(auto simp only:  assign_shifted_bits_and_zero_most_significant_nat_def 
+ assign_shifted_bits_and_zero_most_significant_tail_def
+  subtail_var_bit_to_var subtail_assign_shifted_bits)
+  done
+
 lemma sub_assign_shifted_bits_and_zero_most_significant:
 " assign_shifted_bits_and_zero_most_significant_nat n (vname_encode v) =
   comm_encode (assign_shifted_bits_and_zero_most_significant n v)"
@@ -412,6 +725,17 @@ definition binary_right_shift_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<R
 (assign_shifted_bits_and_zero_most_significant_nat n v) ## 0) ##
     (copy_atom_to_operand_nat n (encode_char(CHR ''a'')) (prod_encode(1,0))) ## 0" 
 
+definition binary_right_shift_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"binary_right_shift_tail n v a = 2 ## (2 ## (copy_atom_to_operand_tail n (encode_char(CHR ''a'')) a) ##
+(assign_shifted_bits_and_zero_most_significant_tail n v) ## 0) ##
+    (copy_atom_to_operand_tail n (encode_char(CHR ''a'')) (prod_encode(1,0))) ## 0" 
+
+lemma subtail_binary_right_shift:
+"binary_right_shift_tail n v a = binary_right_shift_nat n v a"
+  apply(auto simp only: binary_right_shift_tail_def  binary_right_shift_nat_def
+   subtail_copy_atom_to_operand subtail_assign_shifted_bits_and_zero_most_significant
+  )done
+
 lemma sub_binary_right_shift:
   "binary_right_shift_nat n (vname_encode v) (atomExp_encode a) = comm_encode (binary_right_shift n v a)"
   apply (auto simp only: binary_right_shift_nat_def cons0 sub_cons sub_copy_atom_to_operand
@@ -430,6 +754,21 @@ else if hd_nat aexp = 3 then binary_parity_nat n v (nth_nat (Suc 0) aexp)
 else  binary_right_shift_nat n v (nth_nat (Suc 0) aexp)
 )"
 
+definition assignment_to_binary_tail:: "nat \<Rightarrow> nat \<Rightarrow>nat \<Rightarrow> nat" where
+"assignment_to_binary_tail n v aexp = (if hd_nat aexp =0 then 
+   binary_adder_tail n v (nth_nat (Suc 0) aexp) (prod_encode (1,0))
+else if hd_nat aexp = 1 then binary_adder_tail n v (nth_nat (Suc 0) aexp) (nth_nat (Suc (Suc 0)) aexp)
+else if hd_nat aexp = 2 then binary_subtractor_tail n v (nth_nat (Suc 0) aexp) (nth_nat (Suc (Suc 0)) aexp)
+else if hd_nat aexp = 3 then binary_parity_tail n v (nth_nat (Suc 0) aexp)
+else  binary_right_shift_tail n v (nth_nat (Suc 0) aexp)
+)"
+
+lemma subtail_assignment_to_binary :
+ "assignment_to_binary_tail n v aexp = assignment_to_binary_nat n v aexp"
+  apply(auto simp only: assignment_to_binary_tail_def assignment_to_binary_nat_def
+    subtail_binary_adder subtail_binary_subtractor subtail_binary_right_shift subtail_binary_parity
+) done
+
 lemma sub_assignment_to_binary:
 "assignment_to_binary_nat n (vname_encode v) (aexp_encode aexp) = 
   comm_encode (assignment_to_binary n v aexp)"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
index b2bef113..18ceda4f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy
@@ -49,24 +49,7 @@ moreover obtain xs' where "xs =list_encode xs'"
                 list_encode_eq
           sub_append)
 qed
-lemma reverse_append_nat:
-    "reverse_nat (append_nat xs ys) = append_nat (reverse_nat ys) (reverse_nat xs)"
-proof - 
-obtain xs' ys' where "xs =list_encode xs'"  "ys = list_encode ys'"
-  by (metis list_decode_inverse)
-  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
-          sub_append sub_reverse)
-qed
-lemma reverse_singleton_nat:
-"reverse_nat (a ## 0) = a ## 0" by(auto simp add: cons0 sub_reverse simp del:list_encode.simps) 
-lemma append_singleton_nat : 
-"append_nat (a##0) xs = a ## xs"
-proof - 
-  obtain xs' where "xs = list_encode xs'"
- by (metis list_decode_inverse)
-  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
-          sub_append )
-qed
+
 lemma takeWhile_char_induct: " takeWhile_char xs = xs \<Longrightarrow>
 takeWhile_char (append_nat xs ys) = 
 reverse_nat (takeWhile_char_acc (reverse_nat (takeWhile_char xs)) ys) "
@@ -172,8 +155,7 @@ lemma sub_n_hashes : "n_hashes_nat n = vname_encode (n_hashes n)"
 fun n_hashes_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "n_hashes_acc acc 0  = acc" |
 "n_hashes_acc acc (Suc n) = n_hashes_acc ((encode_char (CHR ''#'')) ## acc) n"
-lemma Suc_plus:"Suc(m+n) = Suc m + n "
-  by simp
+
 lemma n_hashes_dashes: 
 "reverse_nat (n_hashes_nat (Suc m)) = (encode_char CHR ''#'') ## reverse_nat (n_hashes_nat m)"
   apply(auto simp add: sub_cons sub_reverse sub_n_hashes vname_encode_def 
@@ -207,11 +189,11 @@ definition var_bit_to_var_nat:: "nat \<Rightarrow> nat" where
     (vname_encode ''$'')) (fst_nat vk)" 
 
 definition var_bit_to_var_tail:: "nat \<Rightarrow> nat" where
-"var_bit_to_var_tail vk = append_nat (append_nat (n_hashes_tail (snd_nat vk + 1)) 
+"var_bit_to_var_tail vk = append_tail (append_tail (n_hashes_tail (snd_nat vk + 1)) 
     (vname_encode ''$'')) (fst_nat vk)" 
 lemma subtail_var_bit_to_var:
 "var_bit_to_var_tail vk = var_bit_to_var_nat vk"
-  apply(auto simp only: var_bit_to_var_nat_def var_bit_to_var_tail_def subtail_n_hashes)
+  apply(auto simp only:subtail_append var_bit_to_var_nat_def var_bit_to_var_tail_def subtail_n_hashes)
   done
 
 lemma sub_var_bit_to_var :
@@ -508,16 +490,7 @@ map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.simps map_nat.simps simp add:
     submap_IMP_Minus_State_To_IMP_Minus_Minus_partial sub_map sub_append)
     done
 qed
-lemma append_nat_Suc: 
-"append_nat xs (Suc v) = append_nat (append_nat xs ((hd_nat (Suc v))##0)) (tl_nat (Suc v))"
-proof -
-  obtain xs' v' where "xs =list_encode xs'" "Suc v = list_encode v'"
-    by (metis list_decode_inverse)
-  then moreover obtain a ys where "v' = a # ys" 
-    by (metis Zero_neq_Suc list_encode.elims)
-  ultimately show ?thesis apply(auto simp add:sub_append  sub_hd cons0 
-              sub_tl simp del:list_encode.simps) done
-qed
+
 
 lemma map_IMP_Minus_State_To_IMP_Minus_Minus_partial_induct:
 " map_IMP_Minus_State_To_IMP_Minus_Minus_partial k (append_nat xs ys) = reverse_nat(
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index 01f7e665..8e9b6828 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -6,15 +6,75 @@ begin
 fun map_var_bit_to_var:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_var_bit_to_var v n = (if n =0 then 0 else (var_bit_to_var_nat (prod_encode (v,hd_nat n)))## map_var_bit_to_var v (tl_nat n)  )"
 
+fun map_var_bit_to_var_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_var_bit_to_var_acc acc v n = (if n =0 then acc 
+else map_var_bit_to_var_acc ((var_bit_to_var_tail (prod_encode (v,hd_nat n)))## acc) v (tl_nat n)  )"
+
 lemma submap_var_bit_to_var :
 "map_var_bit_to_var v n =  map_nat (\<lambda>i. var_bit_to_var_nat (prod_encode (v,i))) n "
   apply (induct v n rule:map_var_bit_to_var.induct)
   apply auto
   done
 
+
+lemma map_var_bit_to_var_append:
+"map_var_bit_to_var v (append_nat xs ys) = 
+append_nat(map_var_bit_to_var v xs) (map_var_bit_to_var v ys)"
+proof -
+  obtain xs' ys' where "ys = list_encode ys'"  "xs = list_encode xs'" 
+  by (metis list_decode_inverse)
+  thus ?thesis 
+    apply(auto simp add: sub_append submap_var_bit_to_var
+sub_map
+ simp del:map_nat.simps
+map_var_bit_to_var.simps)
+    done
+qed
+
+lemma map_var_bit_to_var_induct:
+"reverse_nat (map_var_bit_to_var v (append_nat xs ys))
+= map_var_bit_to_var_acc (reverse_nat (map_var_bit_to_var v xs)) v ys"
+  apply(induct ys arbitrary:xs rule:length_nat.induct)
+   apply(auto simp del:  map_var_bit_to_var_acc.simps  map_var_bit_to_var.simps
+          simp add: append_nat_0)
+   apply simp
+    apply(auto simp del:  map_var_bit_to_var_acc.simps  map_var_bit_to_var.simps
+          simp add: append_nat_0 append_nat_Suc)
+  apply (subst (2) map_var_bit_to_var_acc.simps)
+  apply(auto simp add: map_var_bit_to_var_append subtail_var_bit_to_var
+        reverse_append_nat simp del:  map_var_bit_to_var_acc.simps  map_var_bit_to_var.simps
+          simp add: append_nat_0 append_nat_Suc)
+  apply(subst map_var_bit_to_var.simps)
+  apply(auto simp add: cons_Nil
+ simp del:  map_var_bit_to_var_acc.simps  map_var_bit_to_var.simps)
+
+  apply(auto simp only: cons0 sub_hd head.simps sub_tl tail.simps)
+  apply(subst map_var_bit_to_var.simps)
+    apply(auto simp add: reverse_singleton_nat append_singleton_nat
+ simp del:  map_var_bit_to_var_acc.simps  map_var_bit_to_var.simps)
+  done
+
+definition map_var_bit_to_var_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_var_bit_to_var_tail v n = reverse_nat (map_var_bit_to_var_acc 0 v n)"
+
+lemma subtail_map_var_bit_to_var:
+"map_var_bit_to_var_tail v n = map_var_bit_to_var v n"
+  apply(auto simp only: map_var_bit_to_var_tail_def)
+  using map_var_bit_to_var_induct [of v 0 n] rev_rev_nat map_var_bit_to_var.simps
+  by (metis append_nat.simps(1) reverse_nat_0)
+
 definition var_bit_list_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "var_bit_list_nat n v = map_var_bit_to_var v (list_less_nat n)"
 
+definition var_bit_list_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"var_bit_list_tail n v = map_var_bit_to_var_tail v (list_less_tail n)"
+
+lemma subtail_var_bit_list: 
+"var_bit_list_tail n v = var_bit_list_nat n v"
+  apply(auto simp only: var_bit_list_tail_def var_bit_list_nat_def 
+          subtail_list_less subtail_map_var_bit_to_var)
+  done
+
 lemma sub_var_bit_list: "var_bit_list_nat n (vname_encode v) = vname_list_encode (var_bit_list n v)"
   apply (simp only: submap_var_bit_to_var  var_bit_list_nat_def var_bit_list_def sub_var_bit_to_var sub_map sub_list_less
         vname_list_encode_def
@@ -24,6 +84,38 @@ lemma sub_var_bit_list: "var_bit_list_nat n (vname_encode v) = vname_list_encode
 
 
 declare nth_nat.simps[simp del]
+datatype IMPm_IMPmm = SKIP | 
+                      Assign vname aexp |
+                      Seq_0 IMP_Minus_com IMP_Minus_com |
+                      Seq_m IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com |
+                      Seq_f IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com IMP_Minus_Minus_com |
+                      If_0  vname IMP_Minus_com IMP_Minus_com |
+                      If_m  vname IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com |
+                      If_f vname IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com IMP_Minus_Minus_com |
+                      While_0 vname IMP_Minus_com|
+                      While_f vname IMP_Minus_com IMP_Minus_Minus_com
+
+fun push_on_Stack :: "IMP_Minus_com \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
+"push_on_Stack Com.SKIP stack = SKIP # stack "|
+"push_on_Stack (Com.Assign v aexp) stack =  ( Assign v aexp) # stack "|
+"push_on_Stack (Com.Seq c1 c2) stack =  ( Seq_0 c1 c2) # stack "|
+"push_on_Stack (Com.If v c1 c2) stack =  (If_0 v c1 c2) # stack "|
+"push_on_Stack (Com.While v c) stack =  (While_0 v c) # stack "
+
+fun add_result_to_stack :: "IMP_Minus_Minus_com \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
+"add_result_to_stack"
+
+                      
+fun IMP_Minus_To_IMP_Minus_Minus:: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMP_Minus_Minus_com" where
+"IMP_Minus_To_IMP_Minus_Minus Com.SKIP n = IMP_Minus_Minus_Com.SKIP" |
+"IMP_Minus_To_IMP_Minus_Minus (Com.Assign v aexp) n = assignment_to_binary n v aexp" |
+"IMP_Minus_To_IMP_Minus_Minus (Com.Seq c1 c2) n = 
+  (IMP_Minus_To_IMP_Minus_Minus c1 n ;; IMP_Minus_To_IMP_Minus_Minus c2 n )" |
+"IMP_Minus_To_IMP_Minus_Minus (Com.If v c1 c2) n = (IF (var_bit_list n v)\<noteq>0 THEN
+  IMP_Minus_To_IMP_Minus_Minus c1 n ELSE IMP_Minus_To_IMP_Minus_Minus c2 n)" |
+"IMP_Minus_To_IMP_Minus_Minus (Com.While v c) n = (WHILE (var_bit_list n v)\<noteq>0 DO
+  IMP_Minus_To_IMP_Minus_Minus c n)"
+
 fun IMP_Minus_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "IMP_Minus_To_IMP_Minus_Minus_nat c n = (if c =0 \<or> hd_nat c = 0 then  0##0
 else if hd_nat c = 1 then assignment_to_binary_nat n (nth_nat (Suc 0) c) (nth_nat (Suc (Suc 0)) c)
@@ -34,6 +126,7 @@ else if hd_nat c = 3 then
 else 
 4 ## (var_bit_list_nat n (nth_nat (Suc 0) c)) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## 0
 )"
+
 declare nth_nat.simps[simp]
 
 lemma sub_IMP_Minus_To_IMP_Minus_Minus:
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index adba2e80..4a6ac6a8 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -224,6 +224,160 @@ lemma sub_append: "append_nat (list_encode xs) (list_encode ys) = list_encode (x
 head.simps(2) prod.sel(2) prod_encode_inverse snd_nat_def 
 sub_cons sub_hd tl_nat_def)
 
+
+fun append_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"append_acc acc 0 = acc"|
+"append_acc acc xs = append_acc ((hd_nat xs)## acc) (tl_nat xs)"
+
+fun reverse_nat_acc :: "nat \<Rightarrow>nat \<Rightarrow> nat" where 
+"reverse_nat_acc acc n = (if n = 0 then acc else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"
+
+lemma sub_reverse_nat_acc:"reverse_nat_acc (list_encode acc) (list_encode n) = list_encode (rev n @ acc) "
+  apply(induct n arbitrary: acc)
+  apply simp
+  apply(subst reverse_nat_acc.simps)
+  apply(auto simp only:sub_hd head.simps sub_tl tail.simps sub_cons rev.simps)
+  apply auto
+  done
+
+definition reverse_nat :: "nat \<Rightarrow> nat" where 
+"reverse_nat n = reverse_nat_acc 0 n"
+
+lemma sub_reverse:"reverse_nat (list_encode n) = list_encode (rev n)"
+  apply(auto simp only: reverse_nat_def )
+  using sub_reverse_nat_acc list_encode.simps(1) 
+  by (metis append_Nil2)
+lemma reverse_nat_0:"(reverse_nat 0 =0)" by (auto simp add:reverse_nat_def)
+
+lemma append_rev_nat:"append_nat (reverse_nat (Suc v)) xs = append_nat (reverse_nat (tl_nat (Suc v))) ((hd_nat (Suc v)) ## xs)"
+proof-
+  obtain ys where xs_def: "Suc v = list_encode ys" 
+    by (metis list_decode_inverse)
+  then moreover obtain a ys' where xs_def_cons : "ys = a#ys'"
+    by (metis list_encode.elims nat.simps(3))
+  moreover obtain xs_list where "xs = list_encode xs_list"  by (metis list_decode_inverse)
+  ultimately show ?thesis by (auto simp add: sub_reverse sub_tl sub_hd sub_cons 
+          sub_append simp del: list_encode.simps)
+qed
+lemma append_cons_nat_0 : "append_nat xs (a ## ys) \<noteq> 0"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  moreover obtain xs' where xs_def_cons : "xs = list_encode xs'"
+   by (metis list_decode_inverse)
+  ultimately show ?thesis by (auto simp add: sub_reverse sub_tl sub_hd sub_cons 
+          sub_append list_encode_eq simp flip: list_encode.simps)
+qed
+lemma cons_Nil:"xs ## ys \<noteq> 0"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons 
+          list_encode_eq simp flip: list_encode.simps)
+qed
+lemma tl_cons: "tl_nat (a##ys) = ys"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons sub_tl
+          list_encode_eq simp flip: list_encode.simps)
+qed
+
+lemma hd_cons: "hd_nat (a##ys) = a"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons sub_hd
+          list_encode_eq simp flip: list_encode.simps)
+qed
+lemma rev_rev_nat: "reverse_nat (reverse_nat ys) = ys"
+ proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_cons sub_reverse sub_hd
+          list_encode_eq simp flip: list_encode.simps)
+qed
+
+
+lemma append_nat_0: "append_nat ys 0 = ys"
+proof-
+  obtain ys' where xs_def: "ys = list_encode ys'" 
+    by (metis list_decode_inverse)
+  then show ?thesis by (auto simp add: sub_append sub_hd
+          list_encode_eq simp flip: list_encode.simps)
+qed
+lemma cons0:"cons a 0 = list_encode [a]"
+  by (metis list_encode.simps(1) sub_cons)
+
+lemma append_nat_Suc: 
+"append_nat xs (Suc v) = append_nat (append_nat xs ((hd_nat (Suc v))##0)) (tl_nat (Suc v))"
+proof -
+  obtain xs' v' where "xs =list_encode xs'" "Suc v = list_encode v'"
+    by (metis list_decode_inverse)
+  then moreover obtain a ys where "v' = a # ys" 
+    by (metis Zero_neq_Suc list_encode.elims)
+  ultimately show ?thesis apply(auto simp add:sub_append  sub_hd cons0 
+              sub_tl simp del:list_encode.simps) done
+qed
+
+lemma reverse_append_nat:
+    "reverse_nat (append_nat xs ys) = append_nat (reverse_nat ys) (reverse_nat xs)"
+proof - 
+obtain xs' ys' where "xs =list_encode xs'"  "ys = list_encode ys'"
+  by (metis list_decode_inverse)
+  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
+          sub_append sub_reverse)
+qed
+lemma reverse_singleton_nat:
+"reverse_nat (a ## 0) = a ## 0" by(auto simp add: cons0 sub_reverse simp del:list_encode.simps) 
+lemma append_singleton_nat : 
+"append_nat (a##0) xs = a ## xs"
+proof - 
+  obtain xs' where "xs = list_encode xs'"
+ by (metis list_decode_inverse)
+  thus ?thesis by(auto simp del:append_nat.simps list_encode.simps simp add: cons0 sub_cons
+          sub_append )
+qed
+
+lemma reverse_cons_nat:
+"reverse_nat (a ## xs) = append_nat (reverse_nat xs) (a##0) "
+proof -
+  obtain xs' where "xs= list_encode xs'" 
+    by (metis list_decode_inverse)
+  thus ?thesis 
+    apply (auto simp add:sub_append sub_reverse sub_cons cons0 simp del:
+                  list_encode.simps) done
+qed
+
+lemma cons_is_reverse: "a ## reverse_nat xs = reverse_nat (append_nat xs (a##0))"
+proof -
+  obtain xs' where "xs= list_encode xs'" 
+    by (metis list_decode_inverse)
+  thus ?thesis 
+    apply (auto simp add:sub_append sub_reverse sub_cons cons0 simp del:
+                  list_encode.simps) done
+qed
+
+lemma append_induct: " reverse_nat(append_nat xs ys) = 
+
+append_acc (reverse_nat xs) ys"
+  apply(induct ys  arbitrary: xs rule:length_nat.induct)
+   apply(simp add: append_nat_0)
+  apply (auto simp add: append_nat_Suc   reverse_append_nat reverse_singleton_nat 
+append_singleton_nat simp flip: reverse_cons_nat)
+  apply(auto simp only: cons_is_reverse)
+  done
+
+definition append_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"append_tail xs ys = reverse_nat (append_acc (reverse_nat xs) ys)"
+
+lemma subtail_append:
+"append_tail xs ys = append_nat xs ys"
+  apply(auto simp only: append_tail_def)
+  using rev_rev_nat
+  by (metis append_induct)
+
+
 fun elemof :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "elemof e l = (if l = 0 then 0 else if hd_nat l = e then 1 else elemof e (tl_nat l))"
 
@@ -240,10 +394,15 @@ split:if_splits
 
 lemma sub_elem_of2: "(elemof e (list_encode l) = 0) =  (e \<notin> set l)"
   using sub_elem_of by blast
+
 fun remdups_nat :: "nat \<Rightarrow> nat" where 
 "remdups_nat n = (if n=0 then 0 else if elemof (hd_nat n) (tl_nat n) \<noteq> 0 then remdups_nat (tl_nat n)
                  else cons (hd_nat n) (remdups_nat (tl_nat n)))"
 
+fun remdups_acc :: "nat \<Rightarrow> nat => nat" where 
+"remdups_acc acc n =(if n=0 then acc else if elemof (hd_nat n) (tl_nat n) \<noteq> 0 then remdups_acc acc (tl_nat n)
+                 else remdups_acc (cons (hd_nat n) acc) (tl_nat n))"
+
 lemma sub_remdups: "remdups_nat (list_encode xs) = list_encode (remdups xs)"
   apply (subst remdups_nat.simps)
   apply (induct xs)
@@ -252,6 +411,30 @@ lemma sub_remdups: "remdups_nat (list_encode xs) = list_encode (remdups xs)"
    apply auto[1]
   by (smt less_numeral_extra(3) non_empty_positive remdups_nat.elims sub_cons 
 sub_elem_of sub_hd sub_tl)
+lemma non_empty_not_zero:"list_encode (a#xs) \<noteq> 0" using non_empty_positive by auto
+lemma remdups_induct : 
+" reverse_nat (append_nat (reverse_nat acc) (remdups_nat xs))
+= remdups_acc acc xs "
+proof -
+  obtain xs' acc' where "xs =list_encode xs'" "acc = list_encode acc'"
+    by (metis list_decode_inverse)
+  thus ?thesis apply(auto simp only: sub_reverse sub_remdups sub_append rev_append rev_rev_ident)
+    apply(induct xs' arbitrary: acc' xs acc)
+     apply simp
+    apply(subst remdups_acc.simps)
+    apply(auto simp add: sub_cons sub_hd sub_tl sub_elem_of2 sub_elem_of non_empty_positive non_empty_not_zero
+simp del: list_encode.simps remdups_acc.simps append_nat.simps elemof.simps)
+    done
+qed
+
+definition remdups_tail :: "nat \<Rightarrow> nat" where 
+"remdups_tail xs = reverse_nat (remdups_acc 0 xs)"
+
+lemma subtail_remdups:
+"remdups_tail xs = remdups_nat xs"
+  apply(auto simp only:remdups_tail_def)
+  using remdups_induct[of 0 xs]
+  by (metis append_nat.simps(1) rev_rev_nat reverse_nat_0)
 
 lemma prod_sum_less:"0< x \<Longrightarrow>(x,y) = prod_decode p  \<Longrightarrow> x+y < p"
   by (smt Nat.add_0_right Suc_leI add.left_commute add.left_neutral add.right_neutral 
@@ -418,8 +601,7 @@ not_less_eq_eq prod.exhaust_sel prod_decode_inverse)
     using pos_tl_less[of x] nth_less[of n "tl_nat x"]
     by linarith
   done
-lemma cons0:"cons a 0 = list_encode [a]"
-  by (metis list_encode.simps(1) sub_cons)
+
 
 fun map_nat :: "(nat\<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_nat f n= (if n =0 then 0 else cons (f (hd_nat n)) (map_nat f (tl_nat n)))"
@@ -467,9 +649,16 @@ lemma sub_tail_map : "tail (map f v) = map f (tl v)"
    apply auto
   done
 
+
 fun list_from_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "list_from_nat s n = (if n = 0 then 0 else cons s (list_from_nat (s+1) (n-1)))"
 
+fun list_from_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"list_from_acc acc s n = (if n = 0 then acc else list_from_acc (s ## acc) (s+1) (n-1) )  "
+
+lemma Suc_plus:"Suc(m+n) = Suc m + n "
+  by simp
+
 lemma sub_list_from: "list_from_nat s n = list_encode [s..<s+n]"
   apply (induct s n rule: list_from_nat.induct)
   apply (simp)
@@ -477,9 +666,46 @@ lemma sub_list_from: "list_from_nat s n = list_encode [s..<s+n]"
   apply (simp add: upt_rec)
   done
 
+lemma list_from_reverse:
+"reverse_nat (list_from_nat s (Suc n)) = (s + n) ## reverse_nat (list_from_nat s n)"
+  apply(auto simp only:sub_list_from sub_reverse sub_cons list_encode_eq)
+  by auto
+
+lemma list_from_induct:
+"reverse_nat (list_from_nat s (n+m)) =
+list_from_acc (reverse_nat (list_from_nat s n)) (s+n) m 
+"
+  apply(induct m arbitrary: n)
+   apply (simp)
+  apply(subst list_from_acc.simps)
+  subgoal for m n
+    apply (auto simp del: list_from_acc.simps list_from_nat.simps)
+    apply(subst Suc_plus)
+    apply(auto simp only:)
+    apply (auto  simp add: list_from_reverse simp del: list_from_acc.simps list_from_nat.simps)
+    done
+  done
+
+definition list_from_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"list_from_tail s n = reverse_nat (list_from_acc 0 s n)"
+
+lemma subtail_list_from: 
+"list_from_tail s n = list_from_nat s n"
+  apply(auto simp only: list_from_tail_def)
+  using list_from_induct[of s 0 n] list_from_nat.simps reverse_nat_0 rev_rev_nat 
+  by (metis add.left_neutral nat_arith.rule0)
+
 definition list_less_nat :: "nat \<Rightarrow> nat" where
 "list_less_nat n = list_from_nat 0 n"
 
+definition list_less_tail :: "nat \<Rightarrow> nat" where
+"list_less_tail n = list_from_tail 0 n"
+
+lemma subtail_list_less : 
+"list_less_tail n = list_less_nat n"
+  apply(auto simp only: list_less_tail_def list_less_nat_def subtail_list_from)
+  done
+  
 lemma sub_list_less : "list_less_nat n = list_encode ([0..<n])"
   apply (simp only: list_less_nat_def sub_list_from)
   apply auto
@@ -506,6 +732,9 @@ lemma remdups_map : "inj f \<Longrightarrow> remdups (map f xs) = map f (remdups
 fun concat_nat :: "nat \<Rightarrow> nat" where
 "concat_nat n = (if n = 0 then 0 else append_nat (hd_nat n) (concat_nat (tl_nat n)))"
 
+fun concat_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"concat_acc acc n = (if n =0 then acc else concat_acc (append_tail (reverse_nat (hd_nat n)) acc) (tl_nat n)) "
+
 lemma sub_concat : "concat_nat (list_encode (map list_encode xs)) = list_encode (concat xs)"
   apply (induct xs)
    apply simp
@@ -513,6 +742,39 @@ lemma sub_concat : "concat_nat (list_encode (map list_encode xs)) = list_encode
   apply (simp only: concat.simps sub_hd sub_tl)
   apply (auto simp add:sub_append)
   done
+
+lemma conc_append: "concat xs @ a = concat(xs @ [a])" by auto
+find_theorems "rev _ @ rev _"
+lemma concat_induct: 
+"reverse_nat (concat_nat (append_nat xs ys))
+= concat_acc (reverse_nat (concat_nat xs)) ys"
+proof -
+  obtain xs' ys' where "xs =list_encode (map list_encode xs')" "ys = list_encode (map list_encode ys')"
+    by (metis ex_map_conv list_decode_inverse)
+  thus ?thesis 
+    apply(auto simp add: sub_append sub_concat sub_reverse 
+       simp flip: map_append  simp del: list_encode.simps append_nat.simps concat_nat.simps concat_acc.simps)
+    apply(induct ys' arbitrary:xs' xs ys)
+     apply (simp)
+    apply(subst concat_acc.simps)
+    apply(auto  simp add: simp del: list_encode.simps append_nat.simps concat_nat.simps concat_acc.simps)
+     apply(simp)
+    apply(auto simp add: sub_tl sub_hd  sub_append subtail_append  sub_reverse
+           simp del: list_encode.simps append_nat.simps concat_nat.simps concat_acc.simps)
+    apply(auto simp only: conc_append simp flip: rev_append ) 
+    done
+qed
+
+definition concat_tail:: "nat \<Rightarrow> nat" where 
+"concat_tail ys = reverse_nat (concat_acc 0 ys)"
+
+lemma subtail_concat:
+"concat_tail ys = concat_nat ys"
+  apply(auto simp only:concat_tail_def)
+  using concat_induct [of 0 ys] rev_rev_nat append_nat.simps(1)
+  by (metis concat_nat.simps reverse_nat_0)
+
+
 lemma vname_list_encode_as_comp:"vname_list_encode = list_encode o (map vname_encode)"
   by (auto simp add:fun_eq_iff vname_list_encode_def)
 
@@ -727,6 +989,12 @@ fun list_update_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> na
 "list_update_nat l n v = (if l =0 then 0 else if n=0 then (v##tl_nat l) else (hd_nat l) ##
                list_update_nat (tl_nat l) (n-1) v)"
 
+definition list_update_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"list_update_tail l n v = list_update_nat l n v"
+
+lemma subtail_list_update:
+"list_update_tail l n v = list_update_nat l n v" using list_update_tail_def by auto
+
 lemma sub_list_update : 
       "list_update_nat (list_encode l) n v = list_encode (list_update l n v) "
   apply (induct l arbitrary:n)
@@ -1544,6 +1812,12 @@ lemma sat_formula_list_id:
 fun BigAnd_nat:: "nat \<Rightarrow> nat" where 
 "BigAnd_nat xs = (if xs=0 then 2##(0##0)##0 else 3##(hd_nat xs)##(BigAnd_nat (tl_nat xs))##0)"
 
+fun BigAnd_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"BigAnd_acc acc xs = (if xs=0 then acc 
+ else BigAnd_acc (3##(hd_nat xs)## acc ##0) (tl_nat xs))"
+
+
+
 lemma sub_BigAnd:
 "BigAnd_nat (sat_formula_list_encode xs) = sat_formula_encode (BigAnd xs)"
   apply (induct xs)
@@ -1553,7 +1827,32 @@ lemma sub_BigAnd:
 simp del:BigAnd_nat.simps)
   done
 
-fun BigOr_nat:: "nat \<Rightarrow> nat" where 
+lemma BigAnd_induct : 
+" BigAnd_nat (append_nat (reverse_nat xs) ys) = BigAnd_acc (BigAnd_nat ys) xs"
+proof -
+  obtain xs' ys' where "xs =list_encode xs' " "ys = list_encode ys'"
+    
+    by (metis list_decode_inverse)
+  thus ?thesis apply (auto simp only: sub_reverse sub_BigAnd sub_append)
+    apply(induct xs' arbitrary:ys' xs ys )
+     apply (auto simp del:BigAnd_nat.simps BigAnd_acc.simps list_encode.simps)
+     apply simp
+    apply(subst(2) BigAnd_acc.simps)
+    apply (auto simp add: list_encode_eq sub_hd
+        simp del:BigAnd_nat.simps BigAnd_acc.simps simp flip:list_encode.simps)
+    apply(subst BigAnd_nat.simps)
+     apply (auto simp add: list_encode_eq sub_hd sub_tl
+        simp del:BigAnd_nat.simps BigAnd_acc.simps simp flip:list_encode.simps)
+    done
+qed
+definition BigAnd_tail :: "nat \<Rightarrow> nat" where 
+"BigAnd_tail xs = BigAnd_acc (2##(0##0)##0) (reverse_nat xs) "
+
+lemma subtail_BigAnd :
+" BigAnd_tail xs = BigAnd_nat xs "
+  by (metis BigAnd_induct BigAnd_nat.elims BigAnd_tail_def append_nat_0 rev_rev_nat)
+
+fun BigOr_nat:: "nat \<Rightarrow> nat" where
 "BigOr_nat xs = (if xs=0 then (0##0) else 4##(hd_nat xs)##(BigOr_nat (tl_nat xs))##0)"
 
 lemma sub_BigOr:
@@ -1565,6 +1864,38 @@ lemma sub_BigOr:
 simp del:BigOr_nat.simps)
   done
 
+fun BigOr_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"BigOr_acc acc xs = (if xs=0 then acc 
+ else BigOr_acc (4##(hd_nat xs)## acc ##0) (tl_nat xs))"
+
+
+
+
+lemma BigOr_induct : 
+" BigOr_nat (append_nat (reverse_nat xs) ys) = BigOr_acc (BigOr_nat ys) xs"
+proof -
+  obtain xs' ys' where "xs =list_encode xs' " "ys = list_encode ys'"
+    
+    by (metis list_decode_inverse)
+  thus ?thesis apply (auto simp only: sub_reverse sub_BigAnd sub_append)
+    apply(induct xs' arbitrary:ys' xs ys )
+     apply (auto simp del:BigOr_nat.simps BigOr_acc.simps list_encode.simps)
+     apply simp
+    apply(subst(2) BigOr_acc.simps)
+    apply (auto simp add: list_encode_eq sub_hd
+        simp del:BigOr_nat.simps BigOr_acc.simps simp flip:list_encode.simps)
+     apply (auto simp add: list_encode_eq sub_hd sub_tl
+        simp del:BigAnd_nat.simps BigAnd_acc.simps simp flip:list_encode.simps)
+    done
+qed
+
+definition BigOr_tail :: "nat \<Rightarrow> nat" where 
+"BigOr_tail xs = BigOr_acc (0##0) (reverse_nat xs) "
+
+lemma subtail_BigOr :
+" BigOr_tail xs = BigOr_nat xs "
+  by (metis BigOr_induct BigOr_nat.elims BigOr_tail_def append_nat_0 rev_rev_nat)
+
 lemma strips_simp:"strips_assignment_encode = prod_encode o (\<lambda>(s,b). (sas_plus_assignment_encode s, bool_encode b))"
   apply (auto)
   done
@@ -1603,4 +1934,74 @@ lemma sub_elem_of_inj: "inj f \<Longrightarrow> (elemof (f e) (list_encode (map
       list_encode_eq sub_hd sub_tl simp del:elemof.simps simp flip: list_encode.simps)
   done
 
+fun map_acc :: "(nat \<Rightarrow> nat) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_acc f acc n = (if n = 0 then acc else map_acc f ((f (hd_nat n)) ## acc) (tl_nat n))"
+
+lemma rev_cons: "a # rev xs = rev (xs @[a])"
+  apply auto
+  done
+lemma append_singleton:
+"map f xs @ [f a] = map f (xs@[a])"
+  apply(auto)
+  done
+lemma map_induct :
+"reverse_nat (map_nat f (append_nat xs ys))
+= map_acc f (reverse_nat ( map_nat f xs)) ys"
+proof - 
+  obtain xs' ys' where "xs = list_encode xs'" "ys = list_encode ys'"
+    by (metis list_decode_inverse)
+  thus ?thesis  
+    apply(auto simp only: sub_append sub_map sub_reverse) 
+    apply(induct ys' arbitrary:xs' xs ys)
+     apply simp
+    apply(subst map_acc.simps)
+    apply(auto simp add: sub_tl sub_hd sub_cons 
+            simp del:map_acc.simps list_encode.simps)
+     apply simp
+    subgoal for a ys' xs'
+      apply(auto simp only: rev_cons append_singleton)
+      done
+    done
+qed
+
+      
+lemma subtail_map:
+"reverse_nat (map_acc f  0 xs) = map_nat f xs"
+  using map_induct[of f 0 xs] 
+  by (metis append_nat.simps(1) map_nat.simps rev_rev_nat reverse_nat_0)
+
+fun filter_acc :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_acc f acc xs = (if xs = 0 then acc else if f (hd_nat xs) then filter_acc f ((hd_nat xs) ## acc) (tl_nat xs)
+else filter_acc  f  acc (tl_nat xs))"
+
+lemma filter_append:
+"f a \<Longrightarrow> filter f xs @ [a] = filter f (xs @ [a]) "
+  apply auto
+  done
+
+lemma filter_induct:
+"reverse_nat (filter_nat f (append_nat xs ys))
+= filter_acc f (reverse_nat ( filter_nat f xs)) ys"
+proof - 
+  obtain xs' ys' where "xs = list_encode xs'" "ys = list_encode ys'"
+    by (metis list_decode_inverse)
+  thus ?thesis  
+    apply(auto simp only: sub_append sub_filter sub_reverse) 
+    apply(induct ys' arbitrary:xs' xs ys)
+     apply simp
+    apply(subst filter_acc.simps)
+    apply(auto simp add: sub_tl sub_hd sub_cons  non_empty_not_zero
+            simp del:filter_acc.simps list_encode.simps)
+    subgoal for a ys' xs'
+      apply(auto simp only: rev_cons filter_append append_singleton)
+      done
+    done
+qed
+
+lemma subtail_filter:
+"reverse_nat (filter_acc f  0 xs) = filter_nat f xs"
+  using filter_induct[of f 0 xs] 
+  by (metis append_nat.simps(1) filter_nat.simps rev_rev_nat reverse_nat_0)
+
+
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
index aa44c61b..8d6b2829 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
@@ -41,16 +41,45 @@ lemma sublist_SAS_Plus_Plus_State_To_SAS_Plus:
 
 fun map_sasps :: "nat\<Rightarrow>nat" where 
 "map_sasps n = (if n = 0 then 0 else (prod_encode (Suc(fst_nat (hd_nat n)) , Suc(Suc(snd_nat (hd_nat n))) ))## map_sasps (tl_nat n))"
+fun map_sasps_acc :: "nat \<Rightarrow> nat\<Rightarrow>nat" where 
+"map_sasps_acc acc n = (if n = 0 then acc else map_sasps_acc ((prod_encode (Suc(fst_nat (hd_nat n)) , Suc(Suc(snd_nat (hd_nat n))) ))## acc) (tl_nat n))"
+
+
 lemma submap_sasps:
  "map_sasps  n = map_nat (\<lambda>x. prod_encode (Suc(fst_nat x) , Suc(Suc(snd_nat x)) )) n"
   apply (induct n rule:map_sasps.induct)
   apply auto
   done
 
+lemma map_sasps_induct:
+"map_sasps_acc acc n = map_acc  (\<lambda>x. prod_encode (Suc(fst_nat x) , Suc(Suc(snd_nat x)) )) acc n "
+  apply(induct acc n rule:map_sasps_acc.induct)
+  apply auto
+  done
+
+definition map_sasps_tail :: "nat \<Rightarrow> nat" where 
+"map_sasps_tail n = reverse_nat (map_sasps_acc 0 n)"
+
+lemma subtail_map_sasps:
+"map_sasps_tail n = map_sasps n"
+  using map_sasps_tail_def  map_sasps_induct submap_sasps subtail_map
+  by presburger
+
 definition SAS_Plus_Plus_State_To_SAS_Plus_nat :: "nat \<Rightarrow> nat" where
 "SAS_Plus_Plus_State_To_SAS_Plus_nat is = (prod_encode (0,fst_nat is))##
 (map_sasps (snd_nat is))"
 
+definition SAS_Plus_Plus_State_To_SAS_Plus_tail:: "nat \<Rightarrow> nat" where
+"SAS_Plus_Plus_State_To_SAS_Plus_tail is = (prod_encode (0,fst_nat is))##
+(map_sasps_tail (snd_nat is))"
+
+lemma subtail_SAS_Plus_Plus_State_To_SAS_Plus:
+"SAS_Plus_Plus_State_To_SAS_Plus_tail is = SAS_Plus_Plus_State_To_SAS_Plus_nat is"
+  apply(auto simp only: SAS_Plus_Plus_State_To_SAS_Plus_tail_def
+SAS_Plus_Plus_State_To_SAS_Plus_nat_def
+subtail_map_sasps)
+  done
+
 lemma subnat_SAS_Plus_Plus_State_To_SAS_Plus:
 "SAS_Plus_Plus_State_To_SAS_Plus_nat(islist_encode is) =
     sas_plus_assignment_list_encode (SAS_Plus_Plus_State_To_SAS_Plus_list is)"
@@ -76,18 +105,52 @@ lemma sub_SAS_Plus_Plus_State_To_SAS_Plus:
 fun map_var_de :: "nat \<Rightarrow> nat" where 
 "map_var_de n = (if n = 0 then 0 else (prod_encode(Suc (fst_nat (hd_nat n)), Suc (Suc(snd_nat (hd_nat n)))))## map_var_de (tl_nat n) )"
 
+fun map_var_de_acc :: " nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_var_de_acc acc n = (if n = 0 then acc else  map_var_de_acc
+((prod_encode(Suc (fst_nat (hd_nat n)), Suc (Suc(snd_nat (hd_nat n)))))## acc) (tl_nat n) )"
+
 lemma submap_var_de :
 "map_var_de n = map_nat (\<lambda> x. prod_encode(Suc (fst_nat x), Suc (Suc(snd_nat x)))) n"
   apply (induct n rule: map_var_de.induct)
   apply auto
   done
 
+lemma map_var_de_induct:
+"map_var_de_acc acc n = map_acc  (\<lambda> x. prod_encode(Suc (fst_nat x), Suc (Suc(snd_nat x)))) acc n "
+  apply (induct acc n rule: map_var_de_acc.induct)
+  apply auto
+  done
+
+definition map_var_de_tail :: "nat \<Rightarrow> nat" where 
+"map_var_de_tail n = reverse_nat (map_var_de_acc 0 n)"
+
+lemma subtail_map_var_de:
+"map_var_de_tail n = map_var_de n"
+  using map_var_de_tail_def  submap_var_de  map_var_de_induct 
+      subtail_map 
+  by presburger
+      
 definition SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat:: 
   "nat \<Rightarrow> nat" where
 "SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat op = 
   ((prod_encode(0,0)) ## (map_var_de (nth_nat 0 op)))##
    (( map_sasps  (nth_nat (Suc 0) op))) ## 0"
 
+definition SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_tail:: 
+  "nat \<Rightarrow> nat" where
+"SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_tail op = 
+  ((prod_encode(0,0)) ## (map_var_de_tail (nth_nat 0 op)))##
+   (( map_sasps_tail  (nth_nat (Suc 0) op))) ## 0"
+
+lemma subtail_SAS_Plus_Plus_Operator_To_SAS_Plus_Operator:
+"SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_tail op =  SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat op"
+  apply(auto simp only: SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_tail_def 
+SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat_def
+subtail_map_sasps
+subtail_map_var_de)
+  done
+
+
 lemma fst_sas_assignment : "fst_nat (sas_assignment_encode x) = variable_encode (fst x)"
   apply (cases x)
   apply (auto simp add:sub_fst)
@@ -96,6 +159,7 @@ lemma snd_sas_assignment : "snd_nat (sas_assignment_encode x) = domain_element_e
   apply (cases x)
   apply (auto simp add:sub_snd)
   done
+
 lemma sub_SAS_Plus_Plus_Operator_To_SAS_Plus_Operator:
   "SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat (operator_encode op) =
     operator_plus_encode (SAS_Plus_Plus_Operator_To_SAS_Plus_Operator op)"
@@ -134,26 +198,62 @@ lemma sublist_initialization_operators:
 fun map_inner :: "nat \<Rightarrow> nat\<Rightarrow>nat" where 
 "map_inner v n = (if n = 0 then 0 else ((((prod_encode (0, 1)))##0) ## ((prod_encode (Suc v, Suc (Suc (hd_nat n))))## 0) ## 0) ## map_inner v (tl_nat n) )"
 
-lemma submap_inner: 
+fun map_inner_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Rightarrow>nat" where 
+"map_inner_acc v acc n = (if n = 0 then acc else map_inner_acc v (((((prod_encode (0, 1)))##0) ## ((prod_encode (Suc v, Suc (Suc (hd_nat n))))## 0) ## 0) ## acc) (tl_nat n) )"
+
+lemma submap_inner:
 "map_inner v n =  map_nat (\<lambda> y. (((prod_encode (0, 1)))##0) ## ((prod_encode (Suc v, Suc (Suc y)))## 0) ## 0) n"
   apply (induct v n rule:map_inner.induct)
   apply auto
   done
 
+lemma map_inner_induct:
+"map_inner_acc v acc n = map_acc (\<lambda> y. (((prod_encode (0, 1)))##0) ## ((prod_encode (Suc v, Suc (Suc y)))## 0) ## 0) acc n "
+  apply(induct v acc n rule:map_inner_acc.induct)
+  apply auto
+  done
+
+definition map_inner_tail ::"nat \<Rightarrow> nat \<Rightarrow> nat" where
+ "map_inner_tail v n = reverse_nat ( map_inner_acc v 0 n)"
+
+lemma subtail_map_inner:
+"map_inner_tail v n = map_inner v n"
+  using map_inner_tail_def  map_inner_induct submap_inner
+        subtail_map by presburger
+
+
+
 fun map_fst :: "nat\<Rightarrow>nat" where 
 "map_fst n  = (if n =0 then 0 else (fst_nat (hd_nat n)) ## map_fst (tl_nat n))"
 
+fun map_fst_acc :: "nat \<Rightarrow> nat\<Rightarrow>nat" where 
+"map_fst_acc acc n  = (if n =0 then acc else map_fst_acc ((fst_nat (hd_nat n)) ## acc) (tl_nat n))"
+
+
 lemma submap_fst :
 "map_fst n = map_nat fst_nat n"
   apply (induct n rule:map_fst.induct)
   apply auto
   done
-function map_outer :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+lemma map_fst_induct:
+"map_fst_acc acc n = map_acc fst_nat acc n"
+  apply(induct acc n rule:map_fst_acc.induct)
+  apply auto
+  done
+
+definition map_fst_tail :: "nat \<Rightarrow> nat" where 
+"map_fst_tail n = reverse_nat (map_fst_acc 0 n)"
+
+lemma subtail_map_fst :
+"map_fst_tail n = map_fst n"
+  using map_fst_tail_def map_fst_induct submap_fst subtail_map 
+  by presburger
+
+fun map_outer :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "map_outer P n = (if n =0 then 0 else (if elemof (hd_nat n) (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
     else (map_inner (hd_nat n) 
       (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## map_outer P (tl_nat n))"
-   apply  pat_completeness apply (auto simp only:) done
-termination by lexicographic_order
+
 
 lemma submap_outer: 
 "map_outer P n = map_nat (\<lambda> v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
@@ -161,12 +261,48 @@ lemma submap_outer:
       (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v)))) n"
   apply (induct P n rule:map_outer.induct)
   by (metis (no_types, lifting) map_nat.elims map_outer.elims)
+declare map_list_find_nat.simps elemof.simps [simp del]
+fun  map_outer_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_outer_acc P acc n = (if n =0 then acc else map_outer_acc P ((if elemof (hd_nat n) (map_fst_tail (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
+    else (map_inner_tail (hd_nat n) 
+      (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## acc) (tl_nat n))"
+
+lemma map_outer_induct : 
+"map_outer_acc P acc n = map_acc (\<lambda> v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
+    else map_inner v 
+      (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v)))) acc n"
+  apply(induct P acc n rule:map_outer_acc.induct)
+  using subtail_map_fst subtail_map_inner 
+  by (metis (no_types, lifting) map_acc.elims map_outer_acc.elims)
+
+definition map_outer_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_outer_tail P  n = reverse_nat (map_outer_acc P  0 n)"
+
+
+lemma subtail_map_outer:
+"map_outer_tail P  n  = map_outer P n "
+  using map_outer_tail_def  map_outer_induct submap_outer subtail_map
+  by presburger
+
 
 definition initialization_operators_nat::
     "nat \<Rightarrow> nat" where
 "initialization_operators_nat  P = 
   concat_nat (map_outer P (nth_nat 0 P))"
 
+definition initialization_operators_tail::
+    "nat \<Rightarrow> nat" where
+"initialization_operators_tail  P = 
+  concat_tail (map_outer_tail P (nth_nat 0 P))"
+
+lemma subtail_initialization_operators:
+"initialization_operators_tail  P = 
+initialization_operators_nat  P
+"
+  apply(simp only: initialization_operators_tail_def initialization_operators_nat_def
+      subtail_concat subtail_map_outer)
+  done
+
 lemma simp_vdlist_encode: "vdlist_encode = prod_encode o (\<lambda>(x,y). (variable_encode x,list_encode (map domain_element_encode y)))"
   by force
 
@@ -255,6 +391,10 @@ fun map_init_seq :: "nat \<Rightarrow> nat" where
 "map_init_seq n = (if n = 0 then 0 else ((((prod_encode (0,1))##0) ## 
       ((prod_encode(Suc (fst_nat (hd_nat n)), Suc (Suc (snd_nat (hd_nat n)))))##0) ##0)) ## map_init_seq (tl_nat n))"
 
+fun map_init_seq_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_init_seq_acc  acc n = (if n = 0 then acc else map_init_seq_acc (((((prod_encode (0,1))##0) ## 
+      ((prod_encode(Suc (fst_nat (hd_nat n)), Suc (Suc (snd_nat (hd_nat n)))))##0) ##0)) ## acc) (tl_nat n))"
+
 lemma submap_init_seq: 
 "map_init_seq n = map_nat (\<lambda>v. (((prod_encode (0,1))##0) ## 
       ((prod_encode(Suc (fst_nat v), Suc (Suc (snd_nat v))))##0) ##0)) n"
@@ -262,9 +402,34 @@ lemma submap_init_seq:
   apply auto
   done
 
+lemma map_init_seq_induct:
+"map_init_seq_acc  acc n = map_acc  (\<lambda>v. (((prod_encode (0,1))##0) ## 
+      ((prod_encode(Suc (fst_nat v), Suc (Suc (snd_nat v))))##0) ##0)) acc n"
+  apply(induct acc n rule:map_init_seq_acc.induct)
+  apply auto
+  done
+
+definition map_init_seq_tail :: "nat \<Rightarrow> nat" where 
+"map_init_seq_tail n = reverse_nat (map_init_seq_acc 0 n) "
+
+lemma subtail_map_init_seq:
+"map_init_seq_tail n = map_init_seq n"
+  using map_init_seq_tail_def map_init_seq_induct
+submap_init_seq subtail_map by presburger
+
 definition initialization_sequence_nat:: "nat \<Rightarrow> nat" where
   "initialization_sequence_nat vs = map_init_seq vs"
 
+definition initialization_sequence_tail:: "nat \<Rightarrow> nat" where
+  "initialization_sequence_tail vs = map_init_seq_tail vs"
+
+lemma subtail_initialization_sequence:
+"initialization_sequence_tail vs = initialization_sequence_nat vs"
+  using initialization_sequence_nat_def
+ initialization_sequence_tail_def
+ subtail_map_init_seq by presburger
+
+
 lemma sub_initialization_sequence :
   "initialization_sequence_nat (sas_assignment_list_encode vs) =
       list_encode (map operator_plus_encode (initialization_sequence vs)) "
@@ -338,7 +503,10 @@ declare map_list_find_nat.simps [simp del]
 fun map_initial_state :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_initial_state P n = (if n = 0 then 0 else (prod_encode(hd_nat n, case (map_list_find_nat (nth_nat (Suc (Suc 0))  P) (hd_nat n)) of  Suc val \<Rightarrow> val |
         0 \<Rightarrow> hd_nat (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## map_initial_state P (tl_nat n))"
-declare map_list_find_nat.simps [simp]
+
+fun map_initial_state_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>  nat" where 
+"map_initial_state_acc P acc n = (if n = 0 then acc else map_initial_state_acc P ((prod_encode(hd_nat n, case (map_list_find_nat (nth_nat (Suc (Suc 0))  P) (hd_nat n)) of  Suc val \<Rightarrow> val |
+        0 \<Rightarrow> hd_nat (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## acc )(tl_nat n))"
 
 lemma submap_initial_state:
 "map_initial_state P n  =  map_nat (\<lambda>v. prod_encode(v, case (map_list_find_nat (nth_nat (Suc (Suc 0))  P) v) of  Suc val \<Rightarrow> val |
@@ -347,12 +515,44 @@ lemma submap_initial_state:
   apply auto
   done
 
+lemma map_initial_state_induct: 
+"map_initial_state_acc P acc n = map_acc  (\<lambda>v. prod_encode(v, case (map_list_find_nat (nth_nat (Suc (Suc 0))  P) v) of  Suc val \<Rightarrow> val |
+        0 \<Rightarrow> hd_nat (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))) ) acc n "
+  apply(induct P acc n rule:map_initial_state_acc.induct)
+  apply auto
+  done
+
+definition map_initial_state_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_initial_state_tail P n = reverse_nat (map_initial_state_acc P 0 n)"
+
+lemma subtail_map_initial_state:
+" map_initial_state_tail P n = map_initial_state P n"
+  using  map_initial_state_tail_def  map_initial_state_induct submap_initial_state
+subtail_map by presburger
+
+declare map_list_find_nat.simps [simp]
+
+
+
 definition initial_state_nat::
   "nat \<Rightarrow> nat " where
 "initial_state_nat P = SAS_Plus_Plus_State_To_SAS_Plus_nat (prod_encode(1, 
   map_initial_state P (nth_nat 0 P) 
 ))"
 
+
+definition initial_state_tail::
+  "nat \<Rightarrow> nat " where
+"initial_state_tail P = SAS_Plus_Plus_State_To_SAS_Plus_tail (prod_encode(1, 
+  map_initial_state_tail P (nth_nat 0 P) 
+))"
+
+lemma subtail_initial_state:
+"initial_state_tail P = initial_state_nat P"
+
+  using initial_state_nat_def initial_state_tail_def subtail_SAS_Plus_Plus_State_To_SAS_Plus 
+subtail_map_initial_state by presburger
+
 lemma option_encode_case: "(case option_encode x of 0 \<Rightarrow>  t | Suc y \<Rightarrow> f y) =
  (case x of None \<Rightarrow> t | Some y \<Rightarrow> f y)  "
   apply (cases x)
@@ -611,45 +811,130 @@ lemma snd_vdlist_simp: "snd_nat (vdlist_encode x) = list_encode (map domain_elem
 fun map_sasp_to_sas_op :: "nat \<Rightarrow> nat" where 
 "map_sasp_to_sas_op n = (if n = 0 then 0 else (SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat (hd_nat n)) ## map_sasp_to_sas_op (tl_nat n))"
 
+fun map_sasp_to_sas_op_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_sasp_to_sas_op_acc acc n = (if n = 0 then acc else map_sasp_to_sas_op_acc ((SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_tail (hd_nat n)) ## acc) (tl_nat n))"
+
+lemma map_sasp_to_sas_op_induct:
+"map_sasp_to_sas_op_acc acc n = map_acc SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat acc n"
+  apply(induct acc n rule:map_sasp_to_sas_op_acc.induct)
+  apply (auto simp add: subtail_SAS_Plus_Plus_Operator_To_SAS_Plus_Operator)
+  done
+
 lemma submap_sasp_to_sas_op: 
 "map_sasp_to_sas_op n = map_nat SAS_Plus_Plus_Operator_To_SAS_Plus_Operator_nat n "
   apply (induct  n rule: map_sasp_to_sas_op.induct)
   apply auto
   done
 
+definition map_sasp_to_sas_op_tail :: "nat \<Rightarrow> nat" where 
+"map_sasp_to_sas_op_tail n = reverse_nat (map_sasp_to_sas_op_acc 0 n)"
+
+lemma subtail_map_sasp_to_sas_op:
+"map_sasp_to_sas_op_tail n = map_sasp_to_sas_op n "
+  using map_sasp_to_sas_op_tail_def  submap_sasp_to_sas_op  map_sasp_to_sas_op_induct
+subtail_map by presburger
+
 fun map_DE :: "nat \<Rightarrow> nat" where 
 "map_DE n = (if n = 0 then 0 else (Suc (Suc (hd_nat n))) ## map_DE (tl_nat n))"
 
+fun map_DE_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_DE_acc acc n = (if n = 0 then acc else map_DE_acc ((Suc (Suc (hd_nat n))) ## acc) (tl_nat n))"
+
 lemma submap_DE : "map_DE n =  map_nat (\<lambda>n. Suc (Suc n)) n"
   apply (induct n rule:map_DE.induct)
   apply auto
   done
 
+lemma map_DE_induct : 
+"map_DE_acc acc n = map_acc (\<lambda>n. Suc (Suc n)) acc n "
+  apply(induct acc n rule:map_DE_acc.induct)
+  apply auto
+  done
+
+definition map_DE_tail :: "nat \<Rightarrow> nat" where 
+"map_DE_tail n = reverse_nat (map_DE_acc 0 n)"
+
+lemma subtail_map_DE:
+"map_DE_tail n = map_DE n "
+  using map_DE_tail_def  map_DE_induct submap_DE subtail_map
+  by presburger
+
 fun map_var :: "nat \<Rightarrow> nat" where 
 "map_var n = (if n = 0 then 0 else ( prod_encode(Suc (fst_nat (hd_nat n)), snd_nat (hd_nat n))) ## map_var (tl_nat n) )"
 
+fun map_var_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_var_acc acc n = (if n = 0 then acc else map_var_acc (( prod_encode(Suc (fst_nat (hd_nat n)), snd_nat (hd_nat n))) ## acc) (tl_nat n) )"
+
+lemma map_var_induct:
+"map_var_acc acc n = map_acc (\<lambda>n. prod_encode(Suc (fst_nat n), snd_nat n)) acc n"
+  apply(induct acc n rule:map_var_acc.induct)
+  apply auto
+  done
+
 lemma submap_var :
 "map_var n = map_nat (\<lambda>n. prod_encode(Suc (fst_nat n), snd_nat n)) n"
   apply (induct n rule:map_var.induct)
   apply auto
   done
 
+definition map_var_tail :: "nat \<Rightarrow> nat" where 
+"map_var_tail n = reverse_nat (map_var_acc 0 n)"
+
+lemma subtail_map_var:
+"map_var_tail n = map_var n"
+  using map_var_tail_def submap_var map_var_induct subtail_map
+  by presburger
+
 fun map_var_DE :: "nat \<Rightarrow> nat" where 
 "map_var_DE n = (if n = 0 then 0 else (prod_encode(fst_nat (hd_nat n), map_DE (snd_nat (hd_nat n)))) ## map_var_DE (tl_nat n))"
 
+fun map_var_DE_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_var_DE_acc acc n = (if n = 0 then acc else map_var_DE_acc ((prod_encode(fst_nat (hd_nat n), map_DE_tail (snd_nat (hd_nat n)))) ## acc )(tl_nat n))"
+
+lemma map_var_DE_induct:
+"map_var_DE_acc acc n = map_acc ( \<lambda>n. prod_encode(fst_nat n, map_DE (snd_nat n))) acc n "
+  apply(induct acc n rule:map_var_DE_acc.induct)
+  apply (auto simp add:subtail_map_DE)
+  done
+
 lemma submap_var_DE:
 "map_var_DE n = map_nat  ( \<lambda>n. prod_encode(fst_nat n, map_DE (snd_nat n))) n"
   apply (induct n rule: map_var_DE.induct)
   apply auto
   done
+definition map_var_DE_tail :: "nat \<Rightarrow> nat" where 
+"map_var_DE_tail n = reverse_nat (map_var_DE_acc 0 n)"
+
+lemma subtail_map_var_DE:
+"map_var_DE_tail n = map_var_DE n"
+  using map_var_DE_tail_def submap_var_DE map_var_DE_induct
+subtail_map by presburger
+
 fun map_Suc :: "nat\<Rightarrow> nat" where 
 "map_Suc n = (if n = 0 then 0 else ((Suc (hd_nat n)) ## map_Suc (tl_nat n)))"
 
+fun map_Suc_acc :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"map_Suc_acc acc n = (if n = 0 then acc  else map_Suc_acc ((Suc (hd_nat n)) ## acc) (tl_nat n))"
+
 lemma submap_Suc : 
 "map_Suc n = map_nat Suc n"
   apply (induct n rule:map_Suc.induct)
   apply auto
   done
+lemma map_Suc_induct :
+"map_Suc_acc acc n = map_acc Suc acc n"
+  apply(induct acc n rule:map_Suc_acc.induct)
+  apply auto
+  done
+
+definition map_Suc_tail:: "nat\<Rightarrow> nat" where 
+"map_Suc_tail n = reverse_nat (map_Suc_acc 0 n)"
+
+lemma subtail_map_Suc:
+"map_Suc_tail n = map_Suc n"
+  using map_Suc_induct submap_Suc map_Suc_tail_def subtail_map
+  by presburger
+
 definition SAS_Plus_Plus_To_SAS_Plus_nat:: " nat \<Rightarrow> nat " where
 "SAS_Plus_Plus_To_SAS_Plus_nat P = ((0 ## (map_Suc (nth_nat 0 P)))##
       ( append_nat ((((prod_encode(0,Suc 0))##0) ## ((prod_encode(0,0))##0) ## 0 ) 
@@ -660,6 +945,26 @@ definition SAS_Plus_Plus_To_SAS_Plus_nat:: " nat \<Rightarrow> nat " where
       ((prod_encode(0, ((Suc 0) ## 0 ##0)))## 
            map_var_DE (map_var (nth_nat (Suc (Suc (Suc (Suc 0)))) P))) ## 0 )"
 
+definition SAS_Plus_Plus_To_SAS_Plus_tail:: " nat \<Rightarrow> nat " where
+"SAS_Plus_Plus_To_SAS_Plus_tail P = ((0 ## (map_Suc_tail (nth_nat 0 P)))##
+      ( append_tail ((((prod_encode(0,Suc 0))##0) ## ((prod_encode(0,0))##0) ## 0 ) 
+        ## (initialization_operators_tail P)) 
+        (map_sasp_to_sas_op_tail (nth_nat (Suc 0) P))) ## 
+      (initial_state_tail P)  ##
+      (SAS_Plus_Plus_State_To_SAS_Plus_tail (prod_encode(0, (nth_nat (Suc (Suc (Suc 0))) P))))##
+      ((prod_encode(0, ((Suc 0) ## 0 ##0)))## 
+           map_var_DE_tail (map_var_tail (nth_nat (Suc (Suc (Suc (Suc 0)))) P))) ## 0 )"
+
+lemma subtail_SAS_Plus_Plus_To_SAS_Plus:
+"SAS_Plus_Plus_To_SAS_Plus_tail P = SAS_Plus_Plus_To_SAS_Plus_nat P"
+  using SAS_Plus_Plus_To_SAS_Plus_nat_def
+ SAS_Plus_Plus_To_SAS_Plus_tail_def 
+subtail_SAS_Plus_Plus_State_To_SAS_Plus 
+subtail_append
+ subtail_initial_state 
+subtail_initialization_operators subtail_map_Suc subtail_map_sasp_to_sas_op subtail_map_var
+ subtail_map_var_DE by presburger
+
 lemma lambda_equals: " (\<lambda>x. case x of
                   (x1, x2) \<Rightarrow>
                     prod_encode
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
index 65966f6a..97e481af 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
@@ -15,16 +15,40 @@ lemma sublist_possible_assignments_for:
 fun map_prodWith :: " nat \<Rightarrow> nat \<Rightarrow>  nat" where 
 "map_prodWith v n = (if n = 0 then 0 else (prod_encode(v,hd_nat n)) ## map_prodWith v (tl_nat n)) "
 
+fun map_prodWith_acc :: " nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>  nat" where 
+"map_prodWith_acc v acc n = (if n = 0 then acc else map_prodWith_acc v ((prod_encode(v,hd_nat n)) ## acc) (tl_nat n)) "
+
+lemma map_prodWith_induct:
+"map_prodWith_acc v acc n = map_acc (\<lambda>a. prod_encode (v,a)) acc n"
+  apply(induct v acc n rule:map_prodWith_acc.induct)
+  apply auto
+  done
+
 lemma submap_prodWith :
 "map_prodWith v n = map_nat (\<lambda>a. prod_encode (v,a)) n"
   apply (induct v n rule:map_prodWith.induct)
   apply auto
   done
 
+definition map_prodWith_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_prodWith_tail v n = reverse_nat (map_prodWith_acc v 0 n)"
+
+lemma subtail_map_prodWith:
+"map_prodWith_tail v n = map_prodWith v n"
+  using map_prodWith_induct map_prodWith_tail_def submap_prodWith subtail_map by presburger
+
 definition possible_assignments_for_nat
   :: "nat \<Rightarrow> nat \<Rightarrow> nat" 
   where "possible_assignments_for_nat P v \<equiv> map_prodWith v (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"
 
+definition possible_assignments_for_tail
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat" 
+  where "possible_assignments_for_tail P v \<equiv> map_prodWith_tail v (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"
+
+lemma subtail_possible_assignments_for:
+"possible_assignments_for_tail P v = possible_assignments_for_nat P v"
+  using possible_assignments_for_nat_def possible_assignments_for_tail_def subtail_map_prodWith by presburger
+
 lemma vdlist_plus_simp:"vdlist_plus_encode = prod_encode o (\<lambda>(v,d). (var_encode v, list_encode (map dom_encode d)))"
   apply auto
   done
@@ -82,10 +106,45 @@ all_possible_assignments_for (list_problem_to_problem P)"
   sublist_possible_assignments_for)
   done
 
+fun map_possible_assignments_for :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_possible_assignments_for P n = (if n = 0 then 0 else (possible_assignments_for_nat P  (hd_nat n)) ## map_possible_assignments_for P (tl_nat n))"
+
+fun map_possible_assignments_for_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_possible_assignments_for_acc  P acc n = (if n = 0 then acc else map_possible_assignments_for_acc P ((possible_assignments_for_tail P  (hd_nat n)) ## acc ) (tl_nat n))"
+
+lemma map_possible_assignments_for_induct :
+"map_possible_assignments_for_acc  P acc n  = map_acc (possible_assignments_for_nat P) acc n"
+  apply(induct P acc n rule:map_possible_assignments_for_acc.induct)
+  apply (auto simp add: subtail_possible_assignments_for) 
+  done
+
+definition  map_possible_assignments_for_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_possible_assignments_for_tail P n = reverse_nat (map_possible_assignments_for_acc  P 0 n  ) "
+
+lemma submap_possible_assignments_for:
+"map_possible_assignments_for P n = map_nat (possible_assignments_for_nat P) n"
+  apply(induct P n rule: map_possible_assignments_for.induct)
+  apply auto
+  done
+lemma subtail_map_possible_assignments_for:
+"map_possible_assignments_for_tail  P  n  = map_possible_assignments_for  P  n  "
+  using map_possible_assignments_for_induct map_possible_assignments_for_tail_def
+ submap_possible_assignments_for subtail_map by presburger
+
 definition all_possible_assignments_for_nat::
    "nat \<Rightarrow> nat"
   where "all_possible_assignments_for_nat \<Psi> 
-    \<equiv> concat_nat (map_nat (possible_assignments_for_nat \<Psi>) (nth_nat 0 \<Psi>))" 
+    \<equiv> concat_nat (map_possible_assignments_for \<Psi> (nth_nat 0 \<Psi>))" 
+
+definition all_possible_assignments_for_tail::
+   "nat \<Rightarrow> nat"
+  where "all_possible_assignments_for_tail \<Psi> 
+    \<equiv> concat_tail (map_possible_assignments_for_tail \<Psi> (nth_nat 0 \<Psi>))" 
+
+lemma subtail_all_possible_assignments_for:
+"all_possible_assignments_for_tail P = all_possible_assignments_for_nat P"
+  using all_possible_assignments_for_nat_def all_possible_assignments_for_tail_def subtail_concat
+ subtail_map_possible_assignments_for by presburger
 
 lemma subnat_all_possible_assignments_for_map:
   assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
@@ -103,7 +162,9 @@ lemma subnat_all_possible_assignments_for:
   shows "all_possible_assignments_for_nat (list_problem_plus_encode P)
 = sas_plus_assignment_list_encode (all_possible_assignments_for_list P)"
   using assms
-  apply (auto simp only:all_possible_assignments_for_nat_def list_problem_plus_encode_def
+  apply (auto simp only:all_possible_assignments_for_nat_def 
+ submap_possible_assignments_for
+list_problem_plus_encode_def
             sub_nth nth.simps sas_plus_assignment_list_encode_def[of "all_possible_assignments_for_list P"] )
   apply (auto simp only: sub_map map_map comp_def all_possible_assignments_for_list_def 
     subnat_all_possible_assignments_for_map
@@ -133,6 +194,18 @@ fun  map_find_eq:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "map_find_eq s n = 
 (if n = 0 then 0 else (prod_encode(hd_nat n, if the_nat (map_list_find_nat s (fst_nat (hd_nat n))) = snd_nat (hd_nat n) then 1 else 0)) ## map_find_eq s (tl_nat n))"
 
+fun  map_find_eq_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_find_eq_acc s acc n = 
+(if n = 0 then acc else map_find_eq_acc s ((prod_encode(hd_nat n, if the_nat (map_list_find_nat s (fst_nat (hd_nat n))) = snd_nat (hd_nat n) then 1 else 0)) ## acc ) (tl_nat n))"
+
+lemma map_find_eq_induct:
+"map_find_eq_acc s acc n = map_acc  (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) acc n"
+  apply(induct s acc n rule:map_find_eq_acc.induct)
+  apply auto
+  done
+
+definition map_find_eq_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_find_eq_tail s n = reverse_nat (map_find_eq_acc s 0 n)"
 
 lemma submap_find_eq: 
 "map_find_eq s n =  map_nat (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) n "
@@ -140,25 +213,39 @@ lemma submap_find_eq:
   apply (auto simp del:map_list_find_nat.simps)
   done
 
+lemma subtail_map_find_eq :
+"map_find_eq_tail s n = map_find_eq s n"
+  using map_find_eq_induct map_find_eq_tail_def submap_find_eq subtail_map by presburger
+
+
+
 fun filter_defined :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \<noteq> 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))"
 
+fun filter_defined_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_defined_acc s acc n = (if n = 0 then acc else if map_list_find_nat s (hd_nat n) \<noteq> 0 then filter_defined_acc s ((hd_nat n)##acc) (tl_nat n) else filter_defined_acc s acc (tl_nat n))"
+
 lemma subfilter_defined :
 "filter_defined s n = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) n "
   apply (induct s n rule: filter_defined.induct)
   apply auto
   done
 
-fun map_possible_assignments_for :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_possible_assignments_for s n = (if n = 0 then 0 else (possible_assignments_for_nat s (hd_nat n))
-## map_possible_assignments_for s (tl_nat n) ) "
-
-lemma submap_possible_assignments_for:
-"map_possible_assignments_for s n = map_nat (possible_assignments_for_nat s) n "
-  apply (induct s n rule:map_possible_assignments_for.induct)
+lemma filter_defined_induct:
+"filter_defined_acc s acc n = filter_acc (\<lambda>v. map_list_find_nat s v \<noteq> 0) acc n"
+  apply( induct s acc n rule:filter_defined_acc.induct)
   apply auto
   done
 
+definition filter_defined_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_defined_tail s n  = reverse_nat (filter_defined_acc s 0 n)"
+
+lemma subtail_filter_defined :
+"filter_defined_tail s n  = filter_defined s n  "
+  using  filter_defined_tail_def filter_defined_induct subfilter_defined
+subtail_filter  by presburger
+
+
 
 
 definition state_to_strips_state_nat
@@ -167,6 +254,16 @@ definition state_to_strips_state_nat
     \<equiv> let defined = filter_defined s (nth_nat 0 \<Psi>) in
       map_find_eq s (concat_nat (map_possible_assignments_for \<Psi> defined))"
 
+definition state_to_strips_state_tail
+  :: "nat \<Rightarrow>nat \<Rightarrow>nat" 
+  where "state_to_strips_state_tail \<Psi> s 
+    \<equiv> let defined = filter_defined_tail s (nth_nat 0 \<Psi>) in
+      map_find_eq_tail s (concat_tail (map_possible_assignments_for_tail \<Psi> defined))"
+
+lemma subtail_state_to_strips_state:
+"state_to_strips_state_tail \<Psi> s = state_to_strips_state_nat \<Psi> s"
+  using state_to_strips_state_nat_def state_to_strips_state_tail_def subtail_concat
+ subtail_filter_defined subtail_map_find_eq subtail_map_possible_assignments_for by presburger
 
 lemma subnat_state_to_strips_state_map:
   assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
@@ -237,6 +334,13 @@ lemma sublist_sasp_op_to_strips:
 fun operator_for_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "operator_for_nat pre add delete = pre ## add ## delete ##0 "
 
+definition operator_for_tail  :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"operator_for_tail pre add delete = operator_for_nat pre add delete "
+
+lemma subtail_operator_for:
+"operator_for_tail pre add delete = operator_for_nat pre add delete "
+  using operator_for_tail_def by fastforce
+
 lemma sub_operator_for : "operator_for_nat (sas_plus_assignment_list_encode pre) (sas_plus_assignment_list_encode add) (sas_plus_assignment_list_encode delete)
 = strips_operator_encode (operator_for pre add delete)"
   apply (auto simp add: sub_cons cons0 simp del: list_encode.simps)
@@ -246,31 +350,83 @@ lemma sub_operator_for : "operator_for_nat (sas_plus_assignment_list_encode pre)
 fun filter_diff_snd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "filter_diff_snd n xs = (if xs = 0 then 0 else if (hd_nat xs) \<noteq> snd_nat n then (hd_nat xs) ## filter_diff_snd n (tl_nat xs) else filter_diff_snd n (tl_nat xs))"
 
+fun filter_diff_snd_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_diff_snd_acc n acc xs = (if xs = 0 then acc else if (hd_nat xs) \<noteq> snd_nat n then filter_diff_snd_acc n  ((hd_nat xs) ## acc) (tl_nat xs) else filter_diff_snd_acc n acc (tl_nat xs))"
+
+lemma filter_diff_snd_induct : 
+"filter_diff_snd_acc n acc xs = filter_acc ((\<noteq>) (snd_nat n)) acc xs"
+  apply(induct n acc xs rule:filter_diff_snd_acc.induct)
+  apply auto
+  done
+
+definition filter_diff_snd_tail :: "nat \<Rightarrow> nat \<Rightarrow>nat" where 
+"filter_diff_snd_tail n xs = reverse_nat (filter_diff_snd_acc n 0 xs)"
+
 lemma subfilter_diff_snd :
 "filter_diff_snd n xs = filter_nat ((\<noteq>) (snd_nat n)) xs"
   apply (induct n xs rule:filter_diff_snd.induct)
   apply (auto)
   done
+
+lemma subtail_filter_diff_snd :
+"filter_diff_snd_tail n xs = filter_diff_snd n xs "
+  using filter_diff_snd_induct filter_diff_snd_tail_def subfilter_diff_snd
+ subtail_filter by presburger
+
 fun map_prod_fst :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_prod_fst n xs = (if xs = 0 then 0 else (prod_encode(fst_nat n,hd_nat xs)) ## map_prod_fst n (tl_nat xs))"
 
+fun map_prod_fst_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_prod_fst_acc n acc xs = (if xs = 0 then acc else map_prod_fst_acc n ((prod_encode(fst_nat n,hd_nat xs)) ## acc) (tl_nat xs))"
+
 lemma submap_prod_fst:
 "map_prod_fst n xs =  map_nat (\<lambda>a'. prod_encode(fst_nat n, a')) xs"
   apply (induct n xs rule: map_prod_fst.induct)
   apply (auto)
   done
 
+lemma map_prod_fst_induct:
+"map_prod_fst_acc n acc xs = map_acc (\<lambda>a'. prod_encode(fst_nat n, a')) acc xs"
+  apply(induct n acc xs rule: map_prod_fst_acc.induct)
+  apply auto
+  done
+
+definition map_prod_fst_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_prod_fst_tail n xs = reverse_nat (map_prod_fst_acc n 0 xs)"
+
+lemma subtail_map_prod_fst:
+"map_prod_fst_tail n xs = map_prod_fst n xs"
+  using map_prod_fst_induct map_prod_fst_tail_def submap_prod_fst subtail_map by presburger
+
 fun map_sasp_op_to_strips:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 " map_sasp_op_to_strips P xs = (if xs=0 then 0 else (
  map_prod_fst (hd_nat xs) (filter_diff_snd (hd_nat xs) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (fst_nat (hd_nat xs))
 )))) ##  map_sasp_op_to_strips P (tl_nat xs)) "
 
+fun map_sasp_op_to_strips_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+" map_sasp_op_to_strips_acc P acc xs = (if xs=0 then acc else  map_sasp_op_to_strips_acc P ( (
+ map_prod_fst (hd_nat xs) (filter_diff_snd (hd_nat xs) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (fst_nat (hd_nat xs))
+)))) ## acc) (tl_nat xs)) "
+
+lemma map_sasp_op_to_strips_induct :
+"map_sasp_op_to_strips_acc P acc xs = map_acc  (\<lambda>n. map_prod_fst n (filter_diff_snd n (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P ) (fst_nat n))))) acc xs"
+  apply(induct P acc xs rule:map_sasp_op_to_strips_acc.induct)
+  apply auto
+  done
+
 lemma submap_sasp_op_to_strips:
 "map_sasp_op_to_strips P xs = map_nat (\<lambda>n. map_prod_fst n (filter_diff_snd n (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P ) (fst_nat n))))) xs "
   apply (induct P xs rule: map_sasp_op_to_strips.induct)
   apply auto
   done
 
+definition  map_sasp_op_to_strips_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_sasp_op_to_strips_tail P xs = reverse_nat (map_sasp_op_to_strips_acc  P 0 xs)"
+
+lemma subtail_map_sasp_op_to_strips:
+"map_sasp_op_to_strips_tail P xs = map_sasp_op_to_strips P xs"
+  using map_sasp_op_to_strips_induct map_sasp_op_to_strips_tail_def submap_sasp_op_to_strips subtail_map by presburger
+
 definition sasp_op_to_strips_nat
   :: "nat \<Rightarrow>nat \<Rightarrow> nat " 
   where "sasp_op_to_strips_nat \<Psi> op \<equiv> let
@@ -279,6 +435,18 @@ definition sasp_op_to_strips_nat
       ; delete = concat_nat (map_sasp_op_to_strips \<Psi>  (nth_nat (Suc 0) op))
     in operator_for_nat pre add delete"
 
+definition sasp_op_to_strips_tail
+  :: "nat \<Rightarrow>nat \<Rightarrow> nat " 
+  where "sasp_op_to_strips_tail \<Psi> op \<equiv> let
+      pre = nth_nat 0 op
+      ; add = nth_nat (Suc 0)  op
+      ; delete = concat_tail (map_sasp_op_to_strips_tail \<Psi>  (nth_nat (Suc 0) op))
+    in operator_for_tail pre add delete"
+
+lemma subtail_sasp_op_to_strips:
+"sasp_op_to_strips_tail P op = sasp_op_to_strips_nat P op"
+  using operator_for_tail_def sasp_op_to_strips_nat_def sasp_op_to_strips_tail_def subtail_concat
+ subtail_map_sasp_op_to_strips by presburger
 
 
 
@@ -427,6 +595,17 @@ definition problem_for_nat
   \<Rightarrow> nat"
   where "problem_for_nat vs ops I gs \<equiv> vs ## ops ## I ## gs ## 0 "
 
+definition problem_for_tail:: "nat 
+  \<Rightarrow> nat 
+  \<Rightarrow> nat  
+  \<Rightarrow> nat
+  \<Rightarrow> nat" where 
+"problem_for_tail vs ops I gs  = problem_for_nat vs ops I gs "
+
+lemma subtail_problem_for:
+"problem_for_tail vs ops I gs  = problem_for_nat vs ops I gs "
+  using problem_for_tail_def by presburger
+
 lemma subnat_problem_for: 
 "problem_for_nat (sas_plus_assignment_list_encode vs) (strips_operator_list_encode ops)
 (strips_assignment_list_encode I) (strips_assignment_list_encode gs)
@@ -440,12 +619,31 @@ fun maps_sasp_op_to_strips :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "maps_sasp_op_to_strips P xs = (if xs =0 then 0 else (sasp_op_to_strips_nat P (hd_nat xs)) 
 ## maps_sasp_op_to_strips P (tl_nat xs))"
 
+fun maps_sasp_op_to_strips_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"maps_sasp_op_to_strips_acc P acc xs = (if xs =0 then acc else maps_sasp_op_to_strips_acc P ( (sasp_op_to_strips_tail P (hd_nat xs)) 
+## acc) (tl_nat xs))"
+
+lemma maps_sasp_op_to_strips_induct:
+"maps_sasp_op_to_strips_acc P acc xs = map_acc (sasp_op_to_strips_nat P) acc xs"
+  apply(induct P acc xs rule:maps_sasp_op_to_strips_acc.induct)
+  apply (auto simp add:subtail_sasp_op_to_strips)
+  done
+
+definition maps_sasp_op_to_strips_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"maps_sasp_op_to_strips_tail P xs = reverse_nat (maps_sasp_op_to_strips_acc P 0 xs)"
+
 lemma sub_maps_sasp_op_to_strips:
 "maps_sasp_op_to_strips P xs = map_nat (sasp_op_to_strips_nat P) xs"
   apply (induct P xs rule:maps_sasp_op_to_strips.induct)
   apply (auto)
   done
 
+lemma subtail_maps_sasp_op_to_strips:
+"maps_sasp_op_to_strips_tail P xs = maps_sasp_op_to_strips P xs"
+  using maps_sasp_op_to_strips_induct maps_sasp_op_to_strips_tail_def 
+sub_maps_sasp_op_to_strips subtail_map by presburger  
+
+
 definition sas_plus_problem_to_strips_problem_nat
   :: "nat\<Rightarrow>nat" 
   ("\<phi> _ " 99)
@@ -456,6 +654,21 @@ definition sas_plus_problem_to_strips_problem_nat
       ; G = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc (Suc 0))) \<Psi>)
     in problem_for_nat vs ops I G"
 
+definition sas_plus_problem_to_strips_problem_tail
+  :: "nat\<Rightarrow>nat" 
+  ("\<phi> _ " 99)
+  where "sas_plus_problem_to_strips_problem_tail \<Psi> \<equiv> let 
+      vs =  concat_tail (map_possible_assignments_for_tail \<Psi>(nth_nat 0 \<Psi>))
+      ; ops = maps_sasp_op_to_strips_tail \<Psi> (nth_nat (Suc 0) \<Psi>)
+      ; I = state_to_strips_state_tail \<Psi> (nth_nat (Suc (Suc 0)) \<Psi>)
+      ; G = state_to_strips_state_tail \<Psi> (nth_nat (Suc (Suc (Suc 0))) \<Psi>)
+    in problem_for_tail vs ops I G"
+
+lemma subtail_sas_plus_problem_to_strips_problem:
+"sas_plus_problem_to_strips_problem_tail P =  sas_plus_problem_to_strips_problem_nat P "
+  using problem_for_tail_def sas_plus_problem_to_strips_problem_nat_def 
+sas_plus_problem_to_strips_problem_tail_def subtail_concat subtail_map_possible_assignments_for
+ subtail_maps_sasp_op_to_strips subtail_state_to_strips_state by presburger
 
 lemma  subnat_sas_plus_problem_to_strips_problem_map:
   assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
diff --git a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
index 34da4b83..3c6342a4 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
@@ -7,6 +7,14 @@ definition  encode_state_variable_nat
   where "encode_state_variable_nat t k v = ( if v-1 >0  then 1##(0##t##k##0)##0
 else 2##(1##(0##t##k##0)##0)##0)"
 
+definition  encode_state_variable_tail
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Rightarrow> nat"
+  where "encode_state_variable_tail t k v = encode_state_variable_nat t k v"
+
+lemma subtail_encode_state_variable:
+"encode_state_variable_tail t k v = encode_state_variable_nat t k v"
+  by (simp add: encode_state_variable_tail_def)
+
 lemma sub_encode_state_variable:
   assumes "v \<noteq> None"
   shows "encode_state_variable_nat t k (bool_option_encode v)
@@ -35,22 +43,58 @@ lemma sublist_encode_initial_state:
 fun map_encode_initial_state :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat  \<Rightarrow> nat" where 
 "map_encode_initial_state t I vs  xs = (if xs =0 then 0 else ( 4 ## (encode_state_variable_nat t (index_nat vs (hd_nat xs)) (map_list_find_nat I (hd_nat xs)))## (0##0) ## 0) ## map_encode_initial_state t I vs (tl_nat xs))  "
 
+fun map_encode_initial_state_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat  \<Rightarrow> nat" where 
+"map_encode_initial_state_acc t I vs acc  xs = (if xs =0 then acc else map_encode_initial_state_acc t I vs (( 4 ## (encode_state_variable_tail t (index_nat vs (hd_nat xs)) (map_list_find_nat I (hd_nat xs)))## (0##0) ## 0) ## acc) (tl_nat xs))  "
+
+lemma  map_encode_initial_state_induct:
+"map_encode_initial_state_acc t I vs acc xs = map_acc  (\<lambda>v. 4 ## (encode_state_variable_nat t (index_nat vs v) (map_list_find_nat I v))## (0##0) ## 0) acc xs "
+  apply(induct t I vs acc xs rule: map_encode_initial_state_acc.induct)
+  apply (auto simp add: subtail_encode_state_variable)
+  done
+
+definition map_encode_initial_state_tail ::  "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat  \<Rightarrow> nat" where 
+"map_encode_initial_state_tail  t I vs xs = reverse_nat ( map_encode_initial_state_acc t I vs 0 xs)"
 
 lemma submap_encode_initial_state:
 "map_encode_initial_state t I vs xs = map_nat (\<lambda>v. 4 ## (encode_state_variable_nat t (index_nat vs v) (map_list_find_nat I v))## (0##0) ## 0) xs"
   apply (induct t I vs xs rule: map_encode_initial_state.induct)
   apply (auto)
   done
+
+lemma subtail_map_encode_initial_state:
+"map_encode_initial_state_tail  t I vs xs = map_encode_initial_state  t I vs xs"
+  using map_encode_initial_state_induct map_encode_initial_state_tail_def 
+submap_encode_initial_state subtail_map by presburger
+
+
 declare map_list_find_nat.simps[simp del]
 fun filter_defined :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \<noteq> 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))"
 
+fun filter_defined_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_defined_acc s acc n = (if n = 0 then acc else if map_list_find_nat s (hd_nat n) \<noteq> 0 then filter_defined_acc s ((hd_nat n)##acc) (tl_nat n) else filter_defined_acc s acc (tl_nat n))"
+
 lemma subfilter_defined :
 "filter_defined s n = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) n "
   apply (induct s n rule: filter_defined.induct)
   apply auto
   done
 
+lemma filter_defined_induct:
+"filter_defined_acc s acc n = filter_acc (\<lambda>v. map_list_find_nat s v \<noteq> 0) acc n"
+  apply( induct s acc n rule:filter_defined_acc.induct)
+  apply auto
+  done
+
+definition filter_defined_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_defined_tail s n  = reverse_nat (filter_defined_acc s 0 n)"
+
+lemma subtail_filter_defined :
+"filter_defined_tail s n  = filter_defined s n  "
+  using  filter_defined_tail_def filter_defined_induct subfilter_defined
+subtail_filter  by presburger
+
+
 definition  encode_initial_state_nat
   :: "nat\<Rightarrow> nat" 
   where "encode_initial_state_nat \<Pi>
@@ -59,6 +103,18 @@ definition  encode_initial_state_nat
       in BigAnd_nat ( map_encode_initial_state 0 I vs
     (filter_defined I  vs))"
 
+definition  encode_initial_state_tail
+  :: "nat\<Rightarrow> nat" 
+  where "encode_initial_state_tail \<Pi>
+    \<equiv> let I = nth_nat (Suc (Suc 0)) \<Pi>
+        ; vs = nth_nat 0 \<Pi>
+      in BigAnd_tail ( map_encode_initial_state_tail 0 I vs
+    (filter_defined_tail I  vs))"
+
+lemma subtail_encode_initial_state:
+"encode_initial_state_tail \<Pi> = encode_initial_state_nat \<Pi>"
+  using encode_initial_state_nat_def subtail_map_encode_initial_state encode_initial_state_tail_def subtail_BigAnd subtail_filter_defined by presburger
+
 lemma inj_sasp:"inj sas_plus_assignment_encode"
   using sas_plus_assignment_id 
   by (metis inj_onI)
@@ -129,6 +185,19 @@ definition  encode_goal_state_nat
       in BigAnd_nat (map_encode_initial_state t G vs
     (filter_defined G vs))"
 
+definition  encode_goal_state_tail
+  :: "nat\<Rightarrow> nat \<Rightarrow> nat" 
+  where "encode_goal_state_tail \<Pi> t
+    \<equiv> let G = nth_nat (Suc (Suc (Suc 0))) \<Pi>
+        ; vs = nth_nat 0 \<Pi>
+      in BigAnd_tail (map_encode_initial_state_tail t G vs
+    (filter_defined_tail G vs))"
+
+lemma subtail_encode_goal_state:
+"encode_goal_state_tail P t = encode_goal_state_nat P t"
+  using encode_goal_state_nat_def encode_goal_state_tail_def subtail_BigAnd subtail_filter_defined
+ subtail_map_encode_initial_state by presburger
+
 lemma subnat_encode_goal_state_map: 
 "map (\<lambda>x. list_encode
                    [4, encode_state_variable_nat t (index (P\<^sub>G) x)
@@ -215,6 +284,17 @@ definition encode_operator_precondition_nat
     in BigAnd_nat (map_encode_operator_precondition t ops op vs
       (nth_nat 0 op))"
 
+definition encode_operator_precondition_tail
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_operator_precondition_nat \<Pi> t op \<equiv> let
+      vs = nth_nat 0 \<Pi>
+      ; ops = nth_nat (Suc 0) \<Pi>
+    in BigAnd_nat (map_encode_operator_precondition t ops op vs
+      (nth_nat 0 op))"
+
 lemma inj_strips_op: "inj strips_operator_encode"
   using strips_operator_id 
   by (metis injI)

From 4219a292f430112535bd669b86d0aa037df5a13b Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Sat, 28 Aug 2021 23:48:42 +0200
Subject: [PATCH 017/103] IMP- to IMP-- tail recursive

---
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      | 229 +++++++++++++++---
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy |   2 +-
 2 files changed, 201 insertions(+), 30 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index 8e9b6828..8ab10ecb 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -84,37 +84,208 @@ lemma sub_var_bit_list: "var_bit_list_nat n (vname_encode v) = vname_list_encode
 
 
 declare nth_nat.simps[simp del]
-datatype IMPm_IMPmm = SKIP | 
-                      Assign vname aexp |
-                      Seq_0 IMP_Minus_com IMP_Minus_com |
-                      Seq_m IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com |
-                      Seq_f IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com IMP_Minus_Minus_com |
-                      If_0  vname IMP_Minus_com IMP_Minus_com |
-                      If_m  vname IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com |
-                      If_f vname IMP_Minus_com IMP_Minus_com IMP_Minus_Minus_com IMP_Minus_Minus_com |
-                      While_0 vname IMP_Minus_com|
-                      While_f vname IMP_Minus_com IMP_Minus_Minus_com
-
-fun push_on_Stack :: "IMP_Minus_com \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
-"push_on_Stack Com.SKIP stack = SKIP # stack "|
-"push_on_Stack (Com.Assign v aexp) stack =  ( Assign v aexp) # stack "|
-"push_on_Stack (Com.Seq c1 c2) stack =  ( Seq_0 c1 c2) # stack "|
-"push_on_Stack (Com.If v c1 c2) stack =  (If_0 v c1 c2) # stack "|
-"push_on_Stack (Com.While v c) stack =  (While_0 v c) # stack "
+datatype IMPm_IMPmm = Bot IMP_Minus_Minus_com |
+                      SKIP nat| 
+                      Assign vname aexp nat |
+                      Seq_0 IMP_Minus_com IMP_Minus_com nat |
+                      Seq_m IMP_Minus_com IMP_Minus_com nat IMP_Minus_Minus_com  |
+                      Seq_f IMP_Minus_com IMP_Minus_com nat IMP_Minus_Minus_com IMP_Minus_Minus_com  |
+                      If_0  vname IMP_Minus_com IMP_Minus_com nat|
+                      If_m  vname IMP_Minus_com IMP_Minus_com nat IMP_Minus_Minus_com  |
+                      If_f vname IMP_Minus_com IMP_Minus_com nat  IMP_Minus_Minus_com IMP_Minus_Minus_com |
+                      While_0 vname IMP_Minus_com nat|
+                      While_f vname IMP_Minus_com nat IMP_Minus_Minus_com
 
+
+fun IMPm_IMPmm_encode :: "IMPm_IMPmm \<Rightarrow> nat" where 
+"IMPm_IMPmm_encode (Bot x) = list_encode [0,comm_encode x]"|
+"IMPm_IMPmm_encode (SKIP n) = list_encode [1, n]"|
+"IMPm_IMPmm_encode (Assign v a n) = list_encode [2, vname_encode v, aexp_encode a , n]"|
+"IMPm_IMPmm_encode (Seq_0 c1 c2 n) = list_encode [3, com_encode c1, com_encode c2, n]"|
+"IMPm_IMPmm_encode (Seq_m c1 c2 n c3) = list_encode [4, com_encode c1 ,com_encode c2, n , comm_encode c3]"|
+"IMPm_IMPmm_encode (Seq_f c1 c2 n c3 c4) = list_encode [5, com_encode c1 ,com_encode c2, n , comm_encode c3,comm_encode c4]"|
+"IMPm_IMPmm_encode (If_0 v c1 c2 n) = list_encode [6, vname_encode v, com_encode c1, com_encode c2, n]"|
+"IMPm_IMPmm_encode (If_m v c1 c2 n c3) = list_encode [7, vname_encode v, com_encode c1, com_encode c2, n, comm_encode c3]"|
+"IMPm_IMPmm_encode (If_f v c1 c2 n c3 c4) = list_encode [8, vname_encode v, com_encode c1, com_encode c2, n, comm_encode c3 , comm_encode c4]"|
+"IMPm_IMPmm_encode (While_0 v c n) = list_encode [9, vname_encode v, com_encode c , n]"|
+"IMPm_IMPmm_encode (While_f v c n c') = list_encode [10, vname_encode v, com_encode c, n, comm_encode c']"
+
+fun IMPm_IMPmm_decode :: "nat \<Rightarrow> IMPm_IMPmm" where 
+"IMPm_IMPmm_decode  n = (case list_decode n of
+    [0,x] \<Rightarrow> Bot (comm_decode x)|
+    [Suc 0,n] \<Rightarrow> SKIP n|
+    [Suc (Suc 0) , v , a, n] \<Rightarrow> Assign (vname_decode v) (aexp_decode a) n|
+    [Suc (Suc (Suc 0)), c1, c2,n] \<Rightarrow> Seq_0 (com_decode c1) (com_decode c2) n|
+    [Suc (Suc (Suc (Suc 0))), c1, c2 ,n, c3] \<Rightarrow> Seq_m (com_decode c1) (com_decode c2) n (comm_decode c3)|
+    [Suc (Suc (Suc (Suc (Suc 0)))), c1, c2, n, c3,c4] \<Rightarrow> Seq_f (com_decode c1) (com_decode c2) n (comm_decode c3) (comm_decode c4)|
+    [Suc (Suc (Suc (Suc (Suc (Suc 0))))), v ,c1, c2,n] \<Rightarrow> If_0 (vname_decode v) (com_decode c1)  (com_decode c2) n|
+    [Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))), v ,c1 ,c2,n,c3] \<Rightarrow> If_m (vname_decode v) (com_decode c1) (com_decode c2) n (comm_decode c3)|
+    [Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0))))))),v ,c1 ,c2,n,c3,c4] \<Rightarrow> If_f (vname_decode v) (com_decode c1) (com_decode c2) n (comm_decode c3) (comm_decode c4)|
+    [Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))))),v,c,n] \<Rightarrow> While_0 (vname_decode v) (com_decode c)  n|
+    [Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0))))))))), v, c, n, c'] \<Rightarrow> While_f (vname_decode v) (com_decode c) n (comm_decode c')
+) "
+
+lemma IMPm_IMPmm_id : 
+"IMPm_IMPmm_decode (IMPm_IMPmm_encode x) = x"
+  apply(cases x)
+   apply(auto simp add: IMPm_IMPmm_encode.simps IMPm_IMPmm_decode.simps list_encode_inverse comm_id vname_id aexp_id com_id
+                    simp del: comm_encode.simps com_encode.simps comm_decode.simps com_decode.simps aexp_encode.simps aexp_decode.simps)
+  done
+
+definition IMPm_IMPmm_list_encode :: "IMPm_IMPmm list \<Rightarrow> nat" where 
+"IMPm_IMPmm_list_encode xs = list_encode (map IMPm_IMPmm_encode xs)"
+
+definition IMPm_IMPmm_list_decode :: "nat \<Rightarrow> IMPm_IMPmm list " where 
+"IMPm_IMPmm_list_decode xs = map IMPm_IMPmm_decode (list_decode xs)"
+
+lemma IMPm_IMPmm_list_id: 
+"IMPm_IMPmm_list_decode (IMPm_IMPmm_list_encode x) = x"
+  apply(auto simp only:  IMPm_IMPmm_list_decode_def  IMPm_IMPmm_list_encode_def list_encode_inverse 
+            map_map comp_def IMPm_IMPmm_id)
+  apply auto
+  done
+
+fun push_on_stack :: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
+"push_on_stack Com.SKIP n stack = SKIP n # stack "|
+"push_on_stack (Com.Assign v aexp) n stack =  ( Assign v aexp n) # stack "|
+"push_on_stack (Com.Seq c1 c2) n stack =  ( Seq_0 c1 c2 n) # stack "|
+"push_on_stack (Com.If v c1 c2) n stack =  (If_0 v c1 c2 n) # stack "|
+"push_on_stack (Com.While v c) n stack =  (While_0 v c n) # stack "
+
+fun push_on_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"push_on_stack_nat c n s = (if hd_nat c = 0 then (1##n##0)##s else 
+if hd_nat c = 1 then (2## (nth_nat (Suc 0) c) ## (nth_nat (Suc (Suc 0)) c) ## n ## 0)## s else 
+if hd_nat c = 2 then (3## (nth_nat (Suc 0) c) ## (nth_nat (Suc (Suc 0)) c) ## n ## 0)## s else 
+if hd_nat c = 3 then (6## (nth_nat (Suc 0) c) ## (nth_nat (Suc (Suc 0)) c) ## (nth_nat (Suc (Suc (Suc 0))) c) ## n ## 0) ## s else
+(9## (nth_nat (Suc 0) c) ## (nth_nat (Suc (Suc 0)) c) ## n ## 0)## s
+)"
+
+lemma sub_push_on_stack:
+"push_on_stack_nat (com_encode c) n (IMPm_IMPmm_list_encode s) = 
+IMPm_IMPmm_list_encode (push_on_stack c n s)"
+  apply(cases c)
+      apply (auto simp only: push_on_stack_nat.simps push_on_stack.simps sub_hd head.simps com_encode.simps
+             IMPm_IMPmm_list_encode_def sub_cons cons0 sub_nth nth.simps)
+  apply auto
+  done
+
+
+
+      
+           
 fun add_result_to_stack :: "IMP_Minus_Minus_com \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
-"add_result_to_stack"
-
-                      
-fun IMP_Minus_To_IMP_Minus_Minus:: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMP_Minus_Minus_com" where
-"IMP_Minus_To_IMP_Minus_Minus Com.SKIP n = IMP_Minus_Minus_Com.SKIP" |
-"IMP_Minus_To_IMP_Minus_Minus (Com.Assign v aexp) n = assignment_to_binary n v aexp" |
-"IMP_Minus_To_IMP_Minus_Minus (Com.Seq c1 c2) n = 
-  (IMP_Minus_To_IMP_Minus_Minus c1 n ;; IMP_Minus_To_IMP_Minus_Minus c2 n )" |
-"IMP_Minus_To_IMP_Minus_Minus (Com.If v c1 c2) n = (IF (var_bit_list n v)\<noteq>0 THEN
-  IMP_Minus_To_IMP_Minus_Minus c1 n ELSE IMP_Minus_To_IMP_Minus_Minus c2 n)" |
-"IMP_Minus_To_IMP_Minus_Minus (Com.While v c) n = (WHILE (var_bit_list n v)\<noteq>0 DO
-  IMP_Minus_To_IMP_Minus_Minus c n)"
+"add_result_to_stack c [] = [Bot c]"|
+"add_result_to_stack c (Seq_0 c1 c2 n # stack) = Seq_m c1 c2 n c # stack" |
+"add_result_to_stack c (Seq_m c1 c2 n c3 #stack) = (Seq_f c1 c2 n c3 c) # stack"|
+"add_result_to_stack c (If_0 v c1 c2  n # stack)  = If_m v c1 c2 n c # stack"|
+"add_result_to_stack c (If_m v c1 c2 n c3 #stack) = If_f v c1 c2 n c3 c # stack"|
+"add_result_to_stack c (While_0 v c' n # stack ) = While_f v c' n c #stack"|
+"add_result_to_stack c s = s"
+
+fun add_result_to_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"add_result_to_stack_nat c s = (if s = 0 then (0##c##0)##0
+else (let h = hd_nat s; con = hd_nat h; t = tl_nat s  in 
+  if con = 3 then ((4## (nth_nat (Suc 0) h) ## (nth_nat (Suc (Suc 0)) h) ## (nth_nat (Suc (Suc (Suc 0))) h) ## c ## 0) ## t) 
+  else if con = 4 then ((5## (nth_nat (Suc 0) h) ## (nth_nat (Suc (Suc 0)) h) ## (nth_nat (Suc (Suc (Suc 0))) h)  ## (nth_nat (Suc (Suc (Suc ( Suc 0)))) h) ## c ## 0) ## t)
+  else if con = 6 then ((7## (nth_nat (Suc 0) h) ## (nth_nat (Suc (Suc 0)) h) ## (nth_nat (Suc (Suc (Suc 0))) h)  ## (nth_nat (Suc (Suc (Suc ( Suc 0)))) h) ## c ## 0) ## t)    
+  else if con = 7 then ((8## (nth_nat (Suc 0) h) ## (nth_nat (Suc (Suc 0)) h) ## (nth_nat (Suc (Suc (Suc 0))) h)  ## (nth_nat (Suc (Suc (Suc ( Suc 0)))) h)  ## (nth_nat (Suc (Suc (Suc ( Suc (Suc 0))))) h) ## c ## 0) ## t)
+  else if con = 9 then ((10 ## (nth_nat (Suc 0) h) ## (nth_nat (Suc (Suc 0)) h) ## (nth_nat (Suc (Suc (Suc 0))) h) ## c ## 0) ## t) 
+  else s
+))"
+
+lemma sub_add_result_to_stack:
+"add_result_to_stack_nat (comm_encode c) (IMPm_IMPmm_list_encode s)
+= IMPm_IMPmm_list_encode (add_result_to_stack c s) "
+  apply(cases s)
+      apply (auto simp only: map_is_Nil_conv
+      list_encode_non_empty  
+      list.simps add_result_to_stack_nat.simps add_result_to_stack.simps sub_hd head.simps comm_encode.simps
+             IMPm_IMPmm_list_encode_def sub_cons cons0 sub_nth nth.simps)
+    
+   apply (auto simp del: list_encode.simps)
+  subgoal for a xs
+    apply(cases a)
+   apply (auto simp add: Let_def sub_tl sub_cons sub_nth sub_hd list.simps simp del: list_encode.simps)
+    done
+  done
+
+function IMP_Minus_to_IMP_Minus_Minus_stack :: "IMPm_IMPmm list \<Rightarrow> IMP_Minus_Minus_com" where 
+"IMP_Minus_to_IMP_Minus_Minus_stack (Seq_0 c1 c2 n #stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c1 n (Seq_0 c1 c2 n #stack))"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (Seq_m c1 c2 n c3 #stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c2 n (Seq_m c1 c2 n c3 #stack ))"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (If_0 v c1 c2 n # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c1 n (If_0 v c1 c2 n #stack ))"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (If_m v c1 c2 n c3 # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c2 n (If_m v c1 c2 n c3 #stack ))"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (While_0 v c n # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n (While_0 v c n #stack ))" |
+"IMP_Minus_to_IMP_Minus_Minus_stack (SKIP _ # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_Minus_Com.SKIP) stack)" |
+"IMP_Minus_to_IMP_Minus_Minus_stack (Assign v aexp n # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (assignment_to_binary n v aexp) stack)"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (Seq_f _ _ _ c1 c2 # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_Minus_Com.Seq c1 c2) stack)"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (If_f v _ _ n c1 c2 # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack ( IMP_Minus_Minus_Com.If (var_bit_list n v) c1  c2) stack)"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (While_f v _ n c # stack) = 
+  IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_Minus_Com.While (var_bit_list n v) c) stack)"|
+"IMP_Minus_to_IMP_Minus_Minus_stack (Bot res # stack) =  res"
+  sorry
+termination sorry
+
+
+function IMP_Minus_to_IMP_Minus_Minus_stack_nat :: "nat \<Rightarrow> nat" where 
+"IMP_Minus_to_IMP_Minus_Minus_stack_nat s  = ( let h = hd_nat s ; c = hd_nat h ; t = tl_nat s in
+  if c = 3  then  IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc 0) h) (nth_nat (Suc (Suc (Suc 0))) h) s)
+else if c = 4 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
+else if c = 6 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc (Suc 0)))) h) s)
+else if c = 7 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc (Suc 0))) h) (nth_nat (Suc (Suc (Suc (Suc 0)))) h) s)
+else if c = 10 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
+else if c = 1 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (0##0) t)
+else if c = 2 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (assignment_to_binary_nat (nth_nat (Suc (Suc (Suc 0))) h) (nth_nat (Suc 0) h) (nth_nat (Suc (Suc 0)) h)) t)
+else if c = 5 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (2 ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## 0  ) t) 
+else if c = 8 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (3 ## (var_bit_list_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) h)
+  (nth_nat (Suc 0) h))
+ ## (nth_nat (Suc (Suc (Suc (Suc (Suc 0))))) h) ## (nth_nat (Suc (Suc (Suc (Suc (Suc (Suc 0)))))) h) ## 0  ) t)
+else if c = 10 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (3 ## (var_bit_list_nat (nth_nat (Suc (Suc (Suc 0))) h)
+  (nth_nat (Suc 0) h))
+ ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h)  ## 0  ) t )
+
+else nth_nat (Suc 0) h
+
+)"
+  sorry
+termination sorry
+
+lemma subtailnat_IMP_Minus_to_IMP_Minus_Minus_stack:
+"s \<noteq> []  \<Longrightarrow> IMP_Minus_to_IMP_Minus_Minus_stack_nat (IMPm_IMPmm_list_encode s)
+= comm_encode (IMP_Minus_to_IMP_Minus_Minus_stack s) "
+  apply(induct)
+   apply simp
+  subgoal for a xs
+    apply(cases a)
+   apply(auto simp add: sub_nth Let_def sub_tl sub_add_result_to_stack sub_cons cons0
+  IMPm_IMPmm_list_encode_def sub_hd simp del: push_on_stack_nat.simps add_result_to_stack_nat.simps list_encode.simps )
+    apply(auto simp add: sub_add_result_to_stack simp flip: comm_encode.simps IMPm_IMPmm_list_encode_def  simp del: push_on_stack_nat.simps add_result_to_stack_nat.simps list_encode.simps )
+lemma IMP_Minus_to_IMP_Minus_Minus_stack_correct: 
+"IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n stack) 
+= IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_To_IMP_Minus_Minus c n) stack)"
+  by (induct c arbitrary:stack) auto
+
+definition IMP_Minus_to_IMP_Minus_Minus_tail:: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMP_Minus_Minus_com" where
+  "IMP_Minus_to_IMP_Minus_Minus_tail c n = 
+IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n [])"
+
+lemma subtail_IMP_Minus_to_IMP_Minus_Minus:
+"IMP_Minus_to_IMP_Minus_Minus_tail c n = 
+IMP_Minus_To_IMP_Minus_Minus c n "
+  using  IMP_Minus_to_IMP_Minus_Minus_stack_correct [of c n "[]"]
+  apply (auto simp add:IMP_Minus_to_IMP_Minus_Minus_tail_def)
+  done
+
+
+
 
 fun IMP_Minus_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "IMP_Minus_To_IMP_Minus_Minus_nat c n = (if c =0 \<or> hd_nat c = 0 then  0##0
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index 4a6ac6a8..c5c9eaa5 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -523,7 +523,7 @@ fun com_decode :: "nat \<Rightarrow> Com.com" where
                   [Suc (Suc (Suc (Suc 0))),v,c] \<Rightarrow> Com.com.While  (vname_decode v) (com_decode c)
 )" 
   
-lemma "com_decode (com_encode x) = x" 
+lemma com_id: "com_decode (com_encode x) = x" 
   apply (subst com_encode.simps com_decode.simps)
   apply (induct x)
   apply (auto simp add: vname_id aexp_id simp del:aexp_encode.simps aexp_decode.simps )

From 79816908d0490e24836236c5a1ba1a3fde0d38f7 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Sun, 29 Aug 2021 01:05:39 +0200
Subject: [PATCH 018/103] prove correctness for nat, imp- to imp--, first try

---
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      | 54 +++++++++++++++----
 1 file changed, 45 insertions(+), 9 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index 8ab10ecb..3e01e5b2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -241,7 +241,7 @@ function IMP_Minus_to_IMP_Minus_Minus_stack_nat :: "nat \<Rightarrow> nat" where
 else if c = 4 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
 else if c = 6 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc (Suc 0)))) h) s)
 else if c = 7 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc (Suc 0))) h) (nth_nat (Suc (Suc (Suc (Suc 0)))) h) s)
-else if c = 10 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
+else if c = 9 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
 else if c = 1 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (0##0) t)
 else if c = 2 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (assignment_to_binary_nat (nth_nat (Suc (Suc (Suc 0))) h) (nth_nat (Suc 0) h) (nth_nat (Suc (Suc 0)) h)) t)
 else if c = 5 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (2 ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## 0  ) t) 
@@ -258,17 +258,53 @@ else nth_nat (Suc 0) h
   sorry
 termination sorry
 
+lemma push_non_empty : "push_on_stack c n s \<noteq> []"
+  apply(cases c)
+      apply auto
+  done
+lemma add_result_non_empty: "add_result_to_stack c s \<noteq> []"
+  apply(cases s)
+   apply auto
+  subgoal for a xs
+    apply(cases a)
+              apply auto
+    done 
+  done
+
 lemma subtailnat_IMP_Minus_to_IMP_Minus_Minus_stack:
 "s \<noteq> []  \<Longrightarrow> IMP_Minus_to_IMP_Minus_Minus_stack_nat (IMPm_IMPmm_list_encode s)
 = comm_encode (IMP_Minus_to_IMP_Minus_Minus_stack s) "
-  apply(induct)
-   apply simp
-  subgoal for a xs
-    apply(cases a)
-   apply(auto simp add: sub_nth Let_def sub_tl sub_add_result_to_stack sub_cons cons0
-  IMPm_IMPmm_list_encode_def sub_hd simp del: push_on_stack_nat.simps add_result_to_stack_nat.simps list_encode.simps )
-    apply(auto simp add: sub_add_result_to_stack simp flip: comm_encode.simps IMPm_IMPmm_list_encode_def  simp del: push_on_stack_nat.simps add_result_to_stack_nat.simps list_encode.simps )
-lemma IMP_Minus_to_IMP_Minus_Minus_stack_correct: 
+  apply(induct s rule: IMP_Minus_to_IMP_Minus_Minus_stack.induct )
+  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+            apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
+ apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+           apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
+ apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
+ apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+         apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
+ apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_add_result_to_stack sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+ apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps )
+         apply (auto simp del: list_encode.simps IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps add_result_to_stack.simps simp flip: IMPm_IMPmm_encode.simps comm_encode.simps simp add: sub_cons cons0 push_non_empty add_result_non_empty)
+lemma IMP_Minus_to_IMP_Minus_Minus_stack_correct:
 "IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n stack) 
 = IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_To_IMP_Minus_Minus c n) stack)"
   by (induct c arbitrary:stack) auto

From a54496d6e7536d68b11cb73107e8d03a6b9e4796 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Sun, 29 Aug 2021 13:33:46 +0200
Subject: [PATCH 019/103] IMP- to IMP -- refined to tail recursive

---
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy |  30 +++++
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      | 104 ++++++++++--------
 2 files changed, 90 insertions(+), 44 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index 8b85edc0..59592912 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -177,6 +177,36 @@ lemma subtail_map_com_to_operators4:
   using  submap_com_to_operators4  map_com_to_operators4_tail_def
  map_com_to_operators4_induct subtail_map by presburger
 
+fun com_to_operators :: "com \<Rightarrow> operator list" where
+"com_to_operators (SKIP) = []" |
+"com_to_operators (v ::= b) = 
+   [\<lparr> precondition_of = [(PC, PCV (v ::= b))], 
+      effect_of = [(PC, PCV SKIP), (VN v, EV b)]\<rparr>]" |
+"com_to_operators (c1;; c2) = 
+  (if c1 = SKIP then  [\<lparr> precondition_of = [(PC, PCV (c1 ;; c2))],
+                                                   effect_of = [(PC, PCV c2)]\<rparr>]
+   else (let ops = com_to_operators c1 in map (\<lambda> op. 
+    (let c1' = pc_to_com (effect_of op) in 
+      \<lparr> precondition_of = 
+        list_update (precondition_of op) 0 (PC, PCV (c1 ;; c2)),
+        effect_of = 
+        list_update (effect_of op) 0 (PC, PCV (c1' ;; c2))\<rparr>)) ops))" |
+"com_to_operators (IF vs\<noteq>0 THEN c1 ELSE c2) = (let i = PCV (IF vs\<noteq>0 THEN c1 ELSE c2)
+   in  \<lparr> precondition_of = (PC, i) # map (\<lambda>v. (VN v, EV Zero)) (remdups vs), 
+        effect_of = [(PC, PCV c2)]\<rparr> 
+      # map (\<lambda> v. 
+      \<lparr> precondition_of = [(PC, i), (VN v, EV One)], 
+         effect_of = [(PC, PCV c1)]\<rparr>) vs)" |
+"com_to_operators (WHILE vs\<noteq>0 DO c) = (let i = PCV (WHILE vs\<noteq>0 DO c) ;
+  j = PCV (c ;; (WHILE vs\<noteq>0 DO c)); k = PCV SKIP in 
+    \<lparr> precondition_of = (PC, i) # map (\<lambda>v. (VN v, EV Zero)) (remdups vs), 
+        effect_of = [(PC, k)]\<rparr> 
+      # map (\<lambda> v. 
+      \<lparr> precondition_of = [(PC, i), (VN v, EV One)], 
+         effect_of = [(PC, j)]\<rparr>) vs)"
+
+datatype
+
 fun com_to_operators_nat :: "nat \<Rightarrow> nat" where
 "com_to_operators_nat c = (if c = 0 \<or> hd_nat c = 0 then 0 else 
 if hd_nat c = 1 then (
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index 3e01e5b2..a73c2aa7 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -244,11 +244,11 @@ else if c = 7 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nt
 else if c = 9 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
 else if c = 1 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (0##0) t)
 else if c = 2 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (assignment_to_binary_nat (nth_nat (Suc (Suc (Suc 0))) h) (nth_nat (Suc 0) h) (nth_nat (Suc (Suc 0)) h)) t)
-else if c = 5 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (2 ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## 0  ) t) 
+else if c = 5 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (2 ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h) ## (nth_nat (Suc (Suc (Suc (Suc(Suc 0))))) h) ## 0  ) t) 
 else if c = 8 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (3 ## (var_bit_list_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) h)
   (nth_nat (Suc 0) h))
  ## (nth_nat (Suc (Suc (Suc (Suc (Suc 0))))) h) ## (nth_nat (Suc (Suc (Suc (Suc (Suc (Suc 0)))))) h) ## 0  ) t)
-else if c = 10 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (3 ## (var_bit_list_nat (nth_nat (Suc (Suc (Suc 0))) h)
+else if c = 10 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_nat (4 ## (var_bit_list_nat (nth_nat (Suc (Suc (Suc 0))) h)
   (nth_nat (Suc 0) h))
  ## (nth_nat (Suc (Suc (Suc (Suc 0)))) h)  ## 0  ) t )
 
@@ -301,65 +301,81 @@ IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
             apply( simp only: sub_add_result_to_stack sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
         apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
-            apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
-IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps )
-         apply (auto simp del: list_encode.simps IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps add_result_to_stack.simps simp flip: IMPm_IMPmm_encode.simps comm_encode.simps simp add: sub_cons cons0 push_non_empty add_result_non_empty)
+            apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
+       apply( simp only:sub_add_result_to_stack  flip: IMPm_IMPmm_list_encode_def )
+        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
+       apply( simp only:sub_add_result_to_stack sub_assignment_to_binary  flip: IMPm_IMPmm_list_encode_def )
+        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
+       apply( simp only:sub_add_result_to_stack sub_assignment_to_binary  flip: IMPm_IMPmm_list_encode_def )
+        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+  apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
+          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+  apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
+          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+  apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
+          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+  done
+
 lemma IMP_Minus_to_IMP_Minus_Minus_stack_correct:
 "IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n stack) 
 = IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_To_IMP_Minus_Minus c n) stack)"
   by (induct c arbitrary:stack) auto
 
-definition IMP_Minus_to_IMP_Minus_Minus_tail:: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMP_Minus_Minus_com" where
-  "IMP_Minus_to_IMP_Minus_Minus_tail c n = 
+definition IMP_Minus_to_IMP_Minus_Minus_t:: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMP_Minus_Minus_com" where
+  "IMP_Minus_to_IMP_Minus_Minus_t c n = 
 IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n [])"
 
+definition IMP_Minus_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+  "IMP_Minus_To_IMP_Minus_Minus_nat c n = 
+IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat c n 0)"
+
+lemma IMPm_IMPmm_nil: "0 = IMPm_IMPmm_list_encode []"
+  using IMPm_IMPmm_list_encode_def by force
+
+lemma subtailnat_IMP_Minus_to_IMP_Minus_Minus:
+"IMP_Minus_To_IMP_Minus_Minus_nat (com_encode c) n
+= comm_encode (IMP_Minus_to_IMP_Minus_Minus_t c n)"
+  using push_non_empty subtailnat_IMP_Minus_to_IMP_Minus_Minus_stack
+  apply(auto simp only: IMPm_IMPmm_nil IMP_Minus_To_IMP_Minus_Minus_nat_def IMP_Minus_to_IMP_Minus_Minus_t_def 
+       sub_push_on_stack )
+  done
+
 lemma subtail_IMP_Minus_to_IMP_Minus_Minus:
-"IMP_Minus_to_IMP_Minus_Minus_tail c n = 
+"IMP_Minus_to_IMP_Minus_Minus_t c n = 
 IMP_Minus_To_IMP_Minus_Minus c n "
   using  IMP_Minus_to_IMP_Minus_Minus_stack_correct [of c n "[]"]
-  apply (auto simp add:IMP_Minus_to_IMP_Minus_Minus_tail_def)
+  apply (auto simp add:IMP_Minus_to_IMP_Minus_Minus_t_def)
   done
+lemma sub_IMP_Minus_To_IMP_Minus_Minus:
+"IMP_Minus_To_IMP_Minus_Minus_nat (com_encode c) n = comm_encode (IMP_Minus_To_IMP_Minus_Minus c n)"
+  using subtail_IMP_Minus_to_IMP_Minus_Minus subtailnat_IMP_Minus_to_IMP_Minus_Minus by presburger
 
+definition IMP_Minus_To_IMP_Minus_Minus_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"IMP_Minus_To_IMP_Minus_Minus_tail c n = IMP_Minus_To_IMP_Minus_Minus_nat c n "
 
+lemma subtail_IMP_Minus_To_IMP_Minus_Minus:
+"IMP_Minus_To_IMP_Minus_Minus_tail c n = IMP_Minus_To_IMP_Minus_Minus_nat c n "
+  by (simp add: IMP_Minus_To_IMP_Minus_Minus_tail_def)
 
 
-fun IMP_Minus_To_IMP_Minus_Minus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"IMP_Minus_To_IMP_Minus_Minus_nat c n = (if c =0 \<or> hd_nat c = 0 then  0##0
-else if hd_nat c = 1 then assignment_to_binary_nat n (nth_nat (Suc 0) c) (nth_nat (Suc (Suc 0)) c)
-else if hd_nat c = 2 then
-2 ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc 0) c) n) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## 0
-else if hd_nat c = 3 then
-3 ## (var_bit_list_nat n (nth_nat (Suc 0) c)) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc (Suc(Suc 0))) c) n) ## 0
-else 
-4 ## (var_bit_list_nat n (nth_nat (Suc 0) c)) ## (IMP_Minus_To_IMP_Minus_Minus_nat (nth_nat (Suc(Suc 0)) c) n) ## 0
-)"
 
-declare nth_nat.simps[simp]
 
-lemma sub_IMP_Minus_To_IMP_Minus_Minus:
-"IMP_Minus_To_IMP_Minus_Minus_nat (com_encode c) n = comm_encode (IMP_Minus_To_IMP_Minus_Minus c n)"
-  apply(induct c)
-      apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
-      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
-                sub_assignment_to_binary cons0)
-      apply simp
-       apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
-      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
-                sub_assignment_to_binary cons0)
-     apply simp
-      apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
-      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
-                sub_assignment_to_binary cons0 sub_cons)
-    apply simp
-   apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
-      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
-                sub_assignment_to_binary cons0 sub_cons sub_var_bit_list)
-   apply simp
- apply(subst IMP_Minus_To_IMP_Minus_Minus_nat.simps)
-      apply (simp only: com_encode.simps sub_hd head.simps sub_nth nth.simps 
-                sub_assignment_to_binary cons0 sub_cons sub_var_bit_list)
-  apply simp
-  done
 
 
 end
\ No newline at end of file

From a492fb7afb14b43d9a288aac7d93e5940521f74b Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Tue, 31 Aug 2021 11:28:27 +0200
Subject: [PATCH 020/103] all the functions that need a general pattern for
 tail recursion

---
 .../IMP_Minus_Minus_Subprograms_Nat.thy       | 326 +++++++++---
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy | 474 +++++++++++++++---
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy |  50 +-
 .../SAS_Plus_Plus_To_SAS_Plus_Nat.thy         |  14 +-
 Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy |  11 +-
 5 files changed, 739 insertions(+), 136 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
index 0f9e425d..1e29ee99 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
@@ -3,103 +3,294 @@ theory IMP_Minus_Minus_Subprograms_Nat
 begin 
 
 
-fun map_all_subprograms:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_all_subprograms c n = (if n =0 then 0 else (2## (hd_nat n) ## (nth_nat (Suc (Suc 0)) c ) ## 0) ## map_all_subprograms c (tl_nat n) )"
 
-fun map_all_subprograms_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_all_subprograms_acc c acc n = (if n =0 then acc else map_all_subprograms_acc c ((2## (hd_nat n) ## (nth_nat (Suc (Suc 0)) c ) ## 0) ## acc ) (tl_nat n) )"
 
-lemma map_all_subprograms_induct:
-"map_all_subprograms_acc c acc n = map_acc (\<lambda>c'. 2## c' ## (nth_nat (Suc (Suc 0)) c ) ## 0) acc n"
-  apply(induct c acc n rule: map_all_subprograms_acc.induct)
-  apply(auto)
-  done
+fun map_all_subprograms:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms c n = (if n =0 then 0 else ( 2## (hd_nat n) ## c ## 0) ## map_all_subprograms c (tl_nat n) )"
 
-definition map_all_subprograms_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_all_subprograms_tail c n = reverse_nat (map_all_subprograms_acc c 0 n)"
 
 lemma submap_all_subprograms:
-  "map_all_subprograms c n = map_nat (\<lambda>c'. 2## c' ## (nth_nat (Suc (Suc 0)) c ) ## 0) n"
+"map_all_subprograms c n = map_nat (\<lambda>x. 2## x ## c ## 0) n"
   apply (induct c n rule: map_all_subprograms.induct)
   apply auto
   done
 
+fun map_all_subprograms_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms_acc  c acc n = (if n =0 then acc else 
+map_all_subprograms_acc c (( 2## (hd_nat n) ## c ## 0) ## acc) (tl_nat n) )"
+
+lemma  map_all_subprograms_induct:
+" map_all_subprograms_acc c acc n = map_acc  (\<lambda>x. 2## x ## c ## 0) acc n"
+  apply(induct c acc n rule:map_all_subprograms_acc.induct)
+  apply auto
+  done
+
+definition map_all_subprograms_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_all_subprograms_tail c n = reverse_nat (map_all_subprograms_acc c 0 n)"
+
 lemma subtail_map_all_subprograms:
 "map_all_subprograms_tail c n = map_all_subprograms c n"
   using submap_all_subprograms map_all_subprograms_tail_def  map_all_subprograms_induct[of c 0 n]
   subtail_map by presburger
 
+datatype all_sub = Bot  "com list" |
+                   SKIP|
+                   Assign vname bit |
+                   Seq_0 com com|
+                   Seq_m com com "com list"|
+                   Seq_f com com "com list" "com list"|
+                   If_0 "vname list" com com |
+                   If_m  "vname list" com com "com list"|
+                   If_f  "vname list" com com "com list" "com list"|
+                   While_0  "vname list" com |
+                   While_f  "vname list" com "com list"
+
+fun all_sub_encode :: "all_sub \<Rightarrow> nat" where 
+"all_sub_encode SKIP = list_encode [0] "|
+"all_sub_encode (Assign v b) = list_encode [1, vname_encode v, bit_encode b]"|
+"all_sub_encode (Seq_0 c1 c2) = list_encode[2 , comm_encode c1 , comm_encode c2]"|
+"all_sub_encode (If_0 v c1 c2) = list_encode [3, vname_list_encode v, comm_encode c1, comm_encode c2]"|
+"all_sub_encode (While_0 v c) = list_encode [4,vname_list_encode v, comm_encode c]"|
+"all_sub_encode (Seq_m  c1 c2 c3) = list_encode[5, comm_encode c1 ,comm_encode c2, list_encode (map comm_encode c3) ]"|
+"all_sub_encode (Seq_f c1 c2 c3 c4) = list_encode [6, comm_encode c1 ,comm_encode c2 , list_encode (map comm_encode c3) , list_encode (map comm_encode c4)]"|
+"all_sub_encode (If_m v c1 c2 c3) = list_encode[7, vname_list_encode v, comm_encode c1 ,comm_encode c2, list_encode (map comm_encode c3)]"|
+"all_sub_encode (If_f v c1 c2 c3 c4) = list_encode [8, vname_list_encode v, comm_encode c1, comm_encode c2, list_encode (map comm_encode c3), list_encode (map comm_encode c4)]"|
+"all_sub_encode (While_f v c c') = list_encode [9, vname_list_encode v, comm_encode c, list_encode (map comm_encode c')]"|
+"all_sub_encode (Bot x) = list_encode [10, list_encode (map comm_encode x)]"
+
+fun push_stack :: "com \<Rightarrow> all_sub list \<Rightarrow> all_sub list" where 
+"push_stack com.SKIP s = SKIP#s "|
+"push_stack (com.Assign v b) s = Assign v b # s"|
+"push_stack (com.Seq c1 c2) s = Seq_0 c1 c2 # s"|
+"push_stack (com.If v c1 c2) s = If_0 v c1 c2 # s"|
+"push_stack (com.While v c) s = While_0 v c #s"
+
+fun push_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"push_stack_nat c s = (c ##s )"
+
+lemma sub_push_stack:
+"push_stack_nat (comm_encode c) (list_encode (map all_sub_encode s)) 
+= list_encode (map all_sub_encode (push_stack c s))"
+  apply( cases c)
+  apply (auto simp add: sub_cons simp del: list_encode.simps)
+  done
 
+lemma push_stack_not_Nil:
+"push_stack c s \<noteq> []"
+  apply(cases c)
+      apply auto
+  done
 
-fun map_all_subprograms2:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_all_subprograms2 c n = (if n =0 then 0 else ( 2## (hd_nat n) ## c ## 0) ## map_all_subprograms2 c (tl_nat n) )"
 
 
-lemma submap_all_subprograms2:
-"map_all_subprograms2 c n = map_nat (\<lambda>x. 2## x ## c ## 0) n"
-  apply (induct c n rule: map_all_subprograms2.induct)
-  apply auto
+fun add_res :: "com list \<Rightarrow> all_sub list \<Rightarrow> all_sub list" where 
+"add_res c [] = [Bot c] "|
+"add_res c (Seq_0 c1 c2 # s) = Seq_m c1 c2 c #s "|
+"add_res c (Seq_m c1 c2 c3 # s) = Seq_f c1 c2 c3 c # s"|
+"add_res c (If_0 v c1 c2 # s) = If_m v c1 c2 c # s "|
+"add_res c (If_m v c1 c2 c3 #s) = If_f v c1 c2 c3 c # s"|
+"add_res c (While_0 v c'#s) = While_f v c' c # s"|
+"add_res c s = s"
+
+lemma add_res_not_Nil:
+"add_res c s \<noteq> []"
+  apply(cases s)
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+    apply auto
+    done
   done
 
-fun map_all_subprograms2_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_all_subprograms2_acc  c acc n = (if n =0 then acc else 
-map_all_subprograms2_acc c (( 2## (hd_nat n) ## c ## 0) ## acc) (tl_nat n) )"
-
-lemma  map_all_subprograms2_induct:
-" map_all_subprograms2_acc c acc n = map_acc  (\<lambda>x. 2## x ## c ## 0) acc n"
-  apply(induct c acc n rule:map_all_subprograms2_acc.induct)
-  apply auto
+fun add_res_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"add_res_nat c s = (if s =0 then (10##c##0)##0 else 
+(let h = hd_nat s; con = hd_nat h ; fs = nth_nat (Suc 0) h ; sn = nth_nat (Suc (Suc 0)) h;
+       th = nth_nat (Suc (Suc (Suc 0))) h; ft = nth_nat (Suc (Suc (Suc (Suc 0)))) h; t = tl_nat s in
+    if con = 2 then (5## fs ## sn ## c ## 0) ## t
+else if con = 5 then(6 ## fs ## sn ## th ## c ## 0) ## t
+else if con = 3 then (7 ## fs ## sn ## th ## c ## 0) ## t
+else if con = 7 then (8 ## fs ## sn ## th ## ft ## c ## 0)## t
+else if con = 4 then (9 ## fs ## sn ## c ## 0) ## t else s 
+  ))"
+
+lemma sub_add_res:
+"add_res_nat (list_encode (map comm_encode c)) (list_encode  (map all_sub_encode s))
+= list_encode (map all_sub_encode (add_res c s))"
+  apply (cases s)
+   apply (simp add: cons0 sub_cons  flip: list_encode.simps)
+  subgoal for a xs 
+    apply(cases a)
+       apply (auto simp add:cons0 sub_cons list_encode_eq sub_hd sub_tl  simp flip: list_encode.simps)
+                   apply(auto simp add: Let_def sub_hd sub_tl simp flip: list_encode.simps(2)) 
+    done
   done
 
-definition map_all_subprograms2_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"map_all_subprograms2_tail c n = reverse_nat (map_all_subprograms2_acc c 0 n)"
+function all_subprograms_stack :: "all_sub list \<Rightarrow> com list" where 
+"all_subprograms_stack (Bot x#s) = x"|
+"all_subprograms_stack (SKIP # s) = all_subprograms_stack (add_res  [com.SKIP] s )"|
+"all_subprograms_stack (Assign v b # s) = all_subprograms_stack (add_res [(com.Assign v b), com.SKIP] s )"|
+"all_subprograms_stack (Seq_0 c1 c2 # s) = all_subprograms_stack (push_stack c1 (Seq_0 c1 c2 # s) )"|
+"all_subprograms_stack (Seq_m c1 c2 c3 # s) = all_subprograms_stack (push_stack c2 (Seq_m c1 c2 c3 # s))"|
+"all_subprograms_stack (Seq_f c1 c2 c3 c4 #s) = all_subprograms_stack (add_res ((map (\<lambda> c. c ;; c2) c3 ) @ c3 
+  @ c4) s) "|
+"all_subprograms_stack (If_0 v c1 c2 # s) = all_subprograms_stack (push_stack c1 (If_0 v c1 c2 # s))"|
+"all_subprograms_stack (If_m v c1 c2 c3 # s) = all_subprograms_stack (push_stack c2 (If_m v c1 c2 c3 # s)) "|
+"all_subprograms_stack (If_f v c1 c2 c3 c4 # s) = all_subprograms_stack (add_res (
+[(com.If v c1 c2)] @ c3 @ c4 ) s )"|
+"all_subprograms_stack (While_0 v c # s) = all_subprograms_stack (push_stack c (While_0 v c # s) )"|
+"all_subprograms_stack (While_f v c c' # s) = all_subprograms_stack (add_res ([(While v c), com.SKIP] @ c' @ 
+  (map (\<lambda> x. x ;; (While v c))  c')) s)"
+  sorry
+termination sorry
+
+function all_subprograms_stack_nat :: "nat  \<Rightarrow> nat" where 
+"all_subprograms_stack_nat s = (let h = hd_nat s; con = hd_nat h ; fs = nth_nat (Suc 0) h ; sn = nth_nat (Suc (Suc 0)) h;
+       th = nth_nat (Suc (Suc (Suc 0))) h; ft = nth_nat (Suc (Suc (Suc (Suc 0)))) h; v = nth_nat (Suc (Suc (Suc (Suc (Suc 0))))) h;  t = tl_nat s in
+if con = 10 then  fs else 
+if con = 0 then  all_subprograms_stack_nat (add_res_nat  ((0##0)##0) t ) else
+if con = 1 then  all_subprograms_stack_nat (add_res_nat   (h##(0##0)##0)  t ) else 
+if con = 2 then all_subprograms_stack_nat (push_stack_nat fs s) else 
+if con = 5 then all_subprograms_stack_nat (push_stack_nat sn s) else 
+if con = 6 then all_subprograms_stack_nat (add_res_nat (append_nat ( append_nat (map_all_subprograms_tail sn th ) th 
+  ) ft) t) else
+if con = 3 then all_subprograms_stack_nat (push_stack_nat sn s) else
+if con = 7 then all_subprograms_stack_nat (push_stack_nat th s) else
+if con = 8 then all_subprograms_stack_nat (add_res_nat (append_nat ((3##fs##sn##th##0)## ft )v) t) else
+if con = 4 then all_subprograms_stack_nat (push_stack_nat sn s) else
+all_subprograms_stack_nat (add_res_nat ((4##fs##sn##0) ## (0##0) ## append_nat th (map_all_subprograms_tail (4##fs##sn##0) th)) t)
+) "
+  sorry
+termination sorry 
+
+lemma map_singleton:
+"[f x] = map f [x]" by auto
+lemma sub_all_programs_stack:
+"s \<noteq> [] \<Longrightarrow> all_subprograms_stack_nat (list_encode (map all_sub_encode s))
+ = list_encode (map comm_encode (all_subprograms_stack s))"
+  apply (cases s)
+   apply simp
+  subgoal  for a xs
+    apply(induct s  arbitrary : a xs rule:all_subprograms_stack.induct)
+    using push_stack_not_Nil add_res_not_Nil   apply (auto simp only:)
+              apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack.simps )
+   apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack.simps ) 
+             apply(simp only:  add_res.simps sub_add_res map_singleton[of comm_encode]  flip: comm_encode.simps list.map )
+    apply (metis neq_Nil_conv)
+ apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack.simps ) 
+             apply(simp only:  add_res.simps sub_add_res map_singleton[of comm_encode]  flip: One_nat_def comm_encode.simps list.map )
+    apply (metis neq_Nil_conv)
+     apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+             apply(simp only:  sub_push_stack   flip: One_nat_def all_sub_encode.simps list.map )
+           apply (metis list.exhaust)
+  apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+          apply(simp only:  sub_push_stack   flip: One_nat_def all_sub_encode.simps list.map )
+               apply (metis list.exhaust)
+ apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+         apply(simp only: subtail_map_all_subprograms submap_all_subprograms
+        sub_map sub_append map_map comp_def sub_cons cons0
+  add_res.simps sub_add_res  flip: One_nat_def comm_encode.simps list.map )
+    apply (simp only: sub_add_res flip: map_append comp_def[of comm_encode "\<lambda>x. (com.Seq x  _ )"] map_map)
+         apply (metis append.assoc neq_Nil_conv)
+  apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+          apply(simp only:  sub_push_stack   flip: One_nat_def all_sub_encode.simps list.map )
+        apply (metis list.exhaust)
+  apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+          apply(simp only:  sub_push_stack   flip: One_nat_def all_sub_encode.simps list.map )
+       apply (metis list.exhaust)
+ apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+         apply(simp only: subtail_map_all_subprograms submap_all_subprograms
+        sub_map sub_append map_map comp_def sub_cons cons0
+  add_res.simps sub_add_res  flip: One_nat_def comm_encode.simps list.map map_append)
+      apply (metis append_Cons neq_Nil_conv)
+  apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+          apply(simp only:  sub_push_stack   flip: One_nat_def all_sub_encode.simps list.map )
+     apply (metis list.exhaust)
+ apply (subst all_subprograms_stack_nat.simps)
+   apply (simp add: Let_def sub_nth sub_hd sub_cons sub_tl  cons0
+              del: all_subprograms_stack_nat.simps 
+                list_encode.simps nth_nat.simps add_res_nat.simps push_stack_nat.simps ) 
+         apply(simp only: subtail_map_all_subprograms submap_all_subprograms
+        sub_map sub_append map_map comp_def sub_cons cons0
+  add_res.simps sub_add_res  flip: One_nat_def comm_encode.simps list.map map_append)
+    apply (simp only: sub_add_res flip: comp_def [of comm_encode "\<lambda>x. (com.Seq x  (com.While _ _))" ]
+          map_map map_append list.map )
+    apply (metis list.exhaust)
+    done
+  done
 
-lemma subtail_map_all_subprograms2:
-"map_all_subprograms2_tail c n = map_all_subprograms2 c n"
-  using submap_all_subprograms2 map_all_subprograms2_tail_def  map_all_subprograms2_induct[of c 0 n]
-  subtail_map by presburger
+lemma all_subprograms_stack_correct:
+"all_subprograms_stack (push_stack c s) = all_subprograms_stack (add_res (all_subprograms c) s)"
+  apply (induct c arbitrary: s )
+      apply auto
+  done
 
+definition all_subprograms_t :: "com \<Rightarrow> com list" where
+"all_subprograms_t c = all_subprograms_stack (push_stack c [] )"
 
+definition all_subprograms_nat :: "nat \<Rightarrow> nat" where 
+"all_subprograms_nat c = all_subprograms_stack_nat (push_stack_nat c 0)"
 
+lemma subtailnat_all_subprograms:
+"all_subprograms_nat (comm_encode c) = list_encode (map comm_encode (all_subprograms_t c))"
+  by (metis all_subprograms_nat_def all_subprograms_t_def list.simps(8) list_encode.simps(1)
+ push_stack_not_Nil sub_all_programs_stack sub_push_stack)
 
-declare nth_nat.simps[simp del]
-fun all_subprograms_nat :: "nat \<Rightarrow> nat" where
-"all_subprograms_nat c  = (if c=0 \<or> hd_nat c = 0 then (0##0)##0 else
-if hd_nat c = 1 then c##(0##0)##0 else
-if hd_nat c = 2 then append_nat (append_nat (map_all_subprograms c  (all_subprograms_nat (nth_nat (Suc 0) c)))
-(all_subprograms_nat (nth_nat (Suc 0) c))) (all_subprograms_nat (nth_nat (Suc (Suc 0)) c)) else
-if hd_nat c = 3 then c ## append_nat (all_subprograms_nat (nth_nat (Suc (Suc 0)) c)) (all_subprograms_nat (nth_nat (Suc (Suc (Suc 0))) c)) else
-c ## (0##0) ## append_nat (all_subprograms_nat (nth_nat (Suc (Suc 0)) c)) (map_all_subprograms2 c  (all_subprograms_nat (nth_nat (Suc (Suc 0)) c))) 
-)"
-declare nth_nat.simps[simp]
+lemma sub_all_subprograms_t:
+"all_subprograms_t c = all_subprograms c"
+  by (simp add: all_subprograms_stack_correct all_subprograms_t_def)
 
 lemma sub_all_subprograms:
  "all_subprograms_nat (comm_encode c) = list_encode(map comm_encode (all_subprograms c))"
-  apply(induct c)
-      apply (subst all_subprograms_nat.simps)
-      apply (simp only: comm_encode.simps sub_hd head.simps cons0 all_subprograms.simps)
-      apply simp
-      apply (subst all_subprograms_nat.simps)
-      apply (simp only: comm_encode.simps sub_hd head.simps cons0 sub_cons sub_append all_subprograms.simps)
-     apply simp
-     apply (subst all_subprograms_nat.simps)
-    apply (simp only:  submap_all_subprograms comm_encode.simps sub_hd head.simps cons0 map_append map_map[of comm_encode] map_map[of _ comm_encode] comp_apply
-          sub_map sub_nth nth.simps sub_cons sub_append all_subprograms.simps extract_lambda2[of "\<lambda>i j. list_encode [2, i, comm_encode j]" ] flip: extract_lambda )
-    apply simp
-     apply (subst all_subprograms_nat.simps)
-    apply (simp only: comm_encode.simps sub_hd head.simps cons0 map_append map_map[of comm_encode] map_map[of _ comm_encode] comp_apply
-          sub_map sub_nth nth.simps sub_cons sub_append all_subprograms.simps extract_lambda2[of "\<lambda>i j. list_encode [2, i, comm_encode j]" ] flip: extract_lambda )
-   apply simp
-     apply (subst all_subprograms_nat.simps)
-    apply (simp only: submap_all_subprograms2  comm_encode.simps sub_hd head.simps cons0 map_append map_map[of comm_encode] map_map[of _ comm_encode] comp_apply
-          sub_map sub_nth nth.simps sub_cons sub_append all_subprograms.simps extract_lambda2[of "\<lambda>i j. list_encode [2, i,j]" ] flip: extract_lambda )
-  apply simp
-  done
+  by (simp add: sub_all_subprograms_t subtailnat_all_subprograms)
 
+definition all_subprograms_tail :: "nat \<Rightarrow> nat" where 
+"all_subprograms_tail c = all_subprograms_nat c"
+
+lemma subtail_all_subprograms:
+"all_subprograms_tail c = all_subprograms_nat c"
+  by (simp add: all_subprograms_tail_def)
 
 definition enumerate_subprograms_nat :: "nat \<Rightarrow>nat" where
 "enumerate_subprograms_nat c = remdups_nat (all_subprograms_nat c)"
 
+definition enumerate_subprograms_tail :: "nat \<Rightarrow>nat" where
+"enumerate_subprograms_tail c = remdups_tail (all_subprograms_tail c)"
+
+lemma subtail_enumerate_subprograms:
+"enumerate_subprograms_tail c = enumerate_subprograms_nat c"
+  using all_subprograms_tail_def enumerate_subprograms_nat_def 
+enumerate_subprograms_tail_def subtail_remdups by auto
+
 lemma sub_enumerate_subprograms:
 "enumerate_subprograms_nat (comm_encode c) = list_encode (map comm_encode (enumerate_subprograms c))"
   using comm_inj
@@ -152,7 +343,16 @@ definition enumerate_variables_nat :: "nat \<Rightarrow> nat" where
 "enumerate_variables_nat c =
      remdups_nat (concat_nat (map_all_variables (enumerate_subprograms_nat c)))"
 
-thm "remdups_map"
+definition enumerate_variables_tail :: "nat \<Rightarrow> nat" where
+"enumerate_variables_tail c =
+     remdups_tail (concat_tail (map_all_variables_tail (enumerate_subprograms_tail c)))"
+
+
+lemma subtail_enumerate_variables:
+"enumerate_variables_tail c = enumerate_variables_nat c "
+  by (simp add: enumerate_variables_nat_def enumerate_variables_tail_def subtail_concat 
+subtail_enumerate_subprograms subtail_map_all_variables subtail_remdups)
+
 lemma sub_enumerate_variables:
   "enumerate_variables_nat (comm_encode c) = vname_list_encode ( enumerate_variables c)"
   apply 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index 59592912..3ba2c206 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -177,39 +177,146 @@ lemma subtail_map_com_to_operators4:
   using  submap_com_to_operators4  map_com_to_operators4_tail_def
  map_com_to_operators4_induct subtail_map by presburger
 
-fun com_to_operators :: "com \<Rightarrow> operator list" where
-"com_to_operators (SKIP) = []" |
-"com_to_operators (v ::= b) = 
-   [\<lparr> precondition_of = [(PC, PCV (v ::= b))], 
-      effect_of = [(PC, PCV SKIP), (VN v, EV b)]\<rparr>]" |
-"com_to_operators (c1;; c2) = 
-  (if c1 = SKIP then  [\<lparr> precondition_of = [(PC, PCV (c1 ;; c2))],
-                                                   effect_of = [(PC, PCV c2)]\<rparr>]
-   else (let ops = com_to_operators c1 in map (\<lambda> op. 
+
+datatype com_op = Bot "operator list" |
+                  SKIP |
+                  Assign vname bit |
+                  Seq_0 com com |
+                  Seq_f com com "operator list"|
+                  If "vname list" com com |
+                  While "vname list" com
+
+fun com_op_encode :: "com_op \<Rightarrow> nat" where 
+"com_op_encode SKIP = list_encode [0]"|
+"com_op_encode (Assign v b) = list_encode [1,vname_encode v, bit_encode b]"|
+"com_op_encode (Seq_0 c1 c2) = list_encode [2,comm_encode c1, comm_encode c2]"|
+"com_op_encode (If v c1 c2) = list_encode [3, vname_list_encode v, comm_encode c1 ,comm_encode c2] "|
+"com_op_encode (While v c) = list_encode [4,vname_list_encode v, comm_encode c] "|
+"com_op_encode (Seq_f c1 c2 op) = list_encode [5, comm_encode c1, comm_encode c2, list_encode (map operator_encode op)]"|
+"com_op_encode (Bot x) = list_encode [6, list_encode (map operator_encode x)]"
+
+fun com_op_decode :: "nat \<Rightarrow> com_op" where 
+"com_op_decode n = (case list_decode n of 
+    [0] \<Rightarrow> SKIP |
+    [Suc 0,v,b] \<Rightarrow> Assign (vname_decode v) (bit_decode b)|
+    [Suc (Suc 0), c1, c2] \<Rightarrow> Seq_0 (comm_decode c1) (comm_decode c2)|
+    [Suc (Suc (Suc 0)),v ,c1 ,c2] \<Rightarrow> If (vname_list_decode v) (comm_decode c1) (comm_decode c2)|
+    [Suc (Suc (Suc (Suc 0))), v, c] \<Rightarrow> While (vname_list_decode v) (comm_decode c)|
+    [Suc (Suc (Suc (Suc (Suc 0)))),c1,c2,op] \<Rightarrow> Seq_f (comm_decode c1) (comm_decode c2) (map operator_decode (list_decode op))|
+    [Suc (Suc (Suc (Suc (Suc (Suc 0))))),op] \<Rightarrow> Bot (map operator_decode (list_decode op))
+)"
+
+lemma com_op_id: 
+"com_op_decode (com_op_encode x) = x"
+  apply(induct x)
+        apply(auto simp add: operator_id comp_def vname_id comm_id 
+          vname_list_id simp del: comm_decode.simps )
+  done
+
+fun push_to_stack_op :: "com \<Rightarrow> com_op list \<Rightarrow> com_op list" where 
+"push_to_stack_op com.SKIP s = SKIP#s "|
+"push_to_stack_op (com.Assign v n) s = Assign v n #s"|
+"push_to_stack_op (com.Seq c1 c2)  s = Seq_0 c1 c2 # s "|
+"push_to_stack_op (com.If v c1 c2) s = If v c1 c2 #s"|
+"push_to_stack_op (com.While v c) s = While v c #s"
+
+fun push_to_stack_op_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"push_to_stack_op_nat c s = (c ## s)"
+
+lemma sub_push_to_stack_op :
+"push_to_stack_op_nat (comm_encode c) (list_encode (map com_op_encode  s))
+ = list_encode (map com_op_encode (push_to_stack_op c s)) "
+  apply(cases c)
+      apply(auto simp add: sub_cons  simp del:list_encode.simps)
+  done
+
+fun add_res_to_stack_op :: "operator list \<Rightarrow> com_op list \<Rightarrow> com_op list" where 
+"add_res_to_stack_op op [] = [Bot op]"|
+"add_res_to_stack_op op (Seq_0 c1 c2 # s) = Seq_f c1 c2 op # s"|
+"add_res_to_stack_op op s = s"
+
+fun add_res_to_stack_op_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"add_res_to_stack_op_nat op s = (if s = 0 then (6 ## op ## 0)##0
+else if hd_nat (hd_nat s) = 2 then (5 ## (nth_nat (Suc 0) (hd_nat s)) ## (nth_nat (Suc (Suc 0)) (hd_nat s)) ## op ## 0)## (tl_nat s)
+else s)"
+
+lemma list_encode_0:"(list_encode s = 0) = (s= [])"
+  using list_encode_eq by fastforce
+
+lemma sub_add_res_to_stack:
+"add_res_to_stack_op_nat (list_encode (map operator_encode op)) (list_encode (map com_op_encode s))
+ = list_encode (map com_op_encode (add_res_to_stack_op op s))"
+   apply(cases s)
+  apply (auto simp add: sub_hd list_encode_0  sub_cons cons0  simp del: list_encode.simps  )
+  subgoal for a xs
+    apply(cases a)
+      apply (auto simp add: sub_nth sub_tl sub_hd list_encode_0  sub_cons cons0  simp del: list_encode.simps  )
+    done
+  subgoal for a xs
+    apply(cases a)
+      apply (auto simp add: sub_nth sub_tl sub_hd list_encode_0  sub_cons cons0  simp del: list_encode.simps  )
+    done
+  done
+
+  
+function com_to_operators_stack :: "com_op list \<Rightarrow> operator list" where 
+"com_to_operators_stack (Bot x # s) = x "|
+"com_to_operators_stack (SKIP# s) = com_to_operators_stack (add_res_to_stack_op [] s)"|
+"com_to_operators_stack (Assign v b # s) = com_to_operators_stack (add_res_to_stack_op
+     [\<lparr> precondition_of = [(PC, PCV (com.Assign v b))], 
+      effect_of = [(PC, PCV com.SKIP), (VN v, EV b)]\<rparr>] s )" |
+"com_to_operators_stack (Seq_0 c1 c2 #s) = 
+(if c1 = com.SKIP then com_to_operators_stack ( add_res_to_stack_op  [\<lparr> precondition_of = [(PC, PCV (c1 ;; c2))],
+                                                   effect_of = [(PC, PCV c2)]\<rparr>] s)
+else com_to_operators_stack (push_to_stack_op c1 (Seq_0 c1 c2 #s))
+)"|
+"com_to_operators_stack (Seq_f c1 c2 ops # s) = 
+com_to_operators_stack (add_res_to_stack_op ( map (\<lambda> op. 
     (let c1' = pc_to_com (effect_of op) in 
       \<lparr> precondition_of = 
-        list_update (precondition_of op) 0 (PC, PCV (c1 ;; c2)),
+        list_update (precondition_of op) 0 (PC, PCV (com.Seq c1 c2)),
         effect_of = 
-        list_update (effect_of op) 0 (PC, PCV (c1' ;; c2))\<rparr>)) ops))" |
-"com_to_operators (IF vs\<noteq>0 THEN c1 ELSE c2) = (let i = PCV (IF vs\<noteq>0 THEN c1 ELSE c2)
+        list_update (effect_of op) 0 (PC, PCV (com.Seq c1' c2))\<rparr>)) ops) s)"|
+"com_to_operators_stack (If vs c1 c2 #s) = 
+com_to_operators_stack (add_res_to_stack_op   (let i = PCV (IF vs\<noteq>0 THEN c1 ELSE c2)
    in  \<lparr> precondition_of = (PC, i) # map (\<lambda>v. (VN v, EV Zero)) (remdups vs), 
         effect_of = [(PC, PCV c2)]\<rparr> 
       # map (\<lambda> v. 
       \<lparr> precondition_of = [(PC, i), (VN v, EV One)], 
-         effect_of = [(PC, PCV c1)]\<rparr>) vs)" |
-"com_to_operators (WHILE vs\<noteq>0 DO c) = (let i = PCV (WHILE vs\<noteq>0 DO c) ;
-  j = PCV (c ;; (WHILE vs\<noteq>0 DO c)); k = PCV SKIP in 
+         effect_of = [(PC, PCV c1)]\<rparr>) vs)   s )" |
+"com_to_operators_stack (While vs c # s) = 
+com_to_operators_stack (add_res_to_stack_op  (let i = PCV (com.While vs c) ;
+  j = PCV (com.Seq c (com.While vs c)); k = PCV (com.SKIP) in 
     \<lparr> precondition_of = (PC, i) # map (\<lambda>v. (VN v, EV Zero)) (remdups vs), 
         effect_of = [(PC, k)]\<rparr> 
       # map (\<lambda> v. 
       \<lparr> precondition_of = [(PC, i), (VN v, EV One)], 
-         effect_of = [(PC, j)]\<rparr>) vs)"
+         effect_of = [(PC, j)]\<rparr>) vs) s)"
+  sorry
+termination sorry
+
+lemma com_to_operators_stack_correct:
+"com_to_operators_stack (push_to_stack_op c s) = com_to_operators_stack (add_res_to_stack_op (
+com_to_operators c) s)"
+  apply(induct c  arbitrary:s rule: com_to_operators.induct)
+      apply auto
+  done
 
-datatype
+definition com_to_operators_t :: "com  \<Rightarrow> operator list" where 
+"com_to_operators_t c = com_to_operators_stack (push_to_stack_op c [])"
 
-fun com_to_operators_nat :: "nat \<Rightarrow> nat" where
-"com_to_operators_nat c = (if c = 0 \<or> hd_nat c = 0 then 0 else 
-if hd_nat c = 1 then (
+lemma subtailnat_com_to_operators:
+"com_to_operators_t c = com_to_operators c"
+  using com_to_operators_stack_correct[of c "[]"]
+  apply(auto simp add: com_to_operators_t_def)
+  done
+
+
+
+function com_to_operators_stack_nat :: "nat \<Rightarrow> nat" where 
+"com_to_operators_stack_nat s = (let c = hd_nat s ; t = tl_nat s in  
+(if hd_nat c = 0 then com_to_operators_stack_nat (add_res_to_stack_op_nat 0 t) else 
+if hd_nat c = 1 then com_to_operators_stack_nat (add_res_to_stack_op_nat ((
                         ((prod_encode(0,prod_encode(1,c)))##0)
                         ##
                           (
@@ -218,30 +325,70 @@ if hd_nat c = 1 then (
                               (prod_encode(Suc (nth_nat (Suc 0) c),prod_encode(0,nth_nat (Suc (Suc 0)) c)))
                                ##0
                           )
-                        ##0)##0
+                        ##0)##0) t)
 else if hd_nat c = 2 then (let c1 = nth_nat (Suc 0) c; c2= nth_nat (Suc (Suc 0)) c in 
-  (if c1 = 0##0 then (((prod_encode(0,prod_encode(1,c)))##0)##((prod_encode(0,prod_encode(1,c2)))##0)##0)##0
-else  (let ops = com_to_operators_nat c1 in map_com_to_operators c c2 ops)))
+  (if c1 = 0##0 then  com_to_operators_stack_nat (add_res_to_stack_op_nat ( (((prod_encode(0,prod_encode(1,c)))##0)##((prod_encode(0,prod_encode(1,c2)))##0)##0)##0) t)
+else  com_to_operators_stack_nat (push_to_stack_op_nat c1 s)))
 else if hd_nat c = 3 then 
 (let i = prod_encode (1, c); vs = nth_nat (Suc 0) c ; c1 = nth_nat (Suc (Suc 0)) c ; c2 = nth_nat (Suc (Suc (Suc 0))) c
-   in  ( ((prod_encode(0, i)) ## map_com_to_operators2 (remdups_nat vs))## 
+   in com_to_operators_stack_nat (add_res_to_stack_op_nat (( ((prod_encode(0, i)) ## map_com_to_operators2_tail (remdups_nat vs))## 
         ((prod_encode(0, prod_encode(1, c2)))##0)## 0)
-      ## map_com_to_operators3 i c1 vs)
-else (let i = prod_encode(1,c) ;  vs = nth_nat (Suc 0) c ; c' = nth_nat (Suc (Suc 0)) c ; 
+      ## map_com_to_operators3_tail i c1 vs ) t ) )
+else  if hd_nat c = 4 then (let i = prod_encode(1,c) ;  vs = nth_nat (Suc 0) c ; c' = nth_nat (Suc (Suc 0)) c ; 
   j = prod_encode(1, (2##c'## c##0)); k = prod_encode(1, 0##0) in 
-    ( ((prod_encode(0, i)) ##  map_com_to_operators2 (remdups_nat vs))## 
+  com_to_operators_stack_nat (add_res_to_stack_op_nat (( ((prod_encode(0, i)) ##  map_com_to_operators2_tail (remdups_nat vs))## 
         (((prod_encode(0, k))##0))##0) 
-      ## map_com_to_operators4 i j vs))
-"
+      ## map_com_to_operators4_tail i j vs) t))
+else if hd_nat c = 5 then 
+(let ops = nth_nat (Suc (Suc (Suc 0))) c; c2 = nth_nat (Suc (Suc 0)) c ; c1 = nth_nat (Suc 0) c  in  com_to_operators_stack_nat (add_res_to_stack_op_nat  (map_com_to_operators_tail (2 ## c1 ##c2 ## 0) c2 ops) t))
+else nth_nat (Suc 0) c
+))
+"  
+ sorry
+termination sorry
+
 
-declare nth_nat.simps[simp]
 
-lemma com_to_operators_inv: 
-  "\<lbrakk> c \<noteq> SKIP ; L = com_to_operators c; l \<in>set L \<rbrakk> \<Longrightarrow> effect_of l \<noteq>[] \<and> (\<exists>x y. effect_of l!0 = (y,PCV x))"
-  apply (induct c arbitrary:l L rule: com_to_operators.induct )
-      apply (auto simp add:  Let_def split:if_splits  )
+
+lemma push_stack_not_Nil :
+"push_to_stack_op c s \<noteq> []"
+  apply (cases c)
+  apply auto
   done
-  
+
+lemma add_res_not_Nil : 
+"add_res_to_stack_op c s \<noteq> []"
+  apply (cases s)
+   apply auto
+  subgoal for a xs
+    apply( cases a)
+          apply auto
+    done
+  done
+lemma Nil_is_map_op:
+"[] = map operator_encode []"
+  by  auto
+lemma sas_singleton:"list_encode [sas_assignment_encode x] = sas_assignment_list_encode [x]"
+  apply (auto simp add: sas_assignment_list_encode_def)
+  done
+
+lemma op_singleton:"[operator_encode x] = map operator_encode [x]"
+  apply (auto)
+  done
+
+lemma sas_couple:"list_encode [sas_assignment_encode x,sas_assignment_encode y] = sas_assignment_list_encode [x,y]"
+  apply (auto simp add: sas_assignment_list_encode_def)
+  done
+lemma operator_encode_simps: 
+"list_encode [sas_assignment_list_encode x, sas_assignment_list_encode y] = operator_encode \<lparr>
+  precondition_of = x, effect_of = y
+\<rparr>"
+  apply (auto simp add:operator_encode_def)
+  done
+lemma comm_inj_simps: "(comm_encode x= comm_encode y) = (x=y)"
+  by (simp add: comm_inj inj_eq)
+
+
 lemma sub_map_dec: "map_nat P xs = list_encode (map P (list_decode xs))"
   using sub_map list_decode_inverse by metis
 
@@ -268,63 +415,189 @@ lemma list_update_nat_zero: "list_update_nat 0 0 n = 0"
   apply auto
   done
 
-lemma sub_com_to_operators:
-"com_to_operators_nat (comm_encode c) = list_encode (map operator_encode (com_to_operators c))"
-  apply (induct rule:com_to_operators.induct)
-      apply (subst com_to_operators_nat.simps)
-      apply (auto simp only:sub_hd comm_encode.simps head.simps sub_cons cons0 sub_map )
+lemma sub_com_to_operators_stack:
+"s \<noteq> [] \<Longrightarrow> com_to_operators_stack_nat (list_encode (map  com_op_encode s))
+= list_encode (map operator_encode(com_to_operators_stack s))"
+  apply(induct s rule: com_to_operators_stack.induct)
+        apply(auto simp only:add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                  simp del: list_encode.simps )
+        apply(subst com_to_operators_stack_nat.simps)
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps )    
+        apply simp
+         apply(subst com_to_operators_stack_nat.simps)
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps )  
+       apply (simp only: sub_add_res_to_stack list_encode_eq  Nil_is_map_op   flip: list_encode.simps  )
+       apply simp
+         apply(subst com_to_operators_stack_nat.simps)
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+  apply(simp only:  flip: comm_encode.simps del:list_encode.simps)
+      apply (simp only:sub_hd  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps  flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
       apply simp
-       apply (subst com_to_operators_nat.simps)
-     apply (auto simp only:sub_hd comm_encode.simps head.simps sub_cons cons0 sub_map sub_nth com_to_operators.simps
-                                      nth.simps simp flip: domain_element_encode.simps  variable_encode.simps(2) sas_assignment_encode.simps comm_encode.simps(1) imp_assignment_encode.simps)
-     apply (auto simp add: operator_encode_def sas_assignment_list_encode_def 
-            sub_map list_encode_eq )[1]
-      apply (subst com_to_operators_nat.simps)
-     apply (auto simp only: sub_hd list_encode_eq suc_eq list_encode_empty comm_encode_eq head.simps sub_cons cons0 sub_map sub_map_dec sub_nth com_to_operators.simps
+     apply(subst com_to_operators_stack_nat.simps)
+  subgoal for c1 c2 s
+    apply (cases "c1=com.SKIP")
+        apply(auto simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+  apply(simp only:   flip: comm_encode.simps del:list_encode.simps)
+      apply ( simp only:sub_hd  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps   flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps )
+      apply ( simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps   flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+     apply simp
+    apply (auto simp only:sub_push_to_stack_op  comm_inj_simps simp flip: com_op_encode.simps(3) comm_encode.simps(1) list.map(2) split: if_splits)
+    done
+         apply(subst com_to_operators_stack_nat.simps)
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+    apply(simp only:subtail_map_com_to_operators
+        submap_com_to_operators   sub_nth nth.simps  flip: comm_encode.simps del:list_encode.simps)
+      apply (simp only:sub_hd sub_list_update  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps  flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+      apply (auto simp only: sub_hd list_encode_eq suc_eq list_encode_empty comm_encode_eq head.simps sub_cons cons0 sub_map sub_map_dec sub_nth com_to_operators.simps
                          sub_list_update sas_plus_operator.simps sas_assignment_list_encode_def list.map prod_encode_eq  nth.simps sub_pc_to_com Let_def comp_def operator_encode_def
   domain_element_encode.simps  variable_encode.simps  sas_assignment_encode.simps
     map_map list_encode_inverse sub_remdups  comm_encode.simps submap_com_to_operators
-  simp flip: comm_encode.simps(1) 
-                          del: list_encode.simps hd_nat_def cons_def pc_to_com_nat_def map_nat.simps nth_nat.simps list_update_nat.simps  com_to_operators_nat.simps split:if_splits)
-  apply (auto simp only:sub_pc_to_com simp flip:  sas_assignment_list_encode_def )
-    apply (auto simp only: sas_assignment_list_encode_def list.simps map_update 
-            sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps comm_encode.simps)
-   apply (subst com_to_operators_nat.simps)
+  simp flip: comm_encode.simps
+                          del: list_encode.simps hd_nat_def cons_def pc_to_com_nat_def map_nat.simps nth_nat.simps list_update_nat.simps split:if_splits)
+  apply (auto simp only:sub_pc_to_com simp flip:  sas_assignment_list_encode_def  comm_encode.simps )
+    apply (auto simp only:  operator_encode_simps sas_assignment_list_encode_def list.simps map_update 
+            sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps  simp flip:  sas_assignment_encode.simps sas_assignment_list_encode_def map_update  variable_encode.simps domain_element_encode.simps comm_encode.simps)
+     apply (auto simp only:  simp flip:comp_def[of operator_encode 
+"\<lambda>x.  \<lparr>sas_plus_operator.precondition_of = (sas_plus_operator.precondition_of x)
+                           [variable_encode PC := (PC, PCV (_;; _))],
+                           effect_of = (effect_of x)
+                             [variable_encode PC := (PC, PCV (pc_to_com (effect_of x);; _))]\<rparr>"
+
+ ] )
+     apply(auto simp only:sub_add_res_to_stack simp flip: map_map)
+  apply(subst com_to_operators_stack_nat.simps)
+        apply(simp only:  sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+    apply(simp only:subtail_map_com_to_operators2
+        submap_com_to_operators2  subtail_map_com_to_operators3
+        submap_com_to_operators3   sub_nth nth.simps  flip: comm_encode.simps  vname_list_encode_def del:list_encode.simps)
+      apply (simp only:sub_hd sub_list_update  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps   variable_encode.simps  flip:  bit_encode.simps domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+   apply(subst (4) bit_encode.simps) 
+   apply( simp only: flip: domain_element_encode.simps)
   using vname_inj
-   apply (auto simp only:sub_hd head.simps Let_def cons0 sub_cons sub_nth nth.simps sub_map_dec  bit_encode.simps 
-        vname_list_encode_def sub_remdups list_encode_inverse map_map comp_def
-sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps comm_encode.simps list.simps
-    remdups_map submap_com_to_operators2  submap_com_to_operators3
-   )
+   apply(simp only: remdups_map  map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
+   apply(simp only: bit_encode.simps(1) cons0 sub_cons sub_map flip: domain_element_encode.simps comp_def[of sas_assignment_encode "\<lambda>x. (VN x, EV Zero)"] map_map list.map(2))
+   apply( simp only: sub_map vname_list_encode_def map_map comp_def sas_singleton sas_couple operator_encode_simps sub_cons flip: variable_encode.simps sas_assignment_encode.simps  sas_assignment_list_encode_def ) 
+  apply( simp only: sub_add_res_to_stack flip: map_map list.map(2) comp_def [of operator_encode "\<lambda>x. \<lparr>sas_plus_operator.precondition_of =
+                                                [(PC, PCV (IF _\<noteq>0 THEN _ ELSE _)), (VN x, EV One)],
+                                                effect_of = [(PC, PCV _)]\<rparr>" ])
    apply simp
-   apply (subst com_to_operators_nat.simps)
+
+apply(subst com_to_operators_stack_nat.simps)
+        apply(simp only:  sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+    apply(simp only:subtail_map_com_to_operators4
+        submap_com_to_operators4  subtail_map_com_to_operators2
+        submap_com_to_operators2   sub_nth nth.simps  flip: comm_encode.simps  vname_list_encode_def del:list_encode.simps)
+      apply (simp only:sub_hd sub_list_update  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps   variable_encode.simps  flip:  bit_encode.simps domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+   apply(subst (8) bit_encode.simps) 
+   apply( simp only: flip: domain_element_encode.simps)
   using vname_inj
-   apply (auto simp only:sub_hd  submap_com_to_operators2 head.simps Let_def cons0 sub_cons sub_nth nth.simps sub_map_dec  bit_encode.simps 
-        vname_list_encode_def sub_remdups list_encode_inverse map_map comp_def
-sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps comm_encode.simps list.simps
-    remdups_map submap_com_to_operators4
-   )
-  apply simp
+   apply(simp only: remdups_map  map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
+   apply(simp only: bit_encode.simps(1) cons0 sub_cons sub_map flip: domain_element_encode.simps comp_def[of sas_assignment_encode "\<lambda>x. (VN x, EV Zero)"] map_map list.map(2))
+   apply( simp only: sub_map vname_list_encode_def map_map comp_def sas_singleton sas_couple operator_encode_simps sub_cons flip: variable_encode.simps sas_assignment_encode.simps  sas_assignment_list_encode_def ) 
+  apply( simp only: sub_add_res_to_stack flip: map_map list.map(2) comp_def [of operator_encode "\<lambda>x.\<lparr>sas_plus_operator.precondition_of =
+                                                     [(PC, PCV (WHILE _\<noteq>0 DO _ )), (VN x, EV One)],
+                                                     effect_of = [(PC, PCV (_;; WHILE _\<noteq>0 DO _))]\<rparr>" ])
+   apply simp
   done
 
+definition com_to_operators_nat:: "nat \<Rightarrow> nat" where 
+"com_to_operators_nat c = com_to_operators_stack_nat (push_to_stack_op_nat c 0)"
+
+lemma subnat_com_to_operators: 
+"com_to_operators_nat (comm_encode c) = list_encode (map operator_encode (com_to_operators_t c)) "
+  by (metis com_to_operators_nat_def com_to_operators_t_def list.simps(8) list_encode.simps(1)
+ push_stack_not_Nil sub_com_to_operators_stack sub_push_to_stack_op)
+
+lemma sub_com_to_operators:
+"com_to_operators_nat (comm_encode c) = list_encode (map operator_encode (com_to_operators c))"
+  by (simp add: subnat_com_to_operators subtailnat_com_to_operators)
+
+definition com_to_operators_tail:: "nat \<Rightarrow> nat" where
+"com_to_operators_tail c = com_to_operators_nat c"
+
+lemma subtail_com_to_operators:
+"com_to_operators_tail c = com_to_operators_nat c"
+  by (simp add: com_to_operators_tail_def)
 fun map_coms_to_operators :: "nat \<Rightarrow> nat" where 
 "map_coms_to_operators n = (if n = 0 then 0 else (com_to_operators_nat (hd_nat n)) ## map_coms_to_operators (tl_nat n))"
 
+fun map_coms_to_operators_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_coms_to_operators_acc acc  n = (if n = 0 then acc else map_coms_to_operators_acc ((com_to_operators_tail (hd_nat n)) ## acc) (tl_nat n))"
+
+lemma map_coms_to_operators_induct:
+"map_coms_to_operators_acc acc  n = map_acc  com_to_operators_nat acc n"
+  apply(induct acc n rule: map_coms_to_operators_acc.induct)
+  apply (auto simp add: subtail_com_to_operators)
+  done
+
 
 lemma submap_coms_to_operators : 
 "map_coms_to_operators n  = map_nat com_to_operators_nat n "
   apply (induct n rule:map_coms_to_operators.induct)
   apply auto
   done
+
+definition  map_coms_to_operators_tail:: "nat \<Rightarrow> nat" where 
+"map_coms_to_operators_tail n = reverse_nat (map_coms_to_operators_acc 0 n)"
+
+lemma subtail_map_coms_to_operators:
+"map_coms_to_operators_tail n = map_coms_to_operators n"
+  
+  using map_coms_to_operators_induct map_coms_to_operators_tail_def submap_coms_to_operators 
+subtail_map by auto
+
 definition coms_to_operators_nat :: "nat \<Rightarrow> nat" where
 "coms_to_operators_nat cs = concat_nat (map_coms_to_operators cs)"
 
+definition coms_to_operators_tail :: "nat \<Rightarrow> nat" where
+"coms_to_operators_tail cs = concat_tail (map_coms_to_operators_tail cs)"
+lemma subtail_coms_to_operators:
+"coms_to_operators_tail cs = coms_to_operators_nat cs"
+  by (simp add: coms_to_operators_nat_def
+ coms_to_operators_tail_def subtail_concat subtail_map_coms_to_operators)
+
 lemma sub_coms_to_operators:
     "coms_to_operators_nat (list_encode( map comm_encode cs)) = 
           list_encode (map operator_encode (coms_to_operators cs)) "
   apply (auto simp only: coms_to_operators_nat_def sub_map map_map comp_def
         sub_com_to_operators submap_coms_to_operators )
-  apply (auto simp only: coms_to_operators_def sub_concat map_concat simp flip: comp_def[of "list_encode" "%x.(map operator_encode (com_to_operators x))"]
+  apply (auto simp only: coms_to_operators_def sub_concat map_concat simp flip: 
+comp_def[of "list_encode" "%x.(map operator_encode (com_to_operators x))"]
             map_map)
   apply (auto simp add: comp_def)
   done
@@ -341,7 +614,7 @@ definition imp_minus_minus_to_sas_plus_list::
     \<lparr> variables_ofl = PC # (map VN (enumerate_variables c)),
       operators_ofl = coms_to_operators cs, 
       initial_ofl = imp_minus_state_to_sas_plus_list (c, initial_vs),
-      goal_ofl = imp_minus_state_to_sas_plus_list (SKIP, goal_vs),
+      goal_ofl = imp_minus_state_to_sas_plus_list (com.SKIP, goal_vs),
       range_ofl = (PC, pc_d)#(map (\<lambda> v. (VN v, domain)) (enumerate_variables c))\<rparr>)"
 
 lemma sublist_imp_minus_minus_to_sas_plus:
@@ -353,6 +626,7 @@ lemma sublist_imp_minus_minus_to_sas_plus:
             sublist_imp_minus_state_to_sas_plus 
             imp_minus_minus_to_sas_plus_def  )
   done
+
 fun map_PCV :: "nat \<Rightarrow> nat" where 
 "map_PCV n = (if n = 0 then 0 else  (prod_encode(1, hd_nat n))## map_PCV (tl_nat n))"
 
@@ -362,23 +636,70 @@ lemma submap_PCV :
   apply (auto)
   done
 
+fun map_PCV_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_PCV_acc acc n = (if n = 0 then acc else map_PCV_acc ((prod_encode(1, hd_nat n))## acc) (tl_nat n))"
+
+lemma map_PCV_induct: 
+"map_PCV_acc acc n = map_acc (\<lambda> i. prod_encode(1, i)) acc n"
+  apply(induct acc n rule:map_PCV_acc.induct)
+  apply auto done
+
+definition map_PCV_tail :: "nat \<Rightarrow> nat" where 
+"map_PCV_tail n = reverse_nat (map_PCV_acc 0 n)"
+
+lemma subtail_map_PCV:
+"map_PCV_tail n =  map_PCV n"
+  using map_PCV_tail_def map_PCV_induct submap_PCV subtail_map by presburger
+
 fun map_Suc :: "nat \<Rightarrow> nat" where 
 "map_Suc n = (if n = 0 then 0 else (Suc(hd_nat n)) ## (map_Suc (tl_nat n)))"
 
+fun map_Suc_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_Suc_acc acc n = (if n = 0 then acc else map_Suc_acc ((Suc(hd_nat n)) ## acc) (tl_nat n))"
+
 lemma submap_Suc :
 "map_Suc n = map_nat Suc n"
   apply (induct n rule:map_Suc.induct)
   apply auto
   done
 
+lemma map_Suc_induct : 
+"map_Suc_acc acc n = map_acc Suc acc n"
+  apply(induct acc n rule:map_Suc_acc.induct)
+  apply auto
+  done
+
+definition map_Suc_tail :: "nat \<Rightarrow> nat" where 
+"map_Suc_tail n = reverse_nat (map_Suc_acc 0 n)"
+
+lemma subtail_map_Suc:
+"map_Suc_tail n = map_Suc n"
+  
+  using map_Suc_induct map_Suc_tail_def submap_Suc subtail_map by auto
+
 fun map_domain :: "nat\<Rightarrow> nat" where 
 "map_domain n = (if n = 0 then 0 else (prod_encode(Suc (hd_nat n), domain_nat)) ## map_domain (tl_nat n))"
 
+fun map_domain_acc :: " nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"map_domain_acc acc n = (if n = 0 then acc else  map_domain_acc ((prod_encode(Suc (hd_nat n), domain_nat)) ## acc) (tl_nat n))"
+
 lemma submap_domain :
 "map_domain n = map_nat (\<lambda> v. (prod_encode(Suc v, domain_nat))) n"
   apply (induct n rule:map_domain.induct)
   apply auto
   done
+lemma map_domain_induct: 
+"map_domain_acc acc n = map_acc   (\<lambda> v. (prod_encode(Suc v, domain_nat))) acc n"
+  apply(induct acc n rule:map_domain_acc.induct)
+  apply auto
+  done
+
+definition map_domain_tail :: "nat  \<Rightarrow> nat" where 
+"map_domain_tail n = reverse_nat (map_domain_acc 0 n )"
+
+lemma subtail_map_domain:
+"map_domain_tail n = map_domain n"
+  using map_domain_induct map_domain_tail_def submap_domain subtail_map by presburger
 
 definition imp_minus_minus_to_sas_plus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "imp_minus_minus_to_sas_plus_nat c I G = (let cs = enumerate_subprograms_nat c ; 
@@ -391,6 +712,25 @@ definition imp_minus_minus_to_sas_plus_nat:: "nat \<Rightarrow> nat \<Rightarrow
       (imp_minus_state_to_sas_plus_nat (prod_encode (0##0, goal_vs)))##
       ((prod_encode(0, pc_d))##(map_domain (enumerate_variables_nat c)))##0 )"
 
+definition imp_minus_minus_to_sas_plus_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"imp_minus_minus_to_sas_plus_tail c I G = (let cs = enumerate_subprograms_tail c ; 
+  initial_vs = restrict_tail I (enumerate_variables_tail c) ;
+  goal_vs = restrict_tail G (enumerate_variables_tail c) ;
+  pc_d = map_PCV_tail cs in
+   (0 ## (map_Suc_tail (enumerate_variables_tail c)))## 
+      (coms_to_operators_tail cs) ## 
+      (imp_minus_state_to_sas_plus_tail (prod_encode (c, initial_vs)))##
+      (imp_minus_state_to_sas_plus_tail (prod_encode (0##0, goal_vs)))##
+      ((prod_encode(0, pc_d))##(map_domain_tail (enumerate_variables_tail c)))##0 )"
+
+lemma subtail_imp_minus_minus_to_sas_plus:
+"imp_minus_minus_to_sas_plus_tail c I G = imp_minus_minus_to_sas_plus_nat c I G"
+  apply (auto simp only:  imp_minus_minus_to_sas_plus_tail_def imp_minus_minus_to_sas_plus_nat_def
+      subtail_enumerate_subprograms subtail_map_PCV subtail_map_Suc subtail_enumerate_variables
+      subtail_coms_to_operators subtail_map_domain subtail_imp_minus_state_to_sas_plus 
+subtail_restrict
+) done
+
 lemma subnat_imp_minus_minus_to_sas_plus:
 "imp_minus_minus_to_sas_plus_nat (comm_encode c) 
             (imp_assignment_list_encode I) (imp_assignment_list_encode G) =
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index c5c9eaa5..0983d1f2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -1011,7 +1011,7 @@ lemma sub_list_update :
   apply (simp only: head.simps sub_cons )
   by (metis One_nat_def Suc_pred list_encode.simps(1) list_update_code(3) neq0_conv sub_cons tail.simps(2))
 
-fun restrict_list :: "(vname,bit) assignment list \<Rightarrow> vname list \<Rightarrow> (vname,bit) assignment list" where 
+fun restrict_list :: "('vname,'bit) assignment list \<Rightarrow> 'vname list \<Rightarrow> ('vname,'bit) assignment list" where 
 "restrict_list [] s = []" |
 "restrict_list ((x,y)#xs) s = (if x \<in> set s then (x,y) # (restrict_list xs s) else restrict_list xs s)"
 
@@ -1080,7 +1080,10 @@ declare elemof.simps [simp del]
 fun restrict_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "restrict_nat l s = (if l = 0 then 0 else (let t = restrict_nat (tl_nat l) s in (if elemof (fst_nat (hd_nat l)) s \<noteq> 0 then 
     (hd_nat l)## t else t))) "
-declare elemof.simps [simp]
+
+fun restrict_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"restrict_acc acc l s = (if l = 0 then acc else(if elemof (fst_nat (hd_nat l)) s \<noteq> 0 then 
+   restrict_acc  ((hd_nat l)## acc) (tl_nat l) s else restrict_acc acc (tl_nat l) s)) "
 
 lemma sub_restrict_nat:
   "restrict_nat (imp_assignment_list_encode l) (vname_list_encode s) = imp_assignment_list_encode (restrict_list l s)"
@@ -1099,6 +1102,49 @@ lemma sub_restrict_nat:
     done    
   done
 
+lemma sub_restrict_nat_gen:
+  "restrict_nat (list_encode (map prod_encode  l)) (list_encode s) = list_encode (map prod_encode  (restrict_list l s))"
+  apply(induct l)
+   apply (simp)
+  subgoal for x xs
+  apply (cases x)
+  apply (subst restrict_nat.simps)
+    apply (auto simp only:  sub_cons restrict_list.simps list_encode_eq sub_tl  imp_assignment_list_encode_def sub_tail_map Let_def sub_fst sub_hd sub_head_map list.simps  head.simps imp_assignment_encode.simps fst_def tail.simps non_empty_positive  split:if_splits 
+  simp flip: list_encode.simps 
+)
+     apply (auto simp only: list_encode.simps sub_elem_of2)
+    done
+  done
+
+lemma restrict_induct:
+"restrict_acc acc l s = append_nat (reverse_nat (restrict_nat l s)) acc"
+proof -
+  obtain acc' l' s' where "acc = list_encode (map prod_encode acc') "
+"l = list_encode (map prod_encode l')" "s = list_encode s'"
+    by (metis ex_map_conv list_decode_inverse prod_decode_inverse)
+  thus ?thesis apply (auto simp only: sub_restrict_nat_gen sub_reverse sub_append rev_map simp flip:
+        map_append)
+    apply(induct l' arbitrary: acc' acc l)
+    apply (subst restrict_acc.simps)
+     apply simp
+    apply (subst restrict_acc.simps)
+    apply (auto simp only: sub_hd head.simps fst_conv  sub_fst list.simps sub_cons sub_tl tail.simps sub_elem_of2)
+    apply (auto simp only:restrict_list.simps simp flip: list.map(2))
+    apply auto
+    done
+qed
+
+definition restrict_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat " where 
+"restrict_tail l s = reverse_nat (restrict_acc 0 l s)"
+
+lemma subtail_restrict: 
+"restrict_tail l s =  restrict_nat l s"
+  using append_nat_0 restrict_induct restrict_tail_def rev_rev_nat by auto
+  
+declare elemof.simps [simp]
+
+
+
 type_synonym  var = "variable SAS_Plus_Plus_To_SAS_Plus.variable"
 type_synonym  dom = "domain_element SAS_Plus_Plus_To_SAS_Plus.domain_element"
 type_synonym  sas_plus_state = "(var,dom)  State_Variable_Representation.state"
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
index 8d6b2829..a8fcaca7 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
@@ -249,11 +249,14 @@ lemma subtail_map_fst :
   using map_fst_tail_def map_fst_induct submap_fst subtail_map 
   by presburger
 
-fun map_outer :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+function map_outer :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "map_outer P n = (if n =0 then 0 else (if elemof (hd_nat n) (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
     else (map_inner (hd_nat n) 
       (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## map_outer P (tl_nat n))"
-
+   apply pat_completeness
+  apply (auto simp only:)
+  done
+termination by lexicographic_order
 
 lemma submap_outer: 
 "map_outer P n = map_nat (\<lambda> v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
@@ -262,10 +265,15 @@ lemma submap_outer:
   apply (induct P n rule:map_outer.induct)
   by (metis (no_types, lifting) map_nat.elims map_outer.elims)
 declare map_list_find_nat.simps elemof.simps [simp del]
-fun  map_outer_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+
+function  map_outer_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
 "map_outer_acc P acc n = (if n =0 then acc else map_outer_acc P ((if elemof (hd_nat n) (map_fst_tail (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
     else (map_inner_tail (hd_nat n) 
       (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (hd_nat n))))) ## acc) (tl_nat n))"
+  apply pat_completeness
+  apply (auto simp only:)
+  done
+termination by lexicographic_order
 
 lemma map_outer_induct : 
 "map_outer_acc P acc n = map_acc (\<lambda> v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \<noteq> 0 then 0 
diff --git a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
index 3c6342a4..d1aca424 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
@@ -264,6 +264,15 @@ fun map_encode_operator_precondition :: "nat \<Rightarrow> nat \<Rightarrow> nat
 ## map_encode_operator_precondition t ops op vs (tl_nat xs)
 )"
 
+fun map_encode_operator_precondition_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_encode_operator_precondition_acc acc t ops op vs xs = (if xs = 0 then 0 else 
+( 4 ##(2 ## (1## (1 ## t ##(index_nat ops op) ## 0)##0) ## 0 )##  (1##(0 ## t ##(index_nat vs (hd_nat xs)) ## 0)##0) ## 0)
+## map_encode_operator_precondition t ops op vs (tl_nat xs)
+)"
+
+lemma map_encode_operator_precondition_induct:
+"map_encode_operator_precondition_acc acc t ops op vs xs = map_acc "
+
 lemma submap_encode_operator_precondition:
 "map_encode_operator_precondition t ops op vs xs = 
 map_nat (\<lambda>v.
@@ -289,7 +298,7 @@ definition encode_operator_precondition_tail
     \<Rightarrow> nat
     \<Rightarrow> nat
     \<Rightarrow> nat"
-  where "encode_operator_precondition_nat \<Pi> t op \<equiv> let
+  where "encode_operator_precondition_tail \<Pi> t op \<equiv> let
       vs = nth_nat 0 \<Pi>
       ; ops = nth_nat (Suc 0) \<Pi>
     in BigAnd_nat (map_encode_operator_precondition t ops op vs

From 1f86712f1f3ed267973aca4483e9b88dd84fbee8 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Tue, 31 Aug 2021 18:13:32 +0200
Subject: [PATCH 021/103] more refinement to tail-rec , max constant remaining

---
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy | 210 ++++++++++-
 .../IMP_Minus_Max_Constant_Nat.thy            |  31 +-
 .../IMP_Minus_To_SAS_Plus_Nat.thy             |   4 +
 Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy | 349 +++++++++++++++++-
 4 files changed, 586 insertions(+), 8 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index 0983d1f2..d9f82c8e 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -1433,6 +1433,9 @@ fun max_list :: "nat list \<Rightarrow> nat" where
 fun max_list_nat :: "nat \<Rightarrow> nat" where 
 "max_list_nat xs = (if xs = 0 then 0 else max (hd_nat xs) (max_list_nat (tl_nat xs)))"
 
+fun max_list_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"max_list_acc acc xs = (if xs = 0 then acc else max_list_acc (max (hd_nat xs) acc) (tl_nat xs))"
+
 lemma sub_max_list_nat: "max_list_nat (list_encode xs) = max_list xs"
   apply (induct xs)
   apply simp
@@ -1441,6 +1444,29 @@ lemma sub_max_list_nat: "max_list_nat (list_encode xs) = max_list xs"
   apply auto
   done
 
+lemma max_list_acc_correct:
+"max_list_acc acc xs = max (max_list_nat xs) acc"
+proof -
+  obtain xs' where "xs = list_encode xs'"
+    by (metis list_decode_inverse)
+  thus ?thesis apply(auto simp only:sub_max_list_nat )
+    apply(induct xs' arbitrary: xs acc)
+     apply simp
+    apply(subst max_list_acc.simps)
+    apply (auto simp only: sub_tl tail.simps sub_hd head.simps)
+    apply auto
+    done
+qed
+
+definition max_list_tail :: "nat \<Rightarrow>  nat" where 
+"max_list_tail xs = max_list_acc 0 xs "
+
+lemma subtail_max_list: 
+"max_list_tail xs =  max_list_nat xs"
+  using max_list_acc_correct max_list_tail_def by presburger
+  
+
+
 lemma sub_max_list: "xs \<noteq> [] \<Longrightarrow> max_list xs = Max (set xs)"
   apply (cases xs)
     apply (auto simp add: Max.set_eq_fold )
@@ -1456,6 +1482,13 @@ fun del :: "('a,'b) assignment list \<Rightarrow> 'a \<Rightarrow>  ('a,'b) assi
 "del [] _ = []"|
 "del ((x,y)#xs) a = (if x = a then del xs a else (x,y)# del xs a)"
 
+lemma del_filter:
+"del xs a = filter(\<lambda>x. fst x \<noteq> a) xs"
+  apply(induct xs)
+   apply auto
+  done
+
+
 fun del_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "del_nat xs a = (if xs =0 then 0 else if fst_nat (hd_nat xs) = a then del_nat (tl_nat xs) a else cons
 (hd_nat xs)  (del_nat (tl_nat xs) a) )"
@@ -1492,6 +1525,7 @@ lemma del_shorter : "length (del xs a) \<le> length xs"
   apply (induct xs)
    apply auto
   done
+
 function nub_nat :: "nat \<Rightarrow> nat" where 
 "nub_nat xs = (if xs = 0 then 0 else (hd_nat xs) ## nub_nat (del_nat xs (fst_nat (hd_nat xs))))"
   by pat_completeness auto
@@ -1524,6 +1558,7 @@ lemma sub_nub: "nub_nat (list_encode( map prod_encode xs)) = list_encode (map pr
   apply (auto simp add: sub_fst list_encode_eq sub_cons  simp del:nub_nat.simps list_encode.simps(2) simp flip: list_encode.simps(1))
   done
 
+
 lemma del_includes: "set (del xs x) \<subseteq> set xs"
   apply (induct xs)
    apply (auto split:if_splits)
@@ -1552,11 +1587,21 @@ lemma map_of_nub:"map_of (nub xs)  = map_of xs "
 definition ran_list :: "('a,'b) assignment list \<Rightarrow> 'b list" where 
 "ran_list xs = map snd (nub xs)"
 
+fun map_snd  :: "nat \<Rightarrow> nat " where 
+"map_snd xs = (if xs = 0 then 0 else (snd_nat (hd_nat xs)) ## map_snd (tl_nat xs))"
+
+lemma submap_snd:
+"map_snd xs = map_nat snd_nat xs"
+  apply(induct xs rule:map_snd.induct)
+  apply auto
+  done
+
 definition ran_nat :: "nat \<Rightarrow> nat" where 
-"ran_nat xs = map_nat snd_nat (nub_nat xs)"
+"ran_nat xs = map_snd (nub_nat xs)"
 
 lemma sub_ran_nat : "ran_nat (list_encode (map prod_encode  xs)) = list_encode (ran_list xs) "
-  apply (auto simp only: ran_nat_def ran_list_def sub_nub sub_map map_map comp_def sub_snd)
+  apply (auto simp only: ran_nat_def ran_list_def submap_snd
+ sub_nub sub_map map_map comp_def sub_snd)
   done
 
 lemma sub_ran_list_helper : "distinct (map fst xs) \<Longrightarrow> 
@@ -1949,6 +1994,9 @@ lemma strips_simp:"strips_assignment_encode = prod_encode o (\<lambda>(s,b). (sa
 fun map_pair :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_pair x xs = (if xs = 0 then 0 else (prod_encode (x,hd_nat xs)) ## map_pair x (tl_nat xs))"
 
+fun map_pair_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_pair_acc acc x xs = (if xs = 0 then acc else map_pair_acc ((prod_encode (x,hd_nat xs)) ## acc) x (tl_nat xs))"
+
 lemma submap_pair:
 "map_pair (f x) (list_encode (map g xs)) = list_encode ( map (\<lambda>(x,y). prod_encode (f x, g y)) (map (Pair x) xs)) "
   apply (induct xs)
@@ -1959,9 +2007,23 @@ list_encode_eq simp del: map_pair.simps
 simp flip: list_encode.simps 
 )
   done
+
+lemma submap_pair_gen: 
+"map_pair x (list_encode xs) = list_encode  (map (prod_encode o Pair x) xs) "
+  using submap_pair[of id x id xs] apply auto
+  done 
+
+lemma submap_pair_mappair:
+"map_pair x xs = map_nat (prod_encode o Pair x) xs"
+using submap_pair_gen sub_map 
+  by (metis list_decode_inverse)
+
+
+
 fun product_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "product_nat xs ys = (if xs = 0 then 0 else append_nat (map_pair (hd_nat xs) ys) (product_nat (tl_nat xs) ys))"
 
+
 lemma sub_product:
 "product_nat (list_encode (map f xs)) (list_encode (map g ys)) 
 = list_encode (map (\<lambda>(x,y). prod_encode (f x, g y)) (List.product xs ys))"
@@ -1972,6 +2034,12 @@ lemma sub_product:
 sub_hd head.simps)
   apply (auto simp add: list_encode_eq)
   done
+
+lemma sub_product_id:
+"product_nat (list_encode xs) (list_encode ys) 
+= list_encode (map prod_encode (List.product xs ys))"
+  using sub_product[of id xs id ys] by simp
+
 lemma sub_elem_of_inj: "inj f \<Longrightarrow> (elemof (f e) (list_encode (map f l)) \<noteq> 0) = (e \<in> set l)"
   apply (induct l)
    apply simp
@@ -2049,5 +2117,143 @@ lemma subtail_filter:
   using filter_induct[of f 0 xs] 
   by (metis append_nat.simps(1) filter_nat.simps rev_rev_nat reverse_nat_0)
 
+lemma map_pair_induct :
+"map_pair_acc acc x xs = map_acc (prod_encode o Pair x) acc xs"
+  apply(induct acc x xs rule:map_pair_acc.induct)
+  apply auto
+  done
+
+definition map_pair_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_pair_tail x xs = reverse_nat (map_pair_acc 0 x xs)"
+
+lemma subtail_map_pair:
+"map_pair_tail x xs = map_pair x xs"
+  using map_pair_tail_def map_pair_induct submap_pair_mappair subtail_map by presburger
+
+fun product_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"product_acc acc xs ys = (if xs = 0 then acc else 
+product_acc (append_tail ( reverse_nat (map_pair_tail (hd_nat xs) ys)) acc ) (tl_nat xs) ys)"
+
+
+lemma product_induct:
+"product_acc acc xs ys = append_nat (reverse_nat (product_nat xs ys))  acc "
+proof -
+  obtain acc' xs' ys'  where "acc = list_encode acc'" "xs = list_encode xs'" "ys =list_encode ys'"
+    by (metis list_decode_inverse)
+  thus ?thesis using sub_product_id  apply(auto simp only: list.map_id  id_apply
+        sub_reverse sub_append  )
+    apply(induct xs' arbitrary: acc' acc xs)
+     apply simp
+    apply (subst product_acc.simps)
+    apply (auto simp add: non_empty_not_zero subtail_append sub_reverse sub_hd subtail_map_pair
+      submap_pair_mappair sub_map sub_append sub_tl 
+ simp flip: map_append 
+          simp del: product_acc.simps product_nat.simps list_encode.simps map_pair.simps map_nat.simps)
+    apply force
+    done
+
+qed
+
+definition product_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"product_tail xs ys = reverse_nat (product_acc 0 xs ys)"
+
+lemma subtail_product: 
+"product_tail xs ys = product_nat xs ys "
+  using append_nat_0 product_induct product_tail_def rev_rev_nat by presburger
+
+fun map_snd_acc  :: "nat \<Rightarrow> nat \<Rightarrow> nat " where 
+"map_snd_acc acc xs = (if xs = 0 then acc else map_snd_acc ((snd_nat (hd_nat xs)) ##acc) (tl_nat xs))"
+
+lemma map_snd_induct: 
+"map_snd_acc acc xs = map_acc snd_nat acc xs"
+  apply(induct acc xs rule:map_snd_acc.induct)
+  apply auto
+  done
+
+definition map_snd_tail :: "nat \<Rightarrow> nat" where
+"map_snd_tail xs = reverse_nat (map_snd_acc 0 xs)"
+
+lemma subtail_map_snd:
+"map_snd_tail xs = map_snd xs"
+  using map_snd_induct map_snd_tail_def submap_snd subtail_map by presburger
+
+lemma del_filter_nat:
+"del_nat xs a = filter_nat (\<lambda>x. fst_nat x \<noteq> a) xs"
+proof -
+  obtain xs' where "xs =list_encode (map prod_encode xs')"
+    by (metis list_decode_inverse map_idI map_map o_def prod_decode_inverse)
+  thus ?thesis apply (auto simp only: sub_filter filter_map comp_def sub_fst sub_del del_filter)
+    done
+qed
+
+fun del_acc :: "nat \<Rightarrow>nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"del_acc acc xs a = (if xs =0 then acc else if fst_nat (hd_nat xs) = a then del_acc acc (tl_nat xs) a else del_acc 
+  ((hd_nat xs)##acc)  (tl_nat xs) a )"
+
+lemma del_induct :
+"del_acc acc xs a = filter_acc (\<lambda>x. fst_nat x \<noteq> a) acc  xs "
+  apply(induct acc xs a rule:del_acc.induct)
+  apply auto
+  done
+
+definition del_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"del_tail xs a = reverse_nat (del_acc 0 xs a) "
+
+lemma subtail_del:
+"del_tail xs a = del_nat xs a"
+  using del_tail_def del_induct del_filter_nat subtail_filter by presburger
+
+function nub_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nub_acc acc xs = (if xs = 0 then acc else nub_acc ((hd_nat xs) ## acc) 
+      (del_tail xs (fst_nat (hd_nat xs))))"
+ by pat_completeness auto
+termination
+  apply (relation "measure (\<lambda>(acc,xs). length_nat xs)")
+   apply simp
+  apply (auto simp del: del_nat.simps)
+  subgoal for xs
+  proof -
+    assume asm:"0 < xs"
+    obtain ys where ys_def: "ys = map prod_decode (list_decode xs)" by simp
+    then have t:"xs = list_encode (map prod_encode ys)"
+      by (auto simp add: comp_def)
+    moreover have "ys \<noteq> []" using ys_def asm t by force
+    ultimately show  ?thesis  apply (auto simp only: t sub_del sub_length  length_map  sub_hd)
+      apply (auto simp add: sub_head_map sub_fst)
+      apply (cases ys)
+       apply (auto simp only: subtail_del sub_del sub_length )
+      by (auto simp add: del_shorter less_Suc_eq_le)
+  qed
+  done
+
+lemma nub_induct: 
+"nub_acc acc xs = append_nat (reverse_nat (nub_nat xs)) acc "
+proof -
+  obtain xs' acc' where "xs =list_encode (map prod_encode xs')" "acc =list_encode acc'"
+    by (metis list_decode_inverse map_idI map_map o_def prod_decode_inverse)
+  thus ?thesis apply(auto simp only: sub_nub  sub_reverse sub_append )
+    apply(induct  xs' arbitrary: xs acc' acc rule: nub.induct)
+     apply simp
+    apply(subst nub_acc.simps)
+    apply (auto simp only:subtail_del sub_del sub_hd head.simps list.simps sub_fst fst_conv sub_cons )
+    apply(auto simp only: sub_del  simp flip: list.map )
+    by (metis (no_types, lifting) append.assoc append.left_neutral
+ del.simps(2) list.simps(3) list.simps(9) list_encode.simps(1) list_encode_eq 
+nub.simps(2) rev_append rev_cons rev_rev_ident) 
+qed
+
+definition nub_tail :: "nat \<Rightarrow> nat" where 
+"nub_tail xs = reverse_nat (nub_acc 0 xs)"
+
+lemma subtail_nub:
+"nub_tail xs = nub_nat xs"
+  using append_nat_0 nub_induct nub_tail_def rev_rev_nat by presburger
+
+definition ran_tail :: "nat \<Rightarrow> nat" where 
+"ran_tail xs = map_snd_tail (nub_tail xs)"
+
+lemma subtail_ran:
+"ran_tail xs = ran_nat xs"
+  using ran_nat_def ran_tail_def subtail_map_snd subtail_nub by presburger
 
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 841fef87..053fd419 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -8,6 +8,13 @@ begin
 definition atomExp_to_constant_nat:: "nat \<Rightarrow> nat" where 
 "atomExp_to_constant_nat n = (if fst_nat n = 0 then 0 else snd_nat n)"
 
+definition atomExp_to_constant_tail:: "nat \<Rightarrow> nat" where 
+"atomExp_to_constant_tail n = atomExp_to_constant_nat n"
+
+lemma subtail_atomExp_to_constant:
+"atomExp_to_constant_tail n = atomExp_to_constant_nat n"
+  using atomExp_to_constant_tail_def by presburger
+
 lemma sub_atomExp_to_constant[simp]: "atomExp_to_constant_nat (atomExp_encode x) = atomExp_to_constant x"
   apply (cases x)
   apply (auto simp add: atomExp_to_constant_nat_def sub_fst sub_snd)
@@ -19,6 +26,17 @@ fun aexp_max_constant_nat:: "nat \<Rightarrow> nat" where
 then max (atomExp_to_constant_nat (nth_nat (Suc 0) n)) (atomExp_to_constant_nat (nth_nat (Suc (Suc 0)) n))
 else atomExp_to_constant_nat (nth_nat (Suc 0) n))"
 
+fun aexp_max_constant_tail:: "nat \<Rightarrow> nat" where
+"aexp_max_constant_tail n = (if hd_nat n \<le>2 \<and> 1 \<le> hd_nat n 
+then max (atomExp_to_constant_tail (nth_nat (Suc 0) n)) (atomExp_to_constant_tail (nth_nat (Suc (Suc 0)) n))
+else atomExp_to_constant_tail (nth_nat (Suc 0) n))"
+
+lemma subtail_aexp_max_constant:
+"aexp_max_constant_tail n = aexp_max_constant_nat n"
+  using aexp_max_constant_nat.simps aexp_max_constant_tail.simps 
+atomExp_to_constant_tail_def by presburger
+
+
 lemma sub_aexp_max_constant:"aexp_max_constant_nat (aexp_encode x) = aexp_max_constant x"
   apply (cases x)
       apply (auto simp only: aexp_max_constant_nat.simps aexp_encode.simps
@@ -52,7 +70,18 @@ declare nth_nat.simps [simp]
 
 lemma [simp]: "fst_nat 0 =0" 
   by (simp add: fst_nat_def fst_def prod_decode_aux.simps prod_decode_def)
-    
+
+datatype max_con = Bot nat|
+                   SKIP |
+                   Assign vname aexp|
+      
+fun max_constant :: "com \<Rightarrow> nat" where
+"max_constant (SKIP) = 0" |
+"max_constant (Assign vname aexp) = aexp_max_constant aexp" |
+"max_constant (Seq c1  c2) = max (max_constant c1) (max_constant c2)" |         
+"max_constant (If  _ c1 c2) = max (max_constant c1) (max_constant c2)"  |   
+"max_constant (While _ c) = max_constant c"
+
 lemma sub_max_constant:"max_constant_nat (com_encode c) = max_constant c"
   apply (subst max_constant_nat.simps)
   apply (induction c)
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
index 2495278a..c4f1ef1d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
@@ -13,6 +13,10 @@ definition max_input_bits_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Right
 "max_input_bits_nat c I r =
 bit_length (max (max (max_list_nat (ran_nat I)) r) (max_constant_nat c))"
 
+definition max_input_bits_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"max_input_bits_tail c I r =
+bit_length (max (max (max_list_tail (ran_tail I)) r) (max_constant_nat c))"
+
 lemma impm_assignment_simp:"impm_assignment_encode = prod_encode o (\<lambda>(a,b). (vname_encode a,b))"
   apply auto
   done
diff --git a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
index d1aca424..8229ccf3 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
@@ -265,13 +265,19 @@ fun map_encode_operator_precondition :: "nat \<Rightarrow> nat \<Rightarrow> nat
 )"
 
 fun map_encode_operator_precondition_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
-"map_encode_operator_precondition_acc acc t ops op vs xs = (if xs = 0 then 0 else 
+"map_encode_operator_precondition_acc acc t ops op vs xs = (if xs = 0 then acc else map_encode_operator_precondition_acc (
 ( 4 ##(2 ## (1## (1 ## t ##(index_nat ops op) ## 0)##0) ## 0 )##  (1##(0 ## t ##(index_nat vs (hd_nat xs)) ## 0)##0) ## 0)
-## map_encode_operator_precondition t ops op vs (tl_nat xs)
+## acc )t ops op vs (tl_nat xs)
 )"
 
 lemma map_encode_operator_precondition_induct:
-"map_encode_operator_precondition_acc acc t ops op vs xs = map_acc "
+"map_encode_operator_precondition_acc acc t ops op vs xs = map_acc (\<lambda>v.
+        4 ##(2 ## (1## (1 ## t ##(index_nat ops op) ## 0)##0) ## 0 )##  (1##(0 ## t ##(index_nat vs v) ## 0)##0) ## 0)
+ acc xs
+   "
+  apply(induct acc t ops op vs xs rule:map_encode_operator_precondition_acc.induct)
+  apply (auto) done
+
 
 lemma submap_encode_operator_precondition:
 "map_encode_operator_precondition t ops op vs xs = 
@@ -282,6 +288,14 @@ map_nat (\<lambda>v.
   apply auto
   done
 
+definition map_encode_operator_precondition_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+" map_encode_operator_precondition_tail t ops op vs xs = reverse_nat ( map_encode_operator_precondition_acc 0 t ops op vs xs)  "
+
+lemma subtail_map_encode_operator_precondition:
+" map_encode_operator_precondition_tail t ops op vs xs =  map_encode_operator_precondition t ops op vs xs"
+  using  map_encode_operator_precondition_tail_def  submap_encode_operator_precondition
+ map_encode_operator_precondition_induct subtail_map by presburger
+
 definition encode_operator_precondition_nat
   :: "nat
     \<Rightarrow> nat
@@ -301,9 +315,14 @@ definition encode_operator_precondition_tail
   where "encode_operator_precondition_tail \<Pi> t op \<equiv> let
       vs = nth_nat 0 \<Pi>
       ; ops = nth_nat (Suc 0) \<Pi>
-    in BigAnd_nat (map_encode_operator_precondition t ops op vs
+    in BigAnd_tail (map_encode_operator_precondition_tail t ops op vs
       (nth_nat 0 op))"
 
+lemma subtail_encode_operator_precondition:
+"encode_operator_precondition_tail p t op = encode_operator_precondition_nat p t op"
+  using encode_operator_precondition_nat_def encode_operator_precondition_tail_def subtail_BigAnd 
+subtail_map_encode_operator_precondition by presburger
+
 lemma inj_strips_op: "inj strips_operator_encode"
   using strips_operator_id 
   by (metis injI)
@@ -349,7 +368,8 @@ definition  encode_all_operator_preconditions_list
 lemma sublist_encode_all_operator_preconditions:
 "encode_all_operator_preconditions_list \<Pi> ops t = 
 encode_all_operator_preconditions (strips_list_problem_to_problem \<Pi>) ops t"
-  apply (auto simp only:encode_all_operator_preconditions_list_def encode_all_operator_preconditions_def
+  apply (auto simp only:encode_all_operator_preconditions_list_def 
+encode_all_operator_preconditions_def
         sublist_encode_operator_precondition sub_foldr
 )
   done
@@ -368,6 +388,24 @@ lemma submaps_encode_operator_precondition :
   apply auto
   done
 
+fun maps_encode_operator_precondition_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"maps_encode_operator_precondition_acc P acc xs = (if xs = 0 then acc else maps_encode_operator_precondition_acc  P   
+ ((encode_operator_precondition_tail P  (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs))) ## acc ) (tl_nat xs)
+)"
+
+lemma  maps_encode_operator_precondition_induct:
+"maps_encode_operator_precondition_acc P acc xs = map_acc (\<lambda>n. encode_operator_precondition_nat P (fst_nat n) (snd_nat n )) acc xs "
+  apply(induct P acc xs rule:maps_encode_operator_precondition_acc.induct)
+  apply (auto simp add: subtail_encode_operator_precondition)
+  done
+
+definition maps_encode_operator_precondition_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"maps_encode_operator_precondition_tail P  xs = reverse_nat (maps_encode_operator_precondition_acc P 0 xs)"
+
+lemma subtail_maps_encode_operator_precondition:
+"maps_encode_operator_precondition_tail P  xs = maps_encode_operator_precondition P xs"
+  using maps_encode_operator_precondition_induct maps_encode_operator_precondition_tail_def
+ submaps_encode_operator_precondition subtail_map by presburger
 
 definition  encode_all_operator_preconditions_nat
   :: "nat
@@ -377,6 +415,22 @@ definition  encode_all_operator_preconditions_nat
   where "encode_all_operator_preconditions_nat \<Pi> ops t \<equiv> let
       l = product_nat (list_less_nat t) ops
     in BigAnd_nat (maps_encode_operator_precondition \<Pi>  l)"
+
+definition  encode_all_operator_preconditions_tail
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_all_operator_preconditions_tail \<Pi> ops t \<equiv> let
+      l = product_tail (list_less_tail t) ops
+    in BigAnd_tail (maps_encode_operator_precondition_tail \<Pi>  l)"
+
+lemma subtail_encode_all_operator_preconditions:
+"encode_all_operator_preconditions_tail \<Pi> ops t = encode_all_operator_preconditions_nat \<Pi> ops t"
+  using encode_all_operator_preconditions_nat_def encode_all_operator_preconditions_tail_def
+ subtail_BigAnd subtail_list_less subtail_maps_encode_operator_precondition
+ subtail_product by presburger
+
 lemma case_prod_simp:"(\<lambda>x. case x of (a,b) \<Rightarrow> f a b) = (\<lambda>(x,y). f x y)"
   by simp
 
@@ -430,6 +484,20 @@ fun map_encode_operator_effect::"nat \<Rightarrow> nat \<Rightarrow> nat \<Right
 ## map_encode_operator_effect t ops op vs (tl_nat n) 
 )"
 
+fun map_encode_operator_effect_acc::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_operator_effect_acc acc t ops op vs n = (if n =0 then acc else map_encode_operator_effect_acc( 
+( 4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (1 ## (0 ## (Suc t) ## (index_nat vs (hd_nat n))## 0) ## 0) ## 0)
+## acc) t ops op vs (tl_nat n) 
+)"
+lemma map_encode_operator_effect_induct:
+"map_encode_operator_effect_acc acc t ops op vs n =  map_acc (\<lambda>v.
+             4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (1 ## (0 ## (Suc t) ## (index_nat vs v)## 0) ## 0) ## 0)  acc n"
+  apply(induct acc t ops op vs n rule: map_encode_operator_effect_acc.induct)
+  apply   auto
+  done
+
 lemma submap_encode_operator_effect:
 "map_encode_operator_effect t ops op vs n = map_nat (\<lambda>v.
              4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
@@ -438,6 +506,14 @@ lemma submap_encode_operator_effect:
   apply (auto)
   done
 
+definition map_encode_operator_effect_tail ::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+" map_encode_operator_effect_tail t ops op vs n = reverse_nat (map_encode_operator_effect_acc 0 t ops op vs n)"
+
+lemma subtail_map_encode_operator_effect :
+"map_encode_operator_effect_tail t ops op vs n = map_encode_operator_effect t ops op vs n"
+  using  map_encode_operator_effect_tail_def submap_encode_operator_effect 
+ map_encode_operator_effect_induct subtail_map by presburger
+
 fun map_encode_operator_effect2 :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_encode_operator_effect2 t ops op vs n = (if n=0 then 0 else 
 ( 4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
@@ -452,6 +528,33 @@ lemma submap_encode_operator_effect2:
   apply (auto)
   done
 
+
+fun map_encode_operator_effect2_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_operator_effect2_acc acc t ops op vs n = (if n=0 then acc else
+ map_encode_operator_effect2_acc (
+( 4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs (hd_nat n)) ## 0) ## 0) ## 0) ## 0)
+## acc) t ops op vs (tl_nat n) 
+)"
+
+lemma map_encode_operator_effect2_induct:
+"map_encode_operator_effect2_acc acc t ops op vs n = map_acc (\<lambda>v.
+             4 ## (2 ## (1 ## (1 ##  t ## (index_nat ops op)## 0) ## 0) ## 0)
+              ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0) ## 0) ## 0)  acc n "
+  apply(induct acc t ops op vs n rule: map_encode_operator_effect2_acc.induct)
+  apply auto
+  done
+
+definition  map_encode_operator_effect2_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+" map_encode_operator_effect2_tail  t ops op vs n = 
+reverse_nat (map_encode_operator_effect2_acc 0 t ops op vs n)"
+
+lemma subtail_map_encode_operator_effect2:
+"map_encode_operator_effect2_tail t ops op vs n  = map_encode_operator_effect2 t ops op vs n "
+  using  map_encode_operator_effect2_tail_def map_encode_operator_effect2_induct 
+ submap_encode_operator_effect2 subtail_map by presburger
+
+
 definition  encode_operator_effect_nat
   :: "nat
     \<Rightarrow> nat
@@ -466,6 +569,25 @@ definition  encode_operator_effect_nat
           (map_encode_operator_effect2 t ops op vs
             (nth_nat (Suc (Suc 0)) op)))"
 
+definition  encode_operator_effect_tail
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_operator_effect_tail \<Pi> t op
+    \<equiv> let
+        vs = nth_nat 0 \<Pi>
+        ; ops = nth_nat (Suc 0) \<Pi>
+      in BigAnd_tail( append_tail  (map_encode_operator_effect_tail t ops op vs
+            (nth_nat (Suc 0) op))
+          (map_encode_operator_effect2_tail t ops op vs
+            (nth_nat (Suc (Suc 0)) op)))"
+
+lemma subtail_encode_operator_effect:
+"encode_operator_effect_tail P t op = encode_operator_effect_nat P t op"
+  using encode_operator_effect_nat_def encode_operator_effect_tail_def subtail_BigAnd subtail_append
+ subtail_map_encode_operator_effect subtail_map_encode_operator_effect2 by presburger
+
 lemma subnat_encode_operator_effect:
 "encode_operator_effect_nat (strips_list_problem_encode P) t (strips_operator_encode op) = 
  sat_formula_encode (encode_operator_effect_list P t op)"
@@ -511,6 +633,23 @@ fun map_encode_all_operator_effects :: "nat \<Rightarrow> nat \<Rightarrow> nat"
 else (encode_operator_effect_nat P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs))) ##
 map_encode_all_operator_effects P (tl_nat xs)
  )"
+
+fun map_encode_all_operator_effects_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_all_operator_effects_acc acc P xs = (if xs = 0 then acc 
+else map_encode_all_operator_effects_acc( (encode_operator_effect_tail P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs))) ##
+acc) P (tl_nat xs)
+ )"
+
+lemma map_encode_all_operator_effects_induct:
+"map_encode_all_operator_effects_acc acc P xs  = map_acc
+ (\<lambda>n. encode_operator_effect_nat P (fst_nat n) (snd_nat n)) acc xs "
+  apply(induct acc P xs rule:map_encode_all_operator_effects_acc.induct)
+  apply (auto simp add:subtail_encode_operator_effect)
+  done
+
+definition  map_encode_all_operator_effects_tail:: "nat => nat => nat" where
+" map_encode_all_operator_effects_tail P xs = reverse_nat ( map_encode_all_operator_effects_acc 0 P xs)"
+
 lemma submap_encode_all_operator_effects:
 "map_encode_all_operator_effects P xs =
 map_nat (\<lambda>n. encode_operator_effect_nat P (fst_nat n) (snd_nat n)) xs "
@@ -518,6 +657,13 @@ map_nat (\<lambda>n. encode_operator_effect_nat P (fst_nat n) (snd_nat n)) xs "
   apply auto
   done
 
+lemma subtail_map_encode_all_operator_effects:
+" map_encode_all_operator_effects_tail P xs =  map_encode_all_operator_effects P xs"
+  using   map_encode_all_operator_effects_tail_def   map_encode_all_operator_effects_induct 
+submap_encode_all_operator_effects subtail_map
+  by presburger
+
+
 definition encode_all_operator_effects_nat
   :: "nat
     \<Rightarrow> nat
@@ -527,6 +673,20 @@ definition encode_all_operator_effects_nat
     \<equiv> let l = product_nat (list_less_nat t) ops
       in BigAnd_nat (map_encode_all_operator_effects P l)"
 
+definition encode_all_operator_effects_tail
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_all_operator_effects_tail P ops t
+    \<equiv> let l = product_tail (list_less_tail t) ops
+      in BigAnd_tail(map_encode_all_operator_effects_tail P l)"
+
+lemma subtail_encode_all_operator_effects:
+"encode_all_operator_effects_tail P ops t = encode_all_operator_effects_nat P ops t"
+  using encode_all_operator_effects_nat_def encode_all_operator_effects_tail_def subtail_BigAnd
+ subtail_list_less subtail_map_encode_all_operator_effects subtail_product by presburger
+
 lemma subnat_encode_all_operator_effects:
 "encode_all_operator_effects_nat (strips_list_problem_encode P) (strips_operator_list_encode ops) t
 = 
@@ -566,6 +726,18 @@ definition encode_operators_nat
     \<equiv> let ops = nth_nat (Suc 0) \<Pi>
       in 3 ## (encode_all_operator_preconditions_nat \<Pi> ops t) ## (encode_all_operator_effects_nat \<Pi> ops t) ## 0"
 
+definition encode_operators_tail
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_operators_tail \<Pi> t
+    \<equiv> let ops = nth_nat (Suc 0) \<Pi>
+      in 3 ## (encode_all_operator_preconditions_tail \<Pi> ops t) ##
+ (encode_all_operator_effects_tail \<Pi> ops t) ## 0"
+
+lemma subtail_encode_operators:
+"encode_operators_tail \<Pi> t = encode_operators_nat \<Pi> t"
+  by (simp add: encode_operators_nat_def encode_operators_tail_def 
+subtail_encode_all_operator_effects subtail_encode_all_operator_preconditions)
+
 lemma subnat_encode_operators:
 "encode_operators_nat (strips_list_problem_encode P) t =
 sat_formula_encode (encode_operators_list P t)"
@@ -609,17 +781,59 @@ lemma subfilter_del_effects:
   apply auto
   done
 
+fun filter_del_effects_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_del_effects_acc acc v ops = (if ops = 0 then acc else if 
+elemof v (nth_nat (Suc (Suc 0)) (hd_nat ops)) \<noteq> 0 then 
+filter_del_effects_acc ((hd_nat ops) ## acc) v (tl_nat ops) else  filter_del_effects_acc
+ acc v (tl_nat ops) )"
+
+lemma filter_del_effects_induct :
+"filter_del_effects_acc acc v ops = filter_acc 
+(\<lambda>op. elemof v (nth_nat (Suc (Suc 0)) op) \<noteq> 0) acc ops "
+  apply(induct acc v ops rule:filter_del_effects_acc.induct)
+  apply auto
+  done
+
+definition filter_del_effects_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_del_effects_tail v ops = reverse_nat (filter_del_effects_acc 0 v ops ) "
+
+lemma subtail_filter_del_effects:
+"filter_del_effects_tail v ops = filter_del_effects v ops "
+  using filter_del_effects_induct filter_del_effects_tail_def
+ subfilter_del_effects subtail_filter by presburger
+   
 fun map_transition :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_transition t ops xs = (if xs =0 then 0 else 
 (1 ## (1 ## t  ## (index_nat ops (hd_nat xs)) ## 0) ## 0) ## map_transition t ops (tl_nat xs)
   )"
 
+fun map_transition_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_transition_acc acc t ops xs = (if xs =0 then acc else map_transition_acc (
+(1 ## (1 ## t  ## (index_nat ops (hd_nat xs)) ## 0) ## 0) ## acc) t ops (tl_nat xs)
+  )"
+
+lemma map_transition_induct:
+"map_transition_acc acc t ops xs = map_acc 
+(\<lambda>op. 1 ## (1 ## t  ## (index_nat ops op) ## 0) ## 0) acc xs "
+  apply(induct acc t ops xs rule:map_transition_acc.induct)
+  apply auto
+  done
+
 lemma submap_transition:
 "map_transition t ops xs = map_nat (\<lambda>op. 1 ## (1 ## t  ## (index_nat ops op) ## 0) ## 0) xs"
   apply( induct t ops xs rule:map_transition.induct)
   apply auto
   done
 
+definition map_transition_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
+  where 
+"map_transition_tail t ops xs = reverse_nat (map_transition_acc 0 t ops xs)"
+
+lemma subtail_map_transition:
+"map_transition_tail t ops xs  = map_transition t ops xs "
+  using map_transition_induct map_transition_tail_def
+ submap_transition subtail_map by presburger
+
 definition  encode_negative_transition_frame_axiom_nat
   :: "nat
     \<Rightarrow> nat
@@ -633,6 +847,25 @@ definition  encode_negative_transition_frame_axiom_nat
           (4 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0 )
           ## (BigOr_nat (map_transition t ops deleting_operators)) ## 0) ## 0"
 
+definition  encode_negative_transition_frame_axiom_tail
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow>nat
+    \<Rightarrow> nat"
+  where "encode_negative_transition_frame_axiom_tail \<Pi> t v
+    \<equiv> let vs = nth_nat 0 \<Pi>
+        ; ops = nth_nat (Suc 0) \<Pi>
+        ; deleting_operators = filter_del_effects_tail v ops
+     in   4 ## ( 2 ##(1 ## (0 ## t ## (index_nat vs v) ## 0) ## 0 ) ## 0) ##
+          (4 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0 )
+          ## (BigOr_tail (map_transition_tail t ops deleting_operators)) ## 0) ## 0
+"
+lemma subtail_encode_negative_transition_frame_axiom:
+"encode_negative_transition_frame_axiom_tail P t v = encode_negative_transition_frame_axiom_nat P t v"
+  using encode_negative_transition_frame_axiom_nat_def
+ encode_negative_transition_frame_axiom_tail_def subtail_BigOr
+ subtail_filter_del_effects subtail_map_transition by presburger
+  
 lemma subnat_encode_negative_transition_frame_axiom:
 "encode_negative_transition_frame_axiom_nat (strips_list_problem_encode P) t (sas_plus_assignment_encode v) 
 = sat_formula_encode (encode_negative_transition_frame_axiom_list P t v)"
@@ -682,12 +915,31 @@ fun filter_add_effects :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 elemof v (nth_nat (Suc 0) (hd_nat ops)) \<noteq> 0 then 
 (hd_nat ops) ## filter_add_effects v (tl_nat ops) else  filter_add_effects v (tl_nat ops) )"
 
+fun filter_add_effects_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_add_effects_acc acc v ops = (if ops = 0 then acc else if  
+elemof v (nth_nat (Suc 0) (hd_nat ops)) \<noteq> 0 then  filter_add_effects_acc (
+(hd_nat ops) ## acc) v (tl_nat ops) else  filter_add_effects_acc acc v (tl_nat ops) )"
+
+lemma filter_add_effects_induct: 
+"filter_add_effects_acc acc v ops = filter_acc  (\<lambda>op. elemof v (nth_nat (Suc 0) op) \<noteq> 0) acc ops  "
+  apply(induct acc v ops rule:filter_add_effects_acc.induct)
+  apply auto
+  done
+
 lemma subfilter_add_effects:
 "filter_add_effects v ops = filter_nat (\<lambda>op. elemof v (nth_nat (Suc 0) op) \<noteq> 0) ops "
   apply(induct v ops rule:filter_add_effects.induct)
   apply auto
   done
 
+definition filter_add_effects_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_add_effects_tail v ops  = reverse_nat (filter_add_effects_acc 0 v ops)"
+
+lemma subtail_filter_add_effects:
+"filter_add_effects_tail v ops = filter_add_effects v ops"
+  using filter_add_effects_induct filter_add_effects_tail_def 
+subfilter_add_effects subtail_filter by presburger
+
 definition  encode_positive_transition_frame_axiom_nat
   :: "nat
     \<Rightarrow> nat
@@ -701,6 +953,26 @@ definition  encode_positive_transition_frame_axiom_nat
           (4 ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0 ) ## 0)
           ## (BigOr_nat (map_transition t ops adding_operators)) ## 0) ## 0"
 
+definition  encode_positive_transition_frame_axiom_tail
+  :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat"
+  where "encode_positive_transition_frame_axiom_tail \<Pi> t v
+    \<equiv> let vs = nth_nat 0 \<Pi>
+        ; ops = nth_nat (Suc 0) \<Pi>
+        ; adding_operators = filter_add_effects_tail v ops
+      in  4 ## (1 ## (0 ## t ## (index_nat vs v) ## 0) ## 0 ) ##
+          (4 ## (2 ## (1 ## (0 ## (Suc t) ## (index_nat vs v) ## 0) ## 0 ) ## 0)
+          ## (BigOr_tail (map_transition_tail t ops adding_operators)) ## 0) ## 0"
+
+lemma subtail_encode_positive_transition_frame_axiom:
+"encode_positive_transition_frame_axiom_tail P t v = encode_positive_transition_frame_axiom_nat P t v"
+  using encode_positive_transition_frame_axiom_nat_def
+ encode_positive_transition_frame_axiom_tail_def subtail_BigOr
+ subtail_filter_add_effects subtail_map_transition by presburger
+
+
 lemma subnat_encode_positive_transition_frame_axiom:
 "encode_positive_transition_frame_axiom_nat (strips_list_problem_encode P) t (sas_plus_assignment_encode v) 
 = sat_formula_encode (encode_positive_transition_frame_axiom_list P t v)"
@@ -755,6 +1027,27 @@ lemma submap_encode_negative:
   apply auto
   done
 
+fun map_encode_negative_acc ::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_negative_acc acc P xs = (if xs = 0 then acc else  map_encode_negative_acc (
+( encode_negative_transition_frame_axiom_tail P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)))##
+acc) P (tl_nat xs)
+)"
+
+lemma  map_encode_negative_induct : 
+"map_encode_negative_acc acc P xs = map_acc (\<lambda>n. encode_negative_transition_frame_axiom_nat P (fst_nat n) (snd_nat n)) acc  xs "
+  apply(induct acc P xs rule:map_encode_negative_acc.induct)
+  apply (auto simp add:subtail_encode_negative_transition_frame_axiom)
+  done
+
+
+definition map_encode_negative_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_encode_negative_tail P xs = reverse_nat ( map_encode_negative_acc 0 P xs)"
+
+lemma subtail_map_encode_negative:
+"map_encode_negative_tail P xs = map_encode_negative P xs"
+  using map_encode_negative_induct map_encode_negative_tail_def
+ submap_encode_negative subtail_map by presburger
+
 fun map_encode_positive ::"nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_encode_positive P xs = (if xs = 0 then 0 else 
 ( encode_positive_transition_frame_axiom_nat P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)))##
@@ -767,6 +1060,26 @@ lemma submap_encode_positive:
   apply auto
   done
 
+fun map_encode_positive_acc ::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_positive_acc acc P xs = (if xs = 0 then acc else  map_encode_positive_acc (
+( encode_positive_transition_frame_axiom_tail P (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)))##
+acc) P (tl_nat xs)
+)"
+
+lemma  map_encode_positive_induct : 
+"map_encode_positive_acc acc P xs = map_acc (\<lambda>n. encode_positive_transition_frame_axiom_nat P (fst_nat n) (snd_nat n)) acc  xs "
+  apply(induct acc P xs rule:map_encode_positive_acc.induct)
+  apply (auto simp add:subtail_encode_positive_transition_frame_axiom)
+  done
+
+
+definition map_encode_positive_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"map_encode_positive_tail P xs = reverse_nat ( map_encode_positive_acc 0 P xs)"
+
+lemma subtail_map_encode_positive:
+"map_encode_positive_tail P xs = map_encode_positive P xs"
+  using map_encode_positive_induct map_encode_positive_tail_def
+ submap_encode_positive subtail_map by presburger
 
 
 definition encode_all_frame_axioms_nat
@@ -775,6 +1088,20 @@ definition encode_all_frame_axioms_nat
     \<equiv> let l = product_nat (list_less_nat t) (nth_nat 0 \<Pi>)
       in BigAnd_nat ( append_nat (map_encode_negative \<Pi> l)
             (map_encode_positive \<Pi> l))"
+
+definition encode_all_frame_axioms_tail
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_all_frame_axioms_tail \<Pi> t
+    \<equiv> let l = product_tail (list_less_tail t) (nth_nat 0 \<Pi>)
+      in BigAnd_tail ( append_tail (map_encode_negative_tail \<Pi> l)
+            (map_encode_positive_tail \<Pi> l))"
+
+lemma subtail_encode_all_frame_axioms:
+"encode_all_frame_axioms_tail \<Pi> t = encode_all_frame_axioms_nat \<Pi> t"
+  using encode_all_frame_axioms_nat_def encode_all_frame_axioms_tail_def
+ subtail_BigAnd subtail_append subtail_list_less subtail_map_encode_negative 
+subtail_map_encode_positive subtail_product by presburger
+
 thm "prod.case_eq_if"
 lemma subnat_encode_all_frame_axioms:
 "encode_all_frame_axioms_nat (strips_list_problem_encode P) t =
@@ -818,6 +1145,18 @@ definition  encode_problem_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat"
         ## (3 ##(encode_all_frame_axioms_nat \<Pi> t)
      ## (encode_goal_state_nat \<Pi> t) ## 0) ## 0) ## 0"
 
+definition  encode_problem_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_problem_tail \<Pi> t
+    \<equiv> 3 ## (encode_initial_state_tail \<Pi>) ## 
+      ( 3 ## (encode_operators_tail \<Pi> t)
+        ## (3 ##(encode_all_frame_axioms_tail \<Pi> t)
+     ## (encode_goal_state_tail \<Pi> t) ## 0) ## 0) ## 0"
+
+lemma subtail_encode_problem:
+"encode_problem_tail \<Pi> t = encode_problem_nat \<Pi> t"
+  by (simp add: encode_problem_nat_def encode_problem_tail_def subtail_encode_all_frame_axioms 
+subtail_encode_goal_state subtail_encode_initial_state subtail_encode_operators)
+
 lemma subnat_encode_problem:
 "encode_problem_nat (strips_list_problem_encode P) t
 = sat_formula_encode (encode_problem_list P t)"

From c840922d7642572719a7c636ef0d777a0ebd16f7 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Tue, 31 Aug 2021 22:35:49 +0200
Subject: [PATCH 022/103] max constant refined to tail-rec

---
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy |  24 +
 .../IMP_Minus_Max_Constant_Nat.thy            | 499 +++++++++++++++---
 2 files changed, 462 insertions(+), 61 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index d9f82c8e..a6a9e281 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -109,6 +109,7 @@ fun length_nat :: "nat \<Rightarrow> nat" where
 "length_nat 0 = 0"|
 "length_nat n = Suc (length_nat (tl_nat n))"
 
+
 lemma non_empty_positive : "list_encode (a #xs) > 0" by simp
 
 lemma sub_length : "length_nat (list_encode xs) = length xs"
@@ -2256,4 +2257,27 @@ lemma subtail_ran:
 "ran_tail xs = ran_nat xs"
   using ran_nat_def ran_tail_def subtail_map_snd subtail_nub by presburger
 
+fun length_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"length_acc acc xs = (if xs = 0 then acc else length_acc (acc+1) (tl_nat xs))"
+
+lemma length_induct: 
+"length_acc acc xs = length_nat xs + acc"
+proof -
+  obtain xs' where "xs = list_encode xs'"
+    by (metis list_decode_inverse)
+  thus ?thesis apply (auto simp only: sub_length)
+    apply(induct xs' arbitrary:xs acc)
+     apply simp
+    apply(subst length_acc.simps)
+    apply( auto simp add: non_empty_positive sub_tl simp del:length_acc.simps list_encode.simps(2))
+    done
+qed
+definition length_tail :: "nat \<Rightarrow> nat" where 
+"length_tail xs = length_acc 0 xs"
+
+lemma subtail_length :
+"length_tail xs = length_nat xs"
+  using Primitives.length_induct length_tail_def by auto
+
+
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 053fd419..9ff78b05 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -58,43 +58,199 @@ lemma sum_less [simp]: "fst_nat n + snd_nat n \<le> n"
   by (simp add: prod_sum_less2)
     
 
-declare nth_nat.simps [simp del]
-fun max_constant_nat :: "nat \<Rightarrow> nat" where 
-"max_constant_nat n = (if n=0 \<or> hd_nat n = 0 then 0 else if hd_nat n = 1 
-          then aexp_max_constant_nat (nth_nat (Suc (Suc 0)) n ) else (if hd_nat n =2 then 
-          max (max_constant_nat (nth_nat (Suc 0) n)) (max_constant_nat (nth_nat (Suc (Suc 0)) n)) 
-          else (if hd_nat n =3 then 
-       max (max_constant_nat (nth_nat (Suc (Suc 0)) n)) (max_constant_nat (nth_nat (Suc (Suc (Suc 0))) n))
-        else max_constant_nat (nth_nat (Suc (Suc 0)) n ) )))"
-declare nth_nat.simps [simp]
-
 lemma [simp]: "fst_nat 0 =0" 
   by (simp add: fst_nat_def fst_def prod_decode_aux.simps prod_decode_def)
 
 datatype max_con = Bot nat|
                    SKIP |
-                   Assign vname aexp|
-      
-fun max_constant :: "com \<Rightarrow> nat" where
-"max_constant (SKIP) = 0" |
-"max_constant (Assign vname aexp) = aexp_max_constant aexp" |
-"max_constant (Seq c1  c2) = max (max_constant c1) (max_constant c2)" |         
-"max_constant (If  _ c1 c2) = max (max_constant c1) (max_constant c2)"  |   
-"max_constant (While _ c) = max_constant c"
-
-lemma sub_max_constant:"max_constant_nat (com_encode c) = max_constant c"
-  apply (subst max_constant_nat.simps)
-  apply (induction c)
-      apply (simp_all split:if_splits only: com_encode.simps sub_nth sub_hd nth.simps 
-        sub_aexp_max_constant  max_constant.simps head.simps)
-      apply auto
+                   Assign  aexp|
+                   Seq_0 "Com.com" "Com.com" |
+                   Seq_m "Com.com" "Com.com" nat|
+                   Seq_f "Com.com" "Com.com" nat nat|
+                   While_0 "Com.com"|
+                   While_f "Com.com" nat
+
+fun max_con_encode :: "max_con \<Rightarrow> nat" where 
+"max_con_encode SKIP = list_encode [0]"|
+"max_con_encode (Assign aexp) = list_encode [1,aexp_encode aexp]"|
+"max_con_encode (Seq_0 c1 c2) = list_encode [2, com_encode c1 , com_encode c2]"|
+"max_con_encode (Seq_m c1 c2 n) = list_encode [3, com_encode c1 , com_encode c2,n] "|
+"max_con_encode (Seq_f c1 c2 n m) = list_encode [4, com_encode c1 , com_encode c2,n,m] "|
+"max_con_encode (While_0 c) = list_encode [5, com_encode c]"|
+"max_con_encode (While_f c n) = list_encode[6, com_encode c ,n]"|
+"max_con_encode (Bot n) = list_encode[7,n]"
+
+
+fun push_con :: "Com.com \<Rightarrow> max_con list \<Rightarrow> max_con list " where 
+"push_con Com.com.SKIP s = SKIP # s"|
+"push_con (Com.com.Assign v a) s = Assign a # s "|
+"push_con (Com.com.Seq c1 c2) s = Seq_0 c1 c2 # s"|
+"push_con (Com.com.If _ c1 c2) s = Seq_0 c1 c2 # s"|
+"push_con (Com.com.While _ c ) s = While_0 c # s"
+
+lemma push_con_Nil:
+"push_con c s \<noteq> []"
+  apply(cases c)
+  apply auto
+  done
+
+fun push_con_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"push_con_nat c s = (let con = hd_nat c; e1 = nth_nat (Suc 0) c; e2 =nth_nat (Suc (Suc 0)) c;
+    e3 = nth_nat (Suc (Suc (Suc 0))) c in
+     if con = 0 then (0##0) ## s else 
+     if con = 1 then (1##e2##0)## s else 
+     if con = 2 then c ## s else 
+     if con = 3 then (2 ## e2 ## e3 ## 0) ## s else 
+     (5 ## e2 ## 0) ## s
+)"
+
+
+lemma sub_push_con :
+"push_con_nat (com_encode c) (list_encode (map max_con_encode s))
+= list_encode (map max_con_encode (push_con c s)) "
+  apply(cases c)
+  apply (auto simp add: sub_hd sub_cons sub_tl cons0  simp del: list_encode.simps)
+  done
+
+fun add_res :: "nat \<Rightarrow> max_con list \<Rightarrow> max_con list" where 
+"add_res n [] = [Bot n]"|
+"add_res n (Seq_0 c1 c2 # s) = Seq_m c1 c2 n # s"|
+"add_res n (Seq_m c1 c2 n0 #s) = Seq_f c1 c2 n0 n # s "|
+"add_res n (While_0 c #s) = While_f c n # s"|
+"add_res n s = s"
+
+lemma add_res_Nil:
+"add_res n s \<noteq> []"
+  apply (cases s)
+   apply auto
+  subgoal for a xs 
+    apply(cases a)
+           apply auto
+    done
   done
 
 
+fun add_res_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"add_res_nat n s = (
+  if s = 0 then  (7##n##0) ## 0
+else (let h =hd_nat s; t =tl_nat s; c = hd_nat h; e1 = nth_nat (Suc 0) h ; e2 = nth_nat (Suc (Suc 0)) h;
+e3 = nth_nat (Suc (Suc (Suc 0))) h in
+if c = 2 then (3##e1##e2##n##0)##t else 
+if c = 3 then (4##e1##e2##e3##n##0)##t else 
+if c = 5 then (6##e1##n##0)##t else s   )
+
+)"
+
+lemma sub_add_res:
+"add_res_nat n (list_encode (map max_con_encode s))
+= list_encode (map max_con_encode (add_res n s))"
+  apply (cases s)
+   apply (auto simp add:cons0 sub_cons non_empty_not_zero sub_hd sub_tl
+           simp del: list_encode.simps(2))
+  subgoal for a xs
+    apply(cases a)
+           apply( auto simp add: Let_def sub_hd cons0 sub_cons sub_tl  simp del: list_encode.simps(2))
+    done
+  done
+
+function max_constant_stack :: "max_con list \<Rightarrow> nat" where 
+"max_constant_stack (Bot x # s) = x"|
+"max_constant_stack (SKIP # s) = max_constant_stack (add_res 0 s)"|
+"max_constant_stack (Assign v # s) = max_constant_stack (add_res (aexp_max_constant v) s)"|
+"max_constant_stack (Seq_0 c1 c2 # s) = max_constant_stack (push_con c1 (Seq_0 c1 c2 # s)) "|
+"max_constant_stack (Seq_m c1 c2 n0 # s) = max_constant_stack (push_con c2  (Seq_m c1 c2 n0 # s))"|
+"max_constant_stack (Seq_f _ _ n m #s) = max_constant_stack (add_res (max n m) s)"|
+"max_constant_stack (While_0 c# s) = max_constant_stack (push_con c (While_0 c# s)) "|
+"max_constant_stack (While_f _  n# s) = max_constant_stack (add_res n s)"
+  sorry
+termination sorry
+
+
+function max_constant_stack_nat :: "nat \<Rightarrow> nat" where 
+" max_constant_stack_nat s = (let h = hd_nat s; t = tl_nat s;
+  c = hd_nat h; e1 = nth_nat (Suc 0) h; e2 = nth_nat (Suc (Suc 0)) h;
+ e3 = nth_nat (Suc (Suc (Suc 0))) h ; e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
+ if c = 0 then  max_constant_stack_nat (add_res_nat 0 t) 
+else if c = 1 then max_constant_stack_nat (add_res_nat (aexp_max_constant_tail e1) t)
+else if c = 2 then  max_constant_stack_nat (push_con_nat e1 s) 
+else if c = 3 then   max_constant_stack_nat (push_con_nat e2 s)
+else if c = 4 then   max_constant_stack_nat (add_res_nat (max e3 e4) t)
+else if c = 5 then   max_constant_stack_nat (push_con_nat e1 s) 
+else if c = 6 then  max_constant_stack_nat (add_res_nat e2 t)
+else e1)"
+  sorry
+termination sorry
+
+lemma list_encode_0:"(list_encode xs = 0) =  (xs = [])"
+  by (metis list_encode.simps(1) list_encode_inverse)
+
+
+lemma sub_max_constant_stack:
+"s \<noteq> [] \<Longrightarrow> max_constant_stack_nat (list_encode (map max_con_encode s))
+= max_constant_stack s "
+  apply(induct s rule:max_constant_stack.induct)
+         apply(subst max_constant_stack_nat.simps)
+         apply( simp add: Let_def sub_hd sub_tl 
+          del: list_encode.simps(2) max_constant_stack_nat.simps )
+ apply(subst max_constant_stack_nat.simps)
+        apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps  )
+ apply(subst max_constant_stack_nat.simps)
+        apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
+                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+ apply(subst max_constant_stack_nat.simps)
+      apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
+                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+      apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+ apply(subst max_constant_stack_nat.simps)
+      apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
+                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+     apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+ apply(subst max_constant_stack_nat.simps)
+        apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
+                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+ apply(subst max_constant_stack_nat.simps)
+      apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
+                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+     apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+ apply(subst max_constant_stack_nat.simps)
+        apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps max_constant_stack_nat.simps
+                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
+                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+  done
+
+
+lemma max_constant_stack_correct:
+"max_constant_stack (push_con c s) = max_constant_stack (add_res (max_constant c) s)"
+  apply(induct c arbitrary: s)
+  apply auto
+  done
+
+
+
+
 
 fun atomExp_var_nat:: "nat \<Rightarrow> nat" where
 "atomExp_var_nat n = (if fst_nat n = 0 then cons (snd_nat n) 0 else 0)"
 
+definition atomExp_var_tail :: "nat \<Rightarrow> nat" where 
+"atomExp_var_tail n = atomExp_var_nat n"
+
+lemma subtail_atomExp_var:
+"atomExp_var_tail n = atomExp_var_nat n"
+  using atomExp_var_tail_def by auto
 
 lemma sub_atomExp_var: "atomExp_var_nat (atomExp_encode x) = vname_list_encode (atomExp_var x)"
   apply (cases x)
@@ -108,6 +264,17 @@ definition aexp_vars_nat:: "nat \<Rightarrow> nat" where
              append_nat (atomExp_var_nat (nth_nat (Suc 0) n)) (atomExp_var_nat(nth_nat (Suc (Suc 0)) n))
                     else atomExp_var_nat (nth_nat (Suc 0) n))"
 
+definition aexp_vars_tail:: "nat \<Rightarrow> nat" where
+"aexp_vars_tail n =  ( if hd_nat n = 1 \<or> hd_nat n = 2 then
+             append_tail (atomExp_var_tail (nth_nat (Suc 0) n)) (atomExp_var_tail(nth_nat (Suc (Suc 0)) n))
+                    else atomExp_var_tail (nth_nat (Suc 0) n))"
+
+lemma subtail_aexp_vars:
+"aexp_vars_tail n = aexp_vars_nat n"
+  apply (auto simp only: aexp_vars_tail_def aexp_vars_nat_def
+            subtail_append subtail_atomExp_var )
+  done
+
 lemma sub_aexp_vars : "aexp_vars_nat (aexp_encode x) = vname_list_encode (aexp_vars x)"
   apply (cases x)
       apply (auto simp only: aexp_vars_nat_def aexp_encode.simps sub_hd head.simps sub_nth nth.simps
@@ -115,18 +282,245 @@ lemma sub_aexp_vars : "aexp_vars_nat (aexp_encode x) = vname_list_encode (aexp_v
       apply auto
   done
 
+datatype all_var = Bot "vname list"|
+                   SKIP |
+                   Assign vname  aexp  |
+                   If_0  vname  "Com.com" "Com.com" |
+                   If_m  vname "Com.com" "Com.com" "vname list"|
+                   If_f  vname "Com.com" "Com.com" "vname list" "vname list"|
+                   Seq_0 "Com.com" "Com.com" |
+                   Seq_m  "Com.com" "Com.com" "vname list"|
+                   Seq_f  "Com.com" "Com.com" "vname list" "vname list"|
+                   While_0 vname "Com.com"|
+                   While_f vname "Com.com" "vname list"
+
+fun all_var_encode :: "all_var  \<Rightarrow> nat" where 
+"all_var_encode SKIP = list_encode [0]"|
+"all_var_encode (Assign v aexp) = list_encode [1,vname_encode v,aexp_encode aexp]"|
+"all_var_encode (Seq_0 c1 c2) = list_encode [2, com_encode c1 , com_encode c2]"|
+"all_var_encode (Seq_m c1 c2 n) = list_encode [3, com_encode c1 , com_encode c2, vname_list_encode n] "|
+"all_var_encode (Seq_f c1 c2 n m) = list_encode [4, com_encode c1 , com_encode c2,vname_list_encode n, vname_list_encode m] "|
+"all_var_encode (If_0  v c1 c2) = list_encode [5, vname_encode v, com_encode c1 , com_encode c2]"|
+"all_var_encode (If_m  v c1 c2 n) = list_encode [6, vname_encode v,  com_encode c1 , com_encode c2,vname_list_encode n] "|
+"all_var_encode (If_f  v c1 c2 n m) = list_encode [7, vname_encode v, com_encode c1 , com_encode c2,vname_list_encode n, vname_list_encode m] "|
+"all_var_encode (While_0 v c) = list_encode [8,vname_encode v, com_encode c]"|
+"all_var_encode (While_f v c n) = list_encode[9, vname_encode v, com_encode c ,vname_list_encode n]"|
+"all_var_encode (Bot n) = list_encode[10, vname_list_encode n]"
+
+
+
+fun push_var :: "Com.com \<Rightarrow> all_var list \<Rightarrow> all_var list " where 
+"push_var Com.com.SKIP s = SKIP # s"|
+"push_var (Com.com.Assign v a) s = Assign v a # s "|
+"push_var (Com.com.Seq c1 c2) s = Seq_0 c1 c2 # s"|
+"push_var (Com.com.If v c1 c2) s = If_0 v c1 c2 # s"|
+"push_var (Com.com.While v c ) s = While_0 v c # s"
+
+lemma push_var_Nil:
+"push_var c s \<noteq> []"
+  apply(cases c)
+  apply auto
+  done
+
+fun push_var_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"push_var_nat c s = (let con = hd_nat c; e1 = nth_nat (Suc 0) c; e2 =nth_nat (Suc (Suc 0)) c;
+    e3 = nth_nat (Suc (Suc (Suc 0))) c in
+     if con = 0 then (0##0) ## s else 
+     if con = 1 then c ## s else 
+     if con = 2 then c ## s else 
+     if con = 3 then (5 ##e1 ## e2 ## e3 ## 0) ## s else 
+     (8 ## e1 ## e2 ## 0) ## s
+)"
+
+
+lemma sub_push_var :
+"push_var_nat (com_encode c) (list_encode (map all_var_encode s))
+= list_encode (map all_var_encode (push_var c s)) "
+  apply(cases c)
+  apply (auto simp add: sub_hd sub_cons sub_tl cons0  simp del: list_encode.simps)
+  done
+
+fun add_var :: " vname list \<Rightarrow> all_var list \<Rightarrow> all_var list" where 
+"add_var n [] = [Bot n]"|
+"add_var vs (Seq_0 c1 c2 # s) = Seq_m c1 c2 vs # s"|
+"add_var vs' (Seq_m c1 c2 vs #s) = Seq_f c1 c2 vs vs' # s "|
+"add_var vs  (If_0 v c1 c2 # s) = If_m v c1 c2 vs # s"|
+"add_var vs' (If_m v c1 c2 vs #s) = If_f v c1 c2 vs vs' # s "|
+"add_var vs' (While_0 v c #s) = While_f v c vs'  # s"|
+"add_var vs' s = s"
+
+lemma add_var_Nil:
+"add_var n s \<noteq> []"
+  apply (cases s)
+   apply auto
+  subgoal for a xs 
+    apply(cases a)
+           apply auto
+    done
+  done
+
+
+fun add_var_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"add_var_nat n s = (
+  if s = 0 then  (10##n##0) ## 0
+else (let h =hd_nat s; t =tl_nat s; c = hd_nat h; e1 = nth_nat (Suc 0) h ; e2 = nth_nat (Suc (Suc 0)) h;
+e3 = nth_nat (Suc (Suc (Suc 0))) h; e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h  in
+if c = 2 then (3##e1##e2##n##0)##t else 
+if c = 3 then (4##e1##e2##e3##n##0)##t else 
+if c = 5 then (6##e1##e2##e3##n ##0)##t else 
+if c = 6 then (7##e1##e2##e3##e4 ## n ##0)##t else 
+if c = 8 then (9##e1##e2##n##0)##t else s   )
+
+)"
+
+lemma sub_add_var:
+"add_var_nat (vname_list_encode n) (list_encode (map all_var_encode s))
+= list_encode (map all_var_encode (add_var n s))"
+  apply (cases s)
+   apply (auto simp add:cons0 sub_cons non_empty_not_zero sub_hd sub_tl
+           simp del: list_encode.simps(2))
+  subgoal for a xs
+    apply(cases a)
+           apply( auto simp add: Let_def sub_hd cons0 sub_cons sub_tl  simp del: list_encode.simps(2))
+    done
+  done
+
+function all_variables_stack :: "all_var list \<Rightarrow>vname list" where 
+"all_variables_stack (Bot x # s) = x"|
+"all_variables_stack (SKIP # s) = all_variables_stack (add_var [] s)"|
+"all_variables_stack (Assign v a # s) = all_variables_stack (add_var (v # aexp_vars a) s)"|
+"all_variables_stack (Seq_0 c1 c2 # s) = all_variables_stack (push_var c1 (Seq_0 c1 c2 # s)) "|
+"all_variables_stack (Seq_m c1 c2 n0 # s) =all_variables_stack (push_var c2  (Seq_m c1 c2 n0 # s))"|
+"all_variables_stack (Seq_f _ _ n m #s) = all_variables_stack (add_var (n @ m) s)"|
+"all_variables_stack (If_0 v c1 c2 # s) = all_variables_stack (push_var c1 (If_0  v c1 c2 # s)) "|
+"all_variables_stack (If_m v c1 c2 n0 # s) =all_variables_stack (push_var c2  (If_m v c1 c2 n0 # s))"|
+"all_variables_stack (If_f v _ _ n m #s) = all_variables_stack (add_var (v # n @ m) s)"|
+"all_variables_stack (While_0 v c# s) = all_variables_stack (push_var c (While_0 v c# s)) "|
+"all_variables_stack (While_f v _  n# s) = all_variables_stack (add_var (v#n) s)"
+  sorry
+termination sorry
+
+function all_variables_stack_nat :: "nat \<Rightarrow> nat" where 
+"  all_variables_stack_nat s = (let h = hd_nat s; t = tl_nat s;
+  c = hd_nat h; e1 = nth_nat (Suc 0) h; e2 = nth_nat (Suc (Suc 0)) h;
+ e3 = nth_nat (Suc (Suc (Suc 0))) h ; e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h; e5 = 
+  nth_nat (Suc (Suc (Suc (Suc (Suc  0))))) h in 
+ if c = 0 then all_variables_stack_nat (add_var_nat 0 t) 
+else if c = 1 then all_variables_stack_nat (add_var_nat (e1 ## aexp_vars_tail e2) t)
+else if c = 2 then  all_variables_stack_nat (push_var_nat e1 s) 
+else if c = 3 then   all_variables_stack_nat (push_var_nat e2 s)
+else if c = 4 then   all_variables_stack_nat (add_var_nat (append_nat e3 e4) t)
+else if c = 5 then   all_variables_stack_nat (push_var_nat e2 s)
+else if c = 6 then   all_variables_stack_nat (push_var_nat e3 s)  
+else if c = 7 then   all_variables_stack_nat (add_var_nat (e1 ## append_nat e4 e5) t)
+else if c = 8 then   all_variables_stack_nat (push_var_nat e2 s)
+else if c = 9 then  all_variables_stack_nat (add_var_nat (e1 ## e3) t)
+else e1)"
+  sorry
+termination sorry
+
+
+lemma all_variables_stack_correct:
+"all_variables_stack (push_var c s) = all_variables_stack (add_var(all_variables c) s)"
+  apply(induct c arbitrary: s)
+  apply auto
+  done
+lemma vname_list_encode_Nil: "vname_list_encode [] = 0" 
+  apply (auto simp add: vname_list_encode_def)
+  done
+
+lemma sub_all_variables_stack:
+"s \<noteq> [] \<Longrightarrow> all_variables_stack_nat (list_encode (map all_var_encode s))
+= vname_list_encode (all_variables_stack s) "
+  apply(induct s rule: all_variables_stack.induct)
+         apply(subst all_variables_stack_nat.simps)
+         apply( simp add: Let_def sub_hd sub_tl 
+          del: list_encode.simps(2) all_variables_stack_nat.simps )
+ apply(subst all_variables_stack_nat.simps)
+           apply( simp add: sub_add_var Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+                  flip: vname_list_encode_Nil
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps  )
+ apply(subst all_variables_stack_nat.simps)
+        apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def  del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+ apply(subst all_variables_stack_nat.simps)
+      apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+      apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+ apply(subst all_variables_stack_nat.simps)
+      apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+        apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+ apply(subst all_variables_stack_nat.simps)
+        apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+apply(subst all_variables_stack_nat.simps)
+      apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+      apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+ apply(subst all_variables_stack_nat.simps)
+      apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+        apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+ apply(subst all_variables_stack_nat.simps)
+        apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+ apply(subst all_variables_stack_nat.simps)
+      apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+        apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+ apply(subst all_variables_stack_nat.simps)
+        apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
+                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+  done
+
+definition all_variables_t :: "Com.com \<Rightarrow> vname list" where 
+" all_variables_t c =  all_variables_stack (push_var c [])"
+
+definition  all_variables_nat :: "nat \<Rightarrow> nat" where 
+" all_variables_nat c =  all_variables_stack_nat (push_var_nat c 0)"
+
+lemma subtailnat_all_variables:
+" all_variables_nat (com_encode c) =  vname_list_encode (all_variables_t c)"
+  by (metis all_variables_nat_def all_variables_t_def list.map(1) list_encode.simps(1) 
+push_var_Nil sub_all_variables_stack sub_push_var)
+
+
+lemma subt_all_variables:
+"all_variables_t c = all_variables c"
+  using all_variables_t_def  all_variables_stack_correct push_var_Nil
+  by simp 
+
+
+lemma sub_all_variables:"all_variables_nat (com_encode c) = vname_list_encode (all_variables c)"
+  by (simp add: subt_all_variables subtailnat_all_variables)
+
+definition all_variables_tail :: "nat \<Rightarrow> nat" where 
+"all_variables_tail  c = all_variables_nat c"
+
+lemma subtail_max_constant:
+"all_variables_tail  c = all_variables_nat c"
+  by (simp add: all_variables_tail_def)
 
 
-declare nth_nat.simps[simp del]
-fun all_variables_nat :: "nat \<Rightarrow> nat" where
-"all_variables_nat n = (if n=0 \<or> hd_nat n =0 then 0 else if hd_nat n = 1 then cons (nth_nat (Suc 0) n) 
-(aexp_vars_nat (nth_nat (Suc (Suc 0)) n )) else if hd_nat n = 2
-then append_nat (all_variables_nat (nth_nat (Suc 0) n)) (all_variables_nat (nth_nat (Suc (Suc 0)) n))
-else if hd_nat n = 3 then
- append_nat (append_nat (cons (nth_nat (Suc 0) n) 0) (all_variables_nat (nth_nat (Suc (Suc 0)) n)))
- (all_variables_nat(nth_nat (Suc (Suc (Suc 0))) n))
-else append_nat (cons (nth_nat (Suc 0) n) 0)  (all_variables_nat (nth_nat (Suc (Suc 0)) n)) )"
-declare nth_nat.simps[simp]
 
 lemma sub_cons_vname: "cons (vname_encode x) (vname_list_encode xs) = vname_list_encode (x#xs)"
   apply (auto simp add:cons_def vname_list_encode_def) done
@@ -135,39 +529,22 @@ lemma sub_append_vname: "append_nat (vname_list_encode x) (vname_list_encode xs)
    apply (auto simp add: vname_list_encode_def sub_append simp flip: list_encode.simps)
   done
 
-lemma sub_all_variables: "all_variables_nat (com_encode x ) = vname_list_encode (all_variables x)"
-  apply (induct x)
-  apply (subst all_variables_nat.simps)
-      apply (auto simp only: com_encode.simps)
-      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
-              vname_list_encode_def sub_append sub_cons cons0)
-      apply simp
- apply (subst all_variables_nat.simps)
-      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
-              vname_list_encode_def sub_append sub_cons cons0)
-     apply simp
- apply (subst all_variables_nat.simps)
-      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
-              vname_list_encode_def sub_append sub_cons cons0)
-    apply simp
- apply (subst all_variables_nat.simps)
-      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
-              vname_list_encode_def sub_append sub_cons cons0)
-   apply simp
- apply (subst all_variables_nat.simps)
-      apply (auto simp only:sub_hd sub_nth head.simps nth.simps sub_aexp_vars 
-              vname_list_encode_def sub_append sub_cons cons0)
-  apply simp
-  done
 
 
 
-    
-   
 
 definition num_variables_nat :: "nat \<Rightarrow> nat" where 
 "num_variables_nat n = length_nat (remdups_nat (all_variables_nat n))"
 
+definition num_variables_tail :: "nat \<Rightarrow> nat" where 
+"num_variables_tail n = length_tail (remdups_tail (all_variables_tail n))"
+
+lemma subtail_num_variables:
+"num_variables_tail n = num_variables_nat n"
+  sledgehammer
+  by (simp add: all_variables_tail_def num_variables_nat_def 
+num_variables_tail_def subtail_length subtail_remdups)
+
 lemma vname_encode_eq: "vname_encode x = vname_encode y \<Longrightarrow> x=y"
   apply (auto simp add:vname_encode_def list_encode_eq idchar)
   by (metis vname_encode_def vname_id)

From f1f97ece3724f607cce435d9b7512e72d5d75bd2 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Wed, 1 Sep 2021 00:48:33 +0200
Subject: [PATCH 023/103] finished refinement to tail-rec

---
 .../IMP_Minus_Max_Constant_Nat.thy            |  30 ++-
 .../IMP_Minus_To_SAS_Plus_Nat.thy             | 100 +++++++-
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     | 227 +++++++++++++++++-
 .../IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy      |   1 -
 4 files changed, 345 insertions(+), 13 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 9ff78b05..7e53e054 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -516,10 +516,37 @@ lemma sub_all_variables:"all_variables_nat (com_encode c) = vname_list_encode (a
 definition all_variables_tail :: "nat \<Rightarrow> nat" where 
 "all_variables_tail  c = all_variables_nat c"
 
-lemma subtail_max_constant:
+lemma subtail_all_variables:
 "all_variables_tail  c = all_variables_nat c"
   by (simp add: all_variables_tail_def)
 
+definition max_constant_t :: "Com.com \<Rightarrow>nat" where 
+" max_constant_t c =  max_constant_stack (push_con c [])"
+
+definition  max_constant_nat :: "nat \<Rightarrow> nat" where 
+" max_constant_nat c =  max_constant_stack_nat (push_con_nat c 0)"
+
+lemma subtailnat_max_constant:
+" max_constant_nat (com_encode c) =   (max_constant_t c)"
+  by (metis max_constant_nat_def max_constant_t_def list.map(1) list_encode.simps(1) 
+push_con_Nil sub_max_constant_stack sub_push_con)
+
+
+lemma subt_max_constant:
+"max_constant_t c = max_constant c"
+  using max_constant_t_def  max_constant_stack_correct push_var_Nil
+  by simp 
+
+
+lemma sub_max_constant:"max_constant_nat (com_encode c) = (max_constant c)"
+  by (simp add: subt_max_constant subtailnat_max_constant)
+
+definition max_constant_tail :: "nat \<Rightarrow> nat" where 
+"max_constant_tail  c = max_constant_nat c"
+
+lemma subtail_max_constant:
+"max_constant_tail  c = max_constant_nat c"
+  by (simp add: max_constant_tail_def)
 
 
 lemma sub_cons_vname: "cons (vname_encode x) (vname_list_encode xs) = vname_list_encode (x#xs)"
@@ -541,7 +568,6 @@ definition num_variables_tail :: "nat \<Rightarrow> nat" where
 
 lemma subtail_num_variables:
 "num_variables_tail n = num_variables_nat n"
-  sledgehammer
   by (simp add: all_variables_tail_def num_variables_nat_def 
 num_variables_tail_def subtail_length subtail_remdups)
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
index c4f1ef1d..9a0723a2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
@@ -15,7 +15,12 @@ bit_length (max (max (max_list_nat (ran_nat I)) r) (max_constant_nat c))"
 
 definition max_input_bits_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat\<Rightarrow> nat" where 
 "max_input_bits_tail c I r =
-bit_length (max (max (max_list_tail (ran_tail I)) r) (max_constant_nat c))"
+bit_length (max (max (max_list_tail (ran_tail I)) r) (max_constant_tail c))"
+
+lemma subtail_max_input_bits:
+"max_input_bits_tail c I r = max_input_bits_nat c I r "
+  using max_constant_tail_def max_input_bits_nat_def max_input_bits_tail_def
+ subtail_max_list subtail_ran by presburger
 
 lemma impm_assignment_simp:"impm_assignment_encode = prod_encode o (\<lambda>(a,b). (vname_encode a,b))"
   apply auto
@@ -71,6 +76,22 @@ definition IMP_Minus_initial_to_IMP_Minus_Minus_nat::" nat
  else (if v = vname_encode ''carry'' then Suc 0 
   else (IMP_Minus_State_To_IMP_Minus_Minus_partial_nat I n guess_range) v))" 
 
+definition IMP_Minus_initial_to_IMP_Minus_Minus_tail::" nat 
+  \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"IMP_Minus_initial_to_IMP_Minus_Minus_tail I n guess_range v =
+  (let p = var_to_operand_bit_tail v; v' = fst_nat (p-1) ; k = snd_nat (p-1) in if
+    p \<noteq> 0 \<and> v' = encode_char (CHR ''a'') then 
+    if k < n then Suc 0 else 0 else if  p \<noteq> 0 \<and> v' = encode_char (CHR ''b'')
+   then if k < n then Suc 0 else 0  
+ else (if v = vname_encode ''carry'' then Suc 0 
+  else (IMP_Minus_State_To_IMP_Minus_Minus_partial_tail I n guess_range) v))"
+
+lemma subtail_IMP_Minus_initial_to_IMP_Minus_Minus:
+"IMP_Minus_initial_to_IMP_Minus_Minus_tail I n guess_range v = 
+IMP_Minus_initial_to_IMP_Minus_Minus_nat I n guess_range v"
+  using IMP_Minus_initial_to_IMP_Minus_Minus_nat_def IMP_Minus_initial_to_IMP_Minus_Minus_tail_def 
+subtail_IMP_Minus_State_To_IMP_Minus_Minus_partial subtail_var_to_operand_bit by presburger
+
 lemma subnat_IMP_Minus_initial_to_IMP_Minus_Minus:
 "IMP_Minus_initial_to_IMP_Minus_Minus_nat (impm_assignment_list_encode I) n guess_range 
 (vname_encode v) = 
@@ -135,14 +156,52 @@ lemma submap_IMP_Minus_State_To_IMP_Minus_Minus_partial :
   apply(induct I  n guess_range x rule: map_IMP_Minus_State_To_IMP_Minus_Minus_partial.induct)
   apply auto
   done
+fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc acc I n guess_range x = (if x =0 then acc else  map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc (
+( prod_encode(hd_nat x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat I n guess_range (hd_nat x)))## acc) I n guess_range (tl_nat x) )"
+
+lemma map_IMP_Minus_State_To_IMP_Minus_Minus_partial_induct:
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc acc  I n guess_range x = 
+ map_acc (\<lambda>x. prod_encode(x,IMP_Minus_State_To_IMP_Minus_Minus_partial_nat I n guess_range x)) acc x  "
+  apply(induct acc I n guess_range x rule: map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc.induct)
+  apply auto
+  done
+
+definition map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail ::"nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail   I n guess_range x =
+reverse_nat (map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc 0  I n guess_range x)  "
+
+lemma subtail_map_IMP_Minus_State_To_IMP_Minus_Minus_partial:
+"map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail   I n guess_range x =
+map_IMP_Minus_State_To_IMP_Minus_Minus_partial   I n guess_range x "
+  using IMP_Minus_To_SAS_Plus_Nat.map_IMP_Minus_State_To_IMP_Minus_Minus_partial_induct 
+IMP_Minus_To_SAS_Plus_Nat.map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail_def
+ IMP_Minus_To_SAS_Plus_Nat.submap_IMP_Minus_State_To_IMP_Minus_Minus_partial 
+subtail_map by presburger
 
-fun filter_none :: "nat \<Rightarrow> nat" where 
+fun filter_none :: "nat \<Rightarrow> nat" where
 "filter_none n = (if n =0 then 0 else if snd_nat (hd_nat n) \<noteq> 0 then (hd_nat n) ## (filter_none (tl_nat n)) else filter_none (tl_nat n))"
+
+fun filter_none_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_none_acc acc n = (if n =0 then acc else if snd_nat (hd_nat n) \<noteq> 0 then filter_none_acc ((hd_nat n) ## acc) (tl_nat n) else filter_none_acc acc (tl_nat n))"
+
 lemma subfilter_none :
 "filter_none n = filter_nat (\<lambda>n . snd_nat n \<noteq> 0) n"
   apply (induct n rule: filter_none.induct)
   apply auto
   done
+lemma filter_none_induct : 
+"filter_none_acc acc n = filter_acc (\<lambda>n . snd_nat n \<noteq> 0) acc n"
+  apply(induct acc n rule:filter_none_acc.induct)
+  apply auto
+  done
+
+definition filter_none_tail :: "nat \<Rightarrow> nat" where 
+"filter_none_tail n = reverse_nat (filter_none_acc 0 n)"
+
+lemma subtail_filter_none:
+"filter_none_tail n = filter_none n"
+  using filter_none_induct filter_none_tail_def subfilter_none subtail_filter by presburger
 
 fun map_prod_the :: "nat \<Rightarrow> nat" where 
 "map_prod_the n = (if n = 0 then 0 else (prod_encode(fst_nat (hd_nat n), the_nat (snd_nat (hd_nat n)))) ## map_prod_the(tl_nat n) )"
@@ -153,6 +212,22 @@ lemma submap_prod_the:
   apply auto
   done
 
+fun map_prod_the_acc :: "nat\<Rightarrow> nat \<Rightarrow> nat" where 
+"map_prod_the_acc acc n = (if n = 0 then acc else map_prod_the_acc ( (prod_encode(fst_nat (hd_nat n), the_nat (snd_nat (hd_nat n)))) ## acc) (tl_nat n) )"
+
+lemma map_prod_the_induct:
+"map_prod_the_acc acc n = map_acc (\<lambda>n. prod_encode(fst_nat n, the_nat (snd_nat n))) acc n "
+  apply(induct acc n rule:map_prod_the_acc.induct)
+  apply auto
+  done
+
+definition map_prod_the_tail :: "nat \<Rightarrow> nat" where 
+"map_prod_the_tail n = reverse_nat (map_prod_the_acc 0 n)"
+
+lemma subtail_map_prod_the:
+"map_prod_the_tail n = map_prod_the n"
+  using map_prod_the_induct map_prod_the_tail_def submap_prod_the subtail_map by presburger
+
 definition IMP_Minus_to_SAS_Plus_nat:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat
   \<Rightarrow>  nat \<Rightarrow> nat" where
 "IMP_Minus_to_SAS_Plus_nat c I r G t = (let 
@@ -168,6 +243,27 @@ map_prod_the (filter_none (map_IMP_Minus_State_To_IMP_Minus_Minus_partial I n gu
   SAS_Plus_Plus_To_SAS_Plus_nat (imp_minus_minus_to_sas_plus_nat c' I' G'))"
 
 
+definition IMP_Minus_to_SAS_Plus_tail:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat
+  \<Rightarrow>  nat \<Rightarrow> nat" where
+"IMP_Minus_to_SAS_Plus_tail c I r G t = (let 
+  guess_range = max_input_bits_tail c I r;
+  n = t + guess_range + 1;
+  c' = IMP_Minus_To_IMP_Minus_Minus_tail c n;
+  I' = 
+map_prod_the_tail (filter_none_tail (map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail I n guess_range (enumerate_variables_tail c')))
+;
+
+  G' = map_prod_the_tail (filter_none_tail (map_IMP_Minus_State_To_IMP_Minus_Minus_partial_tail G n n (enumerate_variables_tail c')))
+ in
+  SAS_Plus_Plus_To_SAS_Plus_tail (imp_minus_minus_to_sas_plus_tail c' I' G'))"
+
+lemma subtail_IMP_Minus_to_SAS_Plus:
+"IMP_Minus_to_SAS_Plus_tail c I r G t = IMP_Minus_to_SAS_Plus_nat c I r G t "
+  using IMP_Minus_To_IMP_Minus_Minus_tail_def
+ IMP_Minus_To_SAS_Plus_Nat.subtail_map_IMP_Minus_State_To_IMP_Minus_Minus_partial 
+IMP_Minus_to_SAS_Plus_nat_def IMP_Minus_to_SAS_Plus_tail_def subtail_SAS_Plus_Plus_To_SAS_Plus 
+subtail_enumerate_variables subtail_filter_none subtail_imp_minus_minus_to_sas_plus
+ subtail_map_prod_the subtail_max_input_bits by presburger
 
 lemma thef_bit_option_lambda:"
 map (\<lambda>x. prod_encode
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
index b9e02516..b39ce3d7 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -49,6 +49,9 @@ qed
 fun poly_of_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "poly_of_nat p x = (if snd_nat p = 0 then fst_nat p else x * poly_of_nat (prod_encode (fst_nat p,snd_nat p -1)) x)"
 
+fun poly_of_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"poly_of_acc acc p x = (if snd_nat p = 0 then acc else poly_of_acc  (x *acc) (prod_encode (fst_nat p,snd_nat p -1)) x)"
+
 lemma sub_poly_of: "poly_of_nat (prod_encode p) x = poly_of p x"
   apply (cases p)
   apply (auto simp only:)
@@ -61,9 +64,44 @@ lemma sub_poly_of: "poly_of_nat (prod_encode p) x = poly_of p x"
     done
   done
 
+
+lemma poly_of_induct:
+"poly_of_acc acc p x = poly_of_nat (prod_encode (acc,snd_nat p)) x"
+proof -
+
+  obtain a n where p_def:"p = prod_encode (a,n)"
+    by (metis prod_decode_inverse surj_pair)
+   have helper:"\<forall>m acc. poly_of (x * acc,m) x = x * poly_of (acc,m) x"
+     apply auto subgoal for m acc
+        apply(induct m) apply auto done done
+   from p_def show ?thesis apply(auto simp only: sub_snd snd_conv sub_poly_of)
+    apply (induct n arbitrary: p  acc a)
+     apply(subst poly_of_acc.simps)
+     apply(auto simp add: sub_snd simp del: poly_of_acc.simps)
+     apply(subst poly_of_acc.simps)
+    apply(auto simp add: helper sub_fst sub_snd simp del: poly_of_acc.simps)
+     done
+    
+qed
+
+definition poly_of_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"poly_of_tail p x = poly_of_acc (fst_nat p) p x"
+
+lemma subtail_poly_of:
+"poly_of_tail p x = poly_of_nat p x"
+  by (metis add.right_neutral add_eq_if poly_of.simps(1)
+ poly_of.simps(2) poly_of_induct poly_of_nat.simps poly_of_tail_def sub_poly_of)
+
 definition t'_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "t'_nat pt p_cer x = poly_of_nat pt (bit_length x + poly_of_nat p_cer (bit_length x)) + 1"
 
+definition t'_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"t'_tail pt p_cer x = poly_of_tail pt (bit_length x + poly_of_tail p_cer (bit_length x)) + 1"
+
+lemma subtail_t':
+"t'_tail pt p_cer x = t'_nat pt p_cer x"
+  using subtail_poly_of t'_nat_def t'_tail_def by presburger
+
 lemma subnat_t': 
 "t'_nat (prod_encode pt) (prod_encode p_cer) x = t'_pair pt p_cer x"
   apply (auto simp only:t'_nat_def t'_pair_def sub_poly_of)
@@ -77,6 +115,11 @@ lemma sub_empty_sasp_action: "empty_sasp_action_nat = operator_plus_encode empty
         simp flip: list_encode.simps)
    apply auto
   done
+definition "empty_sasp_action_tail \<equiv> (0 ## 0 ## 0)"
+lemma subtail_empty_sasp_action:
+"empty_sasp_action_tail =empty_sasp_action_nat"
+  using empty_sasp_action_nat_def empty_sasp_action_tail_def by force
+
 
 definition
   "prob_with_noop_list \<Pi> \<equiv>
@@ -95,6 +138,15 @@ definition prob_with_noop_nat :: "nat \<Rightarrow> nat" where
   "prob_with_noop_nat p = (nth_nat 0 p) ## ( empty_sasp_action_nat ##  (nth_nat (Suc 0) p))
 ## (tl_nat (tl_nat p))"
 
+definition prob_with_noop_tail :: "nat \<Rightarrow> nat" where 
+  "prob_with_noop_tail p = (nth_nat 0 p) ## ( empty_sasp_action_tail ##  (nth_nat (Suc 0) p))
+## (tl_nat (tl_nat p))"
+
+
+lemma subtail_prob_with_noop:
+"prob_with_noop_tail p =prob_with_noop_nat p"
+  using prob_with_noop_nat_def prob_with_noop_tail_def subtail_empty_sasp_action by presburger
+
 lemma subnat_prob_with_noop: 
 "prob_with_noop_nat (list_problem_plus_encode p) = 
  list_problem_plus_encode (prob_with_noop_list p)"
@@ -134,6 +186,18 @@ definition encode_interfering_operator_pair_exclusion_nat
     \<equiv> let ops = nth_nat (Suc 0)  p in
      4 ## (2 ## (1 ## (1 ## k ## (index_nat ops o1)## 0) ## 0) ## 0)
       ## (2 ## (1 ## (1  ## k ## (index_nat ops o2) ## 0) ## 0) ## 0) ## 0"
+definition encode_interfering_operator_pair_exclusion_tail :: "nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat
+    \<Rightarrow> nat" where 
+"encode_interfering_operator_pair_exclusion_tail p k o1 o2 =
+encode_interfering_operator_pair_exclusion_nat p k o1 o2 "
+
+lemma subtail_encode_interfering_operator_pair_exclusion:
+"encode_interfering_operator_pair_exclusion_tail p k o1 o2 =
+encode_interfering_operator_pair_exclusion_nat p k o1 o2 "
+  using encode_interfering_operator_pair_exclusion_tail_def by presburger
 
 lemma subnat_encode_interfering_operator_pair_exclusion:
 "encode_interfering_operator_pair_exclusion_nat (strips_list_problem_encode p) k
@@ -153,6 +217,14 @@ fun list_inter :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "list_inter xs ys = (if xs = 0 then 0 
 else if elemof (hd_nat xs) ys \<noteq> 0 then 1 else list_inter (tl_nat xs) ys)"
 
+definition list_inter_tail ::  "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"list_inter_tail xs ys = list_inter xs ys"
+
+lemma subtail_list_inter:
+"list_inter_tail xs ys = list_inter xs ys"
+  using list_inter_tail_def by presburger
+
+
 lemma list_encode_pos:"(list_encode xs > 0) = (xs \<noteq> []) "
   using list_encode_empty by force
 
@@ -182,6 +254,15 @@ definition are_operators_interfering_nat :: "nat \<Rightarrow> nat \<Rightarrow>
 if list_inter (nth_nat (Suc (Suc 0)) o1) (nth_nat 0 o2) \<noteq> 0  \<or> 
     list_inter (nth_nat 0 o1) (nth_nat (Suc (Suc 0)) o2) \<noteq> 0 then 1 else 0 "
 
+definition are_operators_interfering_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"are_operators_interfering_tail o1 o2 \<equiv>
+if list_inter_tail (nth_nat (Suc (Suc 0)) o1) (nth_nat 0 o2) \<noteq> 0  \<or> 
+    list_inter_tail (nth_nat 0 o1) (nth_nat (Suc (Suc 0)) o2) \<noteq> 0 then 1 else 0 "
+lemma subtail_are_operators_interfering:
+"are_operators_interfering_tail o1 o2 = are_operators_interfering_nat o1 o2"
+  using are_operators_interfering_nat_def are_operators_interfering_tail_def 
+list_inter_tail_def by presburger
+
 lemma sub_are_operators_interfering:
 "(are_operators_interfering_nat (strips_operator_encode o1) (strips_operator_encode o2) > 0) =
  (are_operators_interfering o1 o2)"
@@ -215,12 +296,33 @@ fun filter_interfering:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "filter_interfering ops xs = (if xs = 0 then 0 else if index_nat ops (fst_nat (hd_nat xs)) \<noteq> index_nat ops (snd_nat (hd_nat xs))
         \<and> are_operators_interfering_nat (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)) \<noteq> 0 then (hd_nat xs) ## filter_interfering ops (tl_nat xs) else  filter_interfering ops (tl_nat xs))"
 
+fun filter_interfering_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"filter_interfering_acc acc ops xs = (if xs = 0 then acc else if index_nat ops (fst_nat (hd_nat xs)) \<noteq> index_nat ops (snd_nat (hd_nat xs))
+        \<and> are_operators_interfering_tail (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)) \<noteq> 0 then filter_interfering_acc ((hd_nat xs) ## acc) ops (tl_nat xs) else  filter_interfering_acc acc ops (tl_nat xs))"
+
+lemma filter_interfering_induct:
+"filter_interfering_acc acc ops xs  = filter_acc  (\<lambda>n. index_nat ops (fst_nat n) \<noteq> index_nat ops (snd_nat n)
+        \<and> are_operators_interfering_nat (fst_nat n) (snd_nat n) \<noteq> 0 ) acc xs "
+  apply(induct acc ops xs rule:filter_interfering_acc.induct)
+  apply (auto simp add:subtail_are_operators_interfering)
+  done
+
+
 lemma subfilter_interfering:
 "filter_interfering ops xs = filter_nat (\<lambda>n. index_nat ops (fst_nat n) \<noteq> index_nat ops (snd_nat n)
         \<and> are_operators_interfering_nat (fst_nat n) (snd_nat n) \<noteq> 0 ) xs"
   apply (induct ops xs rule:filter_interfering.induct)
   apply (auto simp del:index_nat.simps)
   done
+
+definition filter_interfering_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"filter_interfering_tail ops xs = reverse_nat (filter_interfering_acc 0 ops xs )  "
+
+lemma subtail_filter_interfering:
+"filter_interfering_tail ops xs = filter_interfering ops xs "
+  using filter_interfering_induct filter_interfering_tail_def subfilter_interfering subtail_filter
+  by presburger
+
 fun map_encode_interfering :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_encode_interfering p n xs = (if xs = 0 then 0 else (encode_interfering_operator_pair_exclusion_nat p (hd_nat xs) (fst_nat n) (snd_nat n)) 
 ## map_encode_interfering p n (tl_nat xs))"
@@ -229,11 +331,36 @@ lemma submap_encode_interfering:
   apply (induct p n xs rule: map_encode_interfering.induct)
   apply auto
   done
+fun map_encode_interfering_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_encode_interfering_acc acc  p n xs = (if xs = 0 then acc else
+map_encode_interfering_acc ((encode_interfering_operator_pair_exclusion_nat p (hd_nat xs) (fst_nat n) (snd_nat n)) 
+## acc) p n (tl_nat xs))"
+
+lemma map_encode_interfering_induct:
+"map_encode_interfering_acc acc  p n xs = map_acc
+(\<lambda>k. encode_interfering_operator_pair_exclusion_tail p k (fst_nat n) (snd_nat n)) acc xs"
+  apply(induct acc p n xs rule:map_encode_interfering_acc.induct)
+  apply (auto simp add:subtail_encode_interfering_operator_pair_exclusion)
+  done
+
 
 fun map_map_encode_interfering :: "nat \<Rightarrow>nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "map_map_encode_interfering \<Pi> t xs = (if xs = 0 then 0 else 
 (map_encode_interfering  \<Pi> (hd_nat xs) (list_less_nat t)) ## map_map_encode_interfering \<Pi> t (tl_nat xs) 
 ) "
+
+fun map_map_encode_interfering_acc :: "nat \<Rightarrow> nat \<Rightarrow>nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_map_encode_interfering_acc acc \<Pi> t xs = (if xs = 0 then acc else  map_map_encode_interfering_acc(
+(map_encode_interfering  \<Pi> (hd_nat xs) (list_less_nat t)) ## acc) \<Pi> t (tl_nat xs) 
+) "
+
+lemma map_map_encode_interfering_induct:
+"map_map_encode_interfering_acc acc \<Pi> t xs = map_acc (\<lambda>n. map_encode_interfering  \<Pi> n
+      (list_less_nat t) ) acc xs "
+  apply(induct acc \<Pi> t xs rule: map_map_encode_interfering_acc.induct)
+  apply auto
+  done
+
 lemma submap_map_encode_interfering:
 "map_map_encode_interfering \<Pi> t xs = map_nat (\<lambda>n. map_encode_interfering  \<Pi> n
       (list_less_nat t) ) xs "
@@ -241,12 +368,34 @@ lemma submap_map_encode_interfering:
   apply auto
   done
 
+definition map_map_encode_interfering_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"map_map_encode_interfering_tail \<Pi> t xs = reverse_nat (map_map_encode_interfering_acc 0 \<Pi> t xs)"
+
+lemma subtail_map_map_encode_interfering:
+"map_map_encode_interfering_tail \<Pi> t xs = map_map_encode_interfering \<Pi> t xs "
+  using map_map_encode_interfering_induct map_map_encode_interfering_tail_def
+ submap_map_encode_interfering subtail_map by presburger
+
 definition encode_interfering_operator_exclusion_nat
   :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "encode_interfering_operator_exclusion_nat \<Pi> t \<equiv> let
       ops = nth_nat (Suc 0) \<Pi>
       ; interfering = filter_interfering ops (product_nat ops ops)
     in BigAnd_nat (concat_nat (map_map_encode_interfering \<Pi> t interfering ))"
+
+definition encode_interfering_operator_exclusion_tail
+  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_interfering_operator_exclusion_tail \<Pi> t \<equiv> let
+      ops = nth_nat (Suc 0) \<Pi>
+      ; interfering = filter_interfering_tail ops (product_tail ops ops)
+    in BigAnd_tail (concat_tail (map_map_encode_interfering_tail \<Pi> t interfering ))"
+
+lemma subtail_encode_interfering_operator_exclusion:
+"encode_interfering_operator_exclusion_tail p t = encode_interfering_operator_exclusion_nat p t "
+  using encode_interfering_operator_exclusion_nat_def encode_interfering_operator_exclusion_tail_def
+ subtail_BigAnd subtail_concat subtail_filter_interfering subtail_map_map_encode_interfering 
+subtail_product by presburger
+
 lemma subnat_encode_interfering_operator_exclusion :
 "encode_interfering_operator_exclusion_nat (strips_list_problem_encode p) t =
 sat_formula_encode (encode_interfering_operator_exclusion_list p t)"
@@ -294,6 +443,23 @@ definition encode_problem_with_operator_interference_exclusion_nat
       ## (3 ## (encode_interfering_operator_exclusion_nat \<Pi> t)
       ## (encode_goal_state_nat \<Pi> t) ## 0) ## 0 )## 0) ## 0"
 
+definition encode_problem_with_operator_interference_exclusion_tail
+  :: "nat\<Rightarrow> nat \<Rightarrow> nat"
+  where "encode_problem_with_operator_interference_exclusion_tail \<Pi> t
+    \<equiv> 3 ## (encode_initial_state_tail \<Pi>)
+      ## (3 ## (encode_operators_tail \<Pi> t)
+      ## (3 ## (encode_all_frame_axioms_tail \<Pi> t)
+      ## (3 ## (encode_interfering_operator_exclusion_tail \<Pi> t)
+      ## (encode_goal_state_tail \<Pi> t) ## 0) ## 0 )## 0) ## 0"
+
+lemma subtail_encode_problem_with_operator_interference_exclusion:
+"encode_problem_with_operator_interference_exclusion_tail \<Pi> t =
+ encode_problem_with_operator_interference_exclusion_nat \<Pi> t"
+  using encode_problem_with_operator_interference_exclusion_nat_def
+ encode_problem_with_operator_interference_exclusion_tail_def subtail_encode_all_frame_axioms
+ subtail_encode_goal_state subtail_encode_initial_state subtail_encode_interfering_operator_exclusion 
+subtail_encode_operators by presburger
+
 lemma subnat_encode_problem_with_operator_interference_exclusion:
 "encode_problem_with_operator_interference_exclusion_nat (strips_list_problem_encode \<Pi>) t =
 sat_formula_encode (encode_problem_with_operator_interference_exclusion_list \<Pi> t)"
@@ -395,6 +561,28 @@ lemma main_lemma_hol_list:
         (sas_plus_problem_to_strips_problem_nat (prob_with_noop_nat (IMP_Minus_to_SAS_Plus_nat c I guess_range G (t'_nat pt p_cer x))))
            (100 * (max_bits + (t'_nat pt p_cer x) + 1) * ((t'_nat pt p_cer x) - 1) +
              (max_bits + (t'_nat pt p_cer x) + 2) * (num_variables_nat c + 2) + 52))"
+
+definition imp_to_sat_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+    "imp_to_sat_tail c pt p_cer x =
+      (let I = (prod_encode (vname_encode ''input'', x)) ## 0; 
+          G = (prod_encode (vname_encode ''input'', 0)) ## 0;
+          guess_range = x + 1 + 2 * 2 ^ (poly_of_tail p_cer (bit_length x));
+          max_bits = max_input_bits_tail c I guess_range
+      in
+        encode_problem_with_operator_interference_exclusion_tail 
+        (sas_plus_problem_to_strips_problem_tail (prob_with_noop_tail (IMP_Minus_to_SAS_Plus_tail c I guess_range G (t'_tail pt p_cer x))))
+           (100 * (max_bits + (t'_tail pt p_cer x) + 1) * ((t'_tail pt p_cer x) - 1) +
+             (max_bits + (t'_tail pt p_cer x) + 2) * (num_variables_tail c + 2) + 52))"
+
+lemma subtail_imp_to_sat :
+"imp_to_sat_tail c pt p_cer x = imp_to_sat_nat c pt p_cer x"
+  apply(auto simp only: imp_to_sat_tail_def imp_to_sat_nat_def
+subtail_poly_of subtail_max_input_bits subtail_encode_problem_with_operator_interference_exclusion
+subtail_sas_plus_problem_to_strips_problem subtail_prob_with_noop subtail_IMP_Minus_to_SAS_Plus
+subtail_t' subtail_num_variables
+)
+  done
+
 lemma unfold_map_signleton:"[f x] = map f [x]"
   apply auto
   done
@@ -421,18 +609,21 @@ proof -
     by fast
   hence "is_valid_problem_sas_plus (list_problem_to_problem (prob_with_noop_list ?P))"
     using sublist_prob_with_noop by metis
-  thus " encode_problem_with_operator_interference_exclusion_nat
-     (\<phi> list_problem_plus_encode
-          (prob_with_noop_list
-            (IMP_Minus_to_SAS_Plus_list c [(''input'', x)]
-              (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) [(''input'', 0)]
-              (t'_pair pt p_cer x))) )
+  thus "encode_problem_with_operator_interference_exclusion_nat
+     (sas_plus_problem_to_strips_problem_nat
+       (list_problem_plus_encode
+         (prob_with_noop_list
+           (IMP_Minus_to_SAS_Plus_list c [(''input'', x)]
+             (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) [(''input'', 0)]
+             (t'_pair pt p_cer x)))))
      (100 *
-      (max_input_bits_list c [(''input'', x)] (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) +
+      (max_input_bits_list c [(''input'', x)]
+        (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) +
        t'_pair pt p_cer x +
        1) *
       (t'_pair pt p_cer x - 1) +
-      (max_input_bits_list c [(''input'', x)] (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) +
+      (max_input_bits_list c [(''input'', x)]
+        (x + 1 + 2 * 2 ^ poly_of p_cer (Bit_Length.bit_length x)) +
        t'_pair pt p_cer x +
        2) *
       (num_variables c + 2) +
@@ -471,5 +662,25 @@ lemma main_lemma_hol_nat:
                    \<and> (Sema.sat {f}  \<longleftrightarrow> in_lang x = 0))"
   using assms main_lemma_hol_list by (auto simp add:subnat_imp_to_sat inj_formula_simp)
 
+lemma main_lemma_hol_tail:
+  fixes c and pt::"nat*nat" and p_cer::"nat*nat" and in_lang
+  assumes verifier_tbounded:
+    "\<And>s. \<exists>t s'. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
+                   t \<le> poly_of pt (bit_length (s ''input''))"
+  assumes verifier_terminates: 
+          "\<And>x s. \<lbrakk>in_lang x = 0 ; s ''input'' = x\<rbrakk> \<Longrightarrow>
+                    (\<exists>z t s'. bit_length z \<le> poly_of p_cer (bit_length x) \<and>
+                              (c, s(''certificate'' := z)) \<Rightarrow>\<^bsup> t \<^esup> s' \<and>
+                              s' ''input'' = in_lang x)"
+          "\<And>x s s' t. \<lbrakk>in_lang x \<noteq> 0; s ''input'' = x; (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'\<rbrakk> \<Longrightarrow>
+                         s' ''input'' = in_lang x"
+  assumes verifier_has_registers:
+    "''input'' \<in> set (Max_Constant.all_variables c)"
+  shows "\<exists>t_red s_red.
+         poly t_red 
+       \<and> poly s_red
+       \<and> (\<forall>x. \<exists>f.  bit_length (encode_sat f) \<le> s_red ( bit_length x ) \<and> imp_to_sat_tail(com_encode c) (prod_encode pt) (prod_encode p_cer) x = sat_formula_encode f
+                   \<and> (Sema.sat {f}  \<longleftrightarrow> in_lang x = 0))"
+  using assms main_lemma_hol_nat by (auto simp add:subtail_imp_to_sat inj_formula_simp)
 
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
index 97e481af..03218e4f 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
@@ -646,7 +646,6 @@ sub_maps_sasp_op_to_strips subtail_map by presburger
 
 definition sas_plus_problem_to_strips_problem_nat
   :: "nat\<Rightarrow>nat" 
-  ("\<phi> _ " 99)
   where "sas_plus_problem_to_strips_problem_nat \<Psi> \<equiv> let 
       vs =  concat_nat (map_possible_assignments_for \<Psi>(nth_nat 0 \<Psi>))
       ; ops = maps_sasp_op_to_strips \<Psi> (nth_nat (Suc 0) \<Psi>)

From de1edea3bacdc1a42bf2a73317c6ae6966a09b49 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Wed, 1 Sep 2021 18:05:56 +0200
Subject: [PATCH 024/103] updated multiplication

---
 IMP-/Multiplication.thy | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index 5500e1f3..e801275e 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -136,11 +136,11 @@ proof(induction k arbitrary: s rule: less_induct )
           mult.commute mult_2 mult_Suc numeral_2_eq_2 odd_two_times_div_two_succ)
 
     show ?thesis
-      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> \<open>s ''b'' \<noteq> 0\<close> log_rec remaining_iterations s''_is_goal
+      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> \<open>s ''b'' \<noteq> 0\<close> log_rec s''_is_goal
       by (fastforce simp: Euclidean_Division.div_eq_0_iff
-          intro!: mul_iteration_effect Big_StepT.WhileTrue[
+          intro!: Big_StepT.WhileTrue[
             OF _ mul_iteration_effect
-            terminates_in_state_intro[OF remaining_iterations s''_is_goal]])
+            terminates_in_state_intro[OF remaining_iterations]])
   qed (force intro: terminates_in_state_intro)
 qed
 

From 6d76b4e768943dfe3d6c5760045f3b4d2f379f76 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Thu, 2 Sep 2021 13:08:03 +0200
Subject: [PATCH 025/103] verified implementation of encoding and decoding
 pairs in IMP-

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 139 +++++++++++++++++++++++++++++++
 IMP-/Multiplication.thy          |   6 +-
 2 files changed, 144 insertions(+), 1 deletion(-)
 create mode 100644 IMP-/IMP_Minus_Nat_Bijection.thy

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
new file mode 100644
index 00000000..cb86b231
--- /dev/null
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -0,0 +1,139 @@
+\<^marker>\<open>creator Florian Kessler\<close>
+
+theory IMP_Minus_Nat_Bijection
+  imports Multiplication "HOL-Library.Nat_Bijection" 
+    "../Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives"
+begin
+
+definition IMP_Minus_triangle where "IMP_Minus_triangle \<equiv>
+  ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
+  IMP_minus_mul ;;
+  ''triangle'' ::= ((V ''c'') \<then>) ;;
+  ''c'' ::= (A (N 0))"
+
+lemma IMP_Minus_triangle_correct: 
+   "(IMP_Minus_triangle, s) 
+      \<Rightarrow>\<^bsup>mul_time (1 + s ''a'') + 6\<^esup> 
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''triangle'' := triangle (s ''a''))"
+  unfolding IMP_Minus_triangle_def triangle_def 
+  by(force
+      intro: terminates_in_state_intro[OF Seq[OF Seq]]
+        IMP_minus_mul_correct)
+
+definition IMP_Minus_prod_encode where "IMP_Minus_prod_encode \<equiv>
+  ''prod_encode'' ::= (A (V ''a'')) ;;
+  ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
+  IMP_Minus_triangle ;;
+  ''prod_encode'' ::= ((V ''triangle'') \<oplus> (V ''prod_encode'')) ;;
+  ''triangle'' ::= (A (N 0))"
+
+lemma IMP_Minus_prod_encode_correct: 
+  "(IMP_Minus_prod_encode, s) 
+      \<Rightarrow>\<^bsup>mul_time (1 + s ''a'' + s ''b'') + 14\<^esup> 
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''triangle'' := 0,
+        ''prod_encode'' := prod_encode (s ''a'', s ''b''))"
+  unfolding IMP_Minus_prod_encode_def prod_encode_def
+  by(force
+      intro: terminates_in_state_intro[OF Seq[OF Seq]]
+        IMP_Minus_triangle_correct)
+
+fun prod_decode_aux_iterations :: "nat \<Rightarrow> nat \<Rightarrow> nat"
+  where "prod_decode_aux_iterations k m =
+    (if m \<le> k then 0 else Suc (prod_decode_aux_iterations (Suc k) (m - Suc k)))"
+
+declare prod_decode_aux_iterations.simps [simp del]
+
+definition prod_decode_aux_iteration where "prod_decode_aux_iteration \<equiv>
+  ''a'' ::= ((V ''a'') \<oplus> (N 1)) ;;
+  ''b'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
+  ''c'' ::= ((V ''b'') \<ominus> (V ''a''))"
+
+lemma prod_decode_aux_loop_correct: 
+  "s ''a'' = k \<Longrightarrow> s ''b'' = m \<Longrightarrow> s ''c'' = m - k 
+  \<Longrightarrow> (WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration, s) 
+      \<Rightarrow>\<^bsup>2 + 7 * prod_decode_aux_iterations (s ''a'') (s ''b'')\<^esup> 
+    s(''a'' := fst (prod_decode_aux (s ''a'') (s ''b''))
+         + snd (prod_decode_aux (s ''a'') (s ''b'')),
+      ''b'' := fst (prod_decode_aux (s ''a'') (s ''b'')),
+      ''c'' := 0)"
+proof(induction k m arbitrary: s rule: prod_decode_aux.induct)
+  case (1 k m)
+  then show ?case
+  proof(cases "m - k")
+    case 0
+    then show ?thesis
+      using 1 terminates_in_state_intro[OF Big_StepT.WhileFalse]
+      by(auto simp: fun_eq_iff prod_decode_aux.simps numeral_eq_Suc 
+          prod_decode_aux_iterations.simps)
+  next
+    case (Suc nat)
+
+    have first_iteration: "(prod_decode_aux_iteration, s) \<Rightarrow>\<^bsup> 6 \<^esup> 
+      s(''a'' := Suc k,
+        ''b'' := m - (Suc k),
+        ''c'' := (m - (Suc k)) - Suc k)"
+      unfolding prod_decode_aux_iteration_def
+      using \<open>s ''a'' = k\<close>  \<open>s ''b'' = m\<close>
+      by(auto 
+          simp: numeral_eq_Suc fun_eq_iff 
+          intro!: terminates_in_state_intro[OF Seq[OF Seq]])
+
+    show ?thesis
+      using terminates_in_state_intro[OF Big_StepT.WhileTrue[OF _ first_iteration "1.IH"]]
+        prod_decode_aux_iterations.simps[where ?k = "s ''a''"]
+        prod_decode_aux.simps[where ?k = "s ''a''"]
+        \<open>s ''a'' = k\<close>  \<open>s ''b'' = m\<close> \<open>s ''c'' = m - k\<close> \<open>m - k = Suc nat\<close>
+      by(auto simp: fun_eq_iff)
+  qed
+qed
+
+definition IMP_Minus_fst_nat where "IMP_Minus_fst_nat \<equiv>
+  ''b'' ::= (A (V ''a'')) ;; 
+  ''a'' ::= (A (N 0)) ;;
+  ''c'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
+  WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration ;;
+  ''fst_nat'' ::= (A (V ''b'')) ;;
+  ''a'' ::= (A (N 0)) ;;
+  ''b'' ::= (A (N 0))"
+
+lemma IMP_Minus_fst_nat_correct: 
+  "(IMP_Minus_fst_nat, s) 
+      \<Rightarrow>\<^bsup>14 + 7 * prod_decode_aux_iterations 0 (s ''a'')\<^esup> 
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''fst_nat'' := fst_nat (s ''a''))"
+  unfolding IMP_Minus_fst_nat_def fst_nat_def prod_decode_def
+  by (force intro!: 
+      terminates_in_state_intro[OF Seq]
+      prod_decode_aux_loop_correct)
+
+definition IMP_Minus_snd_nat where "IMP_Minus_snd_nat \<equiv>
+  ''b'' ::= (A (V ''a'')) ;; 
+  ''a'' ::= (A (N 0)) ;;
+  ''c'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
+  WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration ;;
+  ''snd_nat'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
+  ''a'' ::= (A (N 0)) ;;
+  ''b'' ::= (A (N 0))"
+
+lemma IMP_Minus_snd_nat_correct: 
+  "(IMP_Minus_snd_nat, s) 
+      \<Rightarrow>\<^bsup>14 + 7 * prod_decode_aux_iterations 0 (s ''a'')\<^esup> 
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''snd_nat'' := snd_nat (s ''a''))"
+  unfolding IMP_Minus_snd_nat_def snd_nat_def prod_decode_def
+  by (force intro!: 
+      terminates_in_state_intro[OF Seq]
+      prod_decode_aux_loop_correct)
+end
\ No newline at end of file
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index e801275e..48571727 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -150,13 +150,17 @@ definition IMP_minus_mul where "IMP_minus_mul =
   ''a'' ::= A (N 0) ;;
   ''d'' ::= A (N 0)" 
 
+definition mul_time where "mul_time y 
+  \<equiv> 12 * (if y = 0 then 0 else 1 + Discrete.log y) + 8"
+
 lemma IMP_minus_mul_correct: 
   shows "(IMP_minus_mul, s) 
-    \<Rightarrow>\<^bsup>12 * (if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')) + 8\<^esup> 
+    \<Rightarrow>\<^bsup>mul_time (s ''b'')\<^esup> 
     s(''a'' := 0,
       ''b'' := 0,
       ''c'' := s ''a'' * s ''b'',
       ''d'' := 0)"
+  unfolding mul_time_def
   using mul_loop_correct
   by(force simp: IMP_minus_mul_def
            intro!: terminates_in_state_intro[OF Seq[OF Seq[OF Seq]]])

From 0f147ab2a8ca09d976a2cb13250a52745a20ddb6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Thu, 2 Sep 2021 19:30:21 +0200
Subject: [PATCH 026/103] implemented and verified a few functions from IMP-
 Max Constant

---
 ...IMP_Minus_Max_Constant_IMP_Minus.thy.marks |   1 +
 .../IMP_Minus_Max_Constant_IMP_Minus.thy      | 141 ++++++++++++++++++
 IMP-/IMP_Minus_Nat_Bijection.thy              |  98 +++++++++++-
 IMP-/Multiplication.thy                       |  14 +-
 4 files changed, 245 insertions(+), 9 deletions(-)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/.IMP_Minus_Max_Constant_IMP_Minus.thy.marks
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/.IMP_Minus_Max_Constant_IMP_Minus.thy.marks b/Cook_Levin/IMP-_To_SAS+/.IMP_Minus_Max_Constant_IMP_Minus.thy.marks
new file mode 100644
index 00000000..3c60db59
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/.IMP_Minus_Max_Constant_IMP_Minus.thy.marks
@@ -0,0 +1 @@
+!a;4288;4288
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
new file mode 100644
index 00000000..75eec21b
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
@@ -0,0 +1,141 @@
+theory IMP_Minus_Max_Constant_IMP_Minus
+  imports IMP_Minus_Max_Constant_Nat
+    "../../IMP-/IMP_Minus_Nat_Bijection"
+begin
+
+unbundle IMP_Minus_Minus_Com.no_com_syntax
+
+definition atomExp_to_constant_IMP_Minus where "atomExp_to_constant_IMP_Minus \<equiv>
+  ''atomExp_to_constant'' ::= (A (V ''a'')) ;;
+  IMP_Minus_fst_nat ;;
+  ''a'' ::= (A (V ''atomExp_to_constant'')) ;;
+  IMP_Minus_snd_nat ;;
+  (IF ''fst_nat'' \<noteq>0 
+  THEN 
+    ''atomExp_to_constant'' ::= (A (V ''snd_nat''))  
+  ELSE
+    ''atomExp_to_constant'' ::=  (A (N 0)));;
+  ''fst_nat'' ::= (A (N 0)) ;;
+  ''snd_nat'' ::= (A (N 0))"
+
+definition atomExp_to_constant_IMP_Minus_time where "atomExp_to_constant_IMP_Minus_time x \<equiv>
+  11 + 2 * IMP_Minus_fst_nat_time x"
+
+lemma atomExp_to_constant_IMP_Minus_correct:
+  "(atomExp_to_constant_IMP_Minus, s) \<Rightarrow>\<^bsup>atomExp_to_constant_IMP_Minus_time (s ''a'')\<^esup> 
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''fst_nat'' := 0,
+      ''snd_nat'' := 0,
+      ''atomExp_to_constant'' := atomExp_to_constant_tail (s ''a''))"
+  apply(cases "fst_nat (s ''a'')")
+  unfolding atomExp_to_constant_IMP_Minus_def atomExp_to_constant_tail_def
+    atomExp_to_constant_nat_def atomExp_to_constant_IMP_Minus_time_def
+  by (fastforce 
+      intro!: terminates_in_state_intro[OF Seq]
+      IMP_Minus_fst_nat_correct      
+      IMP_Minus_snd_nat_correct)+
+
+definition aexp_max_constant_IMP_Minus where "aexp_max_constant_IMP_Minus \<equiv> 
+  ''aexp_max_constant'' ::= (A (V ''a'')) ;;
+
+  ''a'' ::= (A (N 1)) ;;
+  ''b'' ::= (A (V ''aexp_max_constant'')) ;;
+  nth_nat_IMP_Minus ;;
+  
+  ''a'' ::= (A (V ''nth_nat'')) ;;
+  atomExp_to_constant_IMP_Minus ;;
+  
+  ''a'' ::= (A (N 2)) ;;
+  ''b'' ::= (A (V ''aexp_max_constant'')) ;;
+  nth_nat_IMP_Minus ;;
+  
+  ''a'' ::= (A (V ''nth_nat'')) ;;
+  ''nth_nat'' ::= (A (V ''atomExp_to_constant'')) ;;
+  atomExp_to_constant_IMP_Minus ;;
+
+  ''a'' ::= ((V ''aexp_max_constant'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+
+  ''a'' ::= ((N 3) \<ominus> (V ''fst_nat'')) ;;
+  IF ''a'' \<noteq>0 
+  THEN
+  (
+    IF ''fst_nat'' \<noteq>0
+    THEN
+      ''b'' ::= (A (V ''atomExp_to_constant''))
+    ELSE
+      ''b'' ::= (A (V ''nth_nat''))
+  )
+  ELSE
+  (
+    IF ''fst_nat'' \<noteq>0
+    THEN
+      ''b'' ::= (A (V ''nth_nat''))
+    ELSE
+      ''b'' ::= (A (V ''nth_nat''))
+  );;
+
+  ''a'' ::= (A (V ''nth_nat'')) ;;
+
+  IMP_Minus_max_a_min_b ;;
+  ''aexp_max_constant'' ::= (A (V ''a'')) ;;
+  ''a'' ::= (A (N 0)) ;; 
+  ''b'' ::= (A (N 0)) ;;
+  ''nth_nat'' ::= (A (N 0)) ;;
+  ''atomExp_to_constant'' ::= (A (N 0)) ;;
+  ''fst_nat'' ::= (A (N 0))"
+
+definition aexp_max_constant_IMP_Minus_time where "aexp_max_constant_IMP_Minus_time x \<equiv>
+  38 + nth_nat_IMP_Minus_time 1 x + atomExp_to_constant_IMP_Minus_time (nth_nat 1 x)
+  + nth_nat_IMP_Minus_time 2 x +  atomExp_to_constant_IMP_Minus_time (nth_nat 2 x)
+  + IMP_Minus_fst_nat_time (x - 1) + 11" 
+
+lemma Seq: "\<lbrakk>(c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3"
+  by auto
+
+lemma aexp_max_constant_IMP_Minus_correct:
+  "(aexp_max_constant_IMP_Minus, s) 
+    \<Rightarrow>\<^bsup>aexp_max_constant_IMP_Minus_time (s ''a'')\<^esup>
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''fst_nat'' := 0,
+      ''snd_nat'' := 0,
+      ''nth_nat'' := 0,
+      ''atomExp_to_constant'' := 0,
+      ''aexp_max_constant'' := aexp_max_constant_tail (s ''a''))"
+  unfolding aexp_max_constant_IMP_Minus_def aexp_max_constant_IMP_Minus_time_def
+  apply(cases "3 - fst_nat (s ''a'' - Suc 0)"; cases "fst_nat (s ''a'' - Suc 0)")
+     apply simp
+  apply(fastforce simp: numeral_eq_Suc hd_nat_def 
+        intro!: terminates_in_time_state_intro[OF Seq]
+        atomExp_to_constant_IMP_Minus_correct
+        nth_nat_IMP_Minus_correct
+        IMP_Minus_max_a_min_b_correct
+        IMP_Minus_fst_nat_correct)
+  (*apply(fastforce simp: numeral_eq_Suc hd_nat_def 
+        intro!: terminates_in_time_state_intro[OF Seq]
+        atomExp_to_constant_IMP_Minus_correct
+        nth_nat_IMP_Minus_correct
+        IMP_Minus_max_a_min_b_correct
+        IMP_Minus_fst_nat_correct)*)
+  subgoal
+    by(fastforce simp: numeral_eq_Suc hd_nat_def 
+        intro!: terminates_in_time_state_intro[OF Seq]
+        atomExp_to_constant_IMP_Minus_correct
+        nth_nat_IMP_Minus_correct
+        IMP_Minus_max_a_min_b_correct
+        IMP_Minus_fst_nat_correct)
+  subgoal
+    by(fastforce simp: numeral_eq_Suc hd_nat_def 
+        intro!: terminates_in_time_state_intro[OF Seq]
+        atomExp_to_constant_IMP_Minus_correct
+        nth_nat_IMP_Minus_correct
+        IMP_Minus_max_a_min_b_correct
+        IMP_Minus_fst_nat_correct)
+  done
+
+
+end
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index cb86b231..a33c2d0b 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -5,6 +5,8 @@ theory IMP_Minus_Nat_Bijection
     "../Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives"
 begin
 
+unbundle IMP_Minus_Minus_Com.no_com_syntax
+
 definition IMP_Minus_triangle where "IMP_Minus_triangle \<equiv>
   ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
   IMP_minus_mul ;;
@@ -104,14 +106,17 @@ definition IMP_Minus_fst_nat where "IMP_Minus_fst_nat \<equiv>
   ''a'' ::= (A (N 0)) ;;
   ''b'' ::= (A (N 0))"
 
+definition IMP_Minus_fst_nat_time where "IMP_Minus_fst_nat_time x \<equiv>
+  14 + 7 * prod_decode_aux_iterations 0 x"
+
 lemma IMP_Minus_fst_nat_correct: 
   "(IMP_Minus_fst_nat, s) 
-      \<Rightarrow>\<^bsup>14 + 7 * prod_decode_aux_iterations 0 (s ''a'')\<^esup> 
+      \<Rightarrow>\<^bsup>IMP_Minus_fst_nat_time (s ''a'')\<^esup> 
     s(''a'' := 0,
       ''b'' := 0,
       ''c'' := 0,
       ''fst_nat'' := fst_nat (s ''a''))"
-  unfolding IMP_Minus_fst_nat_def fst_nat_def prod_decode_def
+  unfolding IMP_Minus_fst_nat_def fst_nat_def prod_decode_def IMP_Minus_fst_nat_time_def
   by (force intro!: 
       terminates_in_state_intro[OF Seq]
       prod_decode_aux_loop_correct)
@@ -127,13 +132,98 @@ definition IMP_Minus_snd_nat where "IMP_Minus_snd_nat \<equiv>
 
 lemma IMP_Minus_snd_nat_correct: 
   "(IMP_Minus_snd_nat, s) 
-      \<Rightarrow>\<^bsup>14 + 7 * prod_decode_aux_iterations 0 (s ''a'')\<^esup> 
+      \<Rightarrow>\<^bsup>IMP_Minus_fst_nat_time (s ''a'')\<^esup> 
     s(''a'' := 0,
       ''b'' := 0,
       ''c'' := 0,
       ''snd_nat'' := snd_nat (s ''a''))"
-  unfolding IMP_Minus_snd_nat_def snd_nat_def prod_decode_def
+  unfolding IMP_Minus_snd_nat_def snd_nat_def prod_decode_def IMP_Minus_fst_nat_time_def
   by (force intro!: 
       terminates_in_state_intro[OF Seq]
       prod_decode_aux_loop_correct)
+
+definition nth_nat_iteration where "nth_nat_iteration \<equiv>
+  ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  IMP_Minus_snd_nat ;;
+  ''a'' ::= (A (V ''snd_nat'')) ;;
+  ''snd_nat'' ::= (A (N 0)) ;;
+  ''nth_nat'' ::= ((V ''nth_nat'') \<ominus> (N 1))"
+
+fun nth_nat_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_nat_loop_time 0 x = 2" |
+"nth_nat_loop_time (Suc n) x = 9 + IMP_Minus_fst_nat_time (x - 1) 
+  + nth_nat_loop_time n (tl_nat x)"
+
+fun drop_n_nat :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"drop_n_nat 0 x = x "|
+"drop_n_nat (Suc n) x = drop_n_nat n (tl_nat x)"
+
+lemma nth_nat_is_hd_of_drop_n_nat:
+  "nth_nat n x = fst_nat (drop_n_nat n x - Suc 0)"
+  by (induction n arbitrary: x)
+    (auto simp: hd_nat_def)
+
+lemma nth_nat_loop_correct:
+  "s ''nth_nat'' = k
+  \<Longrightarrow> (WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration, s) 
+      \<Rightarrow>\<^bsup>nth_nat_loop_time (s ''nth_nat'') (s ''a'') \<^esup>
+      s(''a'' := drop_n_nat k (s ''a''),
+        ''b'' := (if k > 0 then 0 else s ''b''),
+        ''c'' := (if k > 0 then 0 else s ''c''),
+        ''snd_nat'' := (if k > 0 then 0 else s ''snd_nat''),
+        ''nth_nat'' := 0)"
+proof(induction k arbitrary: s)
+  case 0
+  then show ?case
+    by(auto simp: numeral_eq_Suc fun_eq_iff 
+        intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse])
+next
+  case (Suc k)
+
+  have first_iteration: "(nth_nat_iteration, s)
+    \<Rightarrow>\<^bsup> 8 + IMP_Minus_fst_nat_time ((s ''a'') - 1) \<^esup>
+      s(''a'' := tl_nat (s ''a''),
+        ''b'' := 0,
+        ''c'' := 0,
+        ''snd_nat'' := 0,
+        ''nth_nat'' := k)"
+    unfolding nth_nat_iteration_def tl_nat_def
+    using \<open>s ''nth_nat'' = Suc k\<close>
+    by(force intro!: terminates_in_state_intro[OF Seq]
+        IMP_Minus_snd_nat_correct)
+
+  show ?case
+    using \<open>s ''nth_nat'' = Suc k\<close>
+    by (force intro!: terminates_in_state_intro
+          [OF Big_StepT.WhileTrue[OF _ first_iteration Suc.IH]])
+qed
+
+
+definition nth_nat_IMP_Minus where "nth_nat_IMP_Minus \<equiv>
+  ''nth_nat'' ::= (A (V ''a'')) ;;
+  ''a'' ::= (A (V ''b'')) ;;
+  WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration ;;
+  ''snd_nat'' ::= (A (N 0)) ;;
+  ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''nth_nat'' ::= (A (V ''fst_nat'')) ;;
+  ''fst_nat'' ::= (A (N 0))"
+
+definition nth_nat_IMP_Minus_time where "nth_nat_IMP_Minus_time n x \<equiv>
+  12 + nth_nat_loop_time n x + IMP_Minus_fst_nat_time ((drop_n_nat n x) - 1)"
+
+lemma nth_nat_IMP_Minus_correct:
+  "(nth_nat_IMP_Minus, s) \<Rightarrow>\<^bsup>nth_nat_IMP_Minus_time (s ''a'') (s ''b'') \<^esup>
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''fst_nat'' := 0,
+      ''snd_nat'' := 0,
+      ''nth_nat'' := nth_nat (s ''a'') (s ''b''))"
+  apply(cases "s ''a'' = 0")
+  unfolding nth_nat_IMP_Minus_def nth_nat_IMP_Minus_time_def tl_nat_def 
+  by (fastforce simp: hd_nat_def nth_nat_is_hd_of_drop_n_nat
+            intro!: terminates_in_state_intro[OF Seq] 
+              IMP_Minus_fst_nat_correct nth_nat_loop_correct)+
+
 end
\ No newline at end of file
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index 48571727..dfdd4e9c 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -4,7 +4,7 @@ theory Multiplication
   imports Big_Step_Small_Step_Equivalence "HOL-Library.Discrete"
 begin
 
-definition IMP_max_a_min_b where "IMP_max_a_min_b = 
+definition IMP_Minus_max_a_min_b where "IMP_Minus_max_a_min_b = 
   ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
   IF ''c'' \<noteq>0 
   THEN
@@ -18,19 +18,19 @@ definition IMP_max_a_min_b where "IMP_max_a_min_b =
     ''b'' ::= A (V ''c'') ;;
     ''c'' ::= A (N 0))"
 
-lemma IMP_max_a_min_b_correct: 
-    "(IMP_max_a_min_b, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := max (s ''a'') (s ''b''),
+lemma IMP_Minus_max_a_min_b_correct: 
+    "(IMP_Minus_max_a_min_b, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := max (s ''a'') (s ''b''),
                                    ''b'' := min (s ''a'') (s ''b''), ''c'' := 0)" 
 proof(cases "(s ''a'') \<le> (s ''b'')")
   case True
   then show ?thesis
-    apply(auto simp: IMP_max_a_min_b_def numeral_eq_Suc
+    apply(auto simp: IMP_Minus_max_a_min_b_def numeral_eq_Suc
         intro!: Seq[OF Big_StepT.Assign Big_StepT.IfFalse])
     by(auto simp: assign_t_simp fun_eq_iff intro!: Seq)
 next
   case False
   then show ?thesis 
-    apply(auto simp: IMP_max_a_min_b_def numeral_eq_Suc seq_assign_t_simp 
+    apply(auto simp: IMP_Minus_max_a_min_b_def numeral_eq_Suc seq_assign_t_simp 
         intro!: Seq[OF Big_StepT.Assign Big_StepT.IfTrue])
     by (auto simp: fun_eq_iff)
 qed
@@ -50,6 +50,10 @@ definition mul_iteration where
 lemma terminates_in_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' = s'' \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s''"
   by simp
 
+lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = t' \<Longrightarrow> s' = s'' 
+  \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
+  by simp
+
 lemma mul_iteration_effect:
   "(mul_iteration, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := 2 * s ''a'',
                                ''b'' := s ''b'' div 2,

From 8d52aa36330181c7cefed58c64d59521c57d6e77 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ghorbel@in.tum.de>
Date: Fri, 3 Sep 2021 02:18:56 +0200
Subject: [PATCH 027/103] termination proof: trying with size function

---
 .../IMP_Minus_Max_Constant_Nat.thy            | 94 ++++++++++++++++++-
 1 file changed, 89 insertions(+), 5 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 7e53e054..10529be8 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -117,7 +117,7 @@ fun add_res :: "nat \<Rightarrow> max_con list \<Rightarrow> max_con list" where
 "add_res n (Seq_0 c1 c2 # s) = Seq_m c1 c2 n # s"|
 "add_res n (Seq_m c1 c2 n0 #s) = Seq_f c1 c2 n0 n # s "|
 "add_res n (While_0 c #s) = While_f c n # s"|
-"add_res n s = s"
+"add_res n s = [Bot n]"
 
 lemma add_res_Nil:
 "add_res n s \<noteq> []"
@@ -137,7 +137,7 @@ else (let h =hd_nat s; t =tl_nat s; c = hd_nat h; e1 = nth_nat (Suc 0) h ; e2 =
 e3 = nth_nat (Suc (Suc (Suc 0))) h in
 if c = 2 then (3##e1##e2##n##0)##t else 
 if c = 3 then (4##e1##e2##e3##n##0)##t else 
-if c = 5 then (6##e1##n##0)##t else s   )
+if c = 5 then (6##e1##n##0)##t else  (7##n##0) ## 0  )
 
 )"
 
@@ -153,6 +153,69 @@ lemma sub_add_res:
     done
   done
 
+fun size_root :: "max_con \<Rightarrow> nat" where 
+"size_root (Seq_0 c1 c2) = Suc (size c1) + (size c2)"|
+"size_root (Seq_m c1 c2 _ ) = Suc (size c1) + (size c2) "|
+"size_root (Seq_f c1 c2 _ _ ) = Suc (size c1) + (size c2)"|
+"size_root (While_0 c) = Suc (size c)"|
+"size_root (While_f c _) = Suc(size c) "|
+"size_root (Bot _ ) = 0"|
+"size_root s = 1"
+
+fun size_out :: "max_con \<Rightarrow> nat" where
+"size_out (Seq_m c1 _ _) = size c1 "|
+"size_out (Seq_f c1 c2 _ _) =  size c1 + size c2"|
+"size_out (While_f c _) = size c"|
+"size_out c = 0"
+
+fun size_e :: "Com.com \<Rightarrow> nat" where 
+"size_e Com.com.SKIP = 1 "|
+"size_e (Com.com.Assign v a)  = 1"|
+"size_e (Com.com.Seq c1 c2) = Suc (size_e c1 + size_e c2)"|
+"size_e (Com.com.If v c1 c2) = Suc (size_e c1 + size_e c2)"|
+"size_e (Com.com.While v c) = Suc (size_e c)"
+
+fun size_stack_rev :: "max_con list \<Rightarrow> nat" where
+"size_stack_rev (Seq_0 c1 c2# s) =  (if s = [] then Suc (2* (size_e c1 + size_e c2)) else  Suc (2 * size_e c2) + size_stack_rev s )  "|
+"size_stack_rev (Seq_m c1 c2 n#s) = (if s = [] then  Suc (2 * size_e c2) else  Suc (size_stack_rev s)) "|
+"size_stack_rev (While_0 c #s)  = (if s = [] then Suc (2* size_e c) else Suc (size_stack_rev s) )"|
+"size_stack_rev (Bot x # s) = size_stack_rev s"|
+"size_stack_rev (_#s) = Suc (size_stack_rev s)"|
+"size_stack_rev [] = 0"
+
+fun size_stack :: "max_con list \<Rightarrow> nat" where 
+"size_stack s = size_stack_rev (rev s)"
+
+fun compare :: "max_con list \<Rightarrow> max_con list \<Rightarrow> bool" where 
+"compare (Bot _ # _) _  = True"|
+"compare [] _ = True"|
+"compare (push_con c1 (Seq_0 c1 c2 # s) )  (Seq_0 c1 c2 # s) = True"|
+"compare (push_con c2 (Seq_m c1 c2 n # s) )  (Seq_m c1 c2 n # s) = True"|
+"compare (push_con c (While_0  c # s))   (While_0  c # s)  = True"
+lemma size_pos:"size_e c >0"
+  apply(induct c)
+      apply auto
+  done
+lemma 
+size_stack_mono :" x \<noteq> [] \<Longrightarrow>y \<noteq>  [] \<Longrightarrow> size_stack_rev y < size_stack_rev x
+ \<Longrightarrow> size_stack_rev (s @ y) < size_stack_rev (s @ x) "
+  apply(induct s )
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto)
+    done
+  done
+
+lemma " (s = Seq_0 c1 c2 # s' \<or> s = Seq_m c1 c2 n # s' \<or> s = While_0 c # s') 
+  \<Longrightarrow> size_stack (add_res r s) < size_stack s "
+  using size_stack_mono size_pos
+  apply auto
+  done
+
+
+    
+
 function max_constant_stack :: "max_con list \<Rightarrow> nat" where 
 "max_constant_stack (Bot x # s) = x"|
 "max_constant_stack (SKIP # s) = max_constant_stack (add_res 0 s)"|
@@ -162,10 +225,30 @@ function max_constant_stack :: "max_con list \<Rightarrow> nat" where
 "max_constant_stack (Seq_f _ _ n m #s) = max_constant_stack (add_res (max n m) s)"|
 "max_constant_stack (While_0 c# s) = max_constant_stack (push_con c (While_0 c# s)) "|
 "max_constant_stack (While_f _  n# s) = max_constant_stack (add_res n s)"
-  sorry
-termination sorry
+  by pat_completeness auto
+termination 
+  apply (relation "measure size_stack")
+         apply auto
+  subgoal for s
+    apply (cases s)
+     apply auto
+    subgoal for a xs
+      apply (cases a)
+      apply auto
+
+
 
 
+fun compare_max_con::  "max_con list \<Rightarrow> max_con list \<Rightarrow> bool" where
+"compare_max_con x y = compare_max_con' (rev x) (rev y)"
+
+lemma "s\<noteq> [] \<Longrightarrow> compare_max_con (a#s) s"
+  nitpick
+  apply (auto)
+  apply(induct s)
+   apply auto
+    
+
 function max_constant_stack_nat :: "nat \<Rightarrow> nat" where 
 " max_constant_stack_nat s = (let h = hd_nat s; t = tl_nat s;
   c = hd_nat h; e1 = nth_nat (Suc 0) h; e2 = nth_nat (Suc (Suc 0)) h;
@@ -184,7 +267,8 @@ termination sorry
 lemma list_encode_0:"(list_encode xs = 0) =  (xs = [])"
   by (metis list_encode.simps(1) list_encode_inverse)
 
-
+thm "accp.simps"
+find_theorems "wf"
 lemma sub_max_constant_stack:
 "s \<noteq> [] \<Longrightarrow> max_constant_stack_nat (list_encode (map max_con_encode s))
 = max_constant_stack s "

From 0ce1728c4ce989634c56984bfc52ebdb211a9634 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Fri, 3 Sep 2021 20:16:58 +0200
Subject: [PATCH 028/103] temrination order for max_constant, and all_variables
 (stack versions ), yet nat version of those aare missing termination proofs

---
 .../IMP_Minus_Max_Constant_Nat.thy            | 263 ++++++++++++++----
 1 file changed, 206 insertions(+), 57 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 10529be8..92c2f851 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -80,6 +80,26 @@ fun max_con_encode :: "max_con \<Rightarrow> nat" where
 "max_con_encode (While_f c n) = list_encode[6, com_encode c ,n]"|
 "max_con_encode (Bot n) = list_encode[7,n]"
 
+fun max_con_decode :: "nat \<Rightarrow> max_con" where 
+"max_con_decode n = (case list_decode n of 
+    [0] \<Rightarrow> SKIP |
+    [Suc 0,aexp] \<Rightarrow> Assign (aexp_decode aexp)|
+    [Suc (Suc 0), c1 , c2] \<Rightarrow> Seq_0  (com_decode c1) (com_decode c2)|
+    [Suc (Suc ( Suc 0)), c1 , c2, n] \<Rightarrow> Seq_m (com_decode c1) (com_decode c2) n|
+    [Suc (Suc (Suc (Suc 0))), c1 , c2, n, m] \<Rightarrow> Seq_f  (com_decode c1) (com_decode c2) n m|
+    [Suc (Suc (Suc (Suc (Suc 0)))), c] \<Rightarrow> While_0  (com_decode c) |
+    [Suc (Suc (Suc (Suc (Suc (Suc 0))))), c,n] \<Rightarrow> While_f  (com_decode c) n |
+    [Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))),n] \<Rightarrow> Bot  n | x \<Rightarrow> Bot 0
+)"
+value "max_con_decode (0##0##0)"
+lemma max_con_id:
+"max_con_decode (max_con_encode x) = x"
+  apply(cases x)
+         apply (auto simp add: max_con_decode.simps max_con_encode.simps list_encode_inverse
+              aexp_id com_id
+            simp del: aexp_decode.simps com_decode.simps )
+  done
+
 
 fun push_con :: "Com.com \<Rightarrow> max_con list \<Rightarrow> max_con list " where 
 "push_con Com.com.SKIP s = SKIP # s"|
@@ -153,21 +173,6 @@ lemma sub_add_res:
     done
   done
 
-fun size_root :: "max_con \<Rightarrow> nat" where 
-"size_root (Seq_0 c1 c2) = Suc (size c1) + (size c2)"|
-"size_root (Seq_m c1 c2 _ ) = Suc (size c1) + (size c2) "|
-"size_root (Seq_f c1 c2 _ _ ) = Suc (size c1) + (size c2)"|
-"size_root (While_0 c) = Suc (size c)"|
-"size_root (While_f c _) = Suc(size c) "|
-"size_root (Bot _ ) = 0"|
-"size_root s = 1"
-
-fun size_out :: "max_con \<Rightarrow> nat" where
-"size_out (Seq_m c1 _ _) = size c1 "|
-"size_out (Seq_f c1 c2 _ _) =  size c1 + size c2"|
-"size_out (While_f c _) = size c"|
-"size_out c = 0"
-
 fun size_e :: "Com.com \<Rightarrow> nat" where 
 "size_e Com.com.SKIP = 1 "|
 "size_e (Com.com.Assign v a)  = 1"|
@@ -179,19 +184,27 @@ fun size_stack_rev :: "max_con list \<Rightarrow> nat" where
 "size_stack_rev (Seq_0 c1 c2# s) =  (if s = [] then Suc (2* (size_e c1 + size_e c2)) else  Suc (2 * size_e c2) + size_stack_rev s )  "|
 "size_stack_rev (Seq_m c1 c2 n#s) = (if s = [] then  Suc (2 * size_e c2) else  Suc (size_stack_rev s)) "|
 "size_stack_rev (While_0 c #s)  = (if s = [] then Suc (2* size_e c) else Suc (size_stack_rev s) )"|
-"size_stack_rev (Bot x # s) = size_stack_rev s"|
-"size_stack_rev (_#s) = Suc (size_stack_rev s)"|
-"size_stack_rev [] = 0"
+"size_stack_rev (Bot x # s) = (if s =[] then 0 else Suc (size_stack_rev s))"|
+"size_stack_rev (_#s) = (if s = [] then 1 else Suc (size_stack_rev s))"|
+"size_stack_rev [] = 1"
 
+lemma size_stack_0:"(size_stack_rev x = 0) = (\<exists>n. x = [Bot n]) "
+  apply(cases x)
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+    done
+ subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+   done
+  done
+
+  
 fun size_stack :: "max_con list \<Rightarrow> nat" where 
 "size_stack s = size_stack_rev (rev s)"
 
-fun compare :: "max_con list \<Rightarrow> max_con list \<Rightarrow> bool" where 
-"compare (Bot _ # _) _  = True"|
-"compare [] _ = True"|
-"compare (push_con c1 (Seq_0 c1 c2 # s) )  (Seq_0 c1 c2 # s) = True"|
-"compare (push_con c2 (Seq_m c1 c2 n # s) )  (Seq_m c1 c2 n # s) = True"|
-"compare (push_con c (While_0  c # s))   (While_0  c # s)  = True"
 lemma size_pos:"size_e c >0"
   apply(induct c)
       apply auto
@@ -207,14 +220,19 @@ size_stack_mono :" x \<noteq> [] \<Longrightarrow>y \<noteq>  [] \<Longrightarro
     done
   done
 
-lemma " (s = Seq_0 c1 c2 # s' \<or> s = Seq_m c1 c2 n # s' \<or> s = While_0 c # s') 
-  \<Longrightarrow> size_stack (add_res r s) < size_stack s "
-  using size_stack_mono size_pos
-  apply auto
-  done
 
 
-    
+lemma add_res_less:"\<forall>x. s \<noteq> [Bot x] \<and> a \<noteq> Bot x \<Longrightarrow> size_stack (add_res r s) < size_stack (a#s) "
+  apply(cases s)
+   apply auto
+   apply (cases a)
+  apply auto
+  subgoal for a xs
+    apply (cases a)
+    using size_stack_mono size_stack_0 nat_less_le    apply (auto )
+    done
+done
+
 
 function max_constant_stack :: "max_con list \<Rightarrow> nat" where 
 "max_constant_stack (Bot x # s) = x"|
@@ -224,32 +242,76 @@ function max_constant_stack :: "max_con list \<Rightarrow> nat" where
 "max_constant_stack (Seq_m c1 c2 n0 # s) = max_constant_stack (push_con c2  (Seq_m c1 c2 n0 # s))"|
 "max_constant_stack (Seq_f _ _ n m #s) = max_constant_stack (add_res (max n m) s)"|
 "max_constant_stack (While_0 c# s) = max_constant_stack (push_con c (While_0 c# s)) "|
-"max_constant_stack (While_f _  n# s) = max_constant_stack (add_res n s)"
-  by pat_completeness auto
-termination 
-  apply (relation "measure size_stack")
-         apply auto
-  subgoal for s
-    apply (cases s)
-     apply auto
-    subgoal for a xs
-      apply (cases a)
-      apply auto
-
+"max_constant_stack (While_f _  n# s) = max_constant_stack (add_res n s)"|
+"max_constant_stack [] = 0"
+  by pat_completeness  auto
+
+lemma max_const_stack_term:"All max_constant_stack_dom"
+proof  (relation "measure size_stack", goal_cases)
+case 1
+  then show ?case by auto
+next
+  case (2 s)
+  then show ?case using add_res_less apply auto
+    by (metis Suc_less_SucD add_res.simps(5) length_Cons length_append_singleton less_Suc_eq_0_disj
+ list.size(3) max_con.distinct(1) not_less_less_Suc_eq rev_singleton_conv size_stack_0)
+        
+next
+  case (3 v s)
+  then show ?case sorry
+next
+  case (4 c1 c2 s)
+  then show ?case sorry
+next
+  case (5 c1 c2 n0 s)
+  then show ?case sorry
+next
+  case (6 uu uv n m s)
+  then show ?case sorry
+next
+  case (7 c s)
+  then show ?case sorry
+next
+  case (8 uw n s)
+  then show ?case sorry
+qed
+
+qed
+
+  using add_res_less apply (auto)
+        apply (metis Suc_less_SucD add_res.simps length_Cons length_append_singleton less_Suc_eq_0_disj
+ list.size(3) max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
+  apply (metis Suc_less_SucD add_res.simps(5) length_Cons length_append_singleton less_Suc_eq_0_disj 
+list.size(3) max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
+  subgoal for c1 c2 s
+    apply (cases c1)
+        using size_stack_mono apply auto
+        done 
+subgoal for c1 c2 n0 s
+    apply (cases c2)
+        using size_stack_mono apply auto
+        done
+      apply (metis add_res.simps(5) append.left_neutral append_Cons max_con.distinct(9)
+ not_Cons_self2 rev.simps(1) rev.simps(2) size_stack_rev.simps(4) zero_less_Suc)
+      subgoal for c s
+        apply (cases c)
+        using size_stack_mono apply auto
+        done
+      apply (metis Suc_less_SucD add_res.simps(5) length_Cons length_append_singleton 
+less_Suc_eq_0_disj list.size(3) max_con.distinct(13) not_less_less_Suc_eq rev_singleton_conv 
+size_stack_0)
+      done
+
+termination using max_const_stack_term  by auto
+
+
+ 
 
 
 
-fun compare_max_con::  "max_con list \<Rightarrow> max_con list \<Rightarrow> bool" where
-"compare_max_con x y = compare_max_con' (rev x) (rev y)"
-
-lemma "s\<noteq> [] \<Longrightarrow> compare_max_con (a#s) s"
-  nitpick
-  apply (auto)
-  apply(induct s)
-   apply auto
-    
+   
 
-function max_constant_stack_nat :: "nat \<Rightarrow> nat" where 
+function (domintros) max_constant_stack_nat :: "nat \<Rightarrow> nat" where 
 " max_constant_stack_nat s = (let h = hd_nat s; t = tl_nat s;
   c = hd_nat h; e1 = nth_nat (Suc 0) h; e2 = nth_nat (Suc (Suc 0)) h;
  e3 = nth_nat (Suc (Suc (Suc 0))) h ; e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
@@ -261,9 +323,14 @@ else if c = 4 then   max_constant_stack_nat (add_res_nat (max e3 e4) t)
 else if c = 5 then   max_constant_stack_nat (push_con_nat e1 s) 
 else if c = 6 then  max_constant_stack_nat (add_res_nat e2 t)
 else e1)"
+  by pat_completeness auto
+thm "max_constant_stack_nat.pinduct"
+find_theorems "max_constant_stack_nat_dom"
+termination
+  apply (relation "measure (size_stack o (map max_con_decode) o list_decode)")
+         apply (auto simp del:add_res_nat.simps simp add: )
   sorry
-termination sorry
-
+         
 lemma list_encode_0:"(list_encode xs = 0) =  (xs = [])"
   by (metis list_encode.simps(1) list_encode_inverse)
 
@@ -313,6 +380,7 @@ lemma sub_max_constant_stack:
           del: list_encode.simps max_constant_stack_nat.simps
                 add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
                     aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
+  apply auto
   done
 
 
@@ -469,6 +537,57 @@ lemma sub_add_var:
     done
   done
 
+fun size_stack_rev_var :: "all_var list \<Rightarrow> nat" where
+"size_stack_rev_var (Seq_0 c1 c2# s) =  (if s = [] then Suc (2* (size_e c1 + size_e c2)) else  Suc (2 * size_e c2) + size_stack_rev_var s )  "|
+"size_stack_rev_var (Seq_m c1 c2 n#s) = (if s = [] then  Suc (2 * size_e c2) else  Suc (size_stack_rev_var s)) "|
+"size_stack_rev_var (If_0 _ c1 c2# s) =  (if s = [] then Suc (2* (size_e c1 + size_e c2)) else  Suc (2 * size_e c2) + size_stack_rev_var s )  "|
+"size_stack_rev_var (If_m _ c1 c2 n#s) = (if s = [] then  Suc (2 * size_e c2) else  Suc (size_stack_rev_var s)) "|
+"size_stack_rev_var (While_0 _ c #s)  = (if s = [] then Suc (2* size_e c) else Suc (size_stack_rev_var s) )"|
+"size_stack_rev_var (Bot x # s) = (if s =[] then 0 else Suc (size_stack_rev_var s))"|
+"size_stack_rev_var (_#s) = (if s = [] then 1 else Suc (size_stack_rev_var s))"|
+"size_stack_rev_var [] = 1"
+
+fun size_stack_var :: "all_var list \<Rightarrow> nat" where 
+"size_stack_var s = size_stack_rev_var (rev s)"
+
+lemma 
+size_stack_var_mono :" x \<noteq> [] \<Longrightarrow>y \<noteq>  [] \<Longrightarrow> size_stack_rev_var y < size_stack_rev_var x
+ \<Longrightarrow> size_stack_rev_var (s @ y) < size_stack_rev_var (s @ x) "
+  apply(induct s )
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto)
+    done
+  done
+
+lemma size_stack_var_0:"(size_stack_rev_var x = 0) = (\<exists>n. x = [Bot n]) "
+  apply(cases x)
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+    done
+ subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+   done
+  done
+
+
+lemma add_res_less_var:
+"\<forall>x. s \<noteq> [Bot x] \<and> a \<noteq> Bot x \<Longrightarrow> size_stack_var (add_var r s) < size_stack_var (a#s) "
+  apply(cases s)
+   apply auto
+   apply (cases a)
+  apply (auto simp add: size_stack_var_mono)
+  subgoal for a xs
+    apply (cases a)
+    using size_stack_var_mono size_stack_var_0 nat_less_le    apply (auto )
+    done
+  done
+
+
 function all_variables_stack :: "all_var list \<Rightarrow>vname list" where 
 "all_variables_stack (Bot x # s) = x"|
 "all_variables_stack (SKIP # s) = all_variables_stack (add_var [] s)"|
@@ -480,9 +599,39 @@ function all_variables_stack :: "all_var list \<Rightarrow>vname list" where
 "all_variables_stack (If_m v c1 c2 n0 # s) =all_variables_stack (push_var c2  (If_m v c1 c2 n0 # s))"|
 "all_variables_stack (If_f v _ _ n m #s) = all_variables_stack (add_var (v # n @ m) s)"|
 "all_variables_stack (While_0 v c# s) = all_variables_stack (push_var c (While_0 v c# s)) "|
-"all_variables_stack (While_f v _  n# s) = all_variables_stack (add_var (v#n) s)"
-  sorry
-termination sorry
+"all_variables_stack (While_f v _  n# s) = all_variables_stack (add_var (v#n) s)"|
+"all_variables_stack [] = []"
+  by pat_completeness auto
+termination 
+  apply (relation "measure size_stack_var")
+  using add_res_less_var  apply auto
+      
+           apply (metis add_var.simps(7)
+ all_var.distinct(1) append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
+  apply (metis add_var.simps(7) all_var.distinct(3) gr0I last_ConsL last_snoc rev_singleton_conv 
+size_stack_var_0)
+  subgoal for c1 c2 s
+    apply (cases c1)
+    using size_stack_var_mono apply auto done
+      subgoal for c1 c2 n s
+    apply (cases c2)
+        using size_stack_var_mono apply auto done
+      apply (metis add_var.simps(7) all_var.distinct(15) append_Cons append_self_conv2
+ not_Cons_self2 rev_singleton_conv size_stack_rev_var.simps(6) zero_less_Suc)
+  subgoal for v c1 c2 s
+    apply (cases c1)
+    using size_stack_var_mono apply auto done
+ subgoal for v c1 c2 n s
+    apply (cases c2)
+   using size_stack_var_mono apply auto done
+   apply (metis add_var.simps(7) all_var.distinct(9) list.inject neq0_conv 
+rev.simps(2) rev_singleton_conv size_stack_var_0)
+  subgoal for v c s
+    apply (cases c)
+    using size_stack_var_mono apply auto done
+  apply (metis add_var.simps(7) all_var.distinct(19) list.distinct(1) n_not_Suc_n neq0_conv
+ rev.simps(2) rev_singleton_conv size_stack_rev_var.simps(11) size_stack_var_0)
+  done
 
 function all_variables_stack_nat :: "nat \<Rightarrow> nat" where 
 "  all_variables_stack_nat s = (let h = hd_nat s; t = tl_nat s;

From e6a920639d5c063cbc35d23684da52a86e2292cb Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Sat, 4 Sep 2021 13:17:03 +0200
Subject: [PATCH 029/103] temrination order for stack simulation
 implementations on HOL level, HOL-nat not yet

---
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy | 109 +++++++++++++-
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      | 122 +++++++++++++++-
 .../IMP_Minus_Max_Constant_Nat.thy            | 138 +++++++++---------
 3 files changed, 294 insertions(+), 75 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index 3ba2c206..1c784c63 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -258,7 +258,59 @@ lemma sub_add_res_to_stack:
     done
   done
 
-  
+fun size_e :: "com \<Rightarrow> nat" where 
+"size_e com.SKIP = 1 "|
+"size_e (com.Assign v a)  = 1"|
+"size_e (com.Seq c1 c2) = Suc (size_e c1)"|
+"size_e (com.If v c1 c2) = 1"|
+"size_e (com.While v c) = 1"
+
+fun stack_size_rev :: "com_op list \<Rightarrow> nat" where 
+"stack_size_rev (Seq_0 c1 c2 # s ) = (if s = [] then Suc (2 * size_e c1) else 
+  Suc (stack_size_rev s))"|
+"stack_size_rev (Bot x # s) = (if s = [] then 0 else Suc (stack_size_rev s))"|
+"stack_size_rev (_ #s) = (if s = [] then 1 else Suc (stack_size_rev s))"|
+"stack_size_rev [] = 1"
+
+fun stack_size :: "com_op list \<Rightarrow> nat" where 
+"stack_size s = stack_size_rev (rev s)"
+
+lemma 
+stack_size_mono :" x \<noteq> [] \<Longrightarrow>y \<noteq>  [] \<Longrightarrow> stack_size_rev y < stack_size_rev x
+ \<Longrightarrow> stack_size_rev (s @ y) < stack_size_rev (s @ x) "
+  apply(induct s )
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto)
+    done
+  done
+
+lemma stack_size_0:"(stack_size_rev x = 0) = (\<exists>n. x = [Bot n]) "
+  apply(cases x)
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+    done
+ subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+   done
+  done
+
+lemma add_res_less:
+"\<forall>x. s \<noteq> [Bot x] \<and> a \<noteq> Bot x \<Longrightarrow> stack_size (add_res_to_stack_op r s) < stack_size (a#s) "
+  apply(cases s)
+   apply auto
+   apply (cases a)
+  apply (auto simp add: stack_size_mono)
+  subgoal for a xs
+    apply (cases a)
+    using stack_size_mono stack_size_0 nat_less_le    apply (auto )
+    done
+  done
+
 function com_to_operators_stack :: "com_op list \<Rightarrow> operator list" where 
 "com_to_operators_stack (Bot x # s) = x "|
 "com_to_operators_stack (SKIP# s) = com_to_operators_stack (add_res_to_stack_op [] s)"|
@@ -291,9 +343,58 @@ com_to_operators_stack (add_res_to_stack_op  (let i = PCV (com.While vs c) ;
         effect_of = [(PC, k)]\<rparr> 
       # map (\<lambda> v. 
       \<lparr> precondition_of = [(PC, i), (VN v, EV One)], 
-         effect_of = [(PC, j)]\<rparr>) vs) s)"
-  sorry
-termination sorry
+         effect_of = [(PC, j)]\<rparr>) vs) s)"|
+"com_to_operators_stack [] = []"
+  by pat_completeness auto
+termination
+proof (relation "measure stack_size",goal_cases)
+case 1
+then show ?case by auto
+next
+  case (2 s)
+  then show ?case using add_res_less apply auto
+    by (metis add_res_to_stack_op.simps butlast.simps(2) butlast_snoc com_op.distinct 
+neq0_conv not_Cons_self2 rev_singleton_conv stack_size_0)
+
+    
+next
+  case (3 v b s)
+   then show ?case using add_res_less apply auto
+     by (smt One_nat_def Zero_not_Suc add_res_to_stack_op.simps(3) 
+last_ConsL last_snoc less_nat_zero_code linorder_neqE_nat rev_singleton_conv 
+stack_size_0 stack_size_rev.simps(4))
+      
+next
+  case (4 c1 c2 s)
+  then show ?case using add_res_less apply auto
+     by (smt One_nat_def Zero_not_Suc add_res_to_stack_op.simps
+last_ConsL last_snoc less_nat_zero_code linorder_neqE_nat rev_singleton_conv 
+stack_size_0 stack_size_rev.simps)
+
+next
+  case (5 c1 c2 s)
+  then show ?case using stack_size_mono  by (cases c1) auto
+
+next
+  case (6 c1 c2 ops s)
+  then show ?case using add_res_less apply auto
+     by (smt One_nat_def Zero_not_Suc add_res_to_stack_op.simps
+last_ConsL last_snoc less_nat_zero_code linorder_neqE_nat rev_singleton_conv 
+stack_size_0 stack_size_rev.simps)
+next
+case (7 vs c1 c2 s)
+then show ?case using add_res_less apply auto
+     by (smt One_nat_def Zero_not_Suc add_res_to_stack_op.simps
+last_ConsL last_snoc less_nat_zero_code linorder_neqE_nat rev_singleton_conv 
+stack_size_0 stack_size_rev.simps)
+next
+  case (8 vs c s)
+  then show ?case using add_res_less apply auto
+     by (smt One_nat_def Zero_not_Suc add_res_to_stack_op.simps
+last_ConsL last_snoc less_nat_zero_code linorder_neqE_nat rev_singleton_conv 
+stack_size_0 stack_size_rev.simps)
+qed
+
 
 lemma com_to_operators_stack_correct:
 "com_to_operators_stack (push_to_stack_op c s) = com_to_operators_stack (add_res_to_stack_op (
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index a73c2aa7..5e74f14c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -145,6 +145,52 @@ lemma IMPm_IMPmm_list_id:
   apply auto
   done
 
+fun size_e :: "Com.com \<Rightarrow> nat" where 
+"size_e Com.com.SKIP = 1 "|
+"size_e (Com.com.Assign v a)  = 1"|
+"size_e (Com.com.Seq c1 c2) = Suc (size_e c1 + size_e c2)"|
+"size_e (Com.com.If v c1 c2) = Suc (size_e c1 + size_e c2)"|
+"size_e (Com.com.While v c) = Suc (size_e c)"
+
+fun size_stack_rev :: "IMPm_IMPmm list \<Rightarrow> nat" where
+"size_stack_rev (Seq_0 c1 c2 _# s) =  (if s = [] then Suc (2* (size_e c1 + size_e c2)) else  Suc (2 * size_e c2) + size_stack_rev s )  "|
+"size_stack_rev (Seq_m c1 c2 _ _#s) = (if s = [] then  Suc (2 * size_e c2) else  Suc (size_stack_rev s)) "|
+"size_stack_rev (If_0 _ c1 c2 _# s) =  (if s = [] then Suc (2* (size_e c1 + size_e c2)) else  Suc (2 * size_e c2) + size_stack_rev s )  "|
+"size_stack_rev (If_m _ c1 c2  _ _#s) = (if s = [] then  Suc (2 * size_e c2) else  Suc (size_stack_rev s)) "|
+"size_stack_rev (While_0 _ c _ #s)  = (if s = [] then Suc (2* size_e c) else Suc (size_stack_rev s) )"|
+"size_stack_rev (Bot x # s) = (if s =[] then 0 else Suc (size_stack_rev s))"|
+"size_stack_rev (_#s) = (if s = [] then 1 else Suc (size_stack_rev s))"|
+"size_stack_rev [] = 1"
+
+fun size_stack :: "IMPm_IMPmm list \<Rightarrow> nat" where 
+"size_stack s = size_stack_rev (rev s)"
+
+lemma 
+size_stack_mono :" x \<noteq> [] \<Longrightarrow>y \<noteq>  [] \<Longrightarrow> size_stack_rev y < size_stack_rev x
+ \<Longrightarrow> size_stack_rev (s @ y) < size_stack_rev (s @ x) "
+  apply(induct s )
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto)
+    done
+  done
+
+lemma size_stack_var_0:"(size_stack_rev x = 0) = (\<exists>n. x = [Bot n]) "
+  apply(cases x)
+   apply auto
+  subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+    done
+ subgoal for a xs
+    apply (cases a)
+           apply (auto split :if_splits)
+   done
+  done
+
+
+
 fun push_on_stack :: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
 "push_on_stack Com.SKIP n stack = SKIP n # stack "|
 "push_on_stack (Com.Assign v aexp) n stack =  ( Assign v aexp n) # stack "|
@@ -171,7 +217,7 @@ IMPm_IMPmm_list_encode (push_on_stack c n s)"
 
 
 
-      
+       
            
 fun add_result_to_stack :: "IMP_Minus_Minus_com \<Rightarrow> IMPm_IMPmm list \<Rightarrow> IMPm_IMPmm list" where 
 "add_result_to_stack c [] = [Bot c]"|
@@ -209,6 +255,19 @@ lemma sub_add_result_to_stack:
     done
   done
 
+lemma add_res_less:
+"\<forall>x. s \<noteq> [Bot x] \<and> a \<noteq> Bot x \<Longrightarrow> size_stack (add_result_to_stack r s) < size_stack (a#s) "
+  apply(cases s)
+   apply auto
+   apply (cases a)
+  apply (auto simp add: size_stack_var_mono)
+  subgoal for a xs
+    apply (cases a)
+    using size_stack_mono size_stack_var_0 nat_less_le    apply (auto )
+    done
+  done
+
+
 function IMP_Minus_to_IMP_Minus_Minus_stack :: "IMPm_IMPmm list \<Rightarrow> IMP_Minus_Minus_com" where 
 "IMP_Minus_to_IMP_Minus_Minus_stack (Seq_0 c1 c2 n #stack) = 
   IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c1 n (Seq_0 c1 c2 n #stack))"|
@@ -230,9 +289,64 @@ function IMP_Minus_to_IMP_Minus_Minus_stack :: "IMPm_IMPmm list \<Rightarrow> IM
   IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack ( IMP_Minus_Minus_Com.If (var_bit_list n v) c1  c2) stack)"|
 "IMP_Minus_to_IMP_Minus_Minus_stack (While_f v _ n c # stack) = 
   IMP_Minus_to_IMP_Minus_Minus_stack (add_result_to_stack (IMP_Minus_Minus_Com.While (var_bit_list n v) c) stack)"|
-"IMP_Minus_to_IMP_Minus_Minus_stack (Bot res # stack) =  res"
-  sorry
-termination sorry
+"IMP_Minus_to_IMP_Minus_Minus_stack (Bot res # stack) =  res"|
+"IMP_Minus_to_IMP_Minus_Minus_stack [] =  com.SKIP"
+  by pat_completeness  auto
+termination 
+proof  (relation "measure size_stack",goal_cases)
+case 1
+then show ?case by auto
+next
+  case (2 c1 c2 n stack)
+  then show ?case   using size_stack_mono by (cases c1)  auto
+next
+  case (3 c1 c2 n c3 stack)
+  then show ?case  using size_stack_mono by (cases c2)  auto
+next
+  case (4 v c1 c2 n stack)
+  then show ?case  using size_stack_mono by (cases c1)  auto
+next
+  case (5 v c1 c2 n c3 stack)
+  then show ?case  using size_stack_mono by (cases c2)  auto
+next
+  case (6 v c n stack)
+  then show ?case  using size_stack_mono by (cases c)  auto
+next
+  case (7 uu stack)
+  then show ?case using add_res_less apply auto
+    by (metis IMP_Minus_To_IMP_Minus_Minus_nat.size_stack_var_0 
+IMPm_IMPmm.distinct One_nat_def Suc_less_SucD Suc_mono add_result_to_stack.simps
+gr0I length_Cons length_append_singleton list.size(3) rev_singleton_conv zero_less_one)
+    
+next
+  case (8 v aexp n stack)
+  then show ?case  using add_res_less apply auto
+    by (metis IMP_Minus_To_IMP_Minus_Minus_nat.size_stack_var_0 
+IMPm_IMPmm.distinct One_nat_def Suc_less_SucD Suc_mono add_result_to_stack.simps
+gr0I length_Cons length_append_singleton list.size(3) rev_singleton_conv zero_less_one)
+
+next
+case (9 uv uw ux c1 c2 stack)
+  then show ?case  using add_res_less apply auto
+    by (metis IMP_Minus_To_IMP_Minus_Minus_nat.size_stack_var_0 
+IMPm_IMPmm.distinct One_nat_def Suc_less_SucD Suc_mono add_result_to_stack.simps
+gr0I length_Cons length_append_singleton list.size(3) rev_singleton_conv zero_less_one)
+
+next
+  case (10 v uy uz n c1 c2 stack)
+  then show ?case  using add_res_less apply auto
+    by (metis IMP_Minus_To_IMP_Minus_Minus_nat.size_stack_var_0 
+IMPm_IMPmm.distinct One_nat_def Suc_less_SucD Suc_mono add_result_to_stack.simps
+gr0I length_Cons length_append_singleton list.size(3) rev_singleton_conv zero_less_one)
+
+next
+  case (11 v va n c stack)
+  then show ?case  using add_res_less apply auto
+    by (metis IMP_Minus_To_IMP_Minus_Minus_nat.size_stack_var_0 
+IMPm_IMPmm.distinct One_nat_def Suc_less_SucD Suc_mono add_result_to_stack.simps
+gr0I length_Cons length_append_singleton list.size(3) rev_singleton_conv zero_less_one)
+
+qed
 
 
 function IMP_Minus_to_IMP_Minus_Minus_stack_nat :: "nat \<Rightarrow> nat" where 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 92c2f851..5bec5482 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -234,7 +234,7 @@ lemma add_res_less:"\<forall>x. s \<noteq> [Bot x] \<and> a \<noteq> Bot x \<Lon
 done
 
 
-function max_constant_stack :: "max_con list \<Rightarrow> nat" where 
+function max_constant_stack :: "max_con list \<Rightarrow> nat"where 
 "max_constant_stack (Bot x # s) = x"|
 "max_constant_stack (SKIP # s) = max_constant_stack (add_res 0 s)"|
 "max_constant_stack (Assign v # s) = max_constant_stack (add_res (aexp_max_constant v) s)"|
@@ -253,56 +253,40 @@ case 1
 next
   case (2 s)
   then show ?case using add_res_less apply auto
-    by (metis Suc_less_SucD add_res.simps(5) length_Cons length_append_singleton less_Suc_eq_0_disj
- list.size(3) max_con.distinct(1) not_less_less_Suc_eq rev_singleton_conv size_stack_0)
+    by (metis Suc_less_SucD add_res.simps length_Cons length_append_singleton less_Suc_eq_0_disj
+ list.size max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
         
 next
   case (3 v s)
-  then show ?case sorry
+  then show ?case using add_res_less apply auto
+    by (metis Suc_less_SucD add_res.simps length_Cons length_append_singleton less_Suc_eq_0_disj
+ list.size max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
 next
   case (4 c1 c2 s)
-  then show ?case sorry
+  then show ?case apply  (cases c1)
+      using size_stack_mono by auto
 next
   case (5 c1 c2 n0 s)
-  then show ?case sorry
+  then show ?case apply  (cases c2)
+      using size_stack_mono by auto
 next
   case (6 uu uv n m s)
-  then show ?case sorry
+  then show ?case using add_res_less apply auto
+    by (metis Suc_less_SucD add_res.simps length_Cons length_append_singleton less_Suc_eq_0_disj
+ list.size max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
 next
   case (7 c s)
-  then show ?case sorry
+  then show ?case apply  (cases c)
+      using size_stack_mono by auto
 next
   case (8 uw n s)
-  then show ?case sorry
+  then show ?case using add_res_less apply auto
+    by (metis Suc_less_SucD add_res.simps length_Cons length_append_singleton less_Suc_eq_0_disj
+ list.size max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
 qed
 
-qed
+termination using max_const_stack_term by auto
 
-  using add_res_less apply (auto)
-        apply (metis Suc_less_SucD add_res.simps length_Cons length_append_singleton less_Suc_eq_0_disj
- list.size(3) max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
-  apply (metis Suc_less_SucD add_res.simps(5) length_Cons length_append_singleton less_Suc_eq_0_disj 
-list.size(3) max_con.distinct not_less_less_Suc_eq rev_singleton_conv size_stack_0)
-  subgoal for c1 c2 s
-    apply (cases c1)
-        using size_stack_mono apply auto
-        done 
-subgoal for c1 c2 n0 s
-    apply (cases c2)
-        using size_stack_mono apply auto
-        done
-      apply (metis add_res.simps(5) append.left_neutral append_Cons max_con.distinct(9)
- not_Cons_self2 rev.simps(1) rev.simps(2) size_stack_rev.simps(4) zero_less_Suc)
-      subgoal for c s
-        apply (cases c)
-        using size_stack_mono apply auto
-        done
-      apply (metis Suc_less_SucD add_res.simps(5) length_Cons length_append_singleton 
-less_Suc_eq_0_disj list.size(3) max_con.distinct(13) not_less_less_Suc_eq rev_singleton_conv 
-size_stack_0)
-      done
-
-termination using max_const_stack_term  by auto
 
 
  
@@ -324,9 +308,7 @@ else if c = 5 then   max_constant_stack_nat (push_con_nat e1 s)
 else if c = 6 then  max_constant_stack_nat (add_res_nat e2 t)
 else e1)"
   by pat_completeness auto
-thm "max_constant_stack_nat.pinduct"
-find_theorems "max_constant_stack_nat_dom"
-termination
+termination 
   apply (relation "measure (size_stack o (map max_con_decode) o list_decode)")
          apply (auto simp del:add_res_nat.simps simp add: )
   sorry
@@ -603,35 +585,56 @@ function all_variables_stack :: "all_var list \<Rightarrow>vname list" where
 "all_variables_stack [] = []"
   by pat_completeness auto
 termination 
-  apply (relation "measure size_stack_var")
-  using add_res_less_var  apply auto
-      
-           apply (metis add_var.simps(7)
- all_var.distinct(1) append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
-  apply (metis add_var.simps(7) all_var.distinct(3) gr0I last_ConsL last_snoc rev_singleton_conv 
-size_stack_var_0)
-  subgoal for c1 c2 s
-    apply (cases c1)
-    using size_stack_var_mono apply auto done
-      subgoal for c1 c2 n s
-    apply (cases c2)
-        using size_stack_var_mono apply auto done
-      apply (metis add_var.simps(7) all_var.distinct(15) append_Cons append_self_conv2
- not_Cons_self2 rev_singleton_conv size_stack_rev_var.simps(6) zero_less_Suc)
-  subgoal for v c1 c2 s
-    apply (cases c1)
-    using size_stack_var_mono apply auto done
- subgoal for v c1 c2 n s
-    apply (cases c2)
-   using size_stack_var_mono apply auto done
-   apply (metis add_var.simps(7) all_var.distinct(9) list.inject neq0_conv 
-rev.simps(2) rev_singleton_conv size_stack_var_0)
-  subgoal for v c s
-    apply (cases c)
-    using size_stack_var_mono apply auto done
-  apply (metis add_var.simps(7) all_var.distinct(19) list.distinct(1) n_not_Suc_n neq0_conv
- rev.simps(2) rev_singleton_conv size_stack_rev_var.simps(11) size_stack_var_0)
-  done
+proof  (relation "measure size_stack_var",goal_cases)
+case 1
+  then show ?case by auto
+next
+  case (2 s)
+  then show ?case using add_res_less_var  apply auto
+    by (metis add_var.simps
+ all_var.distinct append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
+next
+  case (3 v a s)
+  then show ?case using add_res_less_var  apply auto
+    by (metis add_var.simps
+ all_var.distinct append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
+next
+  case (4 c1 c2 s)
+  then show ?case apply (cases c1) 
+    using size_stack_var_mono by auto
+next
+  case (5 c1 c2 n0 s)
+  then show ?case  apply (cases c2) 
+    using size_stack_var_mono by auto
+next
+  case (6 uu uv n m s)
+  then show ?case using add_res_less_var  apply auto
+    by (metis add_var.simps
+ all_var.distinct append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
+next
+  case (7 v c1 c2 s)
+  then show ?case  apply (cases c1) 
+    using size_stack_var_mono by auto
+next
+  case (8 v c1 c2 n0 s)
+  then show ?case  apply (cases c2) 
+    using size_stack_var_mono by auto
+next
+  case (9 v uw ux n m s)
+  then show ?case using add_res_less_var  apply auto
+    by (metis add_var.simps
+ all_var.distinct append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
+next
+  case (10 v c s)
+  then show ?case  apply (cases c) 
+    using size_stack_var_mono by auto
+next
+  case (11 v uy n s)
+  then show ?case using add_res_less_var  apply auto
+    by (metis add_var.simps
+ all_var.distinct append_self_conv2 gr0I last_snoc rev_singleton_conv size_stack_var_0)
+qed
+
 
 function all_variables_stack_nat :: "nat \<Rightarrow> nat" where 
 "  all_variables_stack_nat s = (let h = hd_nat s; t = tl_nat s;
@@ -723,6 +726,7 @@ apply(subst all_variables_stack_nat.simps)
                 add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
   apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
                 add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
+  apply auto
   done
 
 definition all_variables_t :: "Com.com \<Rightarrow> vname list" where 

From a8cd411b775266fe409ac24522f66f515e83853f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Mon, 6 Sep 2021 19:20:02 +0200
Subject: [PATCH 030/103] implemented and verified add_res

---
 .../IMP_Minus_Max_Constant_IMP_Minus.thy      | 288 +++++++++++++++++-
 IMP-/Big_StepT.thy                            |   3 +
 IMP-/IMP_Minus_Nat_Bijection.thy              | 100 +++++-
 3 files changed, 387 insertions(+), 4 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
index 75eec21b..a678899d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
@@ -92,8 +92,6 @@ definition aexp_max_constant_IMP_Minus_time where "aexp_max_constant_IMP_Minus_t
   + nth_nat_IMP_Minus_time 2 x +  atomExp_to_constant_IMP_Minus_time (nth_nat 2 x)
   + IMP_Minus_fst_nat_time (x - 1) + 11" 
 
-lemma Seq: "\<lbrakk>(c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3"
-  by auto
 
 lemma aexp_max_constant_IMP_Minus_correct:
   "(aexp_max_constant_IMP_Minus, s) 
@@ -138,4 +136,290 @@ lemma aexp_max_constant_IMP_Minus_correct:
   done
 
 
+definition add_res_nat_first_part where "add_res_nat_first_part \<equiv>
+  ''d'' ::= (A (V ''a'')) ;;
+  ''e'' ::= (A (V ''b'')) ;;
+
+  ''a'' ::= ((V ''e'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''f'' ::= (A (V ''fst_nat'')) ;;
+
+  ''a'' ::= ((V ''e'') \<ominus> (N 1)) ;;
+  IMP_Minus_snd_nat ;;
+  ''g'' ::= (A (V ''snd_nat'')) ;;
+
+  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''h'' ::= (A (V ''fst_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc 0))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''i'' ::= (A (V ''nth_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc (Suc 0)))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''j'' ::= (A (V ''nth_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc (Suc (Suc 0))))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus"
+
+definition add_res_nat_first_part_time where "add_res_nat_first_part_time n s \<equiv>
+  (let h = hd_nat s in
+    32 + 2 * IMP_Minus_fst_nat_time (s - 1) + IMP_Minus_fst_nat_time (h - 1)
+    + nth_nat_IMP_Minus_time (Suc 0) h + nth_nat_IMP_Minus_time (Suc (Suc 0)) h
+    + nth_nat_IMP_Minus_time (Suc (Suc (Suc 0))) h)"
+
+lemma add_res_nat_first_part_correct:
+  "(add_res_nat_first_part, s) \<Rightarrow>\<^bsup>add_res_nat_first_part_time (s ''a'') (s ''b'')\<^esup>
+    (let h = hd_nat (s ''b''); 
+         t = tl_nat (s ''b''); 
+         c = hd_nat h;  
+         e1 = nth_nat (Suc 0) h ; 
+         e2 = nth_nat (Suc (Suc 0)) h; 
+         e3 = nth_nat (Suc (Suc (Suc 0))) h in 
+       s(''a'' := 0,
+         ''b'' := 0,
+         ''c'' := 0,
+         ''d'' := s ''a'',
+         ''e'' := s ''b'',
+         ''f'' := h,
+         ''g'' := t,
+         ''h'' := c,
+         ''i'' := e1,
+         ''j'' := e2,
+         ''fst_nat'' := 0,
+         ''snd_nat'' := 0,
+         ''nth_nat'' := e3))"
+  unfolding Let_def add_res_nat_first_part_def add_res_nat_first_part_time_def hd_nat_def tl_nat_def
+  by (fastforce intro: terminates_in_time_state_intro[OF Seq] 
+      terminates_in_state_intro[OF nth_nat_IMP_Minus_correct]
+      IMP_Minus_fst_nat_correct IMP_Minus_snd_nat_correct)
+
+definition add_res_nat_second_part where "add_res_nat_second_part \<equiv>
+  ''k'' ::= (A (V ''d'')) ;;
+
+  cons_list_IMP_Minus [N 7, V ''k'', N 0] ;;   
+  cons_IMP_Minus (V ''cons'') (N 0) ;;
+  ''l'' ::= (A (V ''cons'')) ;;
+
+  cons_list_IMP_Minus [N 3, V ''i'', V ''j'', V ''k'', N 0] ;;
+  cons_IMP_Minus (V ''cons'') (V ''g'') ;;
+  ''m'' ::= (A (V ''cons'')) ;;
+  
+  cons_list_IMP_Minus [N 4, V ''i'', V ''j'', V ''nth_nat'', V ''k'', N 0] ;;
+  cons_IMP_Minus (V ''cons'') (V ''g'') ;;
+  ''n'' ::= (A (V ''cons'')) ;;
+
+  cons_list_IMP_Minus [N 6, V ''i'', V ''k'', N 0] ;;
+  cons_IMP_Minus (V ''cons'') (V ''g'') ;;
+
+  ''f'' ::= (A (N 0)) ;;
+  ''g'' ::= (A (N 0)) ;;
+  ''i'' ::= (A (N 0)) ;;
+  ''j'' ::= (A (N 0)) ;;
+  ''nth_nat'' ::= (A (N 0)) "
+
+definition add_res_nat_second_part_time where "add_res_nat_second_part_time n s \<equiv>
+  (let h = hd_nat s; 
+       t = tl_nat s; 
+       c = hd_nat h;  
+       e1 = nth_nat (Suc 0) h ; 
+       e2 = nth_nat (Suc (Suc 0)) h; 
+       e3 = nth_nat (Suc (Suc (Suc 0))) h;
+       l1 = [7, n, 0];
+       l2 = [3, e1, e2, n, 0];
+       l3 = [4, e1, e2, e3, n, 0];
+       l4 = [6, e1, n, 0]
+    in 
+      18 + cons_list_IMP_Minus_time l1 + cons_list_IMP_Minus_time l2 
+         + cons_list_IMP_Minus_time l3 + cons_list_IMP_Minus_time l4
+         + cons_IMP_Minus_time (cons_list l1) 0 + cons_IMP_Minus_time (cons_list l2) t
+         + cons_IMP_Minus_time (cons_list l3) t + cons_IMP_Minus_time (cons_list l4) t)"
+
+lemma add_res_nat_second_part_correct:  
+  "(add_res_nat_first_part ;; add_res_nat_second_part, s) 
+    \<Rightarrow>\<^bsup>add_res_nat_first_part_time (s ''a'') (s ''b'') 
+      + add_res_nat_second_part_time (s ''a'') (s ''b'') \<^esup>
+    (let h = hd_nat (s ''b''); 
+       t = tl_nat (s ''b''); 
+       c = hd_nat h;  
+       e1 = nth_nat (Suc 0) h ; 
+       e2 = nth_nat (Suc (Suc 0)) h; 
+       e3 = nth_nat (Suc (Suc (Suc 0))) h;
+       l1 = [7, s ''a'', 0];
+       l2 = [3, e1, e2, s ''a'', 0];
+       l3 = [4, e1, e2, e3, s ''a'', 0];
+       l4 = [6, e1, s ''a'', 0]
+    in 
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''e'' := s ''b'',
+        ''f'' := 0,
+        ''g'' := 0,
+        ''h'' := c,
+        ''i'' := 0,
+        ''j'' := 0,
+        ''fst_nat'' := 0,
+        ''snd_nat'' := 0,
+        ''nth_nat'' := 0,
+        ''k'' := s ''a'',
+        ''l'' := (cons_list l1) ## 0,
+        ''m'' := (cons_list l2) ## t,
+        ''n'' := (cons_list l3) ## t,
+        ''cons'' := (cons_list l4) ## t,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0))"
+  apply(rule terminates_in_state_intro[OF Seq'[OF add_res_nat_first_part_correct]])
+  unfolding add_res_nat_second_part_def add_res_nat_second_part_time_def Let_def
+  by (fastforce intro: cons_IMP_Minus_correct cons_list_IMP_Minus_correct)+
+
+(*"add_res_nat n s = ( d e
+  if s = 0 then  (7##n##0) ## 0
+else (
+let h =hd_nat s; f
+    t =tl_nat s; g
+    c = hd_nat h; h 
+    e1 = nth_nat (Suc 0) h ; i 
+    e2 = nth_nat (Suc (Suc 0)) h; j 
+    e3 = nth_nat (Suc (Suc (Suc 0))) h in nth_nat
+if c = 2 then (3##e1##e2##n##0)##t else 
+if c = 3 then (4##e1##e2##e3##n##0)##t else 
+if c = 5 then (6##e1##n##0)##t else s   *)
+
+definition add_res_nat_third_part where "add_res_nat_third_part \<equiv>
+  IF ''e'' \<noteq>0
+  THEN
+  (
+    ''a'' ::= ((V ''h'') \<ominus> (N 1)) ;;
+    IF ''a'' \<noteq>0
+    THEN
+    (
+      ''a'' ::= ((V ''h'') \<ominus> (N 3)) ;;
+      IF ''a'' \<noteq>0
+      THEN
+      (
+        ''a'' ::= ((V ''h'') \<ominus> (N 4)) ;;
+        IF ''a'' \<noteq>0
+        THEN
+        (
+           ''a'' ::= ((V ''h'') \<ominus> (N 5)) ;;
+           IF ''a'' \<noteq>0
+           THEN
+           (
+            ''add_res'' ::= (A (V ''e''))
+           )
+           ELSE
+           (
+            ''add_res'' ::= (A (V ''cons''))
+           )
+        )
+        ELSE
+        (
+          ''add_res'' ::= (A (V ''e'')) ;;
+          Com.SKIP ;; Com.SKIP ;; Com.SKIP
+        )
+      )
+      ELSE
+      (
+         ''a'' ::= ((V ''h'') \<ominus> (N 2)) ;;
+         IF ''a'' \<noteq>0
+         THEN 
+         (
+          ''add_res'' ::= (A (V ''n'')) 
+         )
+         ELSE
+         (
+          ''add_res'' ::= (A (V ''m''))
+         ) ;;
+        Com.SKIP ;; Com.SKIP ;; Com.SKIP
+      )
+    )
+    ELSE
+    (
+      ''add_res'' ::= (A (V ''e'')) ;;
+      Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+      Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+      Com.SKIP ;; Com.SKIP ;; Com.SKIP
+    )
+  )
+  ELSE
+  (
+    ''add_res'' ::= (A (V ''l'')) ;;
+    Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+    Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+    Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+    Com.SKIP ;; Com.SKIP ;; Com.SKIP
+  );;
+  ''a'' ::= (A (N 0)) ;;
+  ''e'' ::= (A (N 0)) ;;
+  ''h'' ::= (A (N 0)) ;;
+  ''k'' ::= (A (N 0)) ;;
+  ''l'' ::= (A (N 0)) ;;
+  ''m'' ::= (A (N 0)) ;;
+  ''n'' ::= (A (N 0)) ;;
+  ''cons'' ::= (A (N 0))"
+
+definition add_res_nat_IMP_Minus where "add_res_nat_IMP_Minus \<equiv>
+  add_res_nat_first_part ;;
+  add_res_nat_second_part ;;
+  add_res_nat_third_part"
+
+definition add_res_nat_IMP_Minus_time where "add_res_nat_IMP_Minus_time n s \<equiv>
+  add_res_nat_first_part_time n s
+  + add_res_nat_second_part_time n s
+  + 31"
+
+lemma add_res_nat_IMP_Minus_correct:
+  "(add_res_nat_IMP_Minus, s)
+   \<Rightarrow>\<^bsup>add_res_nat_IMP_Minus_time (s ''a'') (s ''b'') \<^esup>
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''e'' := 0,
+        ''f'' := 0,
+        ''g'' := 0,
+        ''h'' := 0,
+        ''i'' := 0,
+        ''j'' := 0,
+        ''fst_nat'' := 0,
+        ''snd_nat'' := 0,
+        ''nth_nat'' := 0,
+        ''k'' := 0,
+        ''l'' := 0,
+        ''m'' := 0,
+        ''n'' := 0,
+        ''cons'' := 0,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0,
+        ''add_res'' := add_res_nat (s ''a'') (s ''b''))"
+proof(cases "s ''b''")
+  case 0
+  show ?thesis
+    unfolding add_res_nat_IMP_Minus_def add_res_nat_IMP_Minus_time_def
+    apply(rule terminates_in_time_state_intro[OF Seq'
+          [OF add_res_nat_second_part_correct]])
+    unfolding add_res_nat_third_part_def Let_def
+    using \<open>s ''b'' = 0\<close> 
+    by(fastforce)+
+next
+  case (Suc nat)
+  let ?c = "hd_nat (hd_nat (s ''b''))"
+  have "?c = 0 \<or> ?c = 1 \<or> ?c = 2 \<or> ?c = 3 \<or> ?c = 4 \<or> ?c = 5 \<or> ?c > 5"
+    by auto
+  then show ?thesis
+    apply(elim disjE)
+    unfolding add_res_nat_IMP_Minus_def add_res_nat_IMP_Minus_time_def
+    unfolding add_res_nat_third_part_def Let_def
+    using \<open>s ''b'' = Suc nat\<close> 
+    by (fastforce 
+        intro!: terminates_in_time_state_intro[OF Seq'
+          [OF add_res_nat_second_part_correct]]
+        simp: Let_def)+
+qed
 end
\ No newline at end of file
diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index d09e784a..0d965034 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -73,6 +73,9 @@ inductive_cases Seq_tE[elim!]: "(c1;;c2,s1) \<Rightarrow>\<^bsup> p \<^esup> s3"
 inductive_cases If_tE[elim!]: "(IF b \<noteq>0 THEN c1 ELSE c2,s) \<Rightarrow>\<^bsup> x \<^esup> t"
 inductive_cases While_tE[elim]: "(WHILE b \<noteq>0 DO c,s) \<Rightarrow>\<^bsup> x \<^esup> t"
 
+lemma Seq': "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3  \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3"
+  by auto
+
 text "Rule inversion use examples:"
 lemma "(IF b \<noteq>0 THEN SKIP ELSE SKIP, s) \<Rightarrow>\<^bsup> x \<^esup> t \<Longrightarrow> t = s"
   by blast
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index a33c2d0b..ee94f974 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -33,16 +33,19 @@ definition IMP_Minus_prod_encode where "IMP_Minus_prod_encode \<equiv>
   ''prod_encode'' ::= ((V ''triangle'') \<oplus> (V ''prod_encode'')) ;;
   ''triangle'' ::= (A (N 0))"
 
+definition IMP_Minus_prod_encode_time where "IMP_Minus_prod_encode_time x y \<equiv>
+  mul_time (1 + x + y) + 14"
+
 lemma IMP_Minus_prod_encode_correct: 
   "(IMP_Minus_prod_encode, s) 
-      \<Rightarrow>\<^bsup>mul_time (1 + s ''a'' + s ''b'') + 14\<^esup> 
+      \<Rightarrow>\<^bsup>IMP_Minus_prod_encode_time (s ''a'') (s ''b'')\<^esup> 
       s(''a'' := 0,
         ''b'' := 0,
         ''c'' := 0,
         ''d'' := 0,
         ''triangle'' := 0,
         ''prod_encode'' := prod_encode (s ''a'', s ''b''))"
-  unfolding IMP_Minus_prod_encode_def prod_encode_def
+  unfolding IMP_Minus_prod_encode_def prod_encode_def IMP_Minus_prod_encode_time_def
   by(force
       intro: terminates_in_state_intro[OF Seq[OF Seq]]
         IMP_Minus_triangle_correct)
@@ -226,4 +229,97 @@ lemma nth_nat_IMP_Minus_correct:
             intro!: terminates_in_state_intro[OF Seq] 
               IMP_Minus_fst_nat_correct nth_nat_loop_correct)+
 
+definition cons_IMP_Minus :: "atomExp \<Rightarrow> atomExp \<Rightarrow> Com.com" 
+  where "cons_IMP_Minus h t \<equiv> 
+    ''a'' ::= (A h) ;;
+    ''b'' ::= (A t) ;;
+    IMP_Minus_prod_encode ;;
+    ''cons'' ::= ((V ''prod_encode'') \<oplus> (N 1)) ;;
+    ''prod_encode'' ::= (A (N 0))"
+
+definition cons_IMP_Minus_time where "cons_IMP_Minus_time h t \<equiv>
+  8 + IMP_Minus_prod_encode_time h t"
+
+lemma cons_IMP_Minus_correct:
+  "t \<noteq> (V ''a'') \<Longrightarrow>
+    (cons_IMP_Minus h t, s) \<Rightarrow>\<^bsup>cons_IMP_Minus_time (atomVal h s) (atomVal t s)\<^esup>
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''d'' := 0,
+      ''triangle'' := 0,
+      ''prod_encode'' := 0,
+      ''cons'' := (atomVal h s) ## (atomVal t s))"
+  unfolding cons_IMP_Minus_def cons_IMP_Minus_time_def cons_def
+  by (cases t) (fastforce intro!: terminates_in_state_intro[OF Seq] IMP_Minus_prod_encode_correct)+
+
+fun cons_list_IMP_Minus :: "atomExp list \<Rightarrow> Com.com" where
+"cons_list_IMP_Minus [] = Com.SKIP" |
+"cons_list_IMP_Minus (a # as) = (if as = [] 
+  then 
+    ''cons'' ::= (A a) ;;
+    ''a'' ::= (A (N 0)) ;;
+    ''b'' ::= (A (N 0)) ;;
+    ''c'' ::= (A (N 0)) ;;
+    ''d'' ::= (A (N 0)) ;;
+    ''triangle'' ::= (A (N 0)) ;;
+    ''prod_encode'' ::= (A (N 0))
+  else
+    cons_list_IMP_Minus as ;;
+    cons_IMP_Minus a (V ''cons''))"
+
+fun cons_list :: "nat list \<Rightarrow> nat" where
+"cons_list [] = 0" |
+"cons_list (a # as) = 
+  (if as = [] 
+   then a
+   else a ## cons_list as)"
+
+fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
+"cons_list_IMP_Minus_time [] = 1" | 
+"cons_list_IMP_Minus_time (a # as) = 
+  (if as = [] 
+   then 14
+   else cons_list_IMP_Minus_time as + cons_IMP_Minus_time a (cons_list as))"
+
+lemma cons_list_IMP_Minus_correct:
+  "as \<noteq> [] 
+    \<Longrightarrow> (\<forall>i \<in> set as. i \<notin> V ` { ''cons'', ''a'', ''b'', ''c'', ''d'', ''triangle'', ''prod_encode''}) 
+    \<Longrightarrow> (cons_list_IMP_Minus as, s) \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. atomVal i s) as)\<^esup>
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0,
+        ''cons'' := cons_list (map (\<lambda>i. atomVal i s) as))"
+proof(induction as arbitrary: s)
+  case (Cons a as)
+  then show ?case
+  proof (cases as)
+    case Nil
+    then show ?thesis
+      by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])
+  next
+    case (Cons b bs)
+
+    hence "as \<noteq> []" by simp
+    have *: "(\<forall>i \<in> set as. i \<notin> V ` { ''cons'', ''a'', ''b'', ''c'', ''d'',
+       ''triangle'', ''prod_encode''})"
+      using \<open>\<forall>i\<in>set (a # as). i \<notin> V ` {''cons'', ''a'', ''b'', ''c'', ''d'', ''triangle'',
+             ''prod_encode''}\<close>
+      by simp
+
+    show ?thesis
+      apply(cases a; rule terminates_in_state_intro)
+      using \<open>as \<noteq> []\<close> 
+        \<open>\<forall>i\<in>set (a # as). i \<notin> V ` {''cons'', ''a'', ''b'', ''c'', ''d'', ''triangle'',
+           ''prod_encode''}\<close> 
+      by(fastforce intro!: Cons.IH[OF _ *] cons_IMP_Minus_correct)+
+  qed
+qed auto
+
+declare cons_list_IMP_Minus.simps [simp del]
+declare cons_list_IMP_Minus_time.simps [simp del]
+
 end
\ No newline at end of file

From 84fc9c2ae5b958c340bfd73570cd1e95308722ae Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Tue, 7 Sep 2021 08:27:42 +0200
Subject: [PATCH 031/103] show termination for nat, only for valid input and
 replace correctness proofs with psimps

---
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy | 268 +++++++--
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      | 239 ++++++--
 .../IMP_Minus_Max_Constant_Nat.thy            | 550 ++++++++++++++----
 3 files changed, 868 insertions(+), 189 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index 1c784c63..b3f0a07b 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -220,14 +220,15 @@ fun push_to_stack_op :: "com \<Rightarrow> com_op list \<Rightarrow> com_op list
 "push_to_stack_op (com.If v c1 c2) s = If v c1 c2 #s"|
 "push_to_stack_op (com.While v c) s = While v c #s"
 
-fun push_to_stack_op_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition push_to_stack_op_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "push_to_stack_op_nat c s = (c ## s)"
 
 lemma sub_push_to_stack_op :
 "push_to_stack_op_nat (comm_encode c) (list_encode (map com_op_encode  s))
  = list_encode (map com_op_encode (push_to_stack_op c s)) "
   apply(cases c)
-      apply(auto simp add: sub_cons  simp del:list_encode.simps)
+      apply(auto simp add:  push_to_stack_op_nat_def 
+sub_cons  simp del:list_encode.simps)
   done
 
 fun add_res_to_stack_op :: "operator list \<Rightarrow> com_op list \<Rightarrow> com_op list" where 
@@ -235,7 +236,7 @@ fun add_res_to_stack_op :: "operator list \<Rightarrow> com_op list \<Rightarrow
 "add_res_to_stack_op op (Seq_0 c1 c2 # s) = Seq_f c1 c2 op # s"|
 "add_res_to_stack_op op s = s"
 
-fun add_res_to_stack_op_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition add_res_to_stack_op_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "add_res_to_stack_op_nat op s = (if s = 0 then (6 ## op ## 0)##0
 else if hd_nat (hd_nat s) = 2 then (5 ## (nth_nat (Suc 0) (hd_nat s)) ## (nth_nat (Suc (Suc 0)) (hd_nat s)) ## op ## 0)## (tl_nat s)
 else s)"
@@ -247,7 +248,7 @@ lemma sub_add_res_to_stack:
 "add_res_to_stack_op_nat (list_encode (map operator_encode op)) (list_encode (map com_op_encode s))
  = list_encode (map com_op_encode (add_res_to_stack_op op s))"
    apply(cases s)
-  apply (auto simp add: sub_hd list_encode_0  sub_cons cons0  simp del: list_encode.simps  )
+  apply (auto simp add: sub_hd add_res_to_stack_op_nat_def list_encode_0  sub_cons cons0  simp del: list_encode.simps  )
   subgoal for a xs
     apply(cases a)
       apply (auto simp add: sub_nth sub_tl sub_hd list_encode_0  sub_cons cons0  simp del: list_encode.simps  )
@@ -413,9 +414,8 @@ lemma subtailnat_com_to_operators:
   done
 
 
-
-function com_to_operators_stack_nat :: "nat \<Rightarrow> nat" where 
-"com_to_operators_stack_nat s = (let c = hd_nat s ; t = tl_nat s in  
+function (domintros) com_to_operators_stack_nat :: "nat \<Rightarrow> nat" where 
+"com_to_operators_stack_nat s = ( if s = 0 then 0 else let c = hd_nat s ; t = tl_nat s in  
 (if hd_nat c = 0 then com_to_operators_stack_nat (add_res_to_stack_op_nat 0 t) else 
 if hd_nat c = 1 then com_to_operators_stack_nat (add_res_to_stack_op_nat ((
                         ((prod_encode(0,prod_encode(1,c)))##0)
@@ -432,21 +432,20 @@ else if hd_nat c = 2 then (let c1 = nth_nat (Suc 0) c; c2= nth_nat (Suc (Suc 0))
 else  com_to_operators_stack_nat (push_to_stack_op_nat c1 s)))
 else if hd_nat c = 3 then 
 (let i = prod_encode (1, c); vs = nth_nat (Suc 0) c ; c1 = nth_nat (Suc (Suc 0)) c ; c2 = nth_nat (Suc (Suc (Suc 0))) c
-   in com_to_operators_stack_nat (add_res_to_stack_op_nat (( ((prod_encode(0, i)) ## map_com_to_operators2_tail (remdups_nat vs))## 
+   in com_to_operators_stack_nat (add_res_to_stack_op_nat (( ((prod_encode(0, i)) ## map_com_to_operators2_tail (remdups_tail vs))## 
         ((prod_encode(0, prod_encode(1, c2)))##0)## 0)
       ## map_com_to_operators3_tail i c1 vs ) t ) )
 else  if hd_nat c = 4 then (let i = prod_encode(1,c) ;  vs = nth_nat (Suc 0) c ; c' = nth_nat (Suc (Suc 0)) c ; 
   j = prod_encode(1, (2##c'## c##0)); k = prod_encode(1, 0##0) in 
-  com_to_operators_stack_nat (add_res_to_stack_op_nat (( ((prod_encode(0, i)) ##  map_com_to_operators2_tail (remdups_nat vs))## 
+  com_to_operators_stack_nat (add_res_to_stack_op_nat (( ((prod_encode(0, i)) ##  map_com_to_operators2_tail (remdups_tail vs))## 
         (((prod_encode(0, k))##0))##0) 
       ## map_com_to_operators4_tail i j vs) t))
 else if hd_nat c = 5 then 
 (let ops = nth_nat (Suc (Suc (Suc 0))) c; c2 = nth_nat (Suc (Suc 0)) c ; c1 = nth_nat (Suc 0) c  in  com_to_operators_stack_nat (add_res_to_stack_op_nat  (map_com_to_operators_tail (2 ## c1 ##c2 ## 0) c2 ops) t))
 else nth_nat (Suc 0) c
 ))
-"  
- sorry
-termination sorry
+"  by pat_completeness auto
+ 
 
 
 
@@ -516,26 +515,195 @@ lemma list_update_nat_zero: "list_update_nat 0 0 n = 0"
   apply auto
   done
 
+lemma  simp_op_id:"\<lparr>sas_plus_operator.precondition_of =
+                       sas_plus_operator.precondition_of a,
+                       effect_of = effect_of a\<rparr> = a"
+  by auto
+lemma ev_zero_encode:"prod_encode (0,0) = domain_element_encode (EV Zero)"
+  apply auto
+  done
+lemma com_to_operators_term:
+"com_to_operators_stack_nat_dom (list_encode (map  com_op_encode s))"
+proof (induct s rule: com_to_operators_stack.induct)
+case (1 x s)
+  then show ?case using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode [6, list_encode (map operator_encode x)] # map com_op_encode s)"]
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps )    
+done
+next
+  case (2 s)
+  then show ?case using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode [0] # map com_op_encode s)"]
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps )  
+       apply (simp only: sub_add_res_to_stack list_encode_eq  Nil_is_map_op   flip: list_encode.simps  )
+    apply simp
+done
+next
+  case (3 v b s)
+  then show ?case  using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode [1, vname_encode v, bit_encode b] # map com_op_encode s)"]
+        apply(simp only: One_nat_def non_empty_positive list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+         
+  apply(simp only:   flip: comm_encode.simps One_nat_def del:list_encode.simps)
+      apply (simp only:sub_hd  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps )
+      apply (simp only: nth.simps  sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps  flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+    done
+next
+  case (4 c1 c2 s)
+  then show ?case  using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode [2, comm_encode c1, comm_encode c2] # map com_op_encode s)"]
+    apply (cases "c1=com.SKIP")
+        apply(auto simp only: non_empty_positive list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def  
+                   simp del: list_encode.simps ) 
+  apply( simp only:    flip: comm_encode.simps One_nat_def  del:list_encode.simps)
+      apply (auto  simp only:sub_hd  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  simp flip:  domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps )[1]
+      apply ( auto simp only: sub_hd sub_add_res_to_stack sub_push_to_stack_op op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps   simp  flip:  domain_element_encode.simps  sas_assignment_encode.simps )
+    apply (auto simp only:sub_push_to_stack_op sub_add_res_to_stack list_encode_0 comm_inj_simps simp flip: One_nat_def com_op_encode.simps(3) comm_encode.simps(1) list.map(2) split: if_splits)
+    apply auto
+    done
+next
+  case (5 c1 c2 ops s)
+  then show ?case   using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode  [5, comm_encode c1, comm_encode c2, list_encode (map operator_encode ops)] # map com_op_encode s)"]
+        apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+    apply(simp only:subtail_map_com_to_operators
+        submap_com_to_operators   sub_nth nth.simps  flip: comm_encode.simps del:list_encode.simps)
+      apply (simp only:sub_hd sub_list_update  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps  flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+      apply (auto simp only: sub_hd list_encode_eq suc_eq list_encode_empty comm_encode_eq head.simps sub_cons cons0 sub_map sub_map_dec sub_nth com_to_operators.simps
+                         sub_list_update sas_plus_operator.simps sas_assignment_list_encode_def list.map prod_encode_eq  nth.simps sub_pc_to_com Let_def comp_def operator_encode_def
+  domain_element_encode.simps  variable_encode.simps  sas_assignment_encode.simps
+    map_map list_encode_inverse subtail_remdups sub_remdups  comm_encode.simps submap_com_to_operators
+  simp flip: comm_encode.simps
+                          del: list_encode.simps hd_nat_def cons_def pc_to_com_nat_def map_nat.simps nth_nat.simps list_update_nat.simps split:if_splits)
+  apply (auto simp only:sub_pc_to_com simp flip:  sas_assignment_list_encode_def  comm_encode.simps )
+    apply (auto simp only:  operator_encode_simps sas_assignment_list_encode_def list.simps map_update 
+            sas_assignment_encode.simps variable_encode.simps domain_element_encode.simps  simp flip:  sas_assignment_encode.simps sas_assignment_list_encode_def map_update  variable_encode.simps domain_element_encode.simps comm_encode.simps)
+     apply (auto simp only:  simp flip:comp_def[of operator_encode 
+"\<lambda>x.  \<lparr>sas_plus_operator.precondition_of = (sas_plus_operator.precondition_of x)
+                           [variable_encode PC := (PC, PCV (_;; _))],
+                           effect_of = (effect_of x)
+                             [variable_encode PC := (PC, PCV (pc_to_com (effect_of x);; _))]\<rparr>"
+
+ ] )
+    apply(auto simp only:sub_add_res_to_stack simp_op_id simp flip: map_map)
+    apply auto
+    done
+
+next
+  case (6 vs c1 c2 s)
+  then show ?case  using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode   [3, list_encode (map vname_encode vs), comm_encode c1, comm_encode c2] # map com_op_encode s)"]
+        apply(simp only: non_empty_positive subtail_remdups sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+    apply(simp only:subtail_map_com_to_operators2
+        submap_com_to_operators2  subtail_map_com_to_operators3
+        submap_com_to_operators3   sub_nth nth.simps  flip: comm_encode.simps  vname_list_encode_def del:list_encode.simps)
+      apply (simp only:sub_hd sub_list_update  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps   variable_encode.simps  flip:  bit_encode.simps domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+    apply( simp only: bit_encode.simps  flip:One_nat_def domain_element_encode.simps)
+    apply (simp only:  flip: bit_encode.simps)
+  using vname_inj
+   apply(simp only: remdups_map  map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
+  apply(simp only: ev_zero_encode  bit_encode.simps(1) cons0 sub_cons sub_map flip:  sas_assignment_encode.simps domain_element_encode.simps )
+  apply (simp only:  flip: sas_assignment_encode.simps   variable_encode.simps  comp_def[of sas_assignment_encode "\<lambda>x. (VN x, EV Zero)"] map_map list.map(2))
+   apply( simp only: sub_map vname_list_encode_def map_map comp_def sas_singleton sas_couple operator_encode_simps sub_cons flip: variable_encode.simps sas_assignment_encode.simps  sas_assignment_list_encode_def ) 
+  apply( simp only: sub_add_res_to_stack flip: map_map list.map comp_def [of operator_encode "\<lambda>x. \<lparr>sas_plus_operator.precondition_of =
+                                                [(PC, PCV (IF _\<noteq>0 THEN _ ELSE _)), (VN x, EV One)],
+                                                effect_of = [(PC, PCV _)]\<rparr>" ])
+  apply simp
+ done
+next
+  case (7 vs c s)
+  then show ?case  using com_to_operators_stack_nat.domintros[of 
+        "list_encode
+       (list_encode   [4, list_encode (map vname_encode vs), comm_encode c] # map com_op_encode s)"]
+       apply(simp only: subtail_remdups sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+                        nth.simps com_to_operators_stack.simps
+                        add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
+                   del: list_encode.simps ) 
+    apply(simp only:subtail_map_com_to_operators4
+        submap_com_to_operators4  subtail_map_com_to_operators2
+        submap_com_to_operators2   sub_nth nth.simps  flip: comm_encode.simps  vname_list_encode_def del:list_encode.simps)
+      apply (simp only:sub_hd sub_list_update  head.simps sub_cons cons0 sub_map sub_nth
+                                      nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
+      apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
+                                      nth.simps   variable_encode.simps  flip:  bit_encode.simps domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
+      apply( simp only: bit_encode.simps  flip:One_nat_def domain_element_encode.simps)
+    apply (simp only:  flip: bit_encode.simps)
+  using vname_inj
+   apply(simp only: remdups_map  map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
+  apply(simp only: ev_zero_encode  bit_encode.simps(1) cons0 sub_cons sub_map flip:  sas_assignment_encode.simps domain_element_encode.simps )
+  apply (simp only:  flip: sas_assignment_encode.simps   variable_encode.simps  comp_def[of sas_assignment_encode "\<lambda>x. (VN x, EV Zero)"] map_map list.map(2))
+   apply( simp only: sub_map vname_list_encode_def map_map comp_def sas_singleton sas_couple operator_encode_simps sub_cons flip: variable_encode.simps sas_assignment_encode.simps  sas_assignment_list_encode_def )
+  apply( simp only: sub_add_res_to_stack flip: map_map list.map(2) comp_def [of operator_encode "\<lambda>x.\<lparr>sas_plus_operator.precondition_of =
+                                                     [(PC, PCV (WHILE _\<noteq>0 DO _ )), (VN x, EV One)],
+                                                     effect_of = [(PC, PCV (_;; WHILE _\<noteq>0 DO _))]\<rparr>" ])
+  apply simp
+  done
+next
+  case 8
+  then show ?case by (auto intro: com_to_operators_stack_nat.domintros)
+qed
+
 lemma sub_com_to_operators_stack:
-"s \<noteq> [] \<Longrightarrow> com_to_operators_stack_nat (list_encode (map  com_op_encode s))
+" com_to_operators_stack_nat (list_encode (map  com_op_encode s))
 = list_encode (map operator_encode(com_to_operators_stack s))"
-  apply(induct s rule: com_to_operators_stack.induct)
-        apply(auto simp only:add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
-                  simp del: list_encode.simps )
-        apply(subst com_to_operators_stack_nat.simps)
+proof (induct s rule: com_to_operators_stack.induct)
+case (1 x s)
+  then show ?case apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
         apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
                         add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
                    del: list_encode.simps )    
-        apply simp
-         apply(subst com_to_operators_stack_nat.simps)
+    apply simp
+done
+next
+  case (2 s)
+  then show ?case  apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
         apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
                         add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
                    del: list_encode.simps )  
        apply (simp only: sub_add_res_to_stack list_encode_eq  Nil_is_map_op   flip: list_encode.simps  )
-       apply simp
-         apply(subst com_to_operators_stack_nat.simps)
+    apply simp
+done
+next
+  case (3 v b s)
+  then show ?case  apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
         apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
                         add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
@@ -545,9 +713,12 @@ lemma sub_com_to_operators_stack:
                                       nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps )
       apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
                                       nth.simps  flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
-      apply simp
-     apply(subst com_to_operators_stack_nat.simps)
-  subgoal for c1 c2 s
+    apply simp
+    done
+next
+  case (4 c1 c2 s)
+  then show ?case apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
     apply (cases "c1=com.SKIP")
         apply(auto simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
@@ -559,9 +730,12 @@ lemma sub_com_to_operators_stack:
       apply ( simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
                                       nth.simps   flip:  domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
      apply simp
-    apply (auto simp only:sub_push_to_stack_op  comm_inj_simps simp flip: com_op_encode.simps(3) comm_encode.simps(1) list.map(2) split: if_splits)
+    apply (auto simp only:sub_push_to_stack_op list_encode_0 comm_inj_simps simp flip: com_op_encode.simps(3) comm_encode.simps(1) list.map(2) split: if_splits)
     done
-         apply(subst com_to_operators_stack_nat.simps)
+next
+  case (5 c1 c2 ops s)
+  then show ?case apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
         apply(simp only: list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
                         add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
@@ -575,7 +749,7 @@ lemma sub_com_to_operators_stack:
       apply (auto simp only: sub_hd list_encode_eq suc_eq list_encode_empty comm_encode_eq head.simps sub_cons cons0 sub_map sub_map_dec sub_nth com_to_operators.simps
                          sub_list_update sas_plus_operator.simps sas_assignment_list_encode_def list.map prod_encode_eq  nth.simps sub_pc_to_com Let_def comp_def operator_encode_def
   domain_element_encode.simps  variable_encode.simps  sas_assignment_encode.simps
-    map_map list_encode_inverse sub_remdups  comm_encode.simps submap_com_to_operators
+    map_map list_encode_inverse subtail_remdups sub_remdups  comm_encode.simps submap_com_to_operators
   simp flip: comm_encode.simps
                           del: list_encode.simps hd_nat_def cons_def pc_to_com_nat_def map_nat.simps nth_nat.simps list_update_nat.simps split:if_splits)
   apply (auto simp only:sub_pc_to_com simp flip:  sas_assignment_list_encode_def  comm_encode.simps )
@@ -588,9 +762,14 @@ lemma sub_com_to_operators_stack:
                              [variable_encode PC := (PC, PCV (pc_to_com (effect_of x);; _))]\<rparr>"
 
  ] )
-     apply(auto simp only:sub_add_res_to_stack simp flip: map_map)
-  apply(subst com_to_operators_stack_nat.simps)
-        apply(simp only:  sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+     apply(auto simp only:sub_add_res_to_stack simp_op_id simp flip: map_map)
+    done
+
+next
+  case (6 vs c1 c2 s)
+  then show ?case apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
+        apply(simp only: subtail_remdups sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
                         add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
                    del: list_encode.simps ) 
@@ -601,7 +780,7 @@ lemma sub_com_to_operators_stack:
                                       nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
       apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
                                       nth.simps   variable_encode.simps  flip:  bit_encode.simps domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
-   apply(subst (4) bit_encode.simps) 
+   apply(subst (6) bit_encode.simps) 
    apply( simp only: flip: domain_element_encode.simps)
   using vname_inj
    apply(simp only: remdups_map  map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
@@ -611,9 +790,12 @@ lemma sub_com_to_operators_stack:
                                                 [(PC, PCV (IF _\<noteq>0 THEN _ ELSE _)), (VN x, EV One)],
                                                 effect_of = [(PC, PCV _)]\<rparr>" ])
    apply simp
-
-apply(subst com_to_operators_stack_nat.simps)
-        apply(simp only:  sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
+done
+next
+  case (7 vs c s)
+  then show ?case apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
+        apply(simp only: subtail_remdups sub_remdups vname_list_encode_def list.simps head.simps tail.simps com_op_encode.simps cons0 sub_cons sub_nth
                         nth.simps com_to_operators_stack.simps
                         add_res_not_Nil push_stack_not_Nil sub_hd sub_tl Let_def 
                    del: list_encode.simps ) 
@@ -624,17 +806,29 @@ apply(subst com_to_operators_stack_nat.simps)
                                       nth.simps  flip: domain_element_encode.simps  variable_encode.simps sas_assignment_encode.simps comm_encode.simps del: list_encode.simps )
       apply (simp only:sub_hd sub_add_res_to_stack op_singleton operator_encode_simps  sas_singleton sas_couple  head.simps sub_cons cons0 sub_map sub_nth variable_encode.simps(1)
                                       nth.simps   variable_encode.simps  flip:  bit_encode.simps domain_element_encode.simps  sas_assignment_encode.simps comm_encode.simps )
-   apply(subst (8) bit_encode.simps) 
+   apply(subst (10) bit_encode.simps) 
    apply( simp only: flip: domain_element_encode.simps)
   using vname_inj
-   apply(simp only: remdups_map  map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
+   apply(simp only: remdups_map map_map comp_def flip: variable_encode.simps sas_assignment_encode.simps)
    apply(simp only: bit_encode.simps(1) cons0 sub_cons sub_map flip: domain_element_encode.simps comp_def[of sas_assignment_encode "\<lambda>x. (VN x, EV Zero)"] map_map list.map(2))
    apply( simp only: sub_map vname_list_encode_def map_map comp_def sas_singleton sas_couple operator_encode_simps sub_cons flip: variable_encode.simps sas_assignment_encode.simps  sas_assignment_list_encode_def ) 
   apply( simp only: sub_add_res_to_stack flip: map_map list.map(2) comp_def [of operator_encode "\<lambda>x.\<lparr>sas_plus_operator.precondition_of =
                                                      [(PC, PCV (WHILE _\<noteq>0 DO _ )), (VN x, EV One)],
                                                      effect_of = [(PC, PCV (_;; WHILE _\<noteq>0 DO _))]\<rparr>" ])
-   apply simp
+  apply simp
   done
+next
+  case 8
+  then show ?case apply(subst com_to_operators_stack_nat.psimps)
+    using  com_to_operators_term apply blast
+    apply auto
+    done
+qed
+
+                
+        
+        
+     
 
 definition com_to_operators_nat:: "nat \<Rightarrow> nat" where 
 "com_to_operators_nat c = com_to_operators_stack_nat (push_to_stack_op_nat c 0)"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index 5e74f14c..c6ee1a27 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -198,7 +198,7 @@ fun push_on_stack :: "IMP_Minus_com \<Rightarrow> nat \<Rightarrow> IMPm_IMPmm l
 "push_on_stack (Com.If v c1 c2) n stack =  (If_0 v c1 c2 n) # stack "|
 "push_on_stack (Com.While v c) n stack =  (While_0 v c n) # stack "
 
-fun push_on_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition push_on_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "push_on_stack_nat c n s = (if hd_nat c = 0 then (1##n##0)##s else 
 if hd_nat c = 1 then (2## (nth_nat (Suc 0) c) ## (nth_nat (Suc (Suc 0)) c) ## n ## 0)## s else 
 if hd_nat c = 2 then (3## (nth_nat (Suc 0) c) ## (nth_nat (Suc (Suc 0)) c) ## n ## 0)## s else 
@@ -210,7 +210,7 @@ lemma sub_push_on_stack:
 "push_on_stack_nat (com_encode c) n (IMPm_IMPmm_list_encode s) = 
 IMPm_IMPmm_list_encode (push_on_stack c n s)"
   apply(cases c)
-      apply (auto simp only: push_on_stack_nat.simps push_on_stack.simps sub_hd head.simps com_encode.simps
+      apply (auto simp only: push_on_stack_nat_def push_on_stack.simps sub_hd head.simps com_encode.simps
              IMPm_IMPmm_list_encode_def sub_cons cons0 sub_nth nth.simps)
   apply auto
   done
@@ -228,7 +228,7 @@ fun add_result_to_stack :: "IMP_Minus_Minus_com \<Rightarrow> IMPm_IMPmm list \<
 "add_result_to_stack c (While_0 v c' n # stack ) = While_f v c' n c #stack"|
 "add_result_to_stack c s = s"
 
-fun add_result_to_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition add_result_to_stack_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "add_result_to_stack_nat c s = (if s = 0 then (0##c##0)##0
 else (let h = hd_nat s; con = hd_nat h; t = tl_nat s  in 
   if con = 3 then ((4## (nth_nat (Suc 0) h) ## (nth_nat (Suc (Suc 0)) h) ## (nth_nat (Suc (Suc (Suc 0))) h) ## c ## 0) ## t) 
@@ -245,7 +245,7 @@ lemma sub_add_result_to_stack:
   apply(cases s)
       apply (auto simp only: map_is_Nil_conv
       list_encode_non_empty  
-      list.simps add_result_to_stack_nat.simps add_result_to_stack.simps sub_hd head.simps comm_encode.simps
+      list.simps add_result_to_stack_nat_def add_result_to_stack.simps sub_hd head.simps comm_encode.simps
              IMPm_IMPmm_list_encode_def sub_cons cons0 sub_nth nth.simps)
     
    apply (auto simp del: list_encode.simps)
@@ -349,8 +349,8 @@ gr0I length_Cons length_append_singleton list.size(3) rev_singleton_conv zero_le
 qed
 
 
-function IMP_Minus_to_IMP_Minus_Minus_stack_nat :: "nat \<Rightarrow> nat" where 
-"IMP_Minus_to_IMP_Minus_Minus_stack_nat s  = ( let h = hd_nat s ; c = hd_nat h ; t = tl_nat s in
+function (domintros) IMP_Minus_to_IMP_Minus_Minus_stack_nat :: "nat \<Rightarrow> nat" where 
+"IMP_Minus_to_IMP_Minus_Minus_stack_nat s  = ( if s = 0 then 0##0 else let h = hd_nat s ; c = hd_nat h ; t = tl_nat s in
   if c = 3  then  IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc 0) h) (nth_nat (Suc (Suc (Suc 0))) h) s)
 else if c = 4 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc 0))) h) s) 
 else if c = 6 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (push_on_stack_nat (nth_nat (Suc (Suc 0)) h) (nth_nat (Suc (Suc (Suc (Suc 0)))) h) s)
@@ -369,8 +369,7 @@ else if c = 10 then IMP_Minus_to_IMP_Minus_Minus_stack_nat (add_result_to_stack_
 else nth_nat (Suc 0) h
 
 )"
-  sorry
-termination sorry
+  by pat_completeness auto
 
 lemma push_non_empty : "push_on_stack c n s \<noteq> []"
   apply(cases c)
@@ -385,66 +384,238 @@ lemma add_result_non_empty: "add_result_to_stack c s \<noteq> []"
     done 
   done
 
+lemma IMP_Minus_To_IMP_Minus_Minus_term:
+"IMP_Minus_to_IMP_Minus_Minus_stack_nat_dom (IMPm_IMPmm_list_encode c)"
+proof (induct c rule:IMP_Minus_to_IMP_Minus_Minus_stack.induct)
+case (1 c1 c2 n stack)
+  then show ?case  using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [3, com_encode c1, com_encode c2, n] # map IMPm_IMPmm_encode stack)"]
+    apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+    apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+    done
+next
+  case (2 c1 c2 n c3 stack)
+  then show ?case using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [4, com_encode c1, com_encode c2, n, comm_encode c3] # map IMPm_IMPmm_encode stack)"]
+    apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+    apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+    done
+next
+  case (3 v c1 c2 n stack)
+  then show ?case  using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [6, vname_encode v, com_encode c1, com_encode c2, n] # map IMPm_IMPmm_encode stack)"]
+    
+    apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+    apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+    done
+next
+  case (4 v c1 c2 n c3 stack)
+  then show ?case  using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [7, vname_encode v, com_encode c1, com_encode c2, n, comm_encode c3] # map IMPm_IMPmm_encode stack)"]   
+    apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+
+    done
+  next
+    case (5 v c n stack)
+    then show ?case  using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [9, vname_encode v, com_encode c, n] # map IMPm_IMPmm_encode stack)"]   
+ apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
+            apply( simp only: sub_add_result_to_stack sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+      done
+next
+  case (6 uu stack)
+  then show ?case  using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [1, uu] # map IMPm_IMPmm_encode stack)"]
+    apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
+    apply( simp only:sub_add_result_to_stack  flip: IMPm_IMPmm_list_encode_def )
+    done
+next
+  case (7 v aexp n stack)
+  then show ?case   using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [2, vname_encode v, aexp_encode aexp, n] # map IMPm_IMPmm_encode stack)"]
+    
+    apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
+       apply( simp only:sub_add_result_to_stack sub_assignment_to_binary  flip: IMPm_IMPmm_list_encode_def )
+done
+  next
+  case (8 uv uw ux c1 c2 stack)
+  then show ?case using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [5, com_encode uv, com_encode uw, ux, comm_encode c1, comm_encode c2] #
+         map IMPm_IMPmm_encode stack)"]
+        
+    apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+    apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
+    done
+next
+  case (9 v uy uz n c1 c2 stack)
+  then show ?case   using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [8, vname_encode v, com_encode uy, com_encode uz, n, comm_encode c1,
+          comm_encode c2] #
+         map IMPm_IMPmm_encode stack)"]
+    
+    apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+  apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
+    done
+next
+  case (10 v va n c stack)
+  then show ?case   using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [10, vname_encode v, com_encode va, n, comm_encode c] #
+         map IMPm_IMPmm_encode stack)"]
+    
+    apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+  apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
+    done
+next
+  case (11 res stack)
+  then show ?case   using IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros[of
+"list_encode
+       (list_encode [0, comm_encode res] #
+         map IMPm_IMPmm_encode stack)"]
+    apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
+IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
+done         
+next
+  case 12
+  then show ?case by (auto intro: IMP_Minus_to_IMP_Minus_Minus_stack_nat.domintros
+simp add:IMPm_IMPmm_list_encode_def)
+qed
+
+lemma IMPm_IMPmm_list_encode_0: "(IMPm_IMPmm_list_encode xs = 0) = (xs = [])"
+  by (auto simp add: IMPm_IMPmm_list_encode_def list_encode_0)
 lemma subtailnat_IMP_Minus_to_IMP_Minus_Minus_stack:
-"s \<noteq> []  \<Longrightarrow> IMP_Minus_to_IMP_Minus_Minus_stack_nat (IMPm_IMPmm_list_encode s)
+" IMP_Minus_to_IMP_Minus_Minus_stack_nat (IMPm_IMPmm_list_encode s)
 = comm_encode (IMP_Minus_to_IMP_Minus_Minus_stack s) "
-  apply(induct s rule: IMP_Minus_to_IMP_Minus_Minus_stack.induct )
-  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+proof (induct s rule: IMP_Minus_to_IMP_Minus_Minus_stack.induct )
+case (1 c1 c2 n stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+  using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
-            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
-            apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
- apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+            apply( simp only: sub_push_on_stack  flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+            apply (auto simp add: push_non_empty  IMPm_IMPmm_list_encode_0) done
+next
+  case (2 c1 c2 n c3 stack)
+  then show ?case  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
-            apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
-           apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
- apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply( simp only: sub_push_on_stack IMPm_IMPmm_list_encode_0 flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
+           apply (auto) done
+next
+  case (3 v c1 c2 n stack)
+  then show ?case  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
             apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
-          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
- apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (4 v c1 c2 n c3 stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
             apply( simp only: sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
-         apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty )
- apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (5 v c n stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def sub_hd head.simps sub_nth nth.simps sub_push_on_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps)
             apply( simp only: sub_add_result_to_stack sub_push_on_stack flip:IMPm_IMPmm_encode.simps list.simps IMPm_IMPmm_list_encode_def)
-        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
- apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (6 uu stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
        apply( simp only:sub_add_result_to_stack  flip: IMPm_IMPmm_list_encode_def )
-        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
-apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (7 v aexp n stack)
+  then show ?case  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
        apply( simp only:sub_add_result_to_stack sub_assignment_to_binary  flip: IMPm_IMPmm_list_encode_def )
-        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
-apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (8 uv uw ux c1 c2 stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  flip: comm_encode.simps )
        apply( simp only:sub_add_result_to_stack sub_assignment_to_binary  flip: IMPm_IMPmm_list_encode_def )
-        apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
-apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+ apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (9 v uy uz n c1 c2 stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
   apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
-          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
-apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+  apply (auto simp add: IMPm_IMPmm_list_encode_0  )
+done
+next
+  case (10 v va n c stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
   apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
-          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
-apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps)
+          apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case (11 res stack)
+  then show ?case apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
             apply(simp only: sub_var_bit_list sub_add_result_to_stack  Let_def cons0 sub_cons sub_hd sub_tl tail.simps head.simps sub_nth nth.simps sub_push_on_stack sub_add_result_to_stack sub_nth nth.simps
 IMPm_IMPmm_list_encode_def list.simps IMPm_IMPmm_encode.simps  )
   apply(simp only: sub_add_result_to_stack flip: IMPm_IMPmm_list_encode_def comm_encode.simps)
-          apply (auto simp del: IMP_Minus_to_IMP_Minus_Minus_stack_nat.simps simp add: push_non_empty add_result_non_empty)
+  apply (auto simp add: IMPm_IMPmm_list_encode_0  ) done
+next
+  case 12
+  then show ?case  apply(subst IMP_Minus_to_IMP_Minus_Minus_stack_nat.psimps)
+  using  IMP_Minus_To_IMP_Minus_Minus_term apply blast
+    apply (auto simp add: IMPm_IMPmm_list_encode_0 cons_def  )
   done
+qed
+
+             
+           
+        
+        
+       
+      
+    
+    
+         
+   
+  
+  
+
 
 lemma IMP_Minus_to_IMP_Minus_Minus_stack_correct:
 "IMP_Minus_to_IMP_Minus_Minus_stack (push_on_stack c n stack) 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index 5bec5482..d13caa7c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -21,25 +21,25 @@ lemma sub_atomExp_to_constant[simp]: "atomExp_to_constant_nat (atomExp_encode x)
   done
 
 
-fun aexp_max_constant_nat:: "nat \<Rightarrow> nat" where
+definition aexp_max_constant_nat:: "nat \<Rightarrow> nat" where
 "aexp_max_constant_nat n = (if hd_nat n \<le>2 \<and> 1 \<le> hd_nat n 
 then max (atomExp_to_constant_nat (nth_nat (Suc 0) n)) (atomExp_to_constant_nat (nth_nat (Suc (Suc 0)) n))
 else atomExp_to_constant_nat (nth_nat (Suc 0) n))"
 
-fun aexp_max_constant_tail:: "nat \<Rightarrow> nat" where
+definition aexp_max_constant_tail:: "nat \<Rightarrow> nat" where
 "aexp_max_constant_tail n = (if hd_nat n \<le>2 \<and> 1 \<le> hd_nat n 
 then max (atomExp_to_constant_tail (nth_nat (Suc 0) n)) (atomExp_to_constant_tail (nth_nat (Suc (Suc 0)) n))
 else atomExp_to_constant_tail (nth_nat (Suc 0) n))"
 
 lemma subtail_aexp_max_constant:
 "aexp_max_constant_tail n = aexp_max_constant_nat n"
-  using aexp_max_constant_nat.simps aexp_max_constant_tail.simps 
+  using aexp_max_constant_nat_def aexp_max_constant_tail_def
 atomExp_to_constant_tail_def by presburger
 
 
 lemma sub_aexp_max_constant:"aexp_max_constant_nat (aexp_encode x) = aexp_max_constant x"
   apply (cases x)
-      apply (auto simp only: aexp_max_constant_nat.simps aexp_encode.simps
+      apply (auto simp only: aexp_max_constant_nat_def aexp_encode.simps
                 sub_nth  sub_hd head.simps nth.simps
               sub_snd sub_fst snd_def fst_def sub_atomExp_to_constant)
       apply auto
@@ -114,7 +114,7 @@ lemma push_con_Nil:
   apply auto
   done
 
-fun push_con_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition push_con_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "push_con_nat c s = (let con = hd_nat c; e1 = nth_nat (Suc 0) c; e2 =nth_nat (Suc (Suc 0)) c;
     e3 = nth_nat (Suc (Suc (Suc 0))) c in
      if con = 0 then (0##0) ## s else 
@@ -129,7 +129,7 @@ lemma sub_push_con :
 "push_con_nat (com_encode c) (list_encode (map max_con_encode s))
 = list_encode (map max_con_encode (push_con c s)) "
   apply(cases c)
-  apply (auto simp add: sub_hd sub_cons sub_tl cons0  simp del: list_encode.simps)
+  apply (auto simp add: push_con_nat_def sub_hd sub_cons sub_tl cons0  simp del: list_encode.simps)
   done
 
 fun add_res :: "nat \<Rightarrow> max_con list \<Rightarrow> max_con list" where 
@@ -150,7 +150,7 @@ lemma add_res_Nil:
   done
 
 
-fun add_res_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition add_res_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "add_res_nat n s = (
   if s = 0 then  (7##n##0) ## 0
 else (let h =hd_nat s; t =tl_nat s; c = hd_nat h; e1 = nth_nat (Suc 0) h ; e2 = nth_nat (Suc (Suc 0)) h;
@@ -165,7 +165,7 @@ lemma sub_add_res:
 "add_res_nat n (list_encode (map max_con_encode s))
 = list_encode (map max_con_encode (add_res n s))"
   apply (cases s)
-   apply (auto simp add:cons0 sub_cons non_empty_not_zero sub_hd sub_tl
+   apply (auto simp add:cons0 add_res_nat_def sub_cons non_empty_not_zero sub_hd sub_tl
            simp del: list_encode.simps(2))
   subgoal for a xs
     apply(cases a)
@@ -233,8 +233,9 @@ lemma add_res_less:"\<forall>x. s \<noteq> [Bot x] \<and> a \<noteq> Bot x \<Lon
     done
 done
 
-
-function max_constant_stack :: "max_con list \<Rightarrow> nat"where 
+lemma list_encode_0:"(list_encode xs = 0) =  (xs = [])"
+  by (metis list_encode.simps(1) list_encode_inverse)
+function (domintros) max_constant_stack  :: "max_con list \<Rightarrow> nat" where 
 "max_constant_stack (Bot x # s) = x"|
 "max_constant_stack (SKIP # s) = max_constant_stack (add_res 0 s)"|
 "max_constant_stack (Assign v # s) = max_constant_stack (add_res (aexp_max_constant v) s)"|
@@ -296,7 +297,7 @@ termination using max_const_stack_term by auto
    
 
 function (domintros) max_constant_stack_nat :: "nat \<Rightarrow> nat" where 
-" max_constant_stack_nat s = (let h = hd_nat s; t = tl_nat s;
+" max_constant_stack_nat s = (if s= 0 then 0 else let h = hd_nat s; t = tl_nat s;
   c = hd_nat h; e1 = nth_nat (Suc 0) h; e2 = nth_nat (Suc (Suc 0)) h;
  e3 = nth_nat (Suc (Suc (Suc 0))) h ; e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
  if c = 0 then  max_constant_stack_nat (add_res_nat 0 t) 
@@ -308,62 +309,189 @@ else if c = 5 then   max_constant_stack_nat (push_con_nat e1 s)
 else if c = 6 then  max_constant_stack_nat (add_res_nat e2 t)
 else e1)"
   by pat_completeness auto
-termination 
-  apply (relation "measure (size_stack o (map max_con_decode) o list_decode)")
-         apply (auto simp del:add_res_nat.simps simp add: )
-  sorry
-         
-lemma list_encode_0:"(list_encode xs = 0) =  (xs = [])"
-  by (metis list_encode.simps(1) list_encode_inverse)
 
-thm "accp.simps"
-find_theorems "wf"
+
+thm "max_constant_stack_nat.domintros"
+
+lemma max_constant_stack_nat_term:
+  "max_constant_stack_nat_dom (list_encode (map max_con_encode x))"
+proof (induct x rule: max_constant_stack.induct)
+case (1 x s)
+  then show ?case by 
+  (auto intro:
+       max_constant_stack_nat.domintros[of "list_encode (list_encode [7, x] # map max_con_encode s)"]
+     simp del: list_encode.simps(2) simp add: sub_hd)
+next
+  case (2 s)
+  then show ?case by (auto intro: max_constant_stack_nat.domintros[of "list_encode (list_encode [0] # map max_con_encode s)"]  
+              simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          simp del: list_encode.simps 
+                add_res.simps push_con.simps  )
+next
+  case (3 v s)
+  then show ?case 
+    by (auto intro : 
+        max_constant_stack_nat.domintros[of "list_encode (list_encode [Suc 0, aexp_encode v] # map max_con_encode s)"]
+              simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0 aexp_id
+          simp del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                    )
+next
+  case (4 c1 c2 s)
+  then show ?case  
+      using  max_constant_stack_nat.domintros[of  "list_encode (list_encode [2, com_encode c1, com_encode c2] # map max_con_encode s)"]
+    apply (auto simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+      simp del: list_encode.simps
+                add_res.simps push_con.simps aexp_max_constant.simps )
+    apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+    done
+next
+case (5 c1 c2 n0 s)
+  then show ?case 
+    using  max_constant_stack_nat.domintros[of  "list_encode (map max_con_encode (Seq_m c1 c2 n0 # s))"]
+    apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                    )
+    apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+    done
+next
+  case (6 uu uv n m s)
+  then show ?case  by( auto intro: max_constant_stack_nat.domintros[of "list_encode
+       (list_encode [4, com_encode uu, com_encode uv, n, m] # map max_con_encode s)"]
+         simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          simp del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                   )
+next
+  case (7 c s)
+  then show ?case       
+    using max_constant_stack_nat.domintros[of"list_encode (map max_con_encode (While_0 c # s))" ]
+    apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                    )
+    apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+    done
+next
+  case (8 uw n s)
+  then show ?case 
+    by (auto  intro: max_constant_stack_nat.domintros[of "list_encode (list_encode [6, com_encode uw, n] # map max_con_encode s)"]
+        simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+        simp  del: list_encode.simps
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                     )
+next
+  case 9
+  then show ?case by (auto intro: max_constant_stack_nat.domintros)
+qed
+
+lemma max_constant_stack_nat_simps: 
+  assumes " s = list_encode (map max_con_encode s')"
+  shows
+" max_constant_stack_nat s =
+ (if s = 0 then 0
+     else let h = hd_nat s; t = tl_nat s; c = hd_nat h; e1 = nth_nat (Suc 0) h;
+              e2 = nth_nat (Suc (Suc 0)) h; e3 = nth_nat (Suc (Suc (Suc 0))) h;
+              e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h
+          in if c = 0 then max_constant_stack_nat (add_res_nat 0 t)
+             else if c = 1
+                  then max_constant_stack_nat (add_res_nat (aexp_max_constant_tail e1) t)
+                  else if c = 2 then max_constant_stack_nat (push_con_nat e1 s)
+                       else if c = 3 then max_constant_stack_nat (push_con_nat e2 s)
+                            else if c = 4
+                                 then max_constant_stack_nat (add_res_nat (max e3 e4) t)
+                                 else if c = 5
+                                      then max_constant_stack_nat (push_con_nat e1 s)
+                                      else if c = 6
+                                           then max_constant_stack_nat (add_res_nat e2 t)
+                                           else e1)"
+  using max_constant_stack_nat.psimps[of s] max_constant_stack_nat_term[of s'] assms
+  by auto
+
+                  
+thm "max_constant_stack_nat.psimps"
 lemma sub_max_constant_stack:
-"s \<noteq> [] \<Longrightarrow> max_constant_stack_nat (list_encode (map max_con_encode s))
+"max_constant_stack_nat (list_encode (map max_con_encode s))
 = max_constant_stack s "
-  apply(induct s rule:max_constant_stack.induct)
-         apply(subst max_constant_stack_nat.simps)
-         apply( simp add: Let_def sub_hd sub_tl 
-          del: list_encode.simps(2) max_constant_stack_nat.simps )
- apply(subst max_constant_stack_nat.simps)
-        apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps  )
- apply(subst max_constant_stack_nat.simps)
+proof (induct s rule:max_constant_stack.induct)
+case (1 x s)
+  then show ?case  apply(subst max_constant_stack_nat_simps)
+                      apply blast
+       apply (auto simp add:list_encode_0 Let_def sub_hd sub_tl 
+          simp del: list_encode.simps(2) max_constant_stack_nat.psimps )
+    done
+next
+  case (2 s)
+  then show ?case  apply(subst max_constant_stack_nat_simps)
+    apply blast
+        apply(auto simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+         simp del: list_encode.simps max_constant_stack_nat.psimps
+                add_res.simps   push_con.simps  )
+    done
+next
+  case (3 v s)
+  then show ?case apply(subst max_constant_stack_nat_simps)
+    apply blast
         apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
-                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
- apply(subst max_constant_stack_nat.simps)
-      apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
-                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
-      apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
- apply(subst max_constant_stack_nat.simps)
+          del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps)
+    done
+next
+  case (4 c1 c2 s)
+  then show ?case  apply(subst max_constant_stack_nat_simps)
+    apply blast
+        apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps)
+    apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+    done
+next
+  case (5 c1 c2 n0 s)
+  then show ?case  apply(subst max_constant_stack_nat_simps)
+    apply blast
       apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
-                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
-     apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
- apply(subst max_constant_stack_nat.simps)
+          del: list_encode.simps
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                    )
+    apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+    done
+
+next
+  case (6 uu uv n m s)
+  then show ?case  apply(subst max_constant_stack_nat_simps)
+    apply blast
         apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
-                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
- apply(subst max_constant_stack_nat.simps)
+          del: list_encode.simps
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                   )
+    done
+next
+  case (7 c s)
+  then show ?case  apply(subst max_constant_stack_nat_simps)
+    apply blast
       apply( simp add: sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
-                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
-     apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
- apply(subst max_constant_stack_nat.simps)
+          del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                    )
+    apply (simp only: sub_push_con  flip: max_con_encode.simps list.map)
+    done
+next
+  case (8 uw n s)
+  then show ?case apply(subst max_constant_stack_nat_simps)
+    apply blast
         apply( simp add: subtail_aexp_max_constant sub_aexp_max_constant  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps max_constant_stack_nat.simps
-                add_res.simps add_res_nat.simps push_con_nat.simps push_con.simps aexp_max_constant.simps
-                    aexp_max_constant_nat.simps aexp_max_constant_tail.simps )
-  apply auto
-  done
+          del: list_encode.simps 
+                add_res.simps  push_con.simps aexp_max_constant.simps
+                     )
+    done
+next
+  case 9
+  then show ?case apply(subst max_constant_stack_nat_simps)
+     apply blast 
+    apply auto
+    done
+qed
 
 
 lemma max_constant_stack_correct:
@@ -456,7 +584,7 @@ lemma push_var_Nil:
   apply auto
   done
 
-fun push_var_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition push_var_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "push_var_nat c s = (let con = hd_nat c; e1 = nth_nat (Suc 0) c; e2 =nth_nat (Suc (Suc 0)) c;
     e3 = nth_nat (Suc (Suc (Suc 0))) c in
      if con = 0 then (0##0) ## s else 
@@ -471,7 +599,7 @@ lemma sub_push_var :
 "push_var_nat (com_encode c) (list_encode (map all_var_encode s))
 = list_encode (map all_var_encode (push_var c s)) "
   apply(cases c)
-  apply (auto simp add: sub_hd sub_cons sub_tl cons0  simp del: list_encode.simps)
+  apply (auto simp add: sub_hd sub_cons sub_tl cons0 push_var_nat_def simp del: list_encode.simps)
   done
 
 fun add_var :: " vname list \<Rightarrow> all_var list \<Rightarrow> all_var list" where 
@@ -494,7 +622,7 @@ lemma add_var_Nil:
   done
 
 
-fun add_var_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+definition add_var_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "add_var_nat n s = (
   if s = 0 then  (10##n##0) ## 0
 else (let h =hd_nat s; t =tl_nat s; c = hd_nat h; e1 = nth_nat (Suc 0) h ; e2 = nth_nat (Suc (Suc 0)) h;
@@ -511,7 +639,7 @@ lemma sub_add_var:
 "add_var_nat (vname_list_encode n) (list_encode (map all_var_encode s))
 = list_encode (map all_var_encode (add_var n s))"
   apply (cases s)
-   apply (auto simp add:cons0 sub_cons non_empty_not_zero sub_hd sub_tl
+   apply (auto simp add:cons0 add_var_nat_def sub_cons non_empty_not_zero sub_hd sub_tl
            simp del: list_encode.simps(2))
   subgoal for a xs
     apply(cases a)
@@ -636,8 +764,8 @@ next
 qed
 
 
-function all_variables_stack_nat :: "nat \<Rightarrow> nat" where 
-"  all_variables_stack_nat s = (let h = hd_nat s; t = tl_nat s;
+function (domintros) all_variables_stack_nat :: "nat \<Rightarrow> nat" where 
+"  all_variables_stack_nat s = (if s =0 then 0 else let h = hd_nat s; t = tl_nat s;
   c = hd_nat h; e1 = nth_nat (Suc 0) h; e2 = nth_nat (Suc (Suc 0)) h;
  e3 = nth_nat (Suc (Suc (Suc 0))) h ; e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h; e5 = 
   nth_nat (Suc (Suc (Suc (Suc (Suc  0))))) h in 
@@ -652,8 +780,132 @@ else if c = 7 then   all_variables_stack_nat (add_var_nat (e1 ## append_nat e4 e
 else if c = 8 then   all_variables_stack_nat (push_var_nat e2 s)
 else if c = 9 then  all_variables_stack_nat (add_var_nat (e1 ## e3) t)
 else e1)"
-  sorry
-termination sorry
+  by pat_completeness auto
+
+lemma vname_list_encode_Nil: "vname_list_encode [] = 0" 
+  apply (auto simp add: vname_list_encode_def)
+  done
+
+lemma all_variables_stack_nat_term: "all_variables_stack_nat_dom (list_encode (map all_var_encode x))"
+proof (induct x rule: all_variables_stack.induct)
+case (1 x s)
+  then show ?case  
+    by (auto intro: all_variables_stack_nat.domintros 
+      [of "list_encode (list_encode [10, vname_list_encode x] # map all_var_encode s)"]
+          simp add: Let_def sub_hd sub_tl 
+          simp del: list_encode.simps(2))
+next
+  case (2 s)
+  then show ?case 
+    using all_variables_stack_nat.domintros[
+of "list_encode (list_encode [vname_list_encode []] # map all_var_encode s)"
+]
+    apply(
+ simp add: sub_add_var Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+                  flip: vname_list_encode_Nil
+          del: list_encode.simps 
+                add_var.simps push_var.simps  )
+    apply (auto simp only:  vname_list_encode_Nil)
+    done
+
+next
+  case (3 v a s)
+  then show ?case  using all_variables_stack_nat.domintros[
+of "list_encode
+       (list_encode [Suc 0, vname_encode v, aexp_encode a] # map all_var_encode s)"
+]
+    apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def  del: list_encode.simps 
+                add_var.simps push_var.simps )
+    done
+next
+  case (4 c1 c2 s)
+  then show ?case  using all_variables_stack_nat.domintros[
+of "list_encode (list_encode [2, com_encode c1, com_encode c2] # map all_var_encode s)"]
+    apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps
+                add_var.simps  push_var.simps )
+    apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+    done
+next
+  case (5 c1 c2 n0 s)
+  then show ?case using all_variables_stack_nat.domintros[
+of "list_encode (list_encode [3, com_encode c1, com_encode c2, vname_list_encode n0] # map all_var_encode s)"]
+    apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps
+                add_var.simps  push_var.simps )
+    apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+    done
+next
+  case (6 uu uv n m s)
+  then show ?case using all_variables_stack_nat.domintros[
+of "list_encode (list_encode [4, com_encode uu, com_encode uv, list_encode (map vname_encode n),
+          list_encode (map vname_encode m)] # map all_var_encode s)"]
+    apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps
+                add_var.simps  push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps 
+                add_var.simps  push_var.simps )
+    done
+next
+  case (7 v c1 c2 s)
+  then show ?case  using all_variables_stack_nat.domintros[
+of "list_encode (list_encode [5, vname_encode v, com_encode c1, com_encode c2]#
+        map all_var_encode s)"]
+    apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+    apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+    done
+next
+  case (8 v c1 c2 n0 s)
+  then show ?case    using all_variables_stack_nat.domintros[
+of "list_encode (list_encode  [6, vname_encode v, com_encode c1, com_encode c2, vname_list_encode n0]#
+        map all_var_encode s)"]
+    apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+    apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+    done
+next
+  case (9 v uw ux n m s)
+  then show ?case  using all_variables_stack_nat.domintros[
+of "list_encode (list_encode   [7, vname_encode v, com_encode uw, com_encode ux,
+          list_encode (map vname_encode n), list_encode (map vname_encode m)]#
+        map all_var_encode s)"]
+    apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps 
+                add_var.simps  push_var.simps )
+    done
+next
+  case (10 v c s)
+  then show ?case   using all_variables_stack_nat.domintros[
+of "list_encode (list_encode   [8, vname_encode v, com_encode c] #
+        map all_var_encode s)"]
+    apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+    apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+    done
+next
+  case (11 v uy n s)
+  then show ?case  using all_variables_stack_nat.domintros[
+of "list_encode (list_encode    [9, vname_encode v, com_encode uy, list_encode (map vname_encode n)] #
+        map all_var_encode s)"]
+    apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
+          del: list_encode.simps
+                add_var.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps
+                add_var.simps  push_var.simps )
+    done
+next
+  case 12
+  then show ?case by (auto intro:all_variables_stack_nat.domintros)
+qed
 
 
 lemma all_variables_stack_correct:
@@ -661,74 +913,136 @@ lemma all_variables_stack_correct:
   apply(induct c arbitrary: s)
   apply auto
   done
-lemma vname_list_encode_Nil: "vname_list_encode [] = 0" 
-  apply (auto simp add: vname_list_encode_def)
-  done
+
 
 lemma sub_all_variables_stack:
 "s \<noteq> [] \<Longrightarrow> all_variables_stack_nat (list_encode (map all_var_encode s))
 = vname_list_encode (all_variables_stack s) "
-  apply(induct s rule: all_variables_stack.induct)
-         apply(subst all_variables_stack_nat.simps)
-         apply( simp add: Let_def sub_hd sub_tl 
-          del: list_encode.simps(2) all_variables_stack_nat.simps )
- apply(subst all_variables_stack_nat.simps)
+proof (induct s rule: all_variables_stack.induct)
+case (1 x s)
+  then show ?case apply(subst all_variables_stack_nat.psimps)
+  using all_variables_stack_nat_term apply blast
+         apply( simp add: list_encode_0 vname_list_encode_Nil Let_def sub_hd sub_tl 
+          del: list_encode.simps(2) )
+done
+next
+  case (2 s)
+  then show ?case  apply(subst all_variables_stack_nat.psimps)
+  using all_variables_stack_nat_term apply blast
            apply( simp add: sub_add_var Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
                   flip: vname_list_encode_Nil
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps  )
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps 
+                add_var.simps  push_var.simps  )
+            apply (simp add : list_encode_0 vname_list_encode_Nil)
+
+  done
+
+next
+  case (3 v a s)
+  then show ?case  apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
         apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def  del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps
+                add_var.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def  del: list_encode.simps 
+                add_var.simps  push_var.simps )
+              done
+next
+  case (4 c1 c2 s)
+  then show ?case         
+    apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
       apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-      apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps
+                add_var.simps  push_var.simps )
+  apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+  done
+
+next
+case (5 c1 c2 n0 s)
+  then show ?case   apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
       apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-        apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+  apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+done
+next
+  case (6 uu uv n m s)
+  then show ?case       apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
         apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps
+                add_var.simps  push_var.simps )
+       apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps )
+
+  done
+next
+  case (7 v c1 c2 s)
+  then show ?case 
+      apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
       apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-      apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+  apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+  done
+
+next
+  case (8 v c1 c2 n0 s)
+  then show ?case   apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
       apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-        apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps 
+                add_var.simps push_var.simps )
+     apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+done
+next
+  case (9 v uw ux n m s)
+  then show ?case   apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
         apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps 
+                add_var.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps 
+                add_var.simps  push_var.simps )
+  done
+
+next
+  case (10 v c s)
+  then show ?case  apply(subst all_variables_stack_nat.psimps)
+  using all_variables_stack_nat_term apply blast
       apply(simp add: sub_add_res Let_def sub_hd sub_tl add_var_Nil push_var_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-        apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
- apply(subst all_variables_stack_nat.simps)
+          del: list_encode.simps 
+                add_var.simps  push_var.simps )
+  apply (simp only: sub_push_var  flip: all_var_encode.simps list.map)
+  done
+
+next
+  case (11 v uy n s)
+  then show ?case  apply(subst all_variables_stack_nat.psimps)
+ using all_variables_stack_nat_term apply blast
         apply( simp add: subtail_aexp_vars sub_cons vname_list_encode_def sub_append  sub_aexp_vars  sub_add_res Let_def sub_hd sub_tl add_res_Nil push_con_Nil list_encode_0
-          del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps all_variables_stack_nat.simps
-                add_var.simps add_var_nat.simps push_var_nat.simps push_var.simps )
-  apply auto
+          del: list_encode.simps 
+                add_var.simps push_var.simps )
+  apply(simp add: sub_add_var add_var_Nil flip:list.map vname_list_encode_def map_append  del: list_encode.simps
+                add_var.simps push_var.simps )
   done
 
+next
+  case 12
+  then show ?case   apply auto
+done
+qed
+
+             
+           
+          
+
+
+      
+
+
 definition all_variables_t :: "Com.com \<Rightarrow> vname list" where 
 " all_variables_t c =  all_variables_stack (push_var c [])"
 

From 1cd1de19818adc3cd4aae09f4e4ab6bd784f75f3 Mon Sep 17 00:00:00 2001
From: Bilel Ghorbel <ge36toh@mytum.de>
Date: Tue, 7 Sep 2021 08:29:42 +0200
Subject: [PATCH 032/103] rewrite prod_encode, fst_nat , snd_nat in polynomial
 time  code (while staying tail recursive), with functional correctness proof

---
 Cook_Levin/IMP-_To_SAS+/Prod_Poly.thy | 165 ++++++++++++++++++++++++++
 1 file changed, 165 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/Prod_Poly.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/Prod_Poly.thy b/Cook_Levin/IMP-_To_SAS+/Prod_Poly.thy
new file mode 100644
index 00000000..2e9b6eaa
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/Prod_Poly.thy
@@ -0,0 +1,165 @@
+theory Prod_Poly 
+  imports "HOL-Library.Nat_Bijection" "Recursion-Theory-I.CPair"
+begin 
+
+fun mult_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"mult_acc acc c  b  = (if b = 0 then acc else if b mod 2 = 0 then
+ mult_acc acc (c*2) (b div 2) else mult_acc (acc+c) (c*2) (b div 2)
+ )"
+
+
+lemma mult_acc_correct:"mult_acc acc c b = acc + c*b"
+  apply(induct acc c b  rule:mult_acc.induct)
+  apply auto
+  by (metis 
+One_nat_def mod_mult_div_eq mult.assoc 
+mult_Suc_right plus_1_eq_Suc)
+
+definition mult:: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"mult a b = mult_acc 0 a b"
+
+lemma mult_correct: "mult a b = a * b"
+  using mult_def mult_acc_correct by auto
+
+definition triangle' :: "nat \<Rightarrow> nat" where 
+"triangle' n = mult n (Suc n) div 2"
+
+lemma sub_triangle : "triangle' n = triangle n"
+  using triangle_def triangle'_def mult_correct by auto
+
+definition pair :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"pair a b = triangle' (a+b) + a"
+
+lemma sub_pair:"pair a b = prod_encode (a,b)"
+  using pair_def  sub_triangle 
+  by (simp add: prod_encode_def)
+
+lemma triangle_sf:"triangle x = sf x " 
+  by (simp add: sf_def triangle_def) 
+
+lemma  "prod_encode(a,b) = c_pair a b"
+  by (auto simp add:  c_pair_def prod_encode_def triangle_sf) 
+
+lemma prod_c_pair: "prod_decode n = (c_fst n , c_snd n)"
+  by (metis (no_types) c_fst_le_c_sum c_snd_def prod_decode_aux.simps prod_encode_inverse 
+prod_encode_prod_decode_aux sf_c_sum_plus_c_fst triangle_sf)
+
+function find_triangle_search :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"find_triangle_search  a b n = (let m = ((a+b) div 2); t = triangle' m  in 
+if b\<le>a  then a else if n-t \<le> m then find_triangle_search a m n else find_triangle_search (m+1) b n
+)"
+  by pat_completeness auto
+termination by (relation "measure (\<lambda>(a,b,n).b-a)") (auto simp add: sub_triangle)
+
+lemma mean_in_the_interval:"\<not> b \<le> a \<Longrightarrow> ((a::nat) + b ) div 2 \<ge> a \<and> b \<ge> Suc ((a::nat) + b ) div 2 "
+  by auto
+lemma "\<not> b \<le> a \<Longrightarrow> b = Suc ((a + b) div 2) \<Longrightarrow> b = a \<or> b = Suc a \<or> b = Suc(Suc a)"
+  apply auto
+  done
+
+lemma find_triangle_search_inv:"\<lbrakk> a \<le> c_sum n ; c_sum n \<le> b\<rbrakk> \<Longrightarrow> find_triangle_search a b n = c_sum n "
+  apply(induct a b n rule:find_triangle_search.induct)
+  apply(subst find_triangle_search.simps)
+  apply (auto simp add: Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps c_sum_def)
+   apply(subst find_triangle_search.simps)
+   apply (auto simp add:   Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps c_sum_def)
+proof  (goal_cases)
+  case (1 a b n)
+  have "a = (a + b) div 2" using mean_in_the_interval 1(6) 1(8) by auto
+  hence "b = Suc a" using 1(6) by force
+  thus ?case using 1
+    by (smt le_add_diff_inverse le_trans nat_less_le not_less sf_aux2 sf_c_sum_le_arg sf_mono)   
+next
+  case (2 a b n)
+  then have "c_sum n \<le> (a+b) div 2 " 
+    by (metis arg_less_sf_imp_c_sum_less_arg 
+le_add_diff_inverse not_less order_less_imp_le sf_aux2)
+  moreover have "find_triangle_search a ((a + b) div 2) n = find_triangle_search a ((a + (a + b) div 2) div 2) n"
+    using 2 apply(subst find_triangle_search.simps)
+    by (auto simp add: Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps)
+  ultimately show  ?case using 2(1) by auto 
+next
+  case (3 a b n)
+ have "a = (a + b) div 2" using mean_in_the_interval 3(6) 3(8) by auto
+  hence "b = Suc a" using 3(6) by force
+  thus ?case using 3
+    by (smt le_add_diff_inverse le_trans nat_less_le not_less sf_aux2 sf_c_sum_le_arg sf_mono) 
+next
+  case (4 a b n)
+   then have "c_sum n \<le> (a+b) div 2 " 
+    by (metis arg_less_sf_imp_c_sum_less_arg 
+le_add_diff_inverse not_less order_less_imp_le sf_aux2)
+  moreover have "find_triangle_search a ((a + b) div 2) n = find_triangle_search (Suc ((a + (a + b) div 2) div 2)) ((a + b) div 2) n"
+    using 4 apply(subst find_triangle_search.simps)
+    by (auto simp add: Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps)
+  ultimately show  ?case using 4(1) by auto 
+next
+  case (5 a b n)
+  then show ?case 
+    apply(subst find_triangle_search.simps)
+    apply (auto simp add:   Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps c_sum_def)
+  proof (goal_cases)
+case 1
+  have "b = Suc ((a + b) div 2)" using mean_in_the_interval 1(6) 1(8) by auto
+  moreover then have  " b = a \<or> b = Suc a \<or> b = Suc(Suc a)" using 1(6)  by auto
+  ultimately show ?case using 1
+    by (smt add_diff_cancel_left' c_sum_is_sum le_SucE le_add1 le_add_same_cancel1 linorder_not_less
+ nat_less_le sf_aux2 sf_c_sum_plus_c_fst zero_less_diff)
+next
+  case 2
+   then have " Suc ((a + b) div 2) \<le> c_sum n"
+     by (smt Suc_leI add_diff_cancel_left' c_sum_is_sum le_add1 le_add_same_cancel1 le_trans
+ linorder_not_less nat_less_le sf_aux2 sf_c_sum_plus_c_fst zero_less_diff) 
+  moreover have "find_triangle_search (Suc ((a + b) div 2)) b n  = find_triangle_search (Suc ((a + b) div 2)) (Suc ((a + b) div 2 + b) div 2) n"
+    using 2 apply(subst find_triangle_search.simps)
+    by (auto simp add: Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps)
+  ultimately show  ?case using 2(2) by auto 
+next
+  case 3
+  have "b = Suc ((a + b) div 2)" using mean_in_the_interval 3(6) 3(8) by auto
+  moreover then have  " b = a \<or> b = Suc a \<or> b = Suc(Suc a)" using 3(6)  by auto
+  ultimately show ?case using 3
+    by (smt add_diff_cancel_left' c_sum_is_sum le_SucE le_add1 le_add_same_cancel1 linorder_not_less
+ nat_less_le sf_aux2 sf_c_sum_plus_c_fst zero_less_diff)
+next
+  case 4
+   then have " Suc ((a + b) div 2) \<le> c_sum n"
+     by (smt Suc_leI add_diff_cancel_left' c_sum_is_sum le_add1 le_add_same_cancel1 le_trans
+ linorder_not_less nat_less_le sf_aux2 sf_c_sum_plus_c_fst zero_less_diff) 
+  moreover have "find_triangle_search (Suc ((a + b) div 2)) b n = find_triangle_search (Suc (Suc ((a + b) div 2 + b) div 2)) b n"
+    using 4 apply(subst find_triangle_search.simps)
+    by (auto simp add: Let_def sub_triangle triangle_sf simp del: find_triangle_search.simps)
+  ultimately show  ?case using 4(2) by auto 
+qed
+
+qed
+
+definition find_triangle :: "nat \<Rightarrow> nat" where 
+"find_triangle n = find_triangle_search 0 n n"
+
+lemma sub_find_triangle: "find_triangle n = c_sum n"
+  apply(auto simp add: find_triangle_def  simp del: find_triangle_search.simps)
+  using find_triangle_search_inv[of 0 n n]
+  using c_sum_le_arg by blast
+
+definition fst_nat' :: "nat \<Rightarrow> nat" where 
+"fst_nat' n = n - triangle' (find_triangle n)"
+
+lemma fst_nat'_correct:"fst_nat' n = c_fst n"
+  by(auto simp add: fst_nat'_def c_fst_def sub_triangle triangle_sf sub_find_triangle)
+
+lemma sub_fst':
+"fst_nat' n  = fst (prod_decode n)"
+  using prod_c_pair fst_nat'_correct by simp
+
+definition snd_nat' :: "nat \<Rightarrow> nat" where 
+"snd_nat' n = find_triangle n - fst_nat' n"
+
+lemma snd_nat'_correct:"snd_nat' n = c_snd n"
+  by(auto simp add: snd_nat'_def c_snd_def sub_triangle triangle_sf sub_find_triangle fst_nat'_correct)
+
+lemma sub_snd':
+"snd_nat' n  = snd (prod_decode n)"
+  using prod_c_pair snd_nat'_correct  by simp
+
+end
\ No newline at end of file

From 7df86763cf7b74356b243f2f8a5c62cc06676487 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Thu, 9 Sep 2021 18:09:53 +0200
Subject: [PATCH 033/103] started implementing max_constant

---
 .../IMP_Minus_Max_Constant_IMP_Minus.thy      | 509 +++++++++++++++++-
 IMP-/IMP_Minus_Nat_Bijection.thy              |  20 +
 2 files changed, 515 insertions(+), 14 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
index a678899d..f8dd7fa2 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
@@ -278,19 +278,6 @@ lemma add_res_nat_second_part_correct:
   unfolding add_res_nat_second_part_def add_res_nat_second_part_time_def Let_def
   by (fastforce intro: cons_IMP_Minus_correct cons_list_IMP_Minus_correct)+
 
-(*"add_res_nat n s = ( d e
-  if s = 0 then  (7##n##0) ## 0
-else (
-let h =hd_nat s; f
-    t =tl_nat s; g
-    c = hd_nat h; h 
-    e1 = nth_nat (Suc 0) h ; i 
-    e2 = nth_nat (Suc (Suc 0)) h; j 
-    e3 = nth_nat (Suc (Suc (Suc 0))) h in nth_nat
-if c = 2 then (3##e1##e2##n##0)##t else 
-if c = 3 then (4##e1##e2##e3##n##0)##t else 
-if c = 5 then (6##e1##n##0)##t else s   *)
-
 definition add_res_nat_third_part where "add_res_nat_third_part \<equiv>
   IF ''e'' \<noteq>0
   THEN
@@ -422,4 +409,498 @@ next
           [OF add_res_nat_second_part_correct]]
         simp: Let_def)+
 qed
-end
\ No newline at end of file
+
+definition push_con_first_part where "push_con_first_part \<equiv>
+  ''e'' ::= (A (V ''a'')) ;;
+  ''f'' ::= (A (V ''b'')) ;;
+  
+  ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''g'' ::= (A (V ''fst_nat'')) ;;
+  
+  ''a'' ::= (A (N (Suc 0))) ;;
+  ''b'' ::= (A (V ''e'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''h'' ::= (A (V ''nth_nat'')) ;; 
+
+  ''a'' ::= (A (N (Suc (Suc 0)))) ;;
+  ''b'' ::= (A (V ''e'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''i'' ::= (A (V ''nth_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc (Suc (Suc 0))))) ;;
+  ''b'' ::= (A (V ''e'')) ;;
+  nth_nat_IMP_Minus"
+
+definition push_con_first_part_time where "push_con_first_part_time c s \<equiv>
+  (let con = hd_nat c in
+    24 + IMP_Minus_fst_nat_time (c - 1) + nth_nat_IMP_Minus_time (Suc 0) c
+     + nth_nat_IMP_Minus_time (Suc (Suc 0)) c  
+     + nth_nat_IMP_Minus_time (Suc (Suc (Suc 0))) c)"
+
+lemma push_con_first_part_correct:
+  "(push_con_first_part, s) \<Rightarrow>\<^bsup>push_con_first_part_time (s ''a'') (s ''b'')\<^esup>
+    (let con = hd_nat (s ''a''); 
+         e1 = nth_nat (Suc 0) (s ''a'') ; 
+         e2 = nth_nat (Suc (Suc 0)) (s ''a''); 
+         e3 = nth_nat (Suc (Suc (Suc 0))) (s ''a'') in 
+       s(''a'' := 0,
+         ''b'' := 0,
+         ''c'' := 0,
+         ''e'' := s ''a'',
+         ''f'' := s ''b'',
+         ''g'' := con,
+         ''h'' := e1,
+         ''i'' := e2,
+         ''fst_nat'' := 0,
+         ''snd_nat'' := 0,
+         ''nth_nat'' := e3))"
+  unfolding Let_def push_con_first_part_def push_con_first_part_time_def 
+    hd_nat_def
+  by (fastforce simp: Let_def intro: terminates_in_time_state_intro[OF Seq] 
+      terminates_in_state_intro[OF nth_nat_IMP_Minus_correct]
+      IMP_Minus_fst_nat_correct)
+
+definition push_con_second_part where "push_con_second_part \<equiv>
+  cons_IMP_Minus (N 0) (N 0) ;;
+  ''j'' ::= (A (V ''cons'')) ;;
+  
+  cons_list_IMP_Minus [N 1, V ''i'', N 0] ;;
+  ''k'' ::= (A (V ''cons'')) ;;
+    
+  cons_list_IMP_Minus [N 2, V ''i'', V ''nth_nat'', N 0] ;;
+  ''l'' ::= (A (V ''cons'')) ;;
+
+  cons_list_IMP_Minus [N 5, V ''i'', N 0];; 
+
+  ''nth_nat'' ::= (A (N 0)) ;;
+  ''h'' ::= (A (N 0)) ;;
+  ''i'' ::= (A (N 0))"
+
+definition push_con_second_part_time where "push_con_second_part_time c s \<equiv>
+  (let
+    con = hd_nat c;
+    e1 = nth_nat (Suc 0) c;
+    e2 = nth_nat (Suc (Suc 0)) c;
+    e3 = nth_nat (Suc (Suc (Suc 0))) c in
+      12 + cons_IMP_Minus_time 0 0
+      + cons_list_IMP_Minus_time [1, e2, 0]
+      + cons_list_IMP_Minus_time [2, e2, e3, 0]
+      + cons_list_IMP_Minus_time [5, e2, 0])"
+
+lemma push_con_second_part_correct:  
+  "(push_con_first_part ;; push_con_second_part, s) 
+    \<Rightarrow>\<^bsup>push_con_first_part_time (s ''a'') (s ''b'') 
+      + push_con_second_part_time (s ''a'') (s ''b'') \<^esup>
+    (let con = hd_nat (s ''a'');
+         e1 = nth_nat (Suc 0) (s ''a'');
+         e2 = nth_nat (Suc (Suc 0)) (s ''a'');
+         e3 = nth_nat (Suc (Suc (Suc 0))) (s ''a'');
+         l1 = [0, 0];
+         l2 = [1, e2, 0];
+         l3 = [2, e2, e3, 0];
+         l4 = [5, e2, 0]
+    in 
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''e'' := s ''a'',
+        ''f'' := s ''b'',
+        ''g'' := con,
+        ''h'' := 0,
+        ''i'' := 0,
+        ''fst_nat'' := 0,
+        ''snd_nat'' := 0,
+        ''nth_nat'' := 0,
+        ''j'' := cons_list l1,
+        ''k'' := cons_list l2,
+        ''l'' := cons_list l3,
+        ''cons'' := cons_list l4,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0))"
+  apply(rule terminates_in_state_intro[OF Seq'[OF push_con_first_part_correct]])
+  unfolding push_con_second_part_def push_con_second_part_time_def Let_def
+  by (fastforce intro: cons_IMP_Minus_correct cons_list_IMP_Minus_correct)+
+
+definition push_con_third_part where "push_con_third_part \<equiv>
+  ''a'' ::= ((V ''g'') \<ominus> (N 1)) ;;
+  IF ''a'' \<noteq>0 THEN
+  (
+    ''a'' ::= ((V ''g'') \<ominus> (N 2)) ;;
+    IF ''a'' \<noteq>0 THEN
+    (
+      ''a'' ::= ((V ''g'') \<ominus> (N 3)) ;;
+      IF ''a'' \<noteq>0 THEN
+      (
+        ''a'' ::= (A (V ''cons'')) 
+      )
+      ELSE
+      (
+        ''a'' ::= (A (V ''l''))
+      )
+    )
+    ELSE
+    (
+      Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+      ''a'' ::= (A (V ''e''))
+    )
+  )
+  ELSE
+  (
+    Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
+    Com.SKIP ;; Com.SKIP ;;
+    IF ''g'' \<noteq>0 THEN
+    (
+      ''a'' ::= (A (V ''k'')) 
+    )
+    ELSE
+    (
+      ''a'' ::= (A (V ''j''))
+    )
+  ) ;;
+  cons_IMP_Minus (V ''a'') (V ''f'') ;;
+  ''push_con'' ::= (A (V ''cons'')) ;;
+  ''e'' ::= (A (N 0)) ;; 
+  ''f'' ::= (A (N 0)) ;;
+  ''g'' ::= (A (N 0)) ;; 
+  ''j'' ::= (A (N 0)) ;;
+  ''k'' ::= (A (N 0)) ;;
+  ''l'' ::= (A (N 0)) ;;
+  ''cons'' ::= (A (N 0)) ;;
+  ''a'' ::= (A (N 0))"
+
+definition push_con_third_part_time where "push_con_third_part_time c s \<equiv>
+  (let
+    con = hd_nat c;
+    e1 = nth_nat (Suc 0) c;
+    e2 = nth_nat (Suc (Suc 0)) c;
+    e3 = nth_nat (Suc (Suc (Suc 0))) c; 
+    l = (
+     if con = 0 then (0##0) else 
+     if con = 1 then (1##e2##0) else 
+     if con = 2 then c else 
+     if con = 3 then (2 ## e2 ## e3 ## 0) else
+     (5 ## e2 ## 0)) in
+      11 + 18 + cons_IMP_Minus_time l s)"
+
+definition push_con_IMP_Minus where "push_con_IMP_Minus \<equiv>
+  push_con_first_part ;;
+  push_con_second_part ;;
+  push_con_third_part"
+
+definition push_con_IMP_Minus_time where "push_con_IMP_Minus_time c s \<equiv>
+  push_con_first_part_time c s
+  + push_con_second_part_time c s
+  + push_con_third_part_time c s"
+
+lemma push_con_IMP_Minus_correct:
+  "(push_con_IMP_Minus, s) 
+    \<Rightarrow>\<^bsup>push_con_IMP_Minus_time (s ''a'') (s ''b'') \<^esup>
+     (s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''e'' := 0,
+        ''f'' := 0,
+        ''g'' := 0,
+        ''h'' := 0,
+        ''i'' := 0,
+        ''fst_nat'' := 0,
+        ''snd_nat'' := 0,
+        ''nth_nat'' := 0,
+        ''j'' := 0,
+        ''k'' := 0,
+        ''l'' := 0,
+        ''cons'' := 0,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0,
+        ''push_con'' := push_con_nat (s ''a'') (s ''b'')))"
+proof -
+  have "hd_nat (s ''a'') = 0 \<or> hd_nat (s ''a'') = 1 \<or> hd_nat (s ''a'') = 2 
+    \<or> hd_nat (s ''a'') = 3 \<or> hd_nat (s ''a'') > 3"
+    by auto
+  thus ?thesis
+    apply(elim disjE)
+    unfolding push_con_IMP_Minus_def push_con_IMP_Minus_time_def 
+    by(rule terminates_in_state_intro[OF Seq'
+          [OF  push_con_second_part_correct]] ;
+        fastforce 
+        simp: push_con_third_part_def push_con_third_part_time_def Let_def
+        intro: terminates_in_state_intro[OF Seq]
+        terminates_in_state_intro[OF Big_StepT.Assign]
+        cons_IMP_Minus_correct)+
+qed
+
+definition max_constant_iteration_first_part where 
+  "max_constant_iteration_first_part \<equiv>
+  ''e'' ::= (A (V ''a'')) ;;
+
+  ''a'' ::= ((V ''e'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''f'' ::= (A (V ''fst_nat'')) ;;
+
+  ''a'' ::= ((V ''e'') \<ominus> (N 1)) ;;
+  IMP_Minus_snd_nat ;;
+  ''g'' ::= (A (V ''snd_nat'')) ;;
+
+  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''h'' ::= (A (V ''fst_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc 0))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''i'' ::= (A (V ''nth_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc (Suc 0)))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''j'' ::= (A (V ''nth_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc (Suc (Suc 0))))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''k'' ::= (A (V ''nth_nat'')) ;;
+
+  ''a'' ::= (A (N (Suc (Suc (Suc (Suc 0)))))) ;;
+  ''b'' ::= (A (V ''f'')) ;;
+  nth_nat_IMP_Minus ;;
+  ''l'' ::= (A (V ''nth_nat''))"
+
+definition max_constant_iteration_first_part_time 
+  where "max_constant_iteration_first_part_time s \<equiv>
+  (let h = hd_nat s in
+    38 + 2 * IMP_Minus_fst_nat_time (s - 1) + IMP_Minus_fst_nat_time (h - 1)
+    + nth_nat_IMP_Minus_time (Suc 0) h + nth_nat_IMP_Minus_time (Suc (Suc 0)) h
+    + nth_nat_IMP_Minus_time (Suc (Suc (Suc 0))) h
+    + nth_nat_IMP_Minus_time (Suc (Suc (Suc (Suc 0)))) h)"
+
+lemma max_constant_iteration_first_part_correct:
+  "(max_constant_iteration_first_part, s) 
+    \<Rightarrow>\<^bsup>max_constant_iteration_first_part_time (s ''a'')\<^esup>
+    (let h = hd_nat (s ''a''); 
+         t = tl_nat (s ''a''); 
+         c = hd_nat h;  
+         e1 = nth_nat (Suc 0) h ; 
+         e2 = nth_nat (Suc (Suc 0)) h; 
+         e3 = nth_nat (Suc (Suc (Suc 0))) h;
+         e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
+       s(''a'' := 0,
+         ''b'' := 0,
+         ''c'' := 0,
+         ''e'' := s ''a'',
+         ''f'' := h,
+         ''g'' := t,
+         ''h'' := c,
+         ''i'' := e1,
+         ''j'' := e2,
+         ''k'' := e3,
+         ''l'' := e4,
+         ''fst_nat'' := 0,
+         ''snd_nat'' := 0,
+         ''nth_nat'' := e4))"
+  unfolding Let_def max_constant_iteration_first_part_def 
+    max_constant_iteration_first_part_time_def hd_nat_def tl_nat_def
+  by (fastforce intro: terminates_in_time_state_intro[OF Seq] 
+      nth_nat_IMP_Minus_correct
+      terminates_in_state_intro[OF Big_StepT.Assign]
+      IMP_Minus_fst_nat_correct IMP_Minus_snd_nat_correct)+
+
+(*if c = 0 then  max_constant_stack_nat (add_res_nat 0 t) 
+else if c = 1 then max_constant_stack_nat (add_res_nat (aexp_max_constant_tail e1) t)
+else if c = 2 then  max_constant_stack_nat (push_con_nat e1 s) 
+else if c = 3 then   max_constant_stack_nat (push_con_nat e2 s)
+else if c = 4 then   max_constant_stack_nat (add_res_nat (max e3 e4) t)
+else if c = 5 then   max_constant_stack_nat (push_con_nat e1 s) 
+else if c = 6 then  max_constant_stack_nat (add_res_nat e2 t)
+else e1*)
+
+definition max_constant_iteration_second_part where "max_constant_iteration_second_part \<equiv>
+  ''max_constant'' ::= (A (N 1)) ;;
+  IF ''h'' \<noteq>0 THEN
+  (
+    ''a'' ::= ((V ''h'') \<ominus> (N 1)) ;;
+    IF ''a'' \<noteq>0 THEN
+    (
+      ''a'' ::= ((V ''h'') \<ominus> (N 2)) ;;
+      IF ''a'' \<noteq>0 THEN
+      (
+        ''a'' ::= ((V ''h'') \<ominus> (N 3)) ;;
+        IF ''a'' \<noteq>0 THEN
+        (
+          ''a'' ::= ((V ''h'') \<ominus> (N 4)) ;;
+          IF ''a'' \<noteq>0 THEN
+          (
+            ''a'' ::= ((V ''h'') \<ominus> (N 5)) ;;
+            IF ''a'' \<noteq>0 THEN
+            (
+              ''a'' ::= ((V ''h'') \<ominus> (N 6)) ;;
+              IF ''a'' \<noteq>0 THEN
+              (
+                ''a'' ::= (A (V ''i'')) ;;
+                ''max_constant'' ::= (A (N 0))
+              )
+              ELSE
+              (
+                ''a'' ::= (A (V ''j'')) ;;
+                ''b'' ::= (A (V ''g'')) ;;
+                add_res_nat_IMP_Minus ;;
+                ''a'' ::= (A (V ''add_res''))
+              )
+            )
+            ELSE
+            (
+              ''a'' ::= (A (V ''i'')) ;;
+              ''b'' ::= (A (V ''e'')) ;;
+              push_con_IMP_Minus ;;
+              ''a'' ::= (A (V ''push_con''))
+            )
+          )
+          ELSE
+          (
+            ''a'' ::= (A (V ''k'')) ;;
+            ''b'' ::= (A (V ''l'')) ;;
+            IMP_Minus_max_a_min_b ;;
+            ''b'' ::= (A (V ''g'')) ;;
+            add_res_nat_IMP_Minus ;;
+            ''a'' ::= (A (V ''add_res''))
+          )
+        )
+        ELSE
+        (
+          ''a'' ::= (A (V ''j'')) ;;
+          ''b'' ::= (A (V ''e'')) ;;
+          push_con_IMP_Minus ;;
+          ''a'' ::= (A (V ''push_con''))
+        )
+      )
+      ELSE
+      (
+        ''a'' ::= (A (V ''i'')) ;;
+        ''b'' ::= (A (V ''e'')) ;;
+        push_con_IMP_Minus ;;
+        ''a'' ::= (A (V ''push_con''))
+      )
+    )
+    ELSE
+    (
+      ''a'' ::= (A (V ''i'')) ;;
+      aexp_max_constant_IMP_Minus ;;
+      ''a'' ::= (A (V ''aexp_max_constant'')) ;;
+      ''b'' ::= (A (V ''g'')) ;;
+      add_res_nat_IMP_Minus ;;
+      ''a'' ::= (A (V ''add_res''))
+    )
+  )
+  ELSE
+  (
+    ''a'' ::= (A (N 0)) ;;
+    ''b'' ::= (A (V ''g'')) ;;
+    add_res_nat_IMP_Minus ;;
+    ''a'' ::= (A (V ''add_res''))
+  ) ;;
+  zero_variables [''d'', ''e'', ''f'', ''g'', ''h'', ''i'', ''j'', ''k'', ''l'', ''m'', ''n'',
+    ''nth_nat'', ''aexp_max_constant'', ''add_res'', ''cons'', ''triangle'',
+        ''prod_encode'', ''add_res'', ''atomExp_to_constant'', ''push_con'']"
+
+definition max_constant_iteration_second_part_time where 
+  "max_constant_iteration_second_part_time s \<equiv>
+  Suc (Suc 0) + 
+  (let h = hd_nat s; 
+       t = tl_nat s; 
+       c = hd_nat h;  
+       e1 = nth_nat (Suc 0) h ; 
+       e2 = nth_nat (Suc (Suc 0)) h; 
+       e3 = nth_nat (Suc (Suc (Suc 0))) h;
+       e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
+      (if c = 0 then  1 + 6 + (add_res_nat_IMP_Minus_time 0 t) 
+       else if c = 1 then 4 + 8 
+          + (add_res_nat_IMP_Minus_time (aexp_max_constant_tail e1) t)
+          + (aexp_max_constant_IMP_Minus_time e1)
+       else if c = 2 then 7 + 6 + (push_con_IMP_Minus_time e1 s) 
+       else if c = 3 then 10 + 6 + (push_con_IMP_Minus_time e2 s)
+       else if c = 4 then 13 + 8 + 11 + (add_res_nat_IMP_Minus_time (max e3 e4) t)
+       else if c = 5 then 16 + 6 + (push_con_IMP_Minus_time e1 s) 
+       else if c = 6 then 19 + 6 + (add_res_nat_IMP_Minus_time e2 t)
+       else 19 + 4))
+  + zero_variables_time [''d'', ''e'', ''f'', ''g'', ''h'', ''i'', ''j'', ''k'', ''l'', ''m'', ''n'',
+    ''nth_nat'', ''aexp_max_constant'', ''add_res'', ''cons'', ''triangle'',
+        ''prod_encode'', ''add_res'', ''atomExp_to_constant'', ''push_con'']"
+
+definition max_constant_iteration where "max_constant_iteration \<equiv>
+  max_constant_iteration_first_part ;;
+  max_constant_iteration_second_part"
+
+definition max_constant_iteration_time where "max_constant_iteration_time s \<equiv>
+  max_constant_iteration_first_part_time s 
+  + max_constant_iteration_second_part_time s"
+
+declare add_res_nat.simps [simp del]
+declare push_con_nat.simps [simp del]
+declare aexp_max_constant_tail.simps [simp del]
+
+lemma max_constant_iteration_correct: 
+"(max_constant_iteration, s') 
+    \<Rightarrow>\<^bsup>max_constant_iteration_time (s' ''a'')\<^esup>
+    (let s = s' ''a'';
+         h = hd_nat s; 
+         t = tl_nat s; 
+         c = hd_nat h;  
+         e1 = nth_nat (Suc 0) h ; 
+         e2 = nth_nat (Suc (Suc 0)) h; 
+         e3 = nth_nat (Suc (Suc (Suc 0))) h;
+         e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
+       s'(''a'' := 
+          (if c = 0 then (add_res_nat 0 t) 
+           else if c = 1 then (add_res_nat (aexp_max_constant_tail e1) t)
+           else if c = 2 then (push_con_nat e1 s) 
+           else if c = 3 then (push_con_nat e2 s)
+           else if c = 4 then (add_res_nat (max e3 e4) t)
+           else if c = 5 then (push_con_nat e1 s) 
+           else if c = 6 then (add_res_nat e2 t)
+           else e1),
+         ''b'' := 0,
+         ''c'' := 0,
+         ''d'' := 0,
+         ''e'' := 0,
+         ''f'' := 0,
+         ''g'' := 0,
+         ''h'' := 0,
+         ''i'' := 0,
+         ''j'' := 0,
+         ''k'' := 0,
+         ''l'' := 0,
+         ''m'' := 0,
+         ''n'' := 0,
+         ''max_constant'' := (if c < 7 then 1 else 0),
+         ''fst_nat'' := 0,
+         ''snd_nat'' := 0,
+         ''nth_nat'' := 0,
+         ''cons'' := 0,
+         ''triangle'' := 0,
+         ''prod_encode'' := 0,
+         ''aexp_max_constant'' := 0,
+         ''atomExp_to_constant'' := 0,
+         ''add_res'' := 0,
+         ''push_con'' := 0))"
+proof -
+  let ?c = "hd_nat (hd_nat (s' ''a''))"
+  have "?c = 0 \<or> ?c = 1 \<or> ?c = 2 \<or> ?c = 3 \<or> ?c = 4 \<or> ?c = 5 \<or> ?c = 6 \<or> ?c > 6"
+    by auto
+  thus ?thesis
+    unfolding max_constant_iteration_def max_constant_iteration_time_def
+      max_constant_iteration_second_part_def max_constant_iteration_second_part_time_def
+    apply(elim disjE)
+    by(fastforce 
+        simp: Let_def 
+        intro: 
+          aexp_max_constant_IMP_Minus_correct IMP_Minus_max_a_min_b_correct
+          add_res_nat_IMP_Minus_correct push_con_IMP_Minus_correct
+        intro!: 
+          terminates_in_state_intro[OF Seq'
+          [OF max_constant_iteration_first_part_correct
+            Seq'[OF Seq'[OF Big_StepT.Assign] zero_variables_correct]]])+
+qed
+
+end 
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index ee94f974..64a149af 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -322,4 +322,24 @@ qed auto
 declare cons_list_IMP_Minus.simps [simp del]
 declare cons_list_IMP_Minus_time.simps [simp del]
 
+fun zero_variables :: "vname list \<Rightarrow> Com.com" where
+"zero_variables [] = Com.SKIP" |
+"zero_variables (a # as) = (a ::= (A (N 0)) ;; zero_variables as)"
+
+definition zero_variables_time where "zero_variables_time vs \<equiv>
+  1 + 2 * length vs"
+
+lemma zero_variables_correct:
+  "(zero_variables vs, s) 
+    \<Rightarrow>\<^bsup>zero_variables_time vs\<^esup> (\<lambda>v. (if v \<in> set vs then 0 else s v))"
+proof (induction vs arbitrary: s)
+  case (Cons a vs)
+  show ?case
+    by(fastforce 
+        intro: terminates_in_state_intro[OF Seq[OF Big_StepT.Assign Cons.IH]] 
+        simp: zero_variables_time_def)
+qed (auto simp: zero_variables_time_def)
+
+declare zero_variables.simps [simp del]
+
 end
\ No newline at end of file

From 07c5b9f7220c21c1a44e806a582543fef1822f94 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Tue, 14 Sep 2021 19:33:23 +0200
Subject: [PATCH 034/103] finished implementing and verifiying max_constant

---
 .../IMP_Minus_Max_Constant_IMP_Minus.thy      | 351 ++++++++++++++----
 1 file changed, 285 insertions(+), 66 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
index f8dd7fa2..0f6de058 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
@@ -105,6 +105,7 @@ lemma aexp_max_constant_IMP_Minus_correct:
       ''atomExp_to_constant'' := 0,
       ''aexp_max_constant'' := aexp_max_constant_tail (s ''a''))"
   unfolding aexp_max_constant_IMP_Minus_def aexp_max_constant_IMP_Minus_time_def
+    aexp_max_constant_tail_def
   apply(cases "3 - fst_nat (s ''a'' - Suc 0)"; cases "fst_nat (s ''a'' - Suc 0)")
      apply simp
   apply(fastforce simp: numeral_eq_Suc hd_nat_def 
@@ -298,7 +299,7 @@ definition add_res_nat_third_part where "add_res_nat_third_part \<equiv>
            IF ''a'' \<noteq>0
            THEN
            (
-            ''add_res'' ::= (A (V ''e''))
+            ''add_res'' ::= (A (V ''l''))
            )
            ELSE
            (
@@ -307,7 +308,7 @@ definition add_res_nat_third_part where "add_res_nat_third_part \<equiv>
         )
         ELSE
         (
-          ''add_res'' ::= (A (V ''e'')) ;;
+          ''add_res'' ::= (A (V ''l'')) ;;
           Com.SKIP ;; Com.SKIP ;; Com.SKIP
         )
       )
@@ -328,7 +329,7 @@ definition add_res_nat_third_part where "add_res_nat_third_part \<equiv>
     )
     ELSE
     (
-      ''add_res'' ::= (A (V ''e'')) ;;
+      ''add_res'' ::= (A (V ''l'')) ;;
       Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
       Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
       Com.SKIP ;; Com.SKIP ;; Com.SKIP
@@ -342,14 +343,7 @@ definition add_res_nat_third_part where "add_res_nat_third_part \<equiv>
     Com.SKIP ;; Com.SKIP ;; Com.SKIP ;;
     Com.SKIP ;; Com.SKIP ;; Com.SKIP
   );;
-  ''a'' ::= (A (N 0)) ;;
-  ''e'' ::= (A (N 0)) ;;
-  ''h'' ::= (A (N 0)) ;;
-  ''k'' ::= (A (N 0)) ;;
-  ''l'' ::= (A (N 0)) ;;
-  ''m'' ::= (A (N 0)) ;;
-  ''n'' ::= (A (N 0)) ;;
-  ''cons'' ::= (A (N 0))"
+  zero_variables [''a'', ''e'', ''h'', ''k'', ''l'', ''m'', ''n'', ''cons'']"
 
 definition add_res_nat_IMP_Minus where "add_res_nat_IMP_Minus \<equiv>
   add_res_nat_first_part ;;
@@ -359,7 +353,8 @@ definition add_res_nat_IMP_Minus where "add_res_nat_IMP_Minus \<equiv>
 definition add_res_nat_IMP_Minus_time where "add_res_nat_IMP_Minus_time n s \<equiv>
   add_res_nat_first_part_time n s
   + add_res_nat_second_part_time n s
-  + 31"
+  + 15
+  + zero_variables_time [''a'', ''e'', ''h'', ''k'', ''l'', ''m'', ''n'', ''cons'']"
 
 lemma add_res_nat_IMP_Minus_correct:
   "(add_res_nat_IMP_Minus, s)
@@ -391,9 +386,9 @@ proof(cases "s ''b''")
     unfolding add_res_nat_IMP_Minus_def add_res_nat_IMP_Minus_time_def
     apply(rule terminates_in_time_state_intro[OF Seq'
           [OF add_res_nat_second_part_correct]])
-    unfolding add_res_nat_third_part_def Let_def
+    unfolding add_res_nat_third_part_def Let_def add_res_nat_def
     using \<open>s ''b'' = 0\<close> 
-    by(fastforce)+
+    by(fastforce intro: zero_variables_correct)+
 next
   case (Suc nat)
   let ?c = "hd_nat (hd_nat (s ''b''))"
@@ -402,12 +397,14 @@ next
   then show ?thesis
     apply(elim disjE)
     unfolding add_res_nat_IMP_Minus_def add_res_nat_IMP_Minus_time_def
-    unfolding add_res_nat_third_part_def Let_def
-    using \<open>s ''b'' = Suc nat\<close> 
+    unfolding add_res_nat_third_part_def Let_def add_res_nat_def
+    using \<open>s ''b'' = Suc nat\<close>  
+          apply simp
+    using \<open>s ''b'' = Suc nat\<close>  
     by (fastforce 
-        intro!: terminates_in_time_state_intro[OF Seq'
-          [OF add_res_nat_second_part_correct]]
-        simp: Let_def)+
+         intro!: terminates_in_time_state_intro[OF Seq'[OF 
+            add_res_nat_second_part_correct Seq'[OF _ zero_variables_correct]]]
+         simp: Let_def)+
 qed
 
 definition push_con_first_part where "push_con_first_part \<equiv>
@@ -622,7 +619,7 @@ proof -
     by auto
   thus ?thesis
     apply(elim disjE)
-    unfolding push_con_IMP_Minus_def push_con_IMP_Minus_time_def 
+    unfolding push_con_IMP_Minus_def push_con_IMP_Minus_time_def push_con_nat_def
     by(rule terminates_in_state_intro[OF Seq'
           [OF  push_con_second_part_correct]] ;
         fastforce 
@@ -718,58 +715,67 @@ else e1*)
 
 definition max_constant_iteration_second_part where "max_constant_iteration_second_part \<equiv>
   ''max_constant'' ::= (A (N 1)) ;;
-  IF ''h'' \<noteq>0 THEN
-  (
-    ''a'' ::= ((V ''h'') \<ominus> (N 1)) ;;
-    IF ''a'' \<noteq>0 THEN
+  IF ''e'' \<noteq>0 THEN
+    IF ''h'' \<noteq>0 THEN
     (
-      ''a'' ::= ((V ''h'') \<ominus> (N 2)) ;;
+      ''a'' ::= ((V ''h'') \<ominus> (N 1)) ;;
       IF ''a'' \<noteq>0 THEN
       (
-        ''a'' ::= ((V ''h'') \<ominus> (N 3)) ;;
+        ''a'' ::= ((V ''h'') \<ominus> (N 2)) ;;
         IF ''a'' \<noteq>0 THEN
         (
-          ''a'' ::= ((V ''h'') \<ominus> (N 4)) ;;
+          ''a'' ::= ((V ''h'') \<ominus> (N 3)) ;;
           IF ''a'' \<noteq>0 THEN
           (
-            ''a'' ::= ((V ''h'') \<ominus> (N 5)) ;;
+            ''a'' ::= ((V ''h'') \<ominus> (N 4)) ;;
             IF ''a'' \<noteq>0 THEN
             (
-              ''a'' ::= ((V ''h'') \<ominus> (N 6)) ;;
+              ''a'' ::= ((V ''h'') \<ominus> (N 5)) ;;
               IF ''a'' \<noteq>0 THEN
               (
-                ''a'' ::= (A (V ''i'')) ;;
-                ''max_constant'' ::= (A (N 0))
+                ''a'' ::= ((V ''h'') \<ominus> (N 6)) ;;
+                IF ''a'' \<noteq>0 THEN
+                (
+                  ''a'' ::= (A (V ''i'')) ;;
+                  ''max_constant'' ::= (A (N 0))
+                )
+                ELSE
+                (
+                  ''a'' ::= (A (V ''j'')) ;;
+                  ''b'' ::= (A (V ''g'')) ;;
+                  add_res_nat_IMP_Minus ;;
+                  ''a'' ::= (A (V ''add_res''))
+                )
               )
               ELSE
               (
-                ''a'' ::= (A (V ''j'')) ;;
-                ''b'' ::= (A (V ''g'')) ;;
-                add_res_nat_IMP_Minus ;;
-                ''a'' ::= (A (V ''add_res''))
+                ''a'' ::= (A (V ''i'')) ;;
+                ''b'' ::= (A (V ''e'')) ;;
+                push_con_IMP_Minus ;;
+                ''a'' ::= (A (V ''push_con''))
               )
             )
             ELSE
             (
-              ''a'' ::= (A (V ''i'')) ;;
-              ''b'' ::= (A (V ''e'')) ;;
-              push_con_IMP_Minus ;;
-              ''a'' ::= (A (V ''push_con''))
+              ''a'' ::= (A (V ''k'')) ;;
+              ''b'' ::= (A (V ''l'')) ;;
+              IMP_Minus_max_a_min_b ;;
+              ''b'' ::= (A (V ''g'')) ;;
+              add_res_nat_IMP_Minus ;;
+              ''a'' ::= (A (V ''add_res''))
             )
           )
           ELSE
           (
-            ''a'' ::= (A (V ''k'')) ;;
-            ''b'' ::= (A (V ''l'')) ;;
-            IMP_Minus_max_a_min_b ;;
-            ''b'' ::= (A (V ''g'')) ;;
-            add_res_nat_IMP_Minus ;;
-            ''a'' ::= (A (V ''add_res''))
+            ''a'' ::= (A (V ''j'')) ;;
+            ''b'' ::= (A (V ''e'')) ;;
+            push_con_IMP_Minus ;;
+            ''a'' ::= (A (V ''push_con''))
           )
         )
         ELSE
         (
-          ''a'' ::= (A (V ''j'')) ;;
+          ''a'' ::= (A (V ''i'')) ;;
           ''b'' ::= (A (V ''e'')) ;;
           push_con_IMP_Minus ;;
           ''a'' ::= (A (V ''push_con''))
@@ -778,27 +784,24 @@ definition max_constant_iteration_second_part where "max_constant_iteration_seco
       ELSE
       (
         ''a'' ::= (A (V ''i'')) ;;
-        ''b'' ::= (A (V ''e'')) ;;
-        push_con_IMP_Minus ;;
-        ''a'' ::= (A (V ''push_con''))
+        aexp_max_constant_IMP_Minus ;;
+        ''a'' ::= (A (V ''aexp_max_constant'')) ;;
+        ''b'' ::= (A (V ''g'')) ;;
+        add_res_nat_IMP_Minus ;;
+        ''a'' ::= (A (V ''add_res''))
       )
     )
     ELSE
     (
-      ''a'' ::= (A (V ''i'')) ;;
-      aexp_max_constant_IMP_Minus ;;
-      ''a'' ::= (A (V ''aexp_max_constant'')) ;;
+      ''a'' ::= (A (N 0)) ;;
       ''b'' ::= (A (V ''g'')) ;;
       add_res_nat_IMP_Minus ;;
       ''a'' ::= (A (V ''add_res''))
     )
-  )
   ELSE
   (
     ''a'' ::= (A (N 0)) ;;
-    ''b'' ::= (A (V ''g'')) ;;
-    add_res_nat_IMP_Minus ;;
-    ''a'' ::= (A (V ''add_res''))
+    ''max_constant'' ::= (A (N 0))
   ) ;;
   zero_variables [''d'', ''e'', ''f'', ''g'', ''h'', ''i'', ''j'', ''k'', ''l'', ''m'', ''n'',
     ''nth_nat'', ''aexp_max_constant'', ''add_res'', ''cons'', ''triangle'',
@@ -814,7 +817,9 @@ definition max_constant_iteration_second_part_time where
        e2 = nth_nat (Suc (Suc 0)) h; 
        e3 = nth_nat (Suc (Suc (Suc 0))) h;
        e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
-      (if c = 0 then  1 + 6 + (add_res_nat_IMP_Minus_time 0 t) 
+      (if s = 0 then 1 + 4 
+       else 1 + 
+       (if c = 0 then 1 + 6 + (add_res_nat_IMP_Minus_time 0 t) 
        else if c = 1 then 4 + 8 
           + (add_res_nat_IMP_Minus_time (aexp_max_constant_tail e1) t)
           + (aexp_max_constant_IMP_Minus_time e1)
@@ -823,7 +828,7 @@ definition max_constant_iteration_second_part_time where
        else if c = 4 then 13 + 8 + 11 + (add_res_nat_IMP_Minus_time (max e3 e4) t)
        else if c = 5 then 16 + 6 + (push_con_IMP_Minus_time e1 s) 
        else if c = 6 then 19 + 6 + (add_res_nat_IMP_Minus_time e2 t)
-       else 19 + 4))
+       else 19 + 4)))
   + zero_variables_time [''d'', ''e'', ''f'', ''g'', ''h'', ''i'', ''j'', ''k'', ''l'', ''m'', ''n'',
     ''nth_nat'', ''aexp_max_constant'', ''add_res'', ''cons'', ''triangle'',
         ''prod_encode'', ''add_res'', ''atomExp_to_constant'', ''push_con'']"
@@ -836,10 +841,6 @@ definition max_constant_iteration_time where "max_constant_iteration_time s \<eq
   max_constant_iteration_first_part_time s 
   + max_constant_iteration_second_part_time s"
 
-declare add_res_nat.simps [simp del]
-declare push_con_nat.simps [simp del]
-declare aexp_max_constant_tail.simps [simp del]
-
 lemma max_constant_iteration_correct: 
 "(max_constant_iteration, s') 
     \<Rightarrow>\<^bsup>max_constant_iteration_time (s' ''a'')\<^esup>
@@ -852,14 +853,15 @@ lemma max_constant_iteration_correct:
          e3 = nth_nat (Suc (Suc (Suc 0))) h;
          e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
        s'(''a'' := 
-          (if c = 0 then (add_res_nat 0 t) 
+          (if s = 0 then 0
+           else (if c = 0 then (add_res_nat 0 t) 
            else if c = 1 then (add_res_nat (aexp_max_constant_tail e1) t)
            else if c = 2 then (push_con_nat e1 s) 
            else if c = 3 then (push_con_nat e2 s)
            else if c = 4 then (add_res_nat (max e3 e4) t)
            else if c = 5 then (push_con_nat e1 s) 
            else if c = 6 then (add_res_nat e2 t)
-           else e1),
+           else e1)),
          ''b'' := 0,
          ''c'' := 0,
          ''d'' := 0,
@@ -873,7 +875,7 @@ lemma max_constant_iteration_correct:
          ''l'' := 0,
          ''m'' := 0,
          ''n'' := 0,
-         ''max_constant'' := (if c < 7 then 1 else 0),
+         ''max_constant'' := (if s \<noteq> 0 \<and> c < 7 then 1 else 0),
          ''fst_nat'' := 0,
          ''snd_nat'' := 0,
          ''nth_nat'' := 0,
@@ -884,7 +886,23 @@ lemma max_constant_iteration_correct:
          ''atomExp_to_constant'' := 0,
          ''add_res'' := 0,
          ''push_con'' := 0))"
-proof -
+proof (cases "s' ''a''")
+  case 0
+  then show ?thesis
+     unfolding max_constant_iteration_def max_constant_iteration_time_def
+      max_constant_iteration_second_part_def max_constant_iteration_second_part_time_def
+    by(fastforce 
+        simp: Let_def 
+        intro: 
+          aexp_max_constant_IMP_Minus_correct IMP_Minus_max_a_min_b_correct
+          add_res_nat_IMP_Minus_correct push_con_IMP_Minus_correct
+        intro!: 
+          terminates_in_state_intro[OF Seq'
+          [OF max_constant_iteration_first_part_correct
+            Seq'[OF Seq'[OF Big_StepT.Assign] zero_variables_correct]]])
+next
+  case (Suc nat)
+
   let ?c = "hd_nat (hd_nat (s' ''a''))"
   have "?c = 0 \<or> ?c = 1 \<or> ?c = 2 \<or> ?c = 3 \<or> ?c = 4 \<or> ?c = 5 \<or> ?c = 6 \<or> ?c > 6"
     by auto
@@ -892,6 +910,7 @@ proof -
     unfolding max_constant_iteration_def max_constant_iteration_time_def
       max_constant_iteration_second_part_def max_constant_iteration_second_part_time_def
     apply(elim disjE)
+    using Suc
     by(fastforce 
         simp: Let_def 
         intro: 
@@ -903,4 +922,204 @@ proof -
             Seq'[OF Seq'[OF Big_StepT.Assign] zero_variables_correct]]])+
 qed
 
+function (domintros) max_constant_loop_time :: "nat \<Rightarrow> nat" where
+"max_constant_loop_time s = 
+  1 + max_constant_iteration_time s + 
+  (if s = 0 then 2 
+   else (let h = hd_nat s;
+         t = tl_nat s;
+         c = hd_nat h;
+         e1 = nth_nat (Suc 0) h;
+         e2 = nth_nat (Suc (Suc 0)) h;
+         e3 = nth_nat (Suc (Suc (Suc 0))) h;
+         e4 = nth_nat (Suc (Suc (Suc (Suc 0)))) h in 
+      if c = 0 then max_constant_loop_time (add_res_nat 0 t) 
+      else if c = 1 then max_constant_loop_time (add_res_nat (aexp_max_constant_tail e1) t)
+      else if c = 2 then max_constant_loop_time (push_con_nat e1 s) 
+      else if c = 3 then max_constant_loop_time (push_con_nat e2 s)
+      else if c = 4 then max_constant_loop_time (add_res_nat (max e3 e4) t)
+      else if c = 5 then max_constant_loop_time (push_con_nat e1 s) 
+      else if c = 6 then max_constant_loop_time (add_res_nat e2 t)
+      else 2))"
+  by pat_completeness auto
+
+lemma max_constant_stack_nat_domain_then_max_constant_loop_time_domain:
+  "max_constant_stack_nat_dom x \<Longrightarrow> max_constant_loop_time_dom x"
+proof(induction x rule: max_constant_stack_nat.pinduct)
+  case (1 s)
+
+  show ?case 
+  proof (cases s)
+    case 0
+    then show ?thesis
+      using max_constant_loop_time.domintros[where ?s=s]
+      by auto
+  next
+    case (Suc nat)
+    show ?thesis
+      by(fastforce intro: 
+          max_constant_loop_time.domintros[where ?s=s]
+          "1.IH"[where ?x="hd_nat s", simplified])
+  qed
+qed
+
+lemma max_constant_loop_correct:
+   "max_constant_stack_nat_dom s \<Longrightarrow> s' ''a'' = s \<Longrightarrow> 
+    0 < s' ''max_constant'' \<Longrightarrow>
+(WHILE ''max_constant''\<noteq>0 DO max_constant_iteration, s') 
+    \<Rightarrow>\<^bsup>max_constant_loop_time s\<^esup>
+      s'(''a'' := max_constant_stack_nat s,
+         ''b'' := 0,
+         ''c'' := 0,
+         ''d'' := 0,
+         ''e'' := 0,
+         ''f'' := 0,
+         ''g'' := 0,
+         ''h'' := 0,
+         ''i'' := 0,
+         ''j'' := 0,
+         ''k'' := 0,
+         ''l'' := 0,
+         ''m'' := 0,
+         ''n'' := 0,
+         ''max_constant'' := 0,
+         ''fst_nat'' := 0,
+         ''snd_nat'' := 0,
+         ''nth_nat'' := 0,
+         ''cons'' := 0,
+         ''triangle'' := 0,
+         ''prod_encode'' := 0,
+         ''aexp_max_constant'' := 0,
+         ''atomExp_to_constant'' := 0,
+         ''add_res'' := 0,
+         ''push_con'' := 0)"
+proof(induction s arbitrary: s' rule: max_constant_stack_nat.pinduct)
+  case (1 s)
+  
+  let ?c = "hd_nat (hd_nat s)"
+
+  show ?case
+  proof (cases "s \<noteq> 0 \<and> ?c < 7")
+    case True
+
+    hence "?c = 0 \<or> ?c = 1 \<or> ?c = 2 \<or> ?c = 3 \<or> ?c = 4 \<or> ?c = 5 \<or> ?c = 6" 
+      by auto
+
+    then show ?thesis
+      apply(elim disjE)
+      using \<open>0 < s' ''max_constant''\<close>
+        \<open>s \<noteq> 0 \<and> hd_nat (hd_nat s) < 7\<close> \<open>s' ''a'' = s\<close>
+        max_constant_loop_time.psimps
+        max_constant_stack_nat.psimps
+        max_constant_stack_nat_domain_then_max_constant_loop_time_domain
+        \<open>max_constant_stack_nat_dom s\<close>
+            apply -
+            apply (fastforce
+              simp: Let_def
+              intro!: 
+                terminates_in_state_intro
+                [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(1)]])
+           apply (fastforce
+              simp: Let_def
+              intro!: 
+                terminates_in_state_intro
+                [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(2)]])
+          apply (fastforce
+            simp: Let_def
+            intro!: 
+            terminates_in_state_intro
+            [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(3)]])
+         apply (fastforce
+          simp: Let_def
+          intro!: 
+          terminates_in_state_intro
+          [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(4)]])
+        apply (fastforce
+          simp: Let_def
+          intro!: 
+          terminates_in_state_intro
+          [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(5)]])
+       apply (fastforce
+          simp: Let_def
+          intro!: 
+          terminates_in_state_intro
+          [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(6)]])
+      by (fastforce
+          simp: Let_def
+          intro!: 
+          terminates_in_state_intro
+          [OF Big_StepT.WhileTrue[OF _ max_constant_iteration_correct "1.IH"(7)]])
+  next
+    case False
+
+    show ?thesis
+    proof(cases s)
+      case 0
+      thus ?thesis
+        using 
+          \<open>0 < s' ''max_constant''\<close>
+          max_constant_loop_time.psimps[OF max_constant_loop_time.domintros]
+          max_constant_stack_nat.psimps[OF max_constant_stack_nat.domintros]
+          \<open>s' ''a'' = s\<close>
+        by (auto intro!: terminates_in_state_intro[OF Big_StepT.WhileTrue
+              [OF _ max_constant_iteration_correct Big_StepT.WhileFalse]])
+    next
+      case (Suc nat)
+      hence "s \<noteq> 0" "?c > 6"
+        using \<open>\<not> (s \<noteq> 0 \<and> ?c < 7)\<close>
+        by auto
+      thus ?thesis
+        using 
+          \<open>0 < s' ''max_constant''\<close>
+          max_constant_loop_time.psimps[OF max_constant_loop_time.domintros]
+          max_constant_stack_nat.psimps[OF max_constant_stack_nat.domintros]
+          \<open>s' ''a'' = s\<close>
+        by (auto intro!: terminates_in_state_intro[OF Big_StepT.WhileTrue
+              [OF _ max_constant_iteration_correct Big_StepT.WhileFalse]])
+    qed
+  qed
+qed
+
+definition max_constant_IMP_Minus where "max_constant_IMP_Minus \<equiv>
+  ''max_constant'' ::= (A (N 1)) ;;
+  WHILE ''max_constant''\<noteq>0 DO max_constant_iteration ;;
+  ''max_constant'' ::= (A (V ''a'')) ;;
+  ''a'' ::= (A (N 0))" 
+
+definition max_constant_time where "max_constant_time s \<equiv>
+  6 + max_constant_loop_time s" 
+
+lemma max_constant_IMP_Minus_correct: 
+"max_constant_stack_nat_dom (s ''a'') \<Longrightarrow> 
+    0 < s' ''max_constant'' \<Longrightarrow>
+(max_constant_IMP_Minus, s) 
+    \<Rightarrow>\<^bsup>max_constant_time (s ''a'')\<^esup>
+       s(''a'' := 0,
+         ''b'' := 0,
+         ''c'' := 0,
+         ''d'' := 0,
+         ''e'' := 0,
+         ''f'' := 0,
+         ''g'' := 0,
+         ''h'' := 0,
+         ''i'' := 0,
+         ''j'' := 0,
+         ''k'' := 0,
+         ''l'' := 0,
+         ''m'' := 0,
+         ''n'' := 0,
+         ''max_constant'' := max_constant_stack_nat (s ''a''),
+         ''fst_nat'' := 0,
+         ''snd_nat'' := 0,
+         ''nth_nat'' := 0,
+         ''cons'' := 0,
+         ''triangle'' := 0,
+         ''prod_encode'' := 0,
+         ''aexp_max_constant'' := 0,
+         ''atomExp_to_constant'' := 0,
+         ''add_res'' := 0,
+         ''push_con'' := 0)"
+  unfolding max_constant_IMP_Minus_def max_constant_time_def 
+  by(fastforce intro!: terminates_in_state_intro[OF Seq] max_constant_loop_correct)
+
 end 
\ No newline at end of file

From 83291d35bf535ad20f20f379e6dc0c40dd3375cf Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Fri, 17 Sep 2021 17:18:00 +0200
Subject: [PATCH 035/103] implemented another function

---
 .../IMP_Minus_Max_Constant_IMP_Minus.thy      |   2 +
 IMP-/IMP_Minus_Nat_Bijection.thy              | 126 ++++++++++++++++++
 2 files changed, 128 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
index 0f6de058..10007228 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy
@@ -21,6 +21,8 @@ definition atomExp_to_constant_IMP_Minus where "atomExp_to_constant_IMP_Minus \<
 definition atomExp_to_constant_IMP_Minus_time where "atomExp_to_constant_IMP_Minus_time x \<equiv>
   11 + 2 * IMP_Minus_fst_nat_time x"
 
+(*lemma atomExp_to_constant_IMP_Minus_time_polynomial: "poly atomExp_to_constant_IMP_Minus_time"*)
+
 lemma atomExp_to_constant_IMP_Minus_correct:
   "(atomExp_to_constant_IMP_Minus, s) \<Rightarrow>\<^bsup>atomExp_to_constant_IMP_Minus_time (s ''a'')\<^esup> 
     s(''a'' := 0,
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 64a149af..e4ace843 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -342,4 +342,130 @@ qed (auto simp: zero_variables_time_def)
 
 declare zero_variables.simps [simp del]
 
+(*"reverse_nat_acc acc e  n f =
+  (if n = 0 then acc 
+   else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"*)
+
+definition reverse_nat_acc_IMP_Minus_iteration where "reverse_nat_acc_IMP_Minus_iteration \<equiv>
+  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  
+  cons_IMP_Minus (V ''fst_nat'') (V ''e'') ;;
+
+  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
+  IMP_Minus_snd_nat ;;
+  
+  ''e'' ::= (A (V ''cons'')) ;;
+  ''f'' ::= (A (V ''snd_nat'')) ;;
+
+  zero_variables [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'']"
+
+definition reverse_nat_acc_IMP_Minus_iteration_time where 
+  "reverse_nat_acc_IMP_Minus_iteration_time acc n \<equiv>
+    8 + IMP_Minus_fst_nat_time (n - 1) + cons_IMP_Minus_time (hd_nat n) acc
+    + IMP_Minus_fst_nat_time (n - 1)
+    + zero_variables_time [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'']"
+
+(*"reverse_nat_acc acc e  n f =
+  (if n = 0 then acc 
+   else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"*)
+
+lemma reverse_nat_acc_IMP_Minus_iteration_correct: 
+  "(reverse_nat_acc_IMP_Minus_iteration, s) 
+    \<Rightarrow>\<^bsup>reverse_nat_acc_IMP_Minus_iteration_time (s ''e'') (s ''f'')\<^esup>
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''d'' := 0,
+      ''e'' := ((hd_nat (s ''f'')) ## (s ''e'')),
+      ''f'' := (tl_nat (s ''f'')),
+      ''triangle'' := 0,
+      ''prod_encode'' := 0,
+      ''cons'' := 0,
+      ''fst_nat'' := 0,
+      ''snd_nat'' := 0)"
+  unfolding reverse_nat_acc_IMP_Minus_iteration_def 
+    reverse_nat_acc_IMP_Minus_iteration_time_def
+  by(fastforce 
+       simp: hd_nat_def tl_nat_def 
+       intro!: terminates_in_time_state_intro[OF Seq']
+       intro: IMP_Minus_fst_nat_correct IMP_Minus_snd_nat_correct zero_variables_correct
+       cons_IMP_Minus_correct)
+
+(* WHILE ''f'' \<noteq>0 DO reverse_nat_acc_IMP_Minus_loop_iteration *)
+
+fun reverse_nat_acc_IMP_Minus_loop_time where 
+"reverse_nat_acc_IMP_Minus_loop_time acc n = 
+  (if n = 0 then 2 
+   else 1 + reverse_nat_acc_IMP_Minus_iteration_time acc n + 
+    reverse_nat_acc_IMP_Minus_loop_time ((hd_nat n) ## acc) (tl_nat n))"
+
+lemma reverse_nat_acc_IMP_Minus_loop_correct[intro]: 
+  "(WHILE ''f'' \<noteq>0 DO reverse_nat_acc_IMP_Minus_iteration, s) 
+    \<Rightarrow>\<^bsup>reverse_nat_acc_IMP_Minus_loop_time (s ''e'') (s ''f'')\<^esup>
+    (if s ''f'' \<noteq> 0 then
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''e'' := reverse_nat_acc (s ''e'') (s ''f''),
+        ''f'' := 0,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0,
+        ''cons'' := 0,
+        ''fst_nat'' := 0,
+        ''snd_nat'' := 0)
+      else s)"
+proof(induction "s ''e''" "s ''f''" arbitrary: s rule: reverse_nat_acc.induct)
+  case 1
+  then show ?case
+  proof(cases "s ''f''")
+    case 0
+    then show ?thesis
+      by (fastforce intro: terminates_in_time_state_intro[OF Big_StepT.WhileFalse])
+  next
+    case (Suc nat)
+        
+    then show ?thesis
+      by(fastforce intro!: terminates_in_time_state_intro[OF
+        Big_StepT.WhileTrue[OF _ reverse_nat_acc_IMP_Minus_iteration_correct 1(1)]])
+  qed
+qed
+
+definition "reverse_nat_acc_IMP_Minus" where "reverse_nat_acc_IMP_Minus \<equiv>
+  ''e'' ::= (A (V ''a'')) ;;
+  ''f'' ::= (A (V ''b'')) ;;
+  WHILE ''f'' \<noteq>0 DO reverse_nat_acc_IMP_Minus_iteration ;;
+  ''reverse_nat_acc'' ::= (A (V ''e'')) ;;
+  zero_variables [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'', ''e'',
+    ''triangle'', ''prod_encode'']"
+
+definition reverse_nat_acc_IMP_Minus_time where "reverse_nat_acc_IMP_Minus_time acc n \<equiv>
+  6 + reverse_nat_acc_IMP_Minus_loop_time acc n
+  + zero_variables_time 
+    [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'', ''e'',
+      ''triangle'', ''prod_encode'']"
+
+lemma reverse_nat_acc_IMP_Minus_correct:
+  "(reverse_nat_acc_IMP_Minus, s) 
+    \<Rightarrow>\<^bsup>reverse_nat_acc_IMP_Minus_time (s ''a'') (s ''b'')\<^esup>
+      s(''a'' := 0,
+        ''b'' := 0,
+        ''c'' := 0,
+        ''d'' := 0,
+        ''e'' := 0,
+        ''f'' := 0,
+        ''triangle'' := 0,
+        ''prod_encode'' := 0,
+        ''cons'' := 0,
+        ''fst_nat'' := 0,
+        ''snd_nat'' := 0,
+        ''reverse_nat_acc'' := reverse_nat_acc (s ''a'') (s ''b''))"
+  unfolding reverse_nat_acc_IMP_Minus_def reverse_nat_acc_IMP_Minus_time_def
+  apply(cases "s ''b''") 
+  by(fastforce 
+      intro!: HOL.ext terminates_in_time_state_intro[OF Seq'] 
+      zero_variables_correct reverse_nat_acc_IMP_Minus_loop_correct
+      intro:  reverse_nat_acc_IMP_Minus_loop_correct)+
+  
 end
\ No newline at end of file

From 61ea71815469c90eab6545766d735491db38259f Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Mon, 20 Sep 2021 03:41:42 +0200
Subject: [PATCH 036/103] Created empty theory IMP_Minus_Common_Funs_Nat

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
new file mode 100644
index 00000000..b684a9c0
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -0,0 +1,5 @@
+theory IMP_Minus_Common_Funs_Nat
+  imports Main
+begin
+
+end

From a00f8e740c74ecfa436a1529db01d66d2ef4cbea Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Wed, 22 Sep 2021 03:55:57 +0200
Subject: [PATCH 037/103] imported IMP_Minus_Nat_Bijection

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index b684a9c0..829a88ed 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -1,5 +1,5 @@
 theory IMP_Minus_Common_Funs_Nat
-  imports Main
+  imports "../../IMP-/IMP_Minus_Nat_Bijection"
 begin
 
 end

From b742b3534c39f0bf7c8eb897604c47bad82fe536 Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Wed, 22 Sep 2021 03:56:34 +0200
Subject: [PATCH 038/103] stopped working on append

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 21 +++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 829a88ed..a4d7171c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -2,4 +2,25 @@ theory IMP_Minus_Common_Funs_Nat
   imports "../../IMP-/IMP_Minus_Nat_Bijection"
 begin
 
+subsection \<open>append\<close>
+
+text\<open>Goal of this subsection is *append_tail*, which is defined in terms
+  of reverse_nat and append_acc, both of which, in turn, are defined in
+  terms of -- or can be related to -- *reverse_nat_acc*.\<close>
+
+lemma "append_acc acc xs = reverse_nat_acc acc xs"
+  by(induction xs arbitrary: acc rule: append_acc.induct) simp+
+
+(*
+  append_tail xs ys
+= reverse_nat       (append_acc      (reverse_nat       xs) ys)
+= reverse_nat       (reverse_nat_acc (reverse_nat       xs) ys)
+= reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 xs) ys)
+*)
+
+(*
+-- stop -- usage of function --
+*)
+
+
 end

From bdccbd5368150ac5b8c95c757a8e26a34acb0d5e Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Wed, 22 Sep 2021 04:36:48 +0200
Subject: [PATCH 039/103] defined elemof_IMP_Minus_iteration

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 32 +++++++++++++++++++
 1 file changed, 32 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index a4d7171c..6ad5f81e 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -23,4 +23,36 @@ lemma "append_acc acc xs = reverse_nat_acc acc xs"
 *)
 
 
+
+
+
+subsection \<open>elemof\<close>
+
+(* Registers:
+  e: e
+  f: list
+  a: "result"
+*)
+definition elemof_IMP_Minus_iteration where "elemof_IMP_Minus_iteration \<equiv>
+  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''a'' ::= ((V ''fst_nat'') \<ominus> (V ''e'')) ;;
+  ''b'' ::= ((V ''e'') \<ominus> (V ''fst_nat'')) ;;
+  ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
+  IF ''a''\<noteq>0 THEN
+    ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
+    IMP_Minus_snd_nat ;;
+
+    ''f'' ::= (A (V ''snd_nat''))
+  ELSE (
+    ''a'' ::= (A (N 1));;
+    ''f'' ::= (A (N 0))
+  ) ;;
+  zero_variables [''b'', ''c'', ''fst_nat'', ''snd_nat'']"
+(*
+WHILE 0/=l DO
+  if hd_nat l = e then r = 1; BREAK
+  else l = tl_nat l
+*)
+
 end

From 0520d6e5c69cb726eaa835c442f0179c2147ae29 Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Wed, 22 Sep 2021 04:37:09 +0200
Subject: [PATCH 040/103] defined elemof_IMP_Minus_iteration_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 6ad5f81e..1ab121fd 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -55,4 +55,13 @@ WHILE 0/=l DO
   else l = tl_nat l
 *)
 
+definition elemof_IMP_Minus_iteration_time where
+"elemof_IMP_Minus_iteration_time e l \<equiv>
+  2 + IMP_Minus_fst_nat_time (l - 1) + 2 + 2 + 2 +
+  (if e = hd_nat l then  2 + 2 + 1
+  else
+    2 + IMP_Minus_fst_nat_time (l - 1) + 2 + 1
+) +
+  zero_variables_time [''b'', ''c'', ''fst_nat'', ''snd_nat'']"
+
 end

From 524f5394e364c0e671244a863a63d5672c26c084 Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Wed, 22 Sep 2021 04:38:11 +0200
Subject: [PATCH 041/103] stated and gave very messy proof to
 elemof_IMP_Minus_iteration_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 100 ++++++++++++++++++
 1 file changed, 100 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 1ab121fd..60aa168a 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -64,4 +64,104 @@ definition elemof_IMP_Minus_iteration_time where
 ) +
   zero_variables_time [''b'', ''c'', ''fst_nat'', ''snd_nat'']"
 
+lemma elemof_IMP_Minus_iteration_correct:
+  "(elemof_IMP_Minus_iteration, s)
+    \<Rightarrow>\<^bsup>elemof_IMP_Minus_iteration_time (s ''e'') (s ''f'')\<^esup>
+  s(''a'' := (if (s ''e'') = hd_nat (s ''f'') then 1 else 0),
+    ''b'' := 0,
+    ''c'' := 0,
+    ''f'' := (if (s ''e'') = hd_nat (s ''f'') then 0 else (tl_nat (s ''f''))),
+    ''fst_nat'' := 0,
+    ''snd_nat'' := 0)"
+proof(cases "hd_nat (s ''f'') = s ''e''")
+  case True
+  then have 1: "fst_nat (s ''f'' - Suc 0) - s ''e'' +
+        (s ''e'' -
+         fst_nat (s ''f'' - Suc 0)) = 0" 
+    using hd_nat_def by auto
+
+  show ?thesis
+    unfolding elemof_IMP_Minus_iteration_def
+        elemof_IMP_Minus_iteration_time_def
+    apply(rule Seq')+
+    apply(fastforce
+        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
+        )
+    apply(fastforce
+        intro: terminates_in_time_state_intro[OF IMP_Minus_fst_nat_correct]
+        )
+    apply(fastforce
+        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
+        )+
+     apply(fastforce simp: True 1
+        intro: terminates_in_time_state_intro[OF Big_StepT.IfFalse]
+        )
+    apply(fastforce simp add: True
+        intro: terminates_in_time_state_intro[OF zero_variables_correct]
+        )
+    done
+next
+  case False
+  then have 1: "fst_nat (s ''f'' - Suc 0) - s ''e'' +
+        (s ''e'' -
+         fst_nat (s ''f'' - Suc 0)) \<noteq> 0" 
+    using hd_nat_def by auto
+  then have 0: "(s(''c'' := 0, ''fst_nat'' := fst_nat (s ''f'' - Suc 0), ''b'' := s ''e'' - fst_nat (s ''f'' - Suc 0),
+   ''a'' := fst_nat (s ''f'' - Suc 0) - s ''e'' + (s ''e'' - fst_nat (s ''f'' - Suc 0))))
+ ''a'' \<noteq> 0" by simp
+
+  have 2: "( ''a'' ::= (V ''f'' \<ominus> N 1);;
+          IMP_Minus_snd_nat;;
+          ''f'' ::= A (V ''snd_nat''),
+    s(''c'' := 0,
+      ''fst_nat'' := fst_nat (s ''f'' - Suc 0),
+      ''b'' := s ''e'' - fst_nat (s ''f'' - Suc 0),
+      ''a'' := fst_nat (s ''f'' - Suc 0) - s ''e'' +
+              (s ''e'' - fst_nat (s ''f'' - Suc 0))
+      )    )
+     \<Rightarrow>\<^bsup> 2 + IMP_Minus_fst_nat_time (s ''f'' - 1) + 2 \<^esup>
+      s(''a'' := 0, ''b'' := 0, ''c'' := 0,
+        ''f'' := snd_nat (s ''f'' - Suc 0),
+        ''fst_nat'' := fst_nat (s ''f'' - Suc 0),
+        ''snd_nat'' := snd_nat (s ''f'' - 1))"
+    by (auto simp: hd_nat_def
+        intro!: terminates_in_time_state_intro[OF Seq']
+      intro: IMP_Minus_snd_nat_correct)
+
+  have 3: "2 + IMP_Minus_fst_nat_time (s ''f'' - 1) + 2 + 1 =
+  (if s ''e'' = hd_nat (s ''f'') then 2 + 2 + 1
+    else 2 + IMP_Minus_fst_nat_time (s ''f'' - 1) + 2 + 1
+  )"
+    using False by simp
+
+  show ?thesis
+    unfolding elemof_IMP_Minus_iteration_def
+        elemof_IMP_Minus_iteration_time_def
+    apply(rule Seq')+
+    apply(fastforce
+        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
+        )
+    apply(fastforce
+        intro: terminates_in_time_state_intro[OF IMP_Minus_fst_nat_correct]
+        )
+    apply(fastforce
+        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
+        )+
+     apply(fastforce simp add: False 1
+        intro!: terminates_in_time_state_intro[OF Big_StepT.IfTrue ,
+        of "s
+   (''c'' := 0, ''fst_nat'' := fst_nat (s ''f'' - Suc 0), ''b'' := s ''e'' - fst_nat (s ''f'' - Suc 0),
+    ''a'' := fst_nat (s ''f'' - Suc 0) - s ''e'' + (s ''e'' - fst_nat (s ''f'' - Suc 0)))"
+        "''a''"
+        "''a'' ::= (V ''f'' \<ominus> N 1);; IMP_Minus_snd_nat;; ''f'' ::= A (V ''snd_nat'')"
+      , OF 0 2 3[symmetric]
+        ])
+    using False
+    apply simp
+    apply(fastforce simp add: False tl_nat_def
+        intro: terminates_in_time_state_intro[OF zero_variables_correct]
+        )
+    done
+qed
+
 end

From b18f52f18d56a2b98a690b527f6bee02b32559b8 Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Sat, 25 Sep 2021 14:25:20 +0200
Subject: [PATCH 042/103] Defined elemof_IMP_Minus_loop

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 60aa168a..beca2e3f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -164,4 +164,8 @@ next
     done
 qed
 
+
+definition elemof_IMP_Minus_loop where "elemof_IMP_Minus_loop \<equiv>
+  (WHILE ''f'' \<noteq>0 DO elemof_IMP_Minus_iteration)"
+
 end

From 6145c7aecd446f47febe08a93cca708dfcd28e02 Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Sat, 25 Sep 2021 14:25:42 +0200
Subject: [PATCH 043/103] Defined elemof_IMP_Minus_loop_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index beca2e3f..f113a12c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -168,4 +168,9 @@ qed
 definition elemof_IMP_Minus_loop where "elemof_IMP_Minus_loop \<equiv>
   (WHILE ''f'' \<noteq>0 DO elemof_IMP_Minus_iteration)"
 
+fun elemof_IMP_Minus_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+  "elemof_IMP_Minus_loop_time e 0 = 2"
+| "elemof_IMP_Minus_loop_time e l = 1 + elemof_IMP_Minus_iteration_time e l
+ + elemof_IMP_Minus_loop_time e (if e = hd_nat l then 0 else (tl_nat l))"
+
 end

From 396c387ab14149e58fc718975bb8b09f4ecf452a Mon Sep 17 00:00:00 2001
From: Taro Yoshioka <t.yoshioka@tum.de>
Date: Sat, 25 Sep 2021 14:26:42 +0200
Subject: [PATCH 044/103] Stated and gave horrible proof to
 elemof_IMP_Minus_loop_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 105 ++++++++++++++++++
 1 file changed, 105 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index f113a12c..2b74e4a9 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -173,4 +173,109 @@ fun elemof_IMP_Minus_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" wher
 | "elemof_IMP_Minus_loop_time e l = 1 + elemof_IMP_Minus_iteration_time e l
  + elemof_IMP_Minus_loop_time e (if e = hd_nat l then 0 else (tl_nat l))"
 
+
+lemma elemof_IMP_Minus_loop_correct:
+  assumes "s ''a'' = 0" "s ''b'' = 0" "s ''c'' = 0" "s ''fst_nat'' = 0" "s ''snd_nat'' = 0"
+    shows
+  "(elemof_IMP_Minus_loop, s)
+    \<Rightarrow>\<^bsup>elemof_IMP_Minus_loop_time (s ''e'') (s ''f'')\<^esup>
+  s(''a'' := elemof (s ''e'') (s ''f''),
+    ''b'' := 0,
+    ''c'' := 0,
+    ''f'' := 0,
+    ''fst_nat'' := 0,
+    ''snd_nat'' := 0 )"
+using assms
+proof(induction "s ''e''" "s ''f''" arbitrary: s rule: elemof.induct)
+  case 1
+  then show ?case
+  proof(cases "s ''f''")
+    case 0
+    then have "elemof (s ''e'') (s ''f'') = 0" by simp
+    then have a1: "s =
+s(''a'' := elemof (s ''e'') (s ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)"
+      using 0 1 by auto
+
+    from 0 have a2: "Suc (Suc 0) = elemof_IMP_Minus_loop_time (s ''e'') (s ''f'')"
+      by simp
+
+    show ?thesis
+      unfolding elemof_IMP_Minus_loop_def
+      using
+       terminates_in_time_state_intro[OF Big_StepT.WhileFalse a2,
+  of s "''f''", OF 0,
+of "s(''a'' := elemof (s ''e'') (s ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)"
+elemof_IMP_Minus_iteration, OF a1
+] by simp
+
+  next
+    case (Suc nat)
+    then have b1: "s ''f'' \<noteq> 0" by simp
+    show ?thesis
+    proof(cases "hd_nat (s ''f'') = s ''e''")
+      case True
+      then show ?thesis unfolding elemof_IMP_Minus_loop_def
+        using Suc
+          terminates_in_time_state_intro[OF Big_StepT.WhileTrue[of s], OF b1
+elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ]
+        by simp
+    next
+      case False
+      let ?s1 = "(s ( ''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0,
+                      ''b'' := 0, ''c'' := 0,
+                      ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''),
+                      ''fst_nat'' := 0, ''snd_nat'' := 0))"
+
+      have d1: "s ''e'' = ?s1 ''e''" by simp
+
+      have d2: "tl_nat (s ''f'') = ?s1 ''f''" using False by simp
+
+      have d3: "?s1 ''a'' = 0" using False by simp
+      have d4: "?s1 ''b'' = 0" using False by simp
+      have d5: "?s1 ''c'' = 0" using False by simp
+      have d6: "?s1 ''fst_nat'' = 0" using False by simp
+      have d7: "?s1 ''snd_nat'' = 0" using False by simp
+
+      have ih: "(WHILE ''f''\<noteq>0 DO elemof_IMP_Minus_iteration, ?s1)
+        \<Rightarrow>\<^bsup> elemof_IMP_Minus_loop_time (?s1 ''e'') (?s1 ''f'') \<^esup>
+  ?s1(''a'' := elemof (?s1 ''e'') (?s1 ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0,
+  ''fst_nat'' := 0, ''snd_nat'' := 0)" using 1(1)[OF b1 False d1 d2 d3 d4 d5 d6 d7]
+        unfolding elemof_IMP_Minus_loop_def by fast
+
+      have iht: " elemof_IMP_Minus_loop_time (s ''e'') (s ''f'') = 
+ 1 + elemof_IMP_Minus_iteration_time (s ''e'') (s ''f'')
+ + elemof_IMP_Minus_loop_time (?s1 ''e'') (?s1 ''f'')"
+        using Suc
+        by simp
+
+      from False b1 have d9: "elemof (s ''e'') (tl_nat (s ''f'')) = elemof (s ''e'') (s ''f'')" by simp
+
+      have "s(
+          ''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
+          ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''),
+    ''fst_nat'' := 0, ''snd_nat'' := 0,
+    ''a'' := elemof
+       ((s(''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
+           ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''), ''fst_nat'' := 0, ''snd_nat'' := 0))
+         ''e'')
+       ((s(''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
+           ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''), ''fst_nat'' := 0, ''snd_nat'' := 0))
+         ''f''),
+    ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)
+= s(
+    ''a'' := elemof (s ''e'') (s ''f''),
+    ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)" using d9 False by simp
+
+
+      then
+      show ?thesis unfolding elemof_IMP_Minus_loop_def
+        using
+terminates_in_time_state_intro[OF Big_StepT.WhileTrue[of s], OF b1
+elemof_IMP_Minus_iteration_correct ih iht[symmetric] refl
+] by blast
+
+    qed
+  qed
+qed
+
 end

From 15e33dc407e08be424f31e03d7b9dd34f8a0dc66 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 08:15:52 +0200
Subject: [PATCH 045/103] removed unnecessary simp add

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 2b74e4a9..a93330ae 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -158,7 +158,7 @@ next
         ])
     using False
     apply simp
-    apply(fastforce simp add: False tl_nat_def
+    apply(fastforce simp add: tl_nat_def
         intro: terminates_in_time_state_intro[OF zero_variables_correct]
         )
     done

From d31e19fd8dd6800506ad0b5e087433d7d11e59c0 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 08:16:15 +0200
Subject: [PATCH 046/103] defined elemof_IMP_Minus

---
 .../IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy     | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index a93330ae..1740472e 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -278,4 +278,18 @@ elemof_IMP_Minus_iteration_correct ih iht[symmetric] refl
   qed
 qed
 
+
+
+(* Registers:
+  a: e
+  b: l
+*)
+definition elemof_IMP_Minus where "elemof_IMP_Minus \<equiv>
+  ''e'' ::= (A (V ''a'')) ;;
+  ''f'' ::= (A (V ''b'')) ;;
+  zero_variables [''a'', ''b'', ''c'', ''fst_nat'', ''snd_nat''] ;;
+  elemof_IMP_Minus_loop ;;
+  ''elemof'' ::= (A (V ''a'')) ;;
+  zero_variables [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat'']"
+
 end

From 793c26c8c4400476ef007acde47a61e61cfea7f9 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 08:16:36 +0200
Subject: [PATCH 047/103] defined elemof_IMP_Minus_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 1740472e..498e7bd8 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -292,4 +292,11 @@ definition elemof_IMP_Minus where "elemof_IMP_Minus \<equiv>
   ''elemof'' ::= (A (V ''a'')) ;;
   zero_variables [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat'']"
 
+definition elemof_IMP_Minus_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+  "elemof_IMP_Minus_time e l = 2 + 2
+ + zero_variables_time [''a'', ''b'', ''c'', ''fst_nat'', ''snd_nat'']
+ + elemof_IMP_Minus_loop_time e l + 2
+ + zero_variables_time [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat'']
+"
+
 end

From dc879251a171c029cf2a5934a39dde5254e7b921 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 08:19:02 +0200
Subject: [PATCH 048/103] Stated and gave awfully verbose proof
 elemof_IMP_Minus_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 139 ++++++++++++++++++
 1 file changed, 139 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 498e7bd8..dd1f5d72 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -299,4 +299,143 @@ definition elemof_IMP_Minus_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" wh
  + zero_variables_time [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat'']
 "
 
+lemma elemof_IMP_Minus_correct:
+  "(elemof_IMP_Minus, s)
+    \<Rightarrow>\<^bsup>elemof_IMP_Minus_time (s ''a'') (s ''b'')\<^esup>
+  s(''a'' := 0,
+    ''b'' := 0,
+    ''c'' := 0,
+    ''e'' := 0,
+    ''f'' := 0,
+    ''fst_nat'' := 0,
+    ''snd_nat'' := 0,
+    ''elemof'' := elemof (s ''a'') (s ''b'')
+  )"
+  unfolding elemof_IMP_Minus_def elemof_IMP_Minus_time_def
+  apply(rule Seq')+
+       apply (fastforce intro: terminates_in_time_state_intro)
+      apply (fastforce intro: terminates_in_time_state_intro)
+  apply (fastforce intro: zero_variables_correct)
+    apply (fastforce
+        intro: terminates_in_time_state_intro[OF elemof_IMP_Minus_loop_correct]
+        )
+   apply(fastforce intro!: terminates_in_time_state_intro[OF Big_StepT.Assign])
+
+proof-
+
+     have a: "(if s ''b'' = 0 then 0
+        else if hd_nat (s ''b'') = s ''a'' then 1
+             else elemof (s ''a'') (tl_nat (s ''b'')))
+= elemof (s ''a'') (s ''b'')" by simp 
+
+
+     have "(\<lambda>v. if v = ''a'' \<or> v = ''b'' \<or> v = ''c'' \<or> v = ''fst_nat'' \<or> v = ''snd_nat'' then 0 else (s(''e'' := s ''a'', ''f'' := s ''b'')) v)
+=
+ (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+''e'' := s ''a'', ''f'' := s ''b''))
+" by auto
+     then have "(\<lambda>v. if v = ''a'' \<or> v = ''b'' \<or> v = ''c'' \<or> v = ''fst_nat'' \<or> v = ''snd_nat'' then 0 else (s(''e'' := s ''a'', ''f'' := s ''b'')) v)
+     (''a'' := if s ''b'' = 0 then 0 else if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')), ''b'' := 0, ''c'' := 0,
+      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+      ''elemof'' :=
+        if s ''b'' = 0 then 0
+        else if hd_nat (s ''b'') = s ''a'' then 1
+             else elemof (s ''a'') (tl_nat (s ''b'')))
+=
+ (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+''e'' := s ''a'', ''f'' := s ''b''))
+     (''a'' := if s ''b'' = 0 then 0 else if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')), ''b'' := 0, ''c'' := 0,
+      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+      ''elemof'' :=
+        if s ''b'' = 0 then 0
+        else if hd_nat (s ''b'') = s ''a'' then 1
+             else elemof (s ''a'') (tl_nat (s ''b'')))
+" (is "?s1 = _") by simp
+     also have "\<dots> =
+ s(''e'' := s ''a'',
+''a'' := if s ''b'' = 0 then 0 else
+if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')),
+''b'' := 0, ''c'' := 0,
+      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+      ''elemof'' :=
+        if s ''b'' = 0 then 0
+        else if hd_nat (s ''b'') = s ''a'' then 1
+             else elemof (s ''a'') (tl_nat (s ''b'')))
+" by simp
+
+
+     also have "\<dots> =
+ s(''e'' := s ''a'',
+''a'' := if s ''b'' = 0 then 0 else
+if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')),
+''b'' := 0, ''c'' := 0,
+      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+      ''elemof'' := elemof (s ''a'') (s ''b''))
+" (is "_ = ?s2")
+       using a by simp
+
+     finally have "?s1 = ?s2"
+       by simp
+
+     have "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
+      else (?s1) v) =
+(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
+      else (?s2) v)
+" by auto
+
+     also have "\<dots> =
+(\<lambda>v. (s(''e'' := 0,
+''a'' := 0,
+''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+''elemof'' := elemof (s ''a'') (s ''b'')))
+                v)
+" by auto
+     also have "\<dots> =
+  (s(''e'' := 0,
+''a'' := 0,
+''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+''elemof'' := elemof (s ''a'') (s ''b'')))
+" by blast
+
+     ultimately have c1: "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
+      else (?s1) v) = 
+s(''e'' := 0, ''a'' := 0, ''b'' := 0, ''c'' := 0,  ''f'' := 0, ''fst_nat'' := 0,
+''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))"
+       by simp
+
+
+     have "
+s(''e'' := 0, ''a'' := 0, ''b'' := 0, ''c'' := 0,  ''f'' := 0, ''fst_nat'' := 0,
+''snd_nat'' := 0)
+=
+s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0,
+''snd_nat'' := 0)
+"  by auto
+
+     then have c2: "s(''e'' := 0, ''a'' := 0, ''b'' := 0, ''c'' := 0,  ''f'' := 0, ''fst_nat'' := 0,
+''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))
+=
+s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))
+" by simp
+
+     from c1 c2 have d: "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
+      else (?s1) v) = 
+s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))
+" by simp
+
+
+     show "(zero_variables [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''],
+     ?s1) \<Rightarrow>\<^bsup> zero_variables_time [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] \<^esup> s
+    (''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))"
+       using  terminates_in_state_intro[OF zero_variables_correct,
+of "[''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat'']"
+?s1 "s
+(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0,
+''fst_nat'' := 0, ''snd_nat'' := 0,
+''elemof'' := elemof (s ''a'') (s ''b''))",
+OF d] .
+
+   qed
+
+
 end

From 3c096e6fac1474471e9751ecb2a11ffeebdb07bc Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 08:42:37 +0200
Subject: [PATCH 049/103] marginally shortened elemof_IMP_Minus_correct proof

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 46 ++-----------------
 1 file changed, 4 insertions(+), 42 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index dd1f5d72..648613d9 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -322,60 +322,22 @@ lemma elemof_IMP_Minus_correct:
    apply(fastforce intro!: terminates_in_time_state_intro[OF Big_StepT.Assign])
 
 proof-
-
-     have a: "(if s ''b'' = 0 then 0
-        else if hd_nat (s ''b'') = s ''a'' then 1
-             else elemof (s ''a'') (tl_nat (s ''b'')))
-= elemof (s ''a'') (s ''b'')" by simp 
-
-
-     have "(\<lambda>v. if v = ''a'' \<or> v = ''b'' \<or> v = ''c'' \<or> v = ''fst_nat'' \<or> v = ''snd_nat'' then 0 else (s(''e'' := s ''a'', ''f'' := s ''b'')) v)
-=
- (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-''e'' := s ''a'', ''f'' := s ''b''))
-" by auto
-     then have "(\<lambda>v. if v = ''a'' \<or> v = ''b'' \<or> v = ''c'' \<or> v = ''fst_nat'' \<or> v = ''snd_nat'' then 0 else (s(''e'' := s ''a'', ''f'' := s ''b'')) v)
-     (''a'' := if s ''b'' = 0 then 0 else if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')), ''b'' := 0, ''c'' := 0,
-      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-      ''elemof'' :=
-        if s ''b'' = 0 then 0
-        else if hd_nat (s ''b'') = s ''a'' then 1
-             else elemof (s ''a'') (tl_nat (s ''b'')))
-=
- (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-''e'' := s ''a'', ''f'' := s ''b''))
+  let ?s1 = "(\<lambda>v. if v = ''a'' \<or> v = ''b'' \<or> v = ''c'' \<or> v = ''fst_nat'' \<or> v = ''snd_nat'' then 0 else (s(''e'' := s ''a'', ''f'' := s ''b'')) v)
      (''a'' := if s ''b'' = 0 then 0 else if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')), ''b'' := 0, ''c'' := 0,
       ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
       ''elemof'' :=
         if s ''b'' = 0 then 0
         else if hd_nat (s ''b'') = s ''a'' then 1
-             else elemof (s ''a'') (tl_nat (s ''b'')))
-" (is "?s1 = _") by simp
-     also have "\<dots> =
- s(''e'' := s ''a'',
-''a'' := if s ''b'' = 0 then 0 else
-if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')),
-''b'' := 0, ''c'' := 0,
-      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-      ''elemof'' :=
-        if s ''b'' = 0 then 0
-        else if hd_nat (s ''b'') = s ''a'' then 1
-             else elemof (s ''a'') (tl_nat (s ''b'')))
-" by simp
-
+             else elemof (s ''a'') (tl_nat (s ''b'')))"
 
-     also have "\<dots> =
+     let ?s2 = "
  s(''e'' := s ''a'',
 ''a'' := if s ''b'' = 0 then 0 else
 if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')),
 ''b'' := 0, ''c'' := 0,
       ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
       ''elemof'' := elemof (s ''a'') (s ''b''))
-" (is "_ = ?s2")
-       using a by simp
-
-     finally have "?s1 = ?s2"
-       by simp
+"
 
      have "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
       else (?s1) v) =

From 52a92fdf004017ecae5919ffa792d5fbe3cd7cab Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 09:23:44 +0200
Subject: [PATCH 050/103] marginally shortened elemof_IMP_Minus_loop_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 20 +++++--------------
 1 file changed, 5 insertions(+), 15 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 648613d9..8325f20f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -226,21 +226,11 @@ elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ]
                       ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''),
                       ''fst_nat'' := 0, ''snd_nat'' := 0))"
 
-      have d1: "s ''e'' = ?s1 ''e''" by simp
-
-      have d2: "tl_nat (s ''f'') = ?s1 ''f''" using False by simp
-
-      have d3: "?s1 ''a'' = 0" using False by simp
-      have d4: "?s1 ''b'' = 0" using False by simp
-      have d5: "?s1 ''c'' = 0" using False by simp
-      have d6: "?s1 ''fst_nat'' = 0" using False by simp
-      have d7: "?s1 ''snd_nat'' = 0" using False by simp
-
       have ih: "(WHILE ''f''\<noteq>0 DO elemof_IMP_Minus_iteration, ?s1)
         \<Rightarrow>\<^bsup> elemof_IMP_Minus_loop_time (?s1 ''e'') (?s1 ''f'') \<^esup>
   ?s1(''a'' := elemof (?s1 ''e'') (?s1 ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0,
-  ''fst_nat'' := 0, ''snd_nat'' := 0)" using 1(1)[OF b1 False d1 d2 d3 d4 d5 d6 d7]
-        unfolding elemof_IMP_Minus_loop_def by fast
+  ''fst_nat'' := 0, ''snd_nat'' := 0)" using 1(1)[OF b1 False, of ?s1] False
+        unfolding elemof_IMP_Minus_loop_def by simp
 
       have iht: " elemof_IMP_Minus_loop_time (s ''e'') (s ''f'') = 
  1 + elemof_IMP_Minus_iteration_time (s ''e'') (s ''f'')
@@ -248,9 +238,9 @@ elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ]
         using Suc
         by simp
 
-      from False b1 have d9: "elemof (s ''e'') (tl_nat (s ''f'')) = elemof (s ''e'') (s ''f'')" by simp
+      from False b1 have "elemof (s ''e'') (tl_nat (s ''f'')) = elemof (s ''e'') (s ''f'')" by simp
 
-      have "s(
+      then have "s(
           ''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
           ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''),
     ''fst_nat'' := 0, ''snd_nat'' := 0,
@@ -264,7 +254,7 @@ elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ]
     ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)
 = s(
     ''a'' := elemof (s ''e'') (s ''f''),
-    ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)" using d9 False by simp
+    ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)" using False by simp
 
 
       then

From 5df081e632bfb7857090df073d364d293a0376ee Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 26 Sep 2021 09:24:34 +0200
Subject: [PATCH 051/103] shortened True-case in
 elemof_IMP_Minus_iteration_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 26 +++++--------------
 1 file changed, 7 insertions(+), 19 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 8325f20f..dfd0d18a 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -75,31 +75,19 @@ lemma elemof_IMP_Minus_iteration_correct:
     ''snd_nat'' := 0)"
 proof(cases "hd_nat (s ''f'') = s ''e''")
   case True
-  then have 1: "fst_nat (s ''f'' - Suc 0) - s ''e'' +
+  then have "fst_nat (s ''f'' - Suc 0) - s ''e'' +
         (s ''e'' -
          fst_nat (s ''f'' - Suc 0)) = 0" 
     using hd_nat_def by auto
-
-  show ?thesis
+  then show ?thesis
     unfolding elemof_IMP_Minus_iteration_def
-        elemof_IMP_Minus_iteration_time_def
-    apply(rule Seq')+
-    apply(fastforce
-        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
-        )
-    apply(fastforce
-        intro: terminates_in_time_state_intro[OF IMP_Minus_fst_nat_correct]
-        )
-    apply(fastforce
+      elemof_IMP_Minus_iteration_time_def
+    by (fastforce simp: True
         intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
+        terminates_in_time_state_intro[OF Big_StepT.IfFalse]
+        terminates_in_time_state_intro[OF zero_variables_correct]
+        terminates_in_time_state_intro[OF IMP_Minus_fst_nat_correct]
         )+
-     apply(fastforce simp: True 1
-        intro: terminates_in_time_state_intro[OF Big_StepT.IfFalse]
-        )
-    apply(fastforce simp add: True
-        intro: terminates_in_time_state_intro[OF zero_variables_correct]
-        )
-    done
 next
   case False
   then have 1: "fst_nat (s ''f'' - Suc 0) - s ''e'' +

From d5204ab60ed930eb628b0ffcd142952147a9022d Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Wed, 29 Sep 2021 20:52:37 +0200
Subject: [PATCH 052/103] shortened proof for
 elemof_IMP_Minus_iteration_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 77 +++----------------
 1 file changed, 10 insertions(+), 67 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index dfd0d18a..d3469081 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -75,81 +75,24 @@ lemma elemof_IMP_Minus_iteration_correct:
     ''snd_nat'' := 0)"
 proof(cases "hd_nat (s ''f'') = s ''e''")
   case True
-  then have "fst_nat (s ''f'' - Suc 0) - s ''e'' +
-        (s ''e'' -
-         fst_nat (s ''f'' - Suc 0)) = 0" 
-    using hd_nat_def by auto
   then show ?thesis
     unfolding elemof_IMP_Minus_iteration_def
       elemof_IMP_Minus_iteration_time_def
-    by (fastforce simp: True
-        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
-        terminates_in_time_state_intro[OF Big_StepT.IfFalse]
-        terminates_in_time_state_intro[OF zero_variables_correct]
-        terminates_in_time_state_intro[OF IMP_Minus_fst_nat_correct]
+    by (fastforce simp: hd_nat_def
+        intro!: terminates_in_time_state_intro[OF Seq']
+        intro:zero_variables_correct IMP_Minus_fst_nat_correct
         )+
 next
   case False
-  then have 1: "fst_nat (s ''f'' - Suc 0) - s ''e'' +
-        (s ''e'' -
-         fst_nat (s ''f'' - Suc 0)) \<noteq> 0" 
-    using hd_nat_def by auto
-  then have 0: "(s(''c'' := 0, ''fst_nat'' := fst_nat (s ''f'' - Suc 0), ''b'' := s ''e'' - fst_nat (s ''f'' - Suc 0),
-   ''a'' := fst_nat (s ''f'' - Suc 0) - s ''e'' + (s ''e'' - fst_nat (s ''f'' - Suc 0))))
- ''a'' \<noteq> 0" by simp
-
-  have 2: "( ''a'' ::= (V ''f'' \<ominus> N 1);;
-          IMP_Minus_snd_nat;;
-          ''f'' ::= A (V ''snd_nat''),
-    s(''c'' := 0,
-      ''fst_nat'' := fst_nat (s ''f'' - Suc 0),
-      ''b'' := s ''e'' - fst_nat (s ''f'' - Suc 0),
-      ''a'' := fst_nat (s ''f'' - Suc 0) - s ''e'' +
-              (s ''e'' - fst_nat (s ''f'' - Suc 0))
-      )    )
-     \<Rightarrow>\<^bsup> 2 + IMP_Minus_fst_nat_time (s ''f'' - 1) + 2 \<^esup>
-      s(''a'' := 0, ''b'' := 0, ''c'' := 0,
-        ''f'' := snd_nat (s ''f'' - Suc 0),
-        ''fst_nat'' := fst_nat (s ''f'' - Suc 0),
-        ''snd_nat'' := snd_nat (s ''f'' - 1))"
-    by (auto simp: hd_nat_def
-        intro!: terminates_in_time_state_intro[OF Seq']
-      intro: IMP_Minus_snd_nat_correct)
-
-  have 3: "2 + IMP_Minus_fst_nat_time (s ''f'' - 1) + 2 + 1 =
-  (if s ''e'' = hd_nat (s ''f'') then 2 + 2 + 1
-    else 2 + IMP_Minus_fst_nat_time (s ''f'' - 1) + 2 + 1
-  )"
-    using False by simp
-
-  show ?thesis
+  then show ?thesis
     unfolding elemof_IMP_Minus_iteration_def
-        elemof_IMP_Minus_iteration_time_def
-    apply(rule Seq')+
-    apply(fastforce
-        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
-        )
-    apply(fastforce
-        intro: terminates_in_time_state_intro[OF IMP_Minus_fst_nat_correct]
-        )
-    apply(fastforce
-        intro: terminates_in_time_state_intro[OF Big_StepT.Assign]
+      elemof_IMP_Minus_iteration_time_def
+    by (fastforce simp: hd_nat_def tl_nat_def 
+        intro!: terminates_in_time_state_intro[OF Seq']
+        intro: zero_variables_correct
+        IMP_Minus_fst_nat_correct
+        IMP_Minus_snd_nat_correct
         )+
-     apply(fastforce simp add: False 1
-        intro!: terminates_in_time_state_intro[OF Big_StepT.IfTrue ,
-        of "s
-   (''c'' := 0, ''fst_nat'' := fst_nat (s ''f'' - Suc 0), ''b'' := s ''e'' - fst_nat (s ''f'' - Suc 0),
-    ''a'' := fst_nat (s ''f'' - Suc 0) - s ''e'' + (s ''e'' - fst_nat (s ''f'' - Suc 0)))"
-        "''a''"
-        "''a'' ::= (V ''f'' \<ominus> N 1);; IMP_Minus_snd_nat;; ''f'' ::= A (V ''snd_nat'')"
-      , OF 0 2 3[symmetric]
-        ])
-    using False
-    apply simp
-    apply(fastforce simp add: tl_nat_def
-        intro: terminates_in_time_state_intro[OF zero_variables_correct]
-        )
-    done
 qed
 
 

From fe02275d6e5326e106bcbec3deedd20a858ce8ba Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Wed, 29 Sep 2021 21:09:29 +0200
Subject: [PATCH 053/103] simplified time definition

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index d3469081..71f32b4a 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -57,10 +57,10 @@ WHILE 0/=l DO
 
 definition elemof_IMP_Minus_iteration_time where
 "elemof_IMP_Minus_iteration_time e l \<equiv>
-  2 + IMP_Minus_fst_nat_time (l - 1) + 2 + 2 + 2 +
-  (if e = hd_nat l then  2 + 2 + 1
+  8 + IMP_Minus_fst_nat_time (l - 1) +
+  (if e = hd_nat l then 5
   else
-    2 + IMP_Minus_fst_nat_time (l - 1) + 2 + 1
+    5 + IMP_Minus_fst_nat_time (l - 1)
 ) +
   zero_variables_time [''b'', ''c'', ''fst_nat'', ''snd_nat'']"
 

From b57e4cbd8d3d4ee75a1848b228c5eebdc2f5e25a Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 17:35:04 +0200
Subject: [PATCH 054/103] shortened elemof_IMP_Minus_correct proof

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 90 +------------------
 1 file changed, 4 insertions(+), 86 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 71f32b4a..55e90a56 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -233,92 +233,10 @@ lemma elemof_IMP_Minus_correct:
     ''elemof'' := elemof (s ''a'') (s ''b'')
   )"
   unfolding elemof_IMP_Minus_def elemof_IMP_Minus_time_def
-  apply(rule Seq')+
-       apply (fastforce intro: terminates_in_time_state_intro)
-      apply (fastforce intro: terminates_in_time_state_intro)
-  apply (fastforce intro: zero_variables_correct)
-    apply (fastforce
-        intro: terminates_in_time_state_intro[OF elemof_IMP_Minus_loop_correct]
-        )
-   apply(fastforce intro!: terminates_in_time_state_intro[OF Big_StepT.Assign])
-
-proof-
-  let ?s1 = "(\<lambda>v. if v = ''a'' \<or> v = ''b'' \<or> v = ''c'' \<or> v = ''fst_nat'' \<or> v = ''snd_nat'' then 0 else (s(''e'' := s ''a'', ''f'' := s ''b'')) v)
-     (''a'' := if s ''b'' = 0 then 0 else if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')), ''b'' := 0, ''c'' := 0,
-      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-      ''elemof'' :=
-        if s ''b'' = 0 then 0
-        else if hd_nat (s ''b'') = s ''a'' then 1
-             else elemof (s ''a'') (tl_nat (s ''b'')))"
-
-     let ?s2 = "
- s(''e'' := s ''a'',
-''a'' := if s ''b'' = 0 then 0 else
-if hd_nat (s ''b'') = s ''a'' then 1 else elemof (s ''a'') (tl_nat (s ''b'')),
-''b'' := 0, ''c'' := 0,
-      ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-      ''elemof'' := elemof (s ''a'') (s ''b''))
-"
-
-     have "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
-      else (?s1) v) =
-(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
-      else (?s2) v)
-" by auto
-
-     also have "\<dots> =
-(\<lambda>v. (s(''e'' := 0,
-''a'' := 0,
-''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-''elemof'' := elemof (s ''a'') (s ''b'')))
-                v)
-" by auto
-     also have "\<dots> =
-  (s(''e'' := 0,
-''a'' := 0,
-''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-''elemof'' := elemof (s ''a'') (s ''b'')))
-" by blast
-
-     ultimately have c1: "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
-      else (?s1) v) = 
-s(''e'' := 0, ''a'' := 0, ''b'' := 0, ''c'' := 0,  ''f'' := 0, ''fst_nat'' := 0,
-''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))"
-       by simp
-
-
-     have "
-s(''e'' := 0, ''a'' := 0, ''b'' := 0, ''c'' := 0,  ''f'' := 0, ''fst_nat'' := 0,
-''snd_nat'' := 0)
-=
-s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0,
-''snd_nat'' := 0)
-"  by auto
-
-     then have c2: "s(''e'' := 0, ''a'' := 0, ''b'' := 0, ''c'' := 0,  ''f'' := 0, ''fst_nat'' := 0,
-''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))
-=
-s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))
-" by simp
-
-     from c1 c2 have d: "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] then 0
-      else (?s1) v) = 
-s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))
-" by simp
-
-
-     show "(zero_variables [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''],
-     ?s1) \<Rightarrow>\<^bsup> zero_variables_time [''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat''] \<^esup> s
-    (''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''elemof'' := elemof (s ''a'') (s ''b''))"
-       using  terminates_in_state_intro[OF zero_variables_correct,
-of "[''a'', ''b'', ''c'', ''e'', ''f'', ''fst_nat'', ''snd_nat'']"
-?s1 "s
-(''a'' := 0, ''b'' := 0, ''c'' := 0, ''e'' := 0, ''f'' := 0,
-''fst_nat'' := 0, ''snd_nat'' := 0,
-''elemof'' := elemof (s ''a'') (s ''b''))",
-OF d] .
-
-   qed
+  by(fastforce
+      intro!: ext terminates_in_time_state_intro[OF Seq']
+      intro: zero_variables_correct elemof_IMP_Minus_loop_correct
+      )+
 
 
 end

From ec48586456ecee198606710821ac34cbfbdf99fb Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 17:38:46 +0200
Subject: [PATCH 055/103] removed lemmata from elemof_IMP_Minus_loop_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 73 +++----------------
 1 file changed, 11 insertions(+), 62 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 55e90a56..316d709b 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -121,80 +121,29 @@ proof(induction "s ''e''" "s ''f''" arbitrary: s rule: elemof.induct)
   case 1
   then show ?case
   proof(cases "s ''f''")
-    case 0
-    then have "elemof (s ''e'') (s ''f'') = 0" by simp
-    then have a1: "s =
-s(''a'' := elemof (s ''e'') (s ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)"
-      using 0 1 by auto
-
-    from 0 have a2: "Suc (Suc 0) = elemof_IMP_Minus_loop_time (s ''e'') (s ''f'')"
-      by simp
-
-    show ?thesis
+    case 0 then show ?thesis
       unfolding elemof_IMP_Minus_loop_def
-      using
-       terminates_in_time_state_intro[OF Big_StepT.WhileFalse a2,
-  of s "''f''", OF 0,
-of "s(''a'' := elemof (s ''e'') (s ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)"
-elemof_IMP_Minus_iteration, OF a1
-] by simp
-
+      by(auto simp: numeral_2_eq_2 1
+          intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse])
   next
     case (Suc nat)
-    then have b1: "s ''f'' \<noteq> 0" by simp
     show ?thesis
     proof(cases "hd_nat (s ''f'') = s ''e''")
       case True
       then show ?thesis unfolding elemof_IMP_Minus_loop_def
         using Suc
-          terminates_in_time_state_intro[OF Big_StepT.WhileTrue[of s], OF b1
-elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ]
+          terminates_in_time_state_intro[OF Big_StepT.WhileTrue[of s], OF _
+            elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ]
         by simp
     next
       case False
-      let ?s1 = "(s ( ''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0,
-                      ''b'' := 0, ''c'' := 0,
-                      ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''),
-                      ''fst_nat'' := 0, ''snd_nat'' := 0))"
-
-      have ih: "(WHILE ''f''\<noteq>0 DO elemof_IMP_Minus_iteration, ?s1)
-        \<Rightarrow>\<^bsup> elemof_IMP_Minus_loop_time (?s1 ''e'') (?s1 ''f'') \<^esup>
-  ?s1(''a'' := elemof (?s1 ''e'') (?s1 ''f''), ''b'' := 0, ''c'' := 0, ''f'' := 0,
-  ''fst_nat'' := 0, ''snd_nat'' := 0)" using 1(1)[OF b1 False, of ?s1] False
-        unfolding elemof_IMP_Minus_loop_def by simp
-
-      have iht: " elemof_IMP_Minus_loop_time (s ''e'') (s ''f'') = 
- 1 + elemof_IMP_Minus_iteration_time (s ''e'') (s ''f'')
- + elemof_IMP_Minus_loop_time (?s1 ''e'') (?s1 ''f'')"
-        using Suc
-        by simp
-
-      from False b1 have "elemof (s ''e'') (tl_nat (s ''f'')) = elemof (s ''e'') (s ''f'')" by simp
-
-      then have "s(
-          ''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
-          ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''),
-    ''fst_nat'' := 0, ''snd_nat'' := 0,
-    ''a'' := elemof
-       ((s(''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
-           ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''), ''fst_nat'' := 0, ''snd_nat'' := 0))
-         ''e'')
-       ((s(''a'' := if s ''e'' = hd_nat (s ''f'') then 1 else 0, ''b'' := 0, ''c'' := 0,
-           ''f'' := if s ''e'' = hd_nat (s ''f'') then 0 else tl_nat (s ''f''), ''fst_nat'' := 0, ''snd_nat'' := 0))
-         ''f''),
-    ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)
-= s(
-    ''a'' := elemof (s ''e'') (s ''f''),
-    ''b'' := 0, ''c'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0)" using False by simp
-
-
-      then
       show ?thesis unfolding elemof_IMP_Minus_loop_def
-        using
-terminates_in_time_state_intro[OF Big_StepT.WhileTrue[of s], OF b1
-elemof_IMP_Minus_iteration_correct ih iht[symmetric] refl
-] by blast
-
+        apply(rule terminates_in_state_intro[OF Big_StepT.WhileTrue])
+            apply(simp add: Suc)
+           apply(rule elemof_IMP_Minus_iteration_correct)
+          apply(subst elemof_IMP_Minus_loop_def[symmetric])
+          apply(rule 1(1))
+        using False Suc by auto
     qed
   qed
 qed

From bcbfcd73c17cfa7dda8e86c1a82737acec6b6711 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 17:51:52 +0200
Subject: [PATCH 056/103] stylistics

---
 .../IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy     | 14 ++++++--------
 1 file changed, 6 insertions(+), 8 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 316d709b..af62a5ce 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -56,13 +56,11 @@ WHILE 0/=l DO
 *)
 
 definition elemof_IMP_Minus_iteration_time where
-"elemof_IMP_Minus_iteration_time e l \<equiv>
+  "elemof_IMP_Minus_iteration_time e l \<equiv>
   8 + IMP_Minus_fst_nat_time (l - 1) +
   (if e = hd_nat l then 5
-  else
-    5 + IMP_Minus_fst_nat_time (l - 1)
-) +
-  zero_variables_time [''b'', ''c'', ''fst_nat'', ''snd_nat'']"
+  else 5 + IMP_Minus_fst_nat_time (l - 1))
+  + zero_variables_time [''b'', ''c'', ''fst_nat'', ''snd_nat'']"
 
 lemma elemof_IMP_Minus_iteration_correct:
   "(elemof_IMP_Minus_iteration, s)
@@ -107,8 +105,8 @@ fun elemof_IMP_Minus_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" wher
 
 lemma elemof_IMP_Minus_loop_correct:
   assumes "s ''a'' = 0" "s ''b'' = 0" "s ''c'' = 0" "s ''fst_nat'' = 0" "s ''snd_nat'' = 0"
-    shows
-  "(elemof_IMP_Minus_loop, s)
+  shows
+    "(elemof_IMP_Minus_loop, s)
     \<Rightarrow>\<^bsup>elemof_IMP_Minus_loop_time (s ''e'') (s ''f'')\<^esup>
   s(''a'' := elemof (s ''e'') (s ''f''),
     ''b'' := 0,
@@ -116,7 +114,7 @@ lemma elemof_IMP_Minus_loop_correct:
     ''f'' := 0,
     ''fst_nat'' := 0,
     ''snd_nat'' := 0 )"
-using assms
+  using assms
 proof(induction "s ''e''" "s ''f''" arbitrary: s rule: elemof.induct)
   case 1
   then show ?case

From 882b0d89f886718979367a918622843b8d4e4e9a Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 21:04:46 +0200
Subject: [PATCH 057/103] Defined append_tail_IMP_Minus

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 19 +++++++++++++++++--
 1 file changed, 17 insertions(+), 2 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index af62a5ce..db33a38f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -18,9 +18,24 @@ lemma "append_acc acc xs = reverse_nat_acc acc xs"
 = reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 xs) ys)
 *)
 
-(*
--- stop -- usage of function --
+(* Registers:
+e: xs
+f: ys
 *)
+definition append_tail_IMP_Minus where "append_tail_IMP_Minus \<equiv>
+  ''a'' ::= (A (N 0)) ;;
+  ''b'' ::= (A (V ''e'')) ;;
+  ''append_tail'' ::= (A (V ''f'')) ;;
+  reverse_nat_acc_IMP_Minus ;;
+  ''a'' ::= (A (V ''reverse_nat_acc'')) ;;
+  ''b'' ::= (A (V ''append_tail'')) ;;
+  reverse_nat_acc_IMP_Minus ;;
+  ''a'' ::= (A (N 0)) ;;
+  ''b'' ::= (A (V ''reverse_nat_acc'')) ;;
+  reverse_nat_acc_IMP_Minus ;;
+  ''append_tail'' ::= (A (V ''reverse_nat_acc'')) ;;
+  zero_variables [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'',
+    ''triangle'', ''prod_encode'', ''reverse_nat_acc'']"
 
 
 

From 4e098516935ebdd705628c8a9ae5885ee7449777 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 21:05:19 +0200
Subject: [PATCH 058/103] defined append_tail_IMP_Minus_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index db33a38f..5ffa969e 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -37,6 +37,17 @@ definition append_tail_IMP_Minus where "append_tail_IMP_Minus \<equiv>
   zero_variables [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'',
     ''triangle'', ''prod_encode'', ''reverse_nat_acc'']"
 
+definition append_tail_IMP_Minus_time where
+  "append_tail_IMP_Minus_time xs ys \<equiv>
+2 + 2 + 2
++ reverse_nat_acc_IMP_Minus_time 0 xs
++ 2 + 2
++ reverse_nat_acc_IMP_Minus_time (reverse_nat_acc 0 xs) ys
++ 2 + 2
++ reverse_nat_acc_IMP_Minus_time 0 (reverse_nat_acc (reverse_nat_acc 0 xs) ys)
++ 2
++ zero_variables_time [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'',
+    ''triangle'', ''prod_encode'', ''reverse_nat_acc'']"
 
 
 

From f292a060990b41689d0649dfe9d09192da5add7d Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 21:07:02 +0200
Subject: [PATCH 059/103] named revapp lemma

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 5ffa969e..7abcdac4 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -8,7 +8,7 @@ text\<open>Goal of this subsection is *append_tail*, which is defined in terms
   of reverse_nat and append_acc, both of which, in turn, are defined in
   terms of -- or can be related to -- *reverse_nat_acc*.\<close>
 
-lemma "append_acc acc xs = reverse_nat_acc acc xs"
+lemma revapp: "append_acc acc xs = reverse_nat_acc acc xs"
   by(induction xs arbitrary: acc rule: append_acc.induct) simp+
 
 (*

From 16fd26552c5c8c4873207ee0e4d8243fff35a8f9 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 1 Oct 2021 21:09:25 +0200
Subject: [PATCH 060/103] stated and (verbosely) proved
 append_tail_IMP_Minus_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 86 +++++++++++++++++++
 1 file changed, 86 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 7abcdac4..733598c6 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -49,7 +49,93 @@ definition append_tail_IMP_Minus_time where
 + zero_variables_time [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'',
     ''triangle'', ''prod_encode'', ''reverse_nat_acc'']"
 
+lemma x: "
+(\<lambda> v . if v = st then 0 else s v)
+= (s(st := 0))
+" by auto
 
+lemma append_tail_IMP_Minus_correct:
+  "(append_tail_IMP_Minus, s)
+    \<Rightarrow>\<^bsup>append_tail_IMP_Minus_time (s ''e'') (s ''f'')\<^esup>
+  s(''a'':=0, ''b'':=0, ''c'':=0, ''d'':=0, ''e'':=0, ''f'':=0,
+    ''fst_nat'':=0, ''snd_nat'':=0, ''cons'':=0,
+    ''triangle'':=0, ''prod_encode'':=0, ''reverse_nat_acc'':=0,
+    ''append_tail'':= append_tail (s ''e'') (s ''f''))"
+  unfolding append_tail_IMP_Minus_def append_tail_IMP_Minus_time_def
+  apply(rule Seq')+
+             apply(simp add: numeral_2_eq_2)
+             apply(rule terminates_in_state_intro[OF Big_StepT.Assign])
+             apply (rule refl)
+            apply(simp add: numeral_2_eq_2)
+            apply(rule terminates_in_state_intro[OF Big_StepT.Assign])
+            apply simp
+           apply(simp add: numeral_2_eq_2)
+           apply(rule terminates_in_state_intro[OF Big_StepT.Assign])
+           apply simp
+          apply(rule terminates_in_time_state_intro[OF reverse_nat_acc_IMP_Minus_correct])
+           apply simp apply (simp del: reverse_nat_acc.simps)
+         apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+          apply simp apply (simp del: reverse_nat_acc.simps)
+        apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+         apply simp apply (simp del: reverse_nat_acc.simps)
+       apply(rule terminates_in_time_state_intro[OF reverse_nat_acc_IMP_Minus_correct])
+
+        apply (simp) apply (simp del: reverse_nat_acc.simps)
+      apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+       apply simp apply (simp del: reverse_nat_acc.simps)
+     apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+      apply simp apply (simp del: reverse_nat_acc.simps)
+    apply(rule terminates_in_time_state_intro[OF reverse_nat_acc_IMP_Minus_correct])
+     apply simp apply (simp del: reverse_nat_acc.simps)
+   apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+    apply simp apply (simp del: reverse_nat_acc.simps)
+  apply(rule terminates_in_state_intro[OF zero_variables_correct])
+  apply (subst append_tail_def)
+  apply(subst revapp)
+  apply(subst reverse_nat_def)
+  apply(subst reverse_nat_def)
+  using x fun_upd_twist
+proof -
+  have " (\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'', ''triangle'', ''prod_encode'', ''reverse_nat_acc''] then 0
+          else (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0, ''triangle'' := 0, ''prod_encode'' := 0, ''cons'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+                  ''reverse_nat_acc'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')),
+                  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))))
+                v)
+=
+(\<lambda>v. if v = ''reverse_nat_acc'' then 0
+          else (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
+ ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
+  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))
+))
+v)
+" by auto
+
+  also have "\<dots> =
+  (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
+ ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
+  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')),
+''reverse_nat_acc'' := 0
+))
+" using x[of "''reverse_nat_acc''" ]  .
+
+  also have "\<dots> =
+  (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
+ ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
+''reverse_nat_acc'' := 0,
+  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))
+))
+" by (simp add: fun_upd_twist)
+
+
+  finally show "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'', ''triangle'', ''prod_encode'', ''reverse_nat_acc''] then 0
+          else (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0, ''triangle'' := 0, ''prod_encode'' := 0, ''cons'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
+                  ''reverse_nat_acc'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')),
+                  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))))
+                v) =
+    s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
+      ''reverse_nat_acc'' := 0, ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')))"
+    by simp
+qed
 
 
 subsection \<open>elemof\<close>

From 6032f98e5e9fb3a5db73e60a7395df08de76c4be Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sat, 2 Oct 2021 12:33:07 +0200
Subject: [PATCH 061/103]  shortened proof of append_tail_IMP_Minus_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 79 ++-----------------
 1 file changed, 5 insertions(+), 74 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 733598c6..136a5496 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -62,80 +62,11 @@ lemma append_tail_IMP_Minus_correct:
     ''triangle'':=0, ''prod_encode'':=0, ''reverse_nat_acc'':=0,
     ''append_tail'':= append_tail (s ''e'') (s ''f''))"
   unfolding append_tail_IMP_Minus_def append_tail_IMP_Minus_time_def
-  apply(rule Seq')+
-             apply(simp add: numeral_2_eq_2)
-             apply(rule terminates_in_state_intro[OF Big_StepT.Assign])
-             apply (rule refl)
-            apply(simp add: numeral_2_eq_2)
-            apply(rule terminates_in_state_intro[OF Big_StepT.Assign])
-            apply simp
-           apply(simp add: numeral_2_eq_2)
-           apply(rule terminates_in_state_intro[OF Big_StepT.Assign])
-           apply simp
-          apply(rule terminates_in_time_state_intro[OF reverse_nat_acc_IMP_Minus_correct])
-           apply simp apply (simp del: reverse_nat_acc.simps)
-         apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-          apply simp apply (simp del: reverse_nat_acc.simps)
-        apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-         apply simp apply (simp del: reverse_nat_acc.simps)
-       apply(rule terminates_in_time_state_intro[OF reverse_nat_acc_IMP_Minus_correct])
-
-        apply (simp) apply (simp del: reverse_nat_acc.simps)
-      apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-       apply simp apply (simp del: reverse_nat_acc.simps)
-     apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-      apply simp apply (simp del: reverse_nat_acc.simps)
-    apply(rule terminates_in_time_state_intro[OF reverse_nat_acc_IMP_Minus_correct])
-     apply simp apply (simp del: reverse_nat_acc.simps)
-   apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-    apply simp apply (simp del: reverse_nat_acc.simps)
-  apply(rule terminates_in_state_intro[OF zero_variables_correct])
-  apply (subst append_tail_def)
-  apply(subst revapp)
-  apply(subst reverse_nat_def)
-  apply(subst reverse_nat_def)
-  using x fun_upd_twist
-proof -
-  have " (\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'', ''triangle'', ''prod_encode'', ''reverse_nat_acc''] then 0
-          else (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0, ''triangle'' := 0, ''prod_encode'' := 0, ''cons'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-                  ''reverse_nat_acc'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')),
-                  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))))
-                v)
-=
-(\<lambda>v. if v = ''reverse_nat_acc'' then 0
-          else (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
- ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
-  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))
-))
-v)
-" by auto
-
-  also have "\<dots> =
-  (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
- ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
-  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')),
-''reverse_nat_acc'' := 0
-))
-" using x[of "''reverse_nat_acc''" ]  .
-
-  also have "\<dots> =
-  (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
- ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
-''reverse_nat_acc'' := 0,
-  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))
-))
-" by (simp add: fun_upd_twist)
-
-
-  finally show "(\<lambda>v. if v \<in> set [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'', ''triangle'', ''prod_encode'', ''reverse_nat_acc''] then 0
-          else (s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0, ''triangle'' := 0, ''prod_encode'' := 0, ''cons'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0,
-                  ''reverse_nat_acc'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')),
-                  ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f''))))
-                v) =
-    s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0, ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0, ''triangle'' := 0, ''prod_encode'' := 0,
-      ''reverse_nat_acc'' := 0, ''append_tail'' := reverse_nat_acc 0 (reverse_nat_acc (reverse_nat_acc 0 (s ''e'')) (s ''f'')))"
-    by simp
-qed
+  by (fastforce simp: ext reverse_nat_def revapp append_tail_def
+      simp del: reverse_nat_acc.simps
+      intro!: terminates_in_time_state_intro[OF Seq']
+      intro: zero_variables_correct reverse_nat_acc_IMP_Minus_correct
+      )+
 
 
 subsection \<open>elemof\<close>

From 5e6aeb33dd19f29db185e1ca4cbfc1b75951517a Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sat, 2 Oct 2021 12:37:12 +0200
Subject: [PATCH 062/103] removed unused lemma

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 136a5496..15de537b 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -49,11 +49,6 @@ definition append_tail_IMP_Minus_time where
 + zero_variables_time [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'',
     ''triangle'', ''prod_encode'', ''reverse_nat_acc'']"
 
-lemma x: "
-(\<lambda> v . if v = st then 0 else s v)
-= (s(st := 0))
-" by auto
-
 lemma append_tail_IMP_Minus_correct:
   "(append_tail_IMP_Minus, s)
     \<Rightarrow>\<^bsup>append_tail_IMP_Minus_time (s ''e'') (s ''f'')\<^esup>

From 875027ced342a236cfae8793166bc24f92a08870 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sat, 2 Oct 2021 12:37:56 +0200
Subject: [PATCH 063/103] simplified append_tail_IMP_Minus_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 15de537b..4349aca9 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -39,13 +39,10 @@ definition append_tail_IMP_Minus where "append_tail_IMP_Minus \<equiv>
 
 definition append_tail_IMP_Minus_time where
   "append_tail_IMP_Minus_time xs ys \<equiv>
-2 + 2 + 2
+16
 + reverse_nat_acc_IMP_Minus_time 0 xs
-+ 2 + 2
 + reverse_nat_acc_IMP_Minus_time (reverse_nat_acc 0 xs) ys
-+ 2 + 2
 + reverse_nat_acc_IMP_Minus_time 0 (reverse_nat_acc (reverse_nat_acc 0 xs) ys)
-+ 2
 + zero_variables_time [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'',
     ''triangle'', ''prod_encode'', ''reverse_nat_acc'']"
 

From 973bad9ef859b6185fa28398662d7adfe13c8937 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:17:47 +0200
Subject: [PATCH 064/103] stopped working on remdups_tail due to run out of
 registers

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 4349aca9..c7a3a492 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -221,4 +221,6 @@ lemma elemof_IMP_Minus_correct:
       )+
 
 
+subsection \<open>remdups_tail\<close>
+
 end

From 2588badc3d5c1fb2b9adb4dce922ee46f57c456f Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:18:26 +0200
Subject: [PATCH 065/103] defined list_from_acc_IMP_Minus_iteration

---
 .../IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy    | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index c7a3a492..473b31b5 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -223,4 +223,19 @@ lemma elemof_IMP_Minus_correct:
 
 subsection \<open>remdups_tail\<close>
 
+subsection \<open>list_from_acc\<close>
+
+(* Registers:
+acc: d
+s: e
+n: f
+*)
+definition list_from_acc_IMP_Minus_iteration where
+  "list_from_acc_IMP_Minus_iteration \<equiv>
+  cons_IMP_Minus (V ''e'') (V ''d'') ;;
+  ''d'' ::= (A (V ''cons'')) ;;
+  ''e'' ::= ((V ''e'') \<oplus> (N 1)) ;;
+  ''f'' ::= ((V ''f'') \<ominus> (N 1))
+"
+
 end

From aee45aef1b4fbee6f5b5cf5656b6a902f8743a01 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:18:52 +0200
Subject: [PATCH 066/103] defined list_from_acc_IMP_Minus_iteration_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 473b31b5..65bbe9b5 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -238,4 +238,9 @@ definition list_from_acc_IMP_Minus_iteration where
   ''f'' ::= ((V ''f'') \<ominus> (N 1))
 "
 
+definition list_from_acc_IMP_Minus_iteration_time where
+  "list_from_acc_IMP_Minus_iteration_time h t \<equiv>
+  cons_IMP_Minus_time h t + 6
+"
+
 end

From 7abe883fa112557dc6ad94bdddcf1cba2bd881e1 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:19:43 +0200
Subject: [PATCH 067/103] stated and proved
 list_from_acc_IMP_Minus_iteration_correct

---
 .../IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 65bbe9b5..6870868f 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -243,4 +243,22 @@ definition list_from_acc_IMP_Minus_iteration_time where
   cons_IMP_Minus_time h t + 6
 "
 
+lemma list_from_acc_IMP_Minus_iteration_correct:
+  "(list_from_acc_IMP_Minus_iteration, s)
+  \<Rightarrow>\<^bsup>list_from_acc_IMP_Minus_iteration_time (s ''e'') (s ''d'') \<^esup>
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''d'' := (s ''e'')##(s ''d''),
+      ''e'' := (s ''e'') + 1,
+      ''f'' := (s ''f'') - 1,
+      ''triangle'' := 0,
+      ''prod_encode'' := 0,
+      ''cons'' := (s ''e'')##(s ''d'')
+    )"
+  unfolding list_from_acc_IMP_Minus_iteration_def list_from_acc_IMP_Minus_iteration_time_def
+  by(fastforce
+      intro!: terminates_in_time_state_intro[OF Seq']
+      intro: cons_IMP_Minus_correct)+
+
 end

From 0c8a8127a36b9ef1edc8365dc6cab00ef1edf9bd Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:20:33 +0200
Subject: [PATCH 068/103] defined list_from_acc_IMP_Minus_loop_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 6870868f..2c507c23 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -261,4 +261,10 @@ lemma list_from_acc_IMP_Minus_iteration_correct:
       intro!: terminates_in_time_state_intro[OF Seq']
       intro: cons_IMP_Minus_correct)+
 
+fun list_from_acc_IMP_Minus_loop_time where
+  "list_from_acc_IMP_Minus_loop_time acc s 0 = 2"
+| "list_from_acc_IMP_Minus_loop_time acc s (Suc n) =
+  1 + list_from_acc_IMP_Minus_iteration_time s acc
+  + list_from_acc_IMP_Minus_loop_time (s##acc) (s+1) n"
+
 end

From d9019309131c642e1b13d6143176ce0adda3f1d3 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:21:42 +0200
Subject: [PATCH 069/103] stated and proved list_from_acc_loop_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 51 +++++++++++++++++++
 1 file changed, 51 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 2c507c23..9c9f36ac 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -267,4 +267,55 @@ fun list_from_acc_IMP_Minus_loop_time where
   1 + list_from_acc_IMP_Minus_iteration_time s acc
   + list_from_acc_IMP_Minus_loop_time (s##acc) (s+1) n"
 
+lemma list_from_acc_loop_correct:
+  assumes "s ''cons'' = s ''d''"
+    "s ''a'' = 0" "s ''b'' = 0" "s ''c'' = 0"
+    "s ''triangle'' = 0" "s ''prod_encode'' = 0" 
+  shows "(WHILE ''f''\<noteq>0 DO list_from_acc_IMP_Minus_iteration, s)
+  \<Rightarrow>\<^bsup>list_from_acc_IMP_Minus_loop_time (s ''d'') (s ''e'') (s ''f'') \<^esup>
+    s(''a'' := 0,
+      ''b'' := 0,
+      ''c'' := 0,
+      ''d'' := list_from_acc (s ''d'') (s ''e'') (s ''f''),
+      ''e'' := (s ''e'') + (s ''f''),
+      ''f'' := 0,
+      ''triangle'' := 0,
+      ''prod_encode'' := 0,
+      ''cons'' := list_from_acc (s ''d'') (s ''e'') (s ''f'')
+    )"
+  using assms
+proof(induct "s ''d''" "s ''e''" "s ''f''" arbitrary: s rule: list_from_acc.induct)
+  case 1
+  show ?case
+  proof(cases "s ''f''")
+    case 0
+    then show ?thesis
+      by(auto simp add: 1 intro!: terminates_in_time_state_intro[OF Big_StepT.WhileFalse])
+  next
+    case (Suc nat)
+    show ?thesis
+      apply(rule terminates_in_state_intro[OF Big_StepT.WhileTrue])
+          apply(simp add: Suc)
+         apply(rule list_from_acc_IMP_Minus_iteration_correct)
+        apply(simp add: 1 Suc)
+        apply(rule 1(1))
+                 apply(simp add: Suc)
+                apply(simp add: 1 Suc)
+               apply(simp add: 1 Suc)
+              apply(simp add: 1 Suc)
+             apply(simp add: 1 Suc)
+            apply(simp add: 1 Suc)
+           apply(simp add: 1 Suc)
+          apply(simp add: 1 Suc)
+         apply(simp add: 1 Suc)
+        apply(simp add: 1 Suc)
+       apply (subst Suc)
+       apply(subst list_from_acc_IMP_Minus_loop_time.simps(2))
+       apply simp
+      apply(simp add: 1 Suc)
+      done
+  qed
+qed
+
+
 end

From 91bcd315a76b74edc6d72076359a0619bcbffdc6 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Tue, 5 Oct 2021 20:37:30 +0200
Subject: [PATCH 070/103] shortened proof for list_from_acc_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 26 ++++---------------
 1 file changed, 5 insertions(+), 21 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 9c9f36ac..3d0ffe6b 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -288,31 +288,15 @@ proof(induct "s ''d''" "s ''e''" "s ''f''" arbitrary: s rule: list_from_acc.indu
   case 1
   show ?case
   proof(cases "s ''f''")
-    case 0
-    then show ?thesis
+    case 0 then show ?thesis
       by(auto simp add: 1 intro!: terminates_in_time_state_intro[OF Big_StepT.WhileFalse])
   next
     case (Suc nat)
     show ?thesis
-      apply(rule terminates_in_state_intro[OF Big_StepT.WhileTrue])
-          apply(simp add: Suc)
-         apply(rule list_from_acc_IMP_Minus_iteration_correct)
-        apply(simp add: 1 Suc)
-        apply(rule 1(1))
-                 apply(simp add: Suc)
-                apply(simp add: 1 Suc)
-               apply(simp add: 1 Suc)
-              apply(simp add: 1 Suc)
-             apply(simp add: 1 Suc)
-            apply(simp add: 1 Suc)
-           apply(simp add: 1 Suc)
-          apply(simp add: 1 Suc)
-         apply(simp add: 1 Suc)
-        apply(simp add: 1 Suc)
-       apply (subst Suc)
-       apply(subst list_from_acc_IMP_Minus_loop_time.simps(2))
-       apply simp
-      apply(simp add: 1 Suc)
+      apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue])
+           apply(fastforce
+          simp add: 1 Suc
+          intro: 1(1) list_from_acc_IMP_Minus_iteration_correct)+
       done
   qed
 qed

From 9de7f544a82d92aa5b491676ed799470767b3ac1 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 8 Oct 2021 08:21:04 +0200
Subject: [PATCH 071/103] defined concat_acc_IMP_Minus_iteration with
 additional registers

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 35 +++++++++++++++++++
 1 file changed, 35 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 3d0ffe6b..080d06e8 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -302,4 +302,39 @@ proof(induct "s ''d''" "s ''e''" "s ''f''" arbitrary: s rule: list_from_acc.indu
 qed
 
 
+subsection \<open>concat_acc\<close>
+
+(*
+WHILE n \<noteq> 0
+  acc := append_tail (reverse_nat (hd_nat n)) acc ;
+  n = tl_nat n ;
+
+WHILE n \<noteq> 0
+  $fst = hd_nat n ;             -- $ABC fst
+  $rev = reverse_nat $fst ;     -- $ABCDEF fst snd cons triangle prod_encode
+  $app = append_tail $rev acc ; -- $ABCDEF fst snd cons triangle prod_encode rev app
+  acc := $app ;
+  $snd = tl_nat n ;             -- $ABC snd
+  n = $snd ;
+*)
+
+definition concat_acc_IMP_Minus_iteration where
+  "concat_acc_IMP_Minus_iteration \<equiv>
+  ''a'' ::= ((V ''n'') \<ominus> (N 1)) ;;
+  IMP_Minus_fst_nat ;;
+  ''a'' ::= (A (N 0)) ;;
+  ''b'' ::= (A (V ''fst_nat'')) ;;
+  reverse_nat_acc_IMP_Minus ;;
+  ''e'' ::= (A (V ''reverse_nat_acc'')) ;;
+  ''f'' ::= (A (V ''acc'')) ;;
+  append_tail_IMP_Minus ;;
+  ''acc'' ::= (A (V ''append_tail'')) ;;
+  ''a'' ::= ((V ''n'') \<ominus> (N 1)) ;;
+  IMP_Minus_snd_nat ;;
+  ''n'' ::= (A (V ''snd_nat'')) ;;
+  zero_variables [''a'', ''b'', ''c'', ''d'', ''e'', ''f'',
+    ''fst_nat'', ''snd_nat'', ''cons'', ''triangle'', ''prod_encode'',
+    ''reverse_nat_acc'', ''append_tail'']
+  "
+
 end

From 69d3b78eab947c0b44d98f3c8f89114262510166 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 8 Oct 2021 08:22:24 +0200
Subject: [PATCH 072/103] defined concat_acc_IMP_Minus_iteration_time

---
 .../IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy       | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index 080d06e8..f8059156 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -337,4 +337,16 @@ definition concat_acc_IMP_Minus_iteration where
     ''reverse_nat_acc'', ''append_tail'']
   "
 
+definition concat_acc_IMP_Minus_iteration_time where
+  "concat_acc_IMP_Minus_iteration_time acc n \<equiv>
+  16
++ IMP_Minus_fst_nat_time (n - 1)
++ reverse_nat_acc_IMP_Minus_time 0 (hd_nat n)
++ append_tail_IMP_Minus_time (reverse_nat_acc 0 (hd_nat n)) acc
++ IMP_Minus_fst_nat_time (n - 1)
++ zero_variables_time [''a'', ''b'', ''c'', ''d'', ''e'', ''f'',
+    ''fst_nat'', ''snd_nat'', ''cons'', ''triangle'', ''prod_encode'',
+    ''reverse_nat_acc'', ''append_tail'']
+"
+
 end

From fbd2a2dd76910816bb3d4543791170cb82b73f59 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 8 Oct 2021 08:24:26 +0200
Subject: [PATCH 073/103] stated and proved
 concat_acc_IMP_Minus_iteration_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 19 +++++++++++++++++++
 1 file changed, 19 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index f8059156..e1cfba35 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -349,4 +349,23 @@ definition concat_acc_IMP_Minus_iteration_time where
     ''reverse_nat_acc'', ''append_tail'']
 "
 
+lemma concat_acc_IMP_Minus_iteration_correct:
+  "(concat_acc_IMP_Minus_iteration, s)
+    \<Rightarrow>\<^bsup>concat_acc_IMP_Minus_iteration_time (s ''acc'') (s ''n'')\<^esup>
+  s(''a'' := 0, ''b'' := 0, ''c'' := 0, ''d'' := 0, ''e'' := 0, ''f'' := 0,
+  ''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0,
+  ''triangle'' := 0, ''prod_encode'' := 0,
+  ''reverse_nat_acc'' := 0, ''append_tail'' := 0,
+  ''acc'' := append_tail (reverse_nat (hd_nat (s ''n''))) (s ''acc''),
+  ''n'' := tl_nat (s ''n'')
+)"
+  unfolding concat_acc_IMP_Minus_iteration_def
+    concat_acc_IMP_Minus_iteration_time_def
+  by(fastforce simp: hd_nat_def tl_nat_def reverse_nat_def
+      intro!: ext terminates_in_time_state_intro[OF Seq']
+      intro: IMP_Minus_fst_nat_correct IMP_Minus_snd_nat_correct
+      reverse_nat_acc_IMP_Minus_correct
+      append_tail_IMP_Minus_correct
+      zero_variables_correct)+
+
 end

From 0703c844d0179c9ab40b17e29a1e17326fd9c054 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 8 Oct 2021 08:25:08 +0200
Subject: [PATCH 074/103] defined concat_acc_IMP_Minus_loop_time

---
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index e1cfba35..aef77bb3 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -368,4 +368,11 @@ lemma concat_acc_IMP_Minus_iteration_correct:
       append_tail_IMP_Minus_correct
       zero_variables_correct)+
 
+fun concat_acc_IMP_Minus_loop_time where
+  "concat_acc_IMP_Minus_loop_time acc 0 = 2"
+| "concat_acc_IMP_Minus_loop_time acc n = 1
++ concat_acc_IMP_Minus_iteration_time acc n
++ concat_acc_IMP_Minus_loop_time (append_tail (reverse_nat (hd_nat n)) acc) (tl_nat n)
+"
+
 end

From bfa2c4d29f3bbd61014965d0f6ebe4da24f3c84f Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 8 Oct 2021 08:26:06 +0200
Subject: [PATCH 075/103] stated and proved concat_acc_IMP_Minus_correct

---
 .../IMP_Minus_Common_Funs_Nat.thy             | 31 +++++++++++++++++++
 1 file changed, 31 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
index aef77bb3..b67f4ac9 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy
@@ -375,4 +375,35 @@ fun concat_acc_IMP_Minus_loop_time where
 + concat_acc_IMP_Minus_loop_time (append_tail (reverse_nat (hd_nat n)) acc) (tl_nat n)
 "
 
+lemma concat_acc_IMP_Minus_correct:
+  assumes "s ''a'' = 0" "s ''b'' = 0" "s ''c'' = 0" "s ''d'' = 0" "s ''e'' = 0" "s ''f'' = 0"
+    "s ''fst_nat'' = 0" "s ''snd_nat'' = 0" "s ''cons'' = 0"
+    "s ''triangle'' = 0" "s ''prod_encode'' = 0"
+    "s ''reverse_nat_acc'' = 0" "s ''append_tail'' = 0"
+  shows "(WHILE ''n''\<noteq>0 DO concat_acc_IMP_Minus_iteration, s)
+    \<Rightarrow>\<^bsup>concat_acc_IMP_Minus_loop_time (s ''acc'') (s ''n'')\<^esup>
+s(''a'':=0, ''b'':=0, ''c'':=0, ''d'':=0, ''e'':=0, ''f'':=0,
+''fst_nat'' := 0, ''snd_nat'' := 0, ''cons'' := 0,
+  ''triangle'' := 0, ''prod_encode'' := 0,
+  ''reverse_nat_acc'' := 0, ''append_tail'' := 0,
+  ''acc'' := concat_acc (s ''acc'') (s ''n''),
+  ''n'' := 0)"
+  using assms
+proof(induct "s ''acc''" "s ''n''" arbitrary: s rule: concat_acc.induct)
+  case 1
+  show ?case proof(cases "s ''n''")
+    case 0
+    then show ?thesis
+      by(auto simp add: 1
+          intro!: terminates_in_time_state_intro[OF Big_StepT.WhileFalse]
+          )
+    next
+    case (Suc nat)
+    show ?thesis
+      apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue])
+           apply(fastforce simp: Suc intro: 1(1) concat_acc_IMP_Minus_iteration_correct)+
+      done
+  qed
+qed
+
 end

From 9a3eef654c6a8ba2c1df2329421dd80c172285fc Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Fri, 8 Oct 2021 12:57:32 +0200
Subject: [PATCH 076/103] added canonical state transformers

---
 IMP-/Big_StepT.thy                    |   9 +-
 IMP-/Canonical_State_Transformers.thy | 407 ++++++++++++++++++++++++++
 IMP-/Multiplication.thy               | 186 +++++-------
 3 files changed, 490 insertions(+), 112 deletions(-)
 create mode 100644 IMP-/Canonical_State_Transformers.thy

diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 0d965034..34e24fc2 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -196,6 +196,13 @@ proof -
   moreover from b bigstepT_the_cost have "(THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p+1" by simp
   ultimately show ?thesis by simp
 qed
-    
+
+
+lemma terminates_in_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' = s'' \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s''"
+  by simp
+
+lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = t' \<Longrightarrow> s' = s'' 
+  \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
+  by simp
 
 end
\ No newline at end of file
diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
new file mode 100644
index 00000000..9be775e9
--- /dev/null
+++ b/IMP-/Canonical_State_Transformers.thy
@@ -0,0 +1,407 @@
+theory Canonical_State_Transformers
+  imports Com
+begin
+
+definition add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
+"add_prefix p s = (concat (map (\<lambda>i. i # ''!'') p)) @ ''**'' @ s"
+
+lemma length_concat_map[simp]: 
+  "length (concat (map (\<lambda>i. [i, x]) p)) = 2 * length p" 
+  by (induction p) auto
+
+lemma take_concat_map[simp]:
+  "take (2 * x) (concat (map (\<lambda>i. [i, y]) p)) = (concat (map (\<lambda>i. [i, y]) (take x p)))"
+proof (induction x arbitrary: p)
+  case (Suc x)
+  then show ?case
+    by (cases p) auto
+qed auto
+
+lemma drop_concat_map[simp]:
+  "drop (2 * x) (concat (map (\<lambda>i. [i, y]) p)) = (concat (map (\<lambda>i. [i, y]) (drop x p)))"
+proof (induction x arbitrary: p)
+  case (Suc x)
+  then show ?case
+    by (cases p) auto
+qed auto
+
+lemma concat_map_eq_iff[simp]:
+  "(concat (map (\<lambda>i. [i, y]) p) = concat (map (\<lambda>i. [i, y]) p'))
+    \<longleftrightarrow> p = p'"
+proof(induction p arbitrary: p')
+  case (Cons a p)
+  then show ?case
+    by (cases p') auto
+qed auto
+
+lemma add_prefix_equal_then_prefix_equal: 
+  assumes "add_prefix p v = add_prefix p' v'"
+  shows "p = p'"
+proof -
+  have "length p < length p' \<or> length p = length p' \<or> length p > length p'"
+    by auto
+  thus ?thesis
+  proof(elim disjE)
+    assume "length p < length p'"
+
+    then obtain p'' p''' x where "drop (length p) p' = p''" "p'' = x # p'''"
+      by (metis Cons_nth_drop_Suc)
+
+    thus ?thesis
+      using assms \<open>length p < length p'\<close> 
+      unfolding add_prefix_def 
+      by(auto simp: append_eq_append_conv_if)
+  next
+    assume "length p = length p'"
+    thus ?thesis
+      using assms  
+      unfolding add_prefix_def 
+      by(auto simp: append_eq_append_conv_if)
+  next 
+    assume "length p > length p'"
+
+    then obtain p'' p''' x where "drop (length p') p = p''" "p'' = x # p'''"
+      by (metis Cons_nth_drop_Suc)
+
+    thus ?thesis
+      using assms \<open>length p > length p'\<close> 
+      unfolding add_prefix_def 
+      by(auto simp: append_eq_append_conv_if)
+  qed
+qed
+
+lemma add_prefix_same_prefix_eq_iff[simp]: "add_prefix p x = add_prefix p y
+  \<longleftrightarrow> x = y"
+proof
+  assume "add_prefix p x = add_prefix p y"
+  hence "drop (2 * length p + 2) (add_prefix p x) = drop (2 * length p + 2) (add_prefix p y)"
+    by auto
+  thus "x = y" 
+    unfolding add_prefix_def
+    by simp
+qed auto
+
+lemma add_prefix_inj: "inj (add_prefix p)"
+  by (auto intro: injI)
+
+lemma add_prefix_equal_iff[simp]: "add_prefix p a = add_prefix p' b \<longleftrightarrow>
+  p = p' \<and> a = b"
+  using add_prefix_equal_then_prefix_equal add_prefix_same_prefix_eq_iff
+  by blast
+
+definition state_transformer :: "string \<Rightarrow> (vname * nat) list \<Rightarrow> state \<Rightarrow> state" where
+"state_transformer p vs s = 
+  (\<lambda>v. (case (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) v of
+    (Some y) \<Rightarrow> y |
+    None \<Rightarrow> s v))"
+
+(* Only use for intermediate states. State transformer definitions of sub-programs
+   should not depend on the state before the program invocation, because we do not
+   want to compute that when composing state transformers *) 
+abbreviation state_transformer' where "state_transformer' p vs s \<equiv>
+  state_transformer p (vs (\<lambda>v. s (add_prefix p v))) s"
+
+lemma state_transformer_commutes:
+  assumes "p \<noteq> p'"
+  shows "state_transformer p vs \<circ> state_transformer p' vs' 
+          = state_transformer p' vs' \<circ> state_transformer p vs"
+  unfolding state_transformer_def comp_def
+  using \<open>p \<noteq> p'\<close>
+  by(fastforce 
+      dest: map_of_SomeD add_prefix_equal_then_prefix_equal
+      split: option.splits)
+
+lemma state_transformer_commutes':
+  assumes "p \<noteq> p'"
+  shows "state_transformer p vs (state_transformer p' vs' s)  
+          = state_transformer p' vs' (state_transformer p vs s)"
+  using state_transformer_commutes[OF \<open>p \<noteq> p'\<close>]
+  by (metis comp_eq_dest)
+
+lemma state_transformer_comp_same_prefix[simp]: 
+  "state_transformer p vs (state_transformer p vs' s)
+    = state_transformer p (vs @ vs') s"
+  unfolding state_transformer_def
+  by(fastforce split: option.splits)
+
+lemma state_transformer_commutes_comp[simp]:
+  assumes "p \<noteq> p'" 
+  shows "state_transformer p vs (state_transformer p' vs' (state_transformer p vs'' s))
+    = state_transformer p (vs @ vs'') (state_transformer p' vs' s)"
+  using state_transformer_commutes'[OF \<open>p \<noteq> p'\<close>]
+  by simp
+
+lemma map_of_eq_then_map_of_map_of_add_prefix_eq:
+  assumes "map_of vs = map_of vs'" 
+  shows "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) 
+          = map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs')"
+proof -
+  have "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) x
+          = map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs') x" for x
+  proof(cases "\<exists>x'. x = add_prefix p x'")
+    case True
+    then obtain x' where "x = add_prefix p x'"
+      by auto
+    then show ?thesis
+    proof (cases "(map_of vs) x'")
+      case None
+      thus ?thesis
+        using  \<open>map_of vs = map_of vs'\<close>
+      proof(cases "(map_of vs') x'")
+        case None
+        hence "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) x = None"
+          "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs') x = None"
+          using \<open>map_of vs x' = None\<close> \<open>map_of vs' x' = None\<close>
+            \<open>x = add_prefix p x'\<close>
+          by(force simp add: map_of_eq_None_iff)+
+        then show ?thesis 
+          by simp
+      qed auto
+    next
+      case (Some y)
+      thus ?thesis
+        using \<open>map_of vs = map_of vs'\<close>
+      proof (cases "(map_of vs') x'")
+        case (Some y')
+        thus ?thesis
+          using
+            map_of_mapk_SomeI[OF add_prefix_inj]  \<open>map_of vs x' = Some y\<close>
+            \<open>map_of vs' x' = Some y'\<close>  \<open>x = add_prefix p x'\<close>
+            \<open>map_of vs = map_of vs'\<close> \<open>map_of vs x' = Some y\<close>
+          by metis
+      qed auto
+    qed
+  next
+    case False
+    hence "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) x = None"
+      "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs') x = None"
+      by(force simp add: map_of_eq_None_iff)+
+    then show ?thesis
+      by simp
+  qed
+  thus ?thesis 
+    by auto
+qed
+
+lemma state_transformer_same_prefix_equal_intro[intro]:
+  assumes "map_of vs = map_of vs'"
+  shows  "state_transformer p vs = state_transformer p vs'"
+  unfolding state_transformer_def
+  using map_of_eq_then_map_of_map_of_add_prefix_eq[OF \<open>map_of vs = map_of vs'\<close>]
+  by(auto intro!: HOL.ext  split: option.splits)
+
+lemma state_transformer_same_prefix_equal_commutes[simp]:
+  assumes "p \<noteq> p'"
+  shows "state_transformer p vs (state_transformer p' vs' s) = 
+    state_transformer p' vs'' (state_transformer p vs''' s)
+    \<longleftrightarrow> 
+      state_transformer p vs (state_transformer p' vs' s) = 
+      state_transformer p vs''' (state_transformer p' vs'' s)"
+  using state_transformer_commutes'[OF \<open>p \<noteq> p'\<close>]
+  by simp
+
+declare fun_cong[OF state_transformer_same_prefix_equal_intro, intro]
+
+declare cong[OF cong[OF cong [OF refl[of state_transformer] refl] refl], intro]
+
+declare cong[OF state_transformer_same_prefix_equal_intro, intro]
+
+lemma map_of_map_add_prefix_of_add_prefix[simp]:
+  "map_of (map (\<lambda>(i, y). (add_prefix p i, y)) vs) (add_prefix p x) = map_of vs x"
+proof(cases "map_of vs x")
+  case None
+  hence "map_of (map (\<lambda>(i, y). (add_prefix p i, y)) vs) (add_prefix p x) = None"
+    by(force simp: map_of_eq_None_iff)
+  thus ?thesis
+    using None
+    by simp
+next
+  case (Some a)
+  hence "map_of (map (\<lambda>(i, y). (add_prefix p i, y)) vs) (add_prefix p x) = Some a"
+    using map_of_mapk_SomeI[OF add_prefix_inj]
+    by fastforce
+  then show ?thesis
+    using Some
+    by simp
+qed
+
+lemma state_transformers_same_prefix_equal_iff[simp]:
+  "state_transformer p vs s = state_transformer p vs' s \<longleftrightarrow>
+    (\<forall>x \<in> set (map fst (vs @ vs')). (map_of vs x = map_of vs' x) 
+        \<or> (map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)))
+        \<or> (map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x))))"
+proof
+  assume "state_transformer p vs s = state_transformer p vs' s"
+
+  have "x \<in> set (map fst (vs @ vs')) \<Longrightarrow> 
+    map_of vs x = map_of vs' x \<or>
+      map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)) \<or>
+      map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x))" for x
+  proof -
+    assume "x \<in> set (map fst (vs @ vs'))"
+    have "state_transformer p vs s (add_prefix p x) = state_transformer p vs' s (add_prefix p x)"
+      using \<open>state_transformer p vs s = state_transformer p vs' s\<close>
+      by auto
+    thus ?thesis
+      unfolding state_transformer_def
+      by(auto split: option.splits)
+  qed
+  thus "(\<forall>x \<in> set (map fst (vs @ vs')).
+      map_of vs x = map_of vs' x \<or>
+      map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)) \<or>
+      map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x)))"
+    by auto
+next
+  assume *: "\<forall>x\<in>set (map fst (vs @ vs')).
+       map_of vs x = map_of vs' x \<or>
+       map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)) \<or>
+       map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x))"
+
+  hence "state_transformer p vs s x = state_transformer p vs' s x" for x
+  proof(cases "\<exists>x'. x = add_prefix p x'")
+    case True
+    then obtain x' where "x = add_prefix p x'"
+      by auto
+    then show ?thesis
+      unfolding state_transformer_def
+      using *
+      apply(auto split: option.splits)
+      by (metis UnCI UnI2 domI domIff map_of_eq_None_iff option.inject)+
+  next
+    case False
+    thus ?thesis
+      unfolding state_transformer_def
+      using *
+      by(auto dest!: map_of_SomeD split: option.splits)
+  qed
+  thus "state_transformer p vs s = state_transformer p vs' s"
+    by auto
+qed
+
+lemma state_transformer_of_same_prefix[simp]: "state_transformer p vs s (add_prefix p v)
+  = (case (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) (add_prefix p v) of
+      (Some y) \<Rightarrow> y |
+       None \<Rightarrow> s (add_prefix p v))"
+  by(auto simp: state_transformer_def split: option.splits)
+
+lemma state_transformer_of_different_prefix[simp]: "p \<noteq> p'
+  \<Longrightarrow> state_transformer p vs s (add_prefix p' v) = s (add_prefix p' v)"
+  by(auto dest!: map_of_SomeD simp: state_transformer_def split: option.splits)
+
+lemma unchanged_by_state_transformer_intro[intro!]: 
+  "list_all (\<lambda>(i, j). x \<noteq> (add_prefix p i) \<or> j = s x) vs 
+    \<Longrightarrow> state_transformer p vs s x = s x"
+  by(auto 
+      dest!: map_of_SomeD 
+      simp: state_transformer_def list_all_def 
+      split: option.splits)
+
+lemma state_transformer_of_update_same_prefix[simp]:
+  "state_transformer p vs (s((add_prefix p v) := y)) = state_transformer p (vs @ [(v, y)]) s"
+  unfolding state_transformer_def
+  by (auto intro!: HOL.ext split: option.splits)
+
+(* TODO: more elegant / general way of doing this *)
+lemma state_transformer_of_update_same_prefix'[simp]:
+  assumes "p \<noteq> p'"
+  shows "state_transformer p vs 
+    (state_transformer p' vs' (s((add_prefix p v) := y))) 
+    = state_transformer p (vs @ [(v, y)]) (state_transformer p' vs' s)"
+proof -
+  have "state_transformer p vs 
+    (state_transformer p' vs' (s((add_prefix p v) := y))) =
+      state_transformer p' vs' (state_transformer p (vs @ [(v, y)]) s)"
+    using \<open>p \<noteq> p'\<close> state_transformer_commutes' 
+    by (metis state_transformer_of_update_same_prefix)
+  thus ?thesis
+    using \<open>p \<noteq> p'\<close> state_transformer_commutes' 
+    by simp
+qed
+
+lemma state_transformer_update_same_prefix[simp]:
+  "(state_transformer p vs s)((add_prefix p v) := y) = state_transformer p ((v, y) # vs) s"
+  unfolding state_transformer_def
+  by (auto intro!: HOL.ext split: option.splits)
+
+lemma state_transformer_update_different_prefix[simp]:
+  "p \<noteq> p' 
+    \<Longrightarrow>(state_transformer p vs s)((add_prefix p' v) := y) 
+         = state_transformer p' [(v, y)] (state_transformer p vs s)"
+  unfolding state_transformer_def
+  by (auto intro!: HOL.ext split: option.splits)
+
+declare unchanged_by_state_transformer_intro[symmetric, intro]
+
+lemma lambda_as_state_transformer[simp]:
+  "(\<lambda>x. if x = add_prefix p a
+           then y
+           else s x) = state_transformer p [(a, y)] s"
+  unfolding state_transformer_def
+  by auto
+
+lemma updated_state_as_state_transformer[simp]:
+  "s(add_prefix p x := y) = state_transformer p [(x, y)] s"
+  unfolding state_transformer_def
+  by auto
+
+type_synonym pcom = "string \<Rightarrow> com"
+
+fun atomExp_add_prefix where
+"atomExp_add_prefix p (N a) = N a" |
+"atomExp_add_prefix p (V v) = V (add_prefix p v)"
+
+fun aexp_add_prefix where
+"aexp_add_prefix p (A a) = A (atomExp_add_prefix p a)" |
+"aexp_add_prefix p (Plus a b) = Plus (atomExp_add_prefix p a) (atomExp_add_prefix p b)" |
+"aexp_add_prefix p (Sub a b) = Sub (atomExp_add_prefix p a) (atomExp_add_prefix p b)"  | 
+"aexp_add_prefix p (Parity a) = Parity (atomExp_add_prefix p a)" |
+"aexp_add_prefix p (RightShift a) = RightShift (atomExp_add_prefix p a)"
+
+abbreviation pcom_SKIP where "pcom_SKIP p \<equiv> SKIP"
+
+abbreviation pcom_Assign where "pcom_Assign v aexp p \<equiv>
+  Assign (add_prefix p v) (aexp_add_prefix p aexp)"
+
+abbreviation pcom_Seq where "pcom_Seq a b p \<equiv> (a  p) ;; (b p)"
+
+abbreviation pcom_If where "pcom_If v a b p \<equiv> 
+  If (add_prefix p v) (a p) (b p)"
+
+abbreviation pcom_While where "pcom_While v a p \<equiv> While (add_prefix p v) (a p)"
+
+abbreviation invoke_subprogram :: "string \<Rightarrow> pcom \<Rightarrow> pcom" 
+  where "invoke_subprogram p' c \<equiv> (\<lambda>p. c (p' @ p))"
+
+abbreviation write_subprogram_param where "write_subprogram_param p' a  b \<equiv>
+  (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix p b))"
+
+abbreviation read_subprogram_param where "read_subprogram_param a p' b \<equiv> 
+  (\<lambda>p. Assign (add_prefix p a) (aexp_add_prefix (p' @ p) b))"
+
+unbundle no_com_syntax
+
+bundle pcom_syntax
+begin
+notation pcom_SKIP ("SKIP" [] 61) and
+         pcom_Assign ("_ ::= _" [1000, 61] 61) and
+         write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
+         read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
+         pcom_Seq ("_;;/ _"  [60, 61] 60) and
+         pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
+         pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
+end
+
+bundle no_pcom_syntax
+begin
+no_notation pcom_SKIP ("SKIP" [] 61) and
+            pcom_Assign ("_ ::= _" [1000, 61] 61) and
+            write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
+            read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
+            pcom_Seq ("_;;/ _"  [60, 61] 60) and
+            pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
+            pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
+end
+
+unbundle pcom_syntax
+
+end
\ No newline at end of file
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index dfdd4e9c..c58285ca 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -2,11 +2,14 @@
 
 theory Multiplication
   imports Big_Step_Small_Step_Equivalence "HOL-Library.Discrete"
+    Canonical_State_Transformers
 begin
 
-definition IMP_Minus_max_a_min_b where "IMP_Minus_max_a_min_b = 
+unbundle no_com_syntax
+
+definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus = 
   ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
-  IF ''c'' \<noteq>0 
+  IF ''c''\<noteq>0 
   THEN
     (SKIP ;; SKIP ;;
      SKIP ;; SKIP ;;
@@ -18,21 +21,33 @@ definition IMP_Minus_max_a_min_b where "IMP_Minus_max_a_min_b =
     ''b'' ::= A (V ''c'') ;;
     ''c'' ::= A (N 0))"
 
-lemma IMP_Minus_max_a_min_b_correct: 
-    "(IMP_Minus_max_a_min_b, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := max (s ''a'') (s ''b''),
-                                   ''b'' := min (s ''a'') (s ''b''), ''c'' := 0)" 
-proof(cases "(s ''a'') \<le> (s ''b'')")
+definition max_a_min_b_IMP_Minus_time where "max_a_min_b_IMP_Minus_time \<equiv> 11"
+
+abbreviation max_a_min_b_IMP_Minus_state_transformer
+  where "max_a_min_b_IMP_Minus_state_transformer p a b
+    \<equiv> state_transformer p 
+        [(''a'', max a b),
+         (''b'', min a b),
+         (''c'', 0)]"
+
+lemma max_a_min_b_IMP_Minus_correct[intro]: 
+  "(max_a_min_b_IMP_Minus p, s) \<Rightarrow>\<^bsup>max_a_min_b_IMP_Minus_time\<^esup> 
+      max_a_min_b_IMP_Minus_state_transformer p (s (add_prefix p ''a''))
+        (s (add_prefix p ''b'')) s" 
+proof(cases "s (add_prefix p ''a'') \<le> s (add_prefix p ''b'')")
   case True
   then show ?thesis
-    apply(auto simp: IMP_Minus_max_a_min_b_def numeral_eq_Suc
+    by(force 
+        simp: max_a_min_b_IMP_Minus_def numeral_eq_Suc
+        max_a_min_b_IMP_Minus_time_def
+        assign_t_simp
         intro!: Seq[OF Big_StepT.Assign Big_StepT.IfFalse])
-    by(auto simp: assign_t_simp fun_eq_iff intro!: Seq)
 next
   case False
-  then show ?thesis 
-    apply(auto simp: IMP_Minus_max_a_min_b_def numeral_eq_Suc seq_assign_t_simp 
-        intro!: Seq[OF Big_StepT.Assign Big_StepT.IfTrue])
-    by (auto simp: fun_eq_iff)
+  show ?thesis 
+    unfolding max_a_min_b_IMP_Minus_def max_a_min_b_IMP_Minus_time_def
+    using False
+    by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])+
 qed
 
 definition mul_iteration where
@@ -47,60 +62,30 @@ definition mul_iteration where
   ''b'' ::= ((V ''b'') \<then>) ;;
   ''d'' ::= A (N 0)"
 
-lemma terminates_in_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' = s'' \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s''"
-  by simp
-
-lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = t' \<Longrightarrow> s' = s'' 
-  \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
-  by simp
-
 lemma mul_iteration_effect:
-  "(mul_iteration, s) \<Rightarrow>\<^bsup>11\<^esup> s(''a'' := 2 * s ''a'',
-                               ''b'' := s ''b'' div 2,
-                               ''c'' := (if s ''b'' mod 2 \<noteq> 0 then s ''c'' + s ''a'' else s ''c''),
-                               ''d'' := 0)"
-proof (cases "s ''b'' mod 2 \<noteq> 0")
-  case True
-  then show ?thesis
-    apply(simp only: mul_iteration_def)
-    apply(rule terminates_in_state_intro)
-    (* Why does it work only with intro? *)
-    apply(force simp: fun_eq_iff numeral_eq_Suc
-        intro: terminates_in_state_intro
-        intro!: Big_StepT.IfTrue)
-    by(auto simp: fun_eq_iff numeral_eq_Suc)
-next
-  case False
-  then show ?thesis
-  by(force simp: mul_iteration_def fun_eq_iff numeral_eq_Suc 
-        intro: terminates_in_state_intro)
-qed
-
-lemma mul_iteration_invariant:
-  assumes "s ''c'' + s ''a'' * s ''b'' = x * y" "(mul_iteration, s) \<Rightarrow>\<^bsup>t\<^esup> s'"
-  shows "s' ''c'' + s' ''a'' * s' ''b'' = x * y"
-proof -
-  have "s' = s(''a'' := 2 * s ''a'',
-               ''b'' := s ''b'' div 2,
-               ''c'' := (if s ''b'' mod 2 \<noteq> 0 then s ''c'' + s ''a'' else s ''c''),
-               ''d'' := 0)"
-    using bigstep_det mul_iteration_effect \<open>(mul_iteration, s) \<Rightarrow>\<^bsup>t\<^esup> s'\<close>
-    by blast
-  thus ?thesis
-    using \<open>s ''c'' + s ''a'' * s ''b'' = x * y\<close>[symmetric]
-    apply(auto simp: algebra_simps)
-    by (smt (z3) add_mult_distrib2 mod_mult_div_eq mult.assoc mult.commute mult_numeral_1 
-        numeral_1_eq_Suc_0)
-qed
+  "(mul_iteration p, s) \<Rightarrow>\<^bsup>11\<^esup> state_transformer' p
+                                 (\<lambda>s. 
+                                  [(''a'', 2 * s ''a''),
+                                   (''b'', s ''b'' div 2),
+                                   (''c'', 
+                                     (if s ''b'' mod 2 \<noteq> 0 
+                                      then s ''c'' + s ''a''
+                                      else s ''c'')),
+                                   (''d'', 0)]) s"
+    unfolding mul_iteration_def
+    by (cases "s (add_prefix p ''b'') mod 2 \<noteq> 0")
+       (fastforce intro!: terminates_in_time_state_intro[OF Seq'])+
 
 lemma mul_loop_correct:
-  assumes "s ''b'' = k"
-  shows "(WHILE ''b'' \<noteq>0 DO mul_iteration, s) 
-    \<Rightarrow>\<^bsup>12 * (if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')) + 2\<^esup> 
-    s(''a'' := s ''a'' * (2 :: nat) ^(if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')),
-      ''b'' := 0,
-      ''c'' := s ''c'' + s ''a'' * s ''b'',
-      ''d'' := (if s ''b'' = 0 then s ''d'' else 0))"
+  assumes "s (add_prefix p ''b'') = k"
+  shows "((WHILE ''b'' \<noteq>0 DO mul_iteration) p, s) 
+    \<Rightarrow>\<^bsup>12 * (if s (add_prefix p ''b'') = 0 then 0 
+             else 1 + Discrete.log (s (add_prefix p ''b''))) + 2\<^esup> 
+    state_transformer' p
+    (\<lambda>s. [(''a'', (s ''a'') * (2 :: nat)^(if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b''))),
+          (''b'', 0),
+          (''c'', s ''c'' + s ''a'' * s ''b''),
+          (''d'', (if s ''b'' = 0 then s ''d'' else 0))]) s"
   using assms
 proof(induction k arbitrary: s rule: less_induct )
   case (less x)
@@ -108,64 +93,43 @@ proof(induction k arbitrary: s rule: less_induct )
   proof (cases x)
   next
     case (Suc nat)
-    hence "s ''b'' \<noteq> 0" 
-      using \<open>s ''b'' = x\<close> 
-      by simp
-
-    let ?s' = "s(''a'' := 2 * s ''a'',
-                 ''b'' := s ''b'' div 2,
-                 ''c'' := (if s ''b'' mod 2 \<noteq> 0 then s ''c'' + s ''a'' else s ''c''),
-                 ''d'' := 0)"
-    let ?s'' = "?s'(''a'' := ?s' ''a'' 
-                      * (2 :: nat)^(if ?s' ''b'' = 0 then 0 else 1 + Discrete.log (?s' ''b'')),
-                  ''b'' := 0,
-                  ''c'' := ?s' ''c'' + ?s' ''a'' * ?s' ''b'',
-                  ''d'' := (if ?s' ''b'' = 0 then ?s' ''d'' else 0))"
-
-    have remaining_iterations: "(WHILE ''b'' \<noteq>0 DO mul_iteration, ?s') 
-      \<Rightarrow>\<^bsup>12 * (if ?s' ''b'' = 0 then 0 else 1 + Discrete.log (?s' ''b'')) + 2\<^esup> ?s''"
-      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> 
-      by (fastforce intro!: less.IH[where ?y = "x div 2"])
-
-    have s''_is_goal: "?s'' = 
-    s(''a'' := s ''a'' * (2 :: nat) ^(if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b'')),
-      ''b'' := 0,
-      ''c'' := s ''c'' + s ''a'' * s ''b'',
-      ''d'' := (if s ''b'' = 0 then s ''d'' else 0))"
-      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> 
-      apply(auto simp: fun_eq_iff)
-        apply (metis Discrete.log.simps One_nat_def div_less log_half neq0_conv power_Suc)
-       apply presburger
-      by (smt (z3) One_nat_def add.commute add_left_cancel add_mult_distrib2 
-          mult.commute mult_2 mult_Suc numeral_2_eq_2 odd_two_times_div_two_succ)
 
     show ?thesis
-      using \<open>x = Suc nat\<close> \<open>s ''b'' = x\<close> \<open>s ''b'' \<noteq> 0\<close> log_rec s''_is_goal
-      by (fastforce simp: Euclidean_Division.div_eq_0_iff
-          intro!: Big_StepT.WhileTrue[
-            OF _ mul_iteration_effect
-            terminates_in_state_intro[OF remaining_iterations]])
+      apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[
+              OF _ mul_iteration_effect less.IH[where ?y = "x div 2"]]])
+      using \<open>x = Suc nat\<close> \<open>s (add_prefix p ''b'') = x\<close> log_rec 
+           apply auto
+        apply(auto 
+          simp add: Euclidean_Division.div_eq_0_iff 
+          intro!: HOL.ext)
+       apply(presburger)
+      using odd_two_times_div_two_nat[where ?n=nat] mult.commute
+      by (smt (z3) One_nat_def Suc_pred mult.assoc mult_Suc_right)
   qed (force intro: terminates_in_state_intro)
 qed
 
-definition IMP_minus_mul where "IMP_minus_mul =
+definition mul_IMP_minus where "mul_IMP_minus =
   ''c'' ::= A (N 0) ;;
   WHILE ''b'' \<noteq>0 DO mul_iteration ;;
   ''a'' ::= A (N 0) ;;
   ''d'' ::= A (N 0)" 
 
-definition mul_time where "mul_time y 
+definition mul_IMP_Minus_time where "mul_IMP_Minus_time y 
   \<equiv> 12 * (if y = 0 then 0 else 1 + Discrete.log y) + 8"
 
-lemma IMP_minus_mul_correct: 
-  shows "(IMP_minus_mul, s) 
-    \<Rightarrow>\<^bsup>mul_time (s ''b'')\<^esup> 
-    s(''a'' := 0,
-      ''b'' := 0,
-      ''c'' := s ''a'' * s ''b'',
-      ''d'' := 0)"
-  unfolding mul_time_def
-  using mul_loop_correct
-  by(force simp: IMP_minus_mul_def
-           intro!: terminates_in_state_intro[OF Seq[OF Seq[OF Seq]]])
+abbreviation mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p a b \<equiv>
+  state_transformer p  
+    [(''a'', 0),
+     (''b'', 0),
+     (''c'',  a * b),
+     (''d'', 0)]" 
+
+lemma IMP_minus_mul_correct[intro]: 
+  shows "(mul_IMP_minus p, s) 
+    \<Rightarrow>\<^bsup>mul_IMP_Minus_time (s (add_prefix p ''b''))\<^esup> 
+      mul_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
+  unfolding mul_IMP_Minus_time_def mul_IMP_minus_def
+  by(fastforce
+      intro!: terminates_in_time_state_intro[OF Seq']
+      intro: mul_loop_correct)
 end
\ No newline at end of file

From bb18dff8fa938bb43a607be7abe4705c8b04ab20 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Florian=20Ke=C3=9Fler?= <notiho@gmail.com>
Date: Mon, 11 Oct 2021 09:14:45 +0200
Subject: [PATCH 077/103] started changing IMP- implementations to
 state_transformer

---
 IMP-/Canonical_State_Transformers.thy | 116 ++++++-
 IMP-/IMP_Minus_Nat_Bijection.thy      | 428 +++++++++++++-------------
 IMP-/Multiplication.thy               |  27 +-
 3 files changed, 348 insertions(+), 223 deletions(-)

diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
index 9be775e9..6f5f1987 100644
--- a/IMP-/Canonical_State_Transformers.thy
+++ b/IMP-/Canonical_State_Transformers.thy
@@ -25,6 +25,13 @@ proof (induction x arbitrary: p)
     by (cases p) auto
 qed auto
 
+lemma drop_add_prefix[simp]:
+  "drop (2 + 2 * length p) (add_prefix p x) = x"
+  unfolding add_prefix_def
+  by auto
+
+declare drop_add_prefix[simplified, simp]
+
 lemma concat_map_eq_iff[simp]:
   "(concat (map (\<lambda>i. [i, y]) p) = concat (map (\<lambda>i. [i, y]) p'))
     \<longleftrightarrow> p = p'"
@@ -101,6 +108,11 @@ definition state_transformer :: "string \<Rightarrow> (vname * nat) list \<Right
 abbreviation state_transformer' where "state_transformer' p vs s \<equiv>
   state_transformer p (vs (\<lambda>v. s (add_prefix p v))) s"
 
+lemma state_transformer_no_update[simp]:
+  "state_transformer p [] s = s"
+  unfolding state_transformer_def
+  by auto
+
 lemma state_transformer_commutes:
   assumes "p \<noteq> p'"
   shows "state_transformer p vs \<circ> state_transformer p' vs' 
@@ -193,10 +205,10 @@ lemma state_transformer_same_prefix_equal_intro[intro]:
 lemma state_transformer_same_prefix_equal_commutes[simp]:
   assumes "p \<noteq> p'"
   shows "state_transformer p vs (state_transformer p' vs' s) = 
-    state_transformer p' vs'' (state_transformer p vs''' s)
+    state_transformer p' vs'' (state_transformer p vs''' s')
     \<longleftrightarrow> 
       state_transformer p vs (state_transformer p' vs' s) = 
-      state_transformer p vs''' (state_transformer p' vs'' s)"
+      state_transformer p vs''' (state_transformer p' vs'' s')"
   using state_transformer_commutes'[OF \<open>p \<noteq> p'\<close>]
   by simp
 
@@ -278,6 +290,101 @@ next
     by auto
 qed
 
+lemma state_transformers_of_x_same_prefix_equal_iff[simp]:
+  "state_transformer p vs s x = state_transformer p vs' s' x \<longleftrightarrow>
+    (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
+            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
+            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
+          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+             s x = s' x)"
+proof
+  assume "state_transformer p vs s x = state_transformer p vs' s' x"
+
+  have "x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<Longrightarrow> 
+   (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
+            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
+            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x))"
+  proof -
+    assume "x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs'))"
+    then obtain x' where "x = add_prefix p x'" "x' \<in> set (map fst (vs @ vs'))"
+      by auto
+    thus ?thesis
+      using \<open>state_transformer p vs s x = state_transformer p vs' s' x\<close> 
+      unfolding state_transformer_def
+      by(auto split: option.splits)
+  qed
+
+  moreover have "x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<Longrightarrow> s x = s' x"
+  proof -
+    assume "x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs'))"
+    hence "state_transformer p vs s x = s x" "state_transformer p vs' s' x = s' x" 
+      unfolding state_transformer_def
+      by(force dest!: map_of_SomeD split: option.splits)+
+    thus "s x = s' x"
+      using \<open>state_transformer p vs s x = state_transformer p vs' s' x\<close>
+      by simp
+  qed
+
+  ultimately show " 
+          (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
+            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
+            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
+          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+             s x = s' x)"
+    by simp
+next
+  assume *: "
+          (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
+            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
+            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
+          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+             s x = s' x)"
+
+  have "state_transformer p vs s x = state_transformer p vs' s' x" 
+  proof(cases "x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs'))")
+    case True
+    then obtain x' where "x = add_prefix p x'"
+      by auto
+    then show ?thesis
+      unfolding state_transformer_def
+      using * True \<open>x = add_prefix p x'\<close>
+      apply(auto split: option.splits)
+      by (metis option.distinct weak_map_of_SomeI)+
+  next
+    case False
+    thus ?thesis
+      unfolding state_transformer_def
+      using * False
+      by(auto simp: rev_image_eqI dest!: map_of_SomeD split: option.splits)
+  qed
+  thus "state_transformer p vs s x = state_transformer p vs' s' x"
+    by auto
+qed
+
+lemma state_transformers_same_prefix_equal_iff'[simp]:
+  "state_transformer p vs s = state_transformer p vs' s'
+    \<longleftrightarrow> (\<forall>x. 
+          (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
+            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
+            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
+               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
+          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
+             s x = s' x))"
+  by(auto simp: fun_eq_iff)
+
 lemma state_transformer_of_same_prefix[simp]: "state_transformer p vs s (add_prefix p v)
   = (case (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) (add_prefix p v) of
       (Some y) \<Rightarrow> y |
@@ -378,6 +485,9 @@ abbreviation write_subprogram_param where "write_subprogram_param p' a  b \<equi
 abbreviation read_subprogram_param where "read_subprogram_param a p' b \<equiv> 
   (\<lambda>p. Assign (add_prefix p a) (aexp_add_prefix (p' @ p) b))"
 
+abbreviation read_write_subprogram_param where "read_write_subprogram_param p' a p'' b \<equiv>
+  (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix (p'' @ p) b))"
+
 unbundle no_com_syntax
 
 bundle pcom_syntax
@@ -386,6 +496,7 @@ notation pcom_SKIP ("SKIP" [] 61) and
          pcom_Assign ("_ ::= _" [1000, 61] 61) and
          write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
          read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
+         read_write_subprogram_param ("[_] _ ::= [_] _" [1000, 61, 61, 61] 61) and
          pcom_Seq ("_;;/ _"  [60, 61] 60) and
          pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
          pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
@@ -397,6 +508,7 @@ no_notation pcom_SKIP ("SKIP" [] 61) and
             pcom_Assign ("_ ::= _" [1000, 61] 61) and
             write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
             read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
+            read_write_subprogram_param ("[_] _ ::= [_] _" [1000, 61, 61, 61] 61) and
             pcom_Seq ("_;;/ _"  [60, 61] 60) and
             pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
             pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index e4ace843..c403db58 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -6,49 +6,53 @@ theory IMP_Minus_Nat_Bijection
 begin
 
 unbundle IMP_Minus_Minus_Com.no_com_syntax
-
-definition IMP_Minus_triangle where "IMP_Minus_triangle \<equiv>
-  ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
-  IMP_minus_mul ;;
-  ''triangle'' ::= ((V ''c'') \<then>) ;;
-  ''c'' ::= (A (N 0))"
-
-lemma IMP_Minus_triangle_correct: 
-   "(IMP_Minus_triangle, s) 
-      \<Rightarrow>\<^bsup>mul_time (1 + s ''a'') + 6\<^esup> 
-      s(''a'' := 0,
-        ''b'' := 0,
-        ''c'' := 0,
-        ''d'' := 0,
-        ''triangle'' := triangle (s ''a''))"
-  unfolding IMP_Minus_triangle_def triangle_def 
-  by(force
-      intro: terminates_in_state_intro[OF Seq[OF Seq]]
-        IMP_minus_mul_correct)
-
-definition IMP_Minus_prod_encode where "IMP_Minus_prod_encode \<equiv>
-  ''prod_encode'' ::= (A (V ''a'')) ;;
-  ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
-  IMP_Minus_triangle ;;
-  ''prod_encode'' ::= ((V ''triangle'') \<oplus> (V ''prod_encode'')) ;;
-  ''triangle'' ::= (A (N 0))"
-
-definition IMP_Minus_prod_encode_time where "IMP_Minus_prod_encode_time x y \<equiv>
-  mul_time (1 + x + y) + 14"
-
-lemma IMP_Minus_prod_encode_correct: 
-  "(IMP_Minus_prod_encode, s) 
-      \<Rightarrow>\<^bsup>IMP_Minus_prod_encode_time (s ''a'') (s ''b'')\<^esup> 
-      s(''a'' := 0,
-        ''b'' := 0,
-        ''c'' := 0,
-        ''d'' := 0,
-        ''triangle'' := 0,
-        ''prod_encode'' := prod_encode (s ''a'', s ''b''))"
-  unfolding IMP_Minus_prod_encode_def prod_encode_def IMP_Minus_prod_encode_time_def
-  by(force
-      intro: terminates_in_state_intro[OF Seq[OF Seq]]
-        IMP_Minus_triangle_correct)
+unbundle Com.no_com_syntax
+
+definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
+  [''a''] ''a'' ::= (A (V ''a'')) ;;
+  [''a''] ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
+  invoke_subprogram ''a'' mul_IMP_minus ;;
+  ''triangle'' ::= [''a''] ((V ''c'') \<then>) ;;
+  ''a'' ::= (A (N 0))"
+
+definition triangle_IMP_Minus_time where "triangle_IMP_Minus_time x \<equiv>
+  mul_IMP_Minus_time (1 + x) + 8"
+
+abbreviation triangle_IMP_Minus_state_transformer where 
+  "triangle_IMP_Minus_state_transformer p n  \<equiv>
+    state_transformer p [(''triangle'', triangle n), (''a'', 0)] \<circ> 
+    mul_IMP_Minus_state_transformer (''a'' @ p) n (n + 1)"
+
+lemma triangle_IMP_Minus_correct[intro]: 
+   "(triangle_IMP_Minus p, s) 
+      \<Rightarrow>\<^bsup>triangle_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
+      triangle_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
+  unfolding triangle_IMP_Minus_def triangle_def triangle_IMP_Minus_time_def
+  by (fastforce intro!: terminates_in_time_state_intro[OF Seq])
+
+definition prod_encode_IMP_Minus where "prod_encode_IMP_Minus \<equiv>
+  [''a''] ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
+  invoke_subprogram ''a'' triangle_IMP_Minus ;;
+  ''prod_encode'' ::= [''a''] (A (V ''triangle'')) ;;
+  [''a''] ''triangle'' ::= (A (N 0)) ;;
+  ''prod_encode'' ::= ((V ''a'') \<oplus> (V ''prod_encode'')) ;;
+  zero_variables [''a'', ''b'']"
+
+definition prod_encode_IMP_Minus_time where "prod_encode_IMP_Minus_time x y \<equiv>
+  triangle_IMP_Minus_time (x + y) + 8 + zero_variables_time [''a'', ''b'']"
+
+abbreviation prod_encode_IMP_Minus_state_transformer where 
+  "prod_encode_IMP_Minus_state_transformer p x y \<equiv>
+    state_transformer p [(''prod_encode'', prod_encode (x, y)), (''a'', 0), (''b'', 0)] \<circ>
+    state_transformer (''a'' @ p) [(''triangle'', 0)] \<circ> 
+    triangle_IMP_Minus_state_transformer (''a'' @ p) (x + y)"
+
+lemma prod_encode_IMP_Minus_correct[intro]: 
+  "(prod_encode_IMP_Minus p, s) 
+      \<Rightarrow>\<^bsup>prod_encode_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup> 
+      prod_encode_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
+  unfolding prod_encode_IMP_Minus_def prod_encode_def prod_encode_IMP_Minus_time_def
+  by(fastforce intro!: terminates_in_time_state_intro[OF Seq])
 
 fun prod_decode_aux_iterations :: "nat \<Rightarrow> nat \<Rightarrow> nat"
   where "prod_decode_aux_iterations k m =
@@ -61,14 +65,18 @@ definition prod_decode_aux_iteration where "prod_decode_aux_iteration \<equiv>
   ''b'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
   ''c'' ::= ((V ''b'') \<ominus> (V ''a''))"
 
+abbreviation prod_decode_aux_loop_state_transformer 
+  where "prod_decode_aux_loop_state_transformer p x y \<equiv>
+    state_transformer p [(''a'', fst (prod_decode_aux x y)
+                               + snd (prod_decode_aux x y)),
+                         (''b'', fst (prod_decode_aux x y)),
+                         (''c'', 0)]"
+
 lemma prod_decode_aux_loop_correct: 
-  "s ''a'' = k \<Longrightarrow> s ''b'' = m \<Longrightarrow> s ''c'' = m - k 
-  \<Longrightarrow> (WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration, s) 
-      \<Rightarrow>\<^bsup>2 + 7 * prod_decode_aux_iterations (s ''a'') (s ''b'')\<^esup> 
-    s(''a'' := fst (prod_decode_aux (s ''a'') (s ''b''))
-         + snd (prod_decode_aux (s ''a'') (s ''b'')),
-      ''b'' := fst (prod_decode_aux (s ''a'') (s ''b'')),
-      ''c'' := 0)"
+  "s (add_prefix p ''a'') = k \<Longrightarrow> s (add_prefix p ''b'') = m \<Longrightarrow> s (add_prefix p ''c'') = m - k 
+  \<Longrightarrow> ((WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration) p, s) 
+      \<Rightarrow>\<^bsup>2 + 7 * prod_decode_aux_iterations k m\<^esup> 
+      (if m - k \<noteq> 0 then prod_decode_aux_loop_state_transformer p k m s else s)"
 proof(induction k m arbitrary: s rule: prod_decode_aux.induct)
   case (1 k m)
   then show ?case
@@ -76,31 +84,24 @@ proof(induction k m arbitrary: s rule: prod_decode_aux.induct)
     case 0
     then show ?thesis
       using 1 terminates_in_state_intro[OF Big_StepT.WhileFalse]
-      by(auto simp: fun_eq_iff prod_decode_aux.simps numeral_eq_Suc 
+      by(auto simp:  prod_decode_aux.simps numeral_eq_Suc 
           prod_decode_aux_iterations.simps)
   next
     case (Suc nat)
 
-    have first_iteration: "(prod_decode_aux_iteration, s) \<Rightarrow>\<^bsup> 6 \<^esup> 
-      s(''a'' := Suc k,
-        ''b'' := m - (Suc k),
-        ''c'' := (m - (Suc k)) - Suc k)"
-      unfolding prod_decode_aux_iteration_def
-      using \<open>s ''a'' = k\<close>  \<open>s ''b'' = m\<close>
-      by(auto 
-          simp: numeral_eq_Suc fun_eq_iff 
-          intro!: terminates_in_state_intro[OF Seq[OF Seq]])
-
     show ?thesis
-      using terminates_in_state_intro[OF Big_StepT.WhileTrue[OF _ first_iteration "1.IH"]]
-        prod_decode_aux_iterations.simps[where ?k = "s ''a''"]
-        prod_decode_aux.simps[where ?k = "s ''a''"]
-        \<open>s ''a'' = k\<close>  \<open>s ''b'' = m\<close> \<open>s ''c'' = m - k\<close> \<open>m - k = Suc nat\<close>
-      by(auto simp: fun_eq_iff)
+      apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[OF _ _ "1.IH"]])
+      unfolding prod_decode_aux_iteration_def
+      using \<open>s (add_prefix p ''a'') = k\<close>  \<open>s (add_prefix p ''b'') = m\<close>  
+        \<open>s (add_prefix p ''c'') = m - k\<close> \<open>m - k = Suc nat\<close>
+        prod_decode_aux_iterations.simps[where ?k = k]
+        prod_decode_aux.simps[where ?k = k]
+        prod_decode_aux.simps[where ?k = "(Suc (s (add_prefix p ''a'')))"]
+      by fastforce+
   qed
 qed
 
-definition IMP_Minus_fst_nat where "IMP_Minus_fst_nat \<equiv>
+definition fst_nat_IMP_Minus where "fst_nat_IMP_Minus \<equiv>
   ''b'' ::= (A (V ''a'')) ;; 
   ''a'' ::= (A (N 0)) ;;
   ''c'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
@@ -109,22 +110,25 @@ definition IMP_Minus_fst_nat where "IMP_Minus_fst_nat \<equiv>
   ''a'' ::= (A (N 0)) ;;
   ''b'' ::= (A (N 0))"
 
-definition IMP_Minus_fst_nat_time where "IMP_Minus_fst_nat_time x \<equiv>
+definition fst_nat_IMP_Minus_time where "fst_nat_IMP_Minus_time x \<equiv>
   14 + 7 * prod_decode_aux_iterations 0 x"
 
-lemma IMP_Minus_fst_nat_correct: 
-  "(IMP_Minus_fst_nat, s) 
-      \<Rightarrow>\<^bsup>IMP_Minus_fst_nat_time (s ''a'')\<^esup> 
-    s(''a'' := 0,
-      ''b'' := 0,
-      ''c'' := 0,
-      ''fst_nat'' := fst_nat (s ''a''))"
-  unfolding IMP_Minus_fst_nat_def fst_nat_def prod_decode_def IMP_Minus_fst_nat_time_def
-  by (force intro!: 
-      terminates_in_state_intro[OF Seq]
-      prod_decode_aux_loop_correct)
-
-definition IMP_Minus_snd_nat where "IMP_Minus_snd_nat \<equiv>
+abbreviation fst_nat_IMP_Minus_state_transformer where "fst_nat_IMP_Minus_state_transformer p x
+  \<equiv> state_transformer p [(''a'', 0),
+                          (''b'', 0),
+                          (''c'', 0),
+                          (''fst_nat'', fst_nat x)]"
+
+lemma fst_nat_IMP_Minus_correct[intro]: 
+  "(fst_nat_IMP_Minus p, s) 
+      \<Rightarrow>\<^bsup>fst_nat_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
+    fst_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
+  unfolding fst_nat_IMP_Minus_def fst_nat_def fst_nat_IMP_Minus_time_def
+  by (fastforce simp: prod_decode_def prod_decode_aux.simps[of 0 0] 
+      intro!: prod_decode_aux_loop_correct
+      terminates_in_time_state_intro[OF Seq'])
+
+definition snd_nat_IMP_Minus where "snd_nat_IMP_Minus \<equiv>
   ''b'' ::= (A (V ''a'')) ;; 
   ''a'' ::= (A (N 0)) ;;
   ''c'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
@@ -133,28 +137,34 @@ definition IMP_Minus_snd_nat where "IMP_Minus_snd_nat \<equiv>
   ''a'' ::= (A (N 0)) ;;
   ''b'' ::= (A (N 0))"
 
-lemma IMP_Minus_snd_nat_correct: 
-  "(IMP_Minus_snd_nat, s) 
-      \<Rightarrow>\<^bsup>IMP_Minus_fst_nat_time (s ''a'')\<^esup> 
-    s(''a'' := 0,
-      ''b'' := 0,
-      ''c'' := 0,
-      ''snd_nat'' := snd_nat (s ''a''))"
-  unfolding IMP_Minus_snd_nat_def snd_nat_def prod_decode_def IMP_Minus_fst_nat_time_def
-  by (force intro!: 
-      terminates_in_state_intro[OF Seq]
-      prod_decode_aux_loop_correct)
+definition snd_nat_IMP_Minus_time where "snd_nat_IMP_Minus_time x \<equiv>
+  14 + 7 * prod_decode_aux_iterations 0 x"
+
+abbreviation snd_nat_IMP_Minus_state_transformer where "snd_nat_IMP_Minus_state_transformer p x
+  \<equiv> state_transformer p [(''a'', 0),
+                          (''b'', 0),
+                          (''c'', 0),
+                          (''snd_nat'', snd_nat x)]"
+
+lemma snd_nat_IMP_Minus_correct[intro]: 
+  "(snd_nat_IMP_Minus p, s) 
+      \<Rightarrow>\<^bsup>snd_nat_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
+    snd_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
+  unfolding snd_nat_IMP_Minus_def snd_nat_def snd_nat_IMP_Minus_time_def
+  by (fastforce simp: prod_decode_def prod_decode_aux.simps[of 0 0] 
+      intro!: prod_decode_aux_loop_correct
+      terminates_in_time_state_intro[OF Seq'])
 
 definition nth_nat_iteration where "nth_nat_iteration \<equiv>
-  ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
-  IMP_Minus_snd_nat ;;
-  ''a'' ::= (A (V ''snd_nat'')) ;;
-  ''snd_nat'' ::= (A (N 0)) ;;
+  [''a''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  invoke_subprogram ''a'' snd_nat_IMP_Minus ;;
+  ''a'' ::= [''a''] (A (V ''snd_nat'')) ;;
+  [''a''] ''snd_nat'' ::= (A (N 0)) ;;
   ''nth_nat'' ::= ((V ''nth_nat'') \<ominus> (N 1))"
 
 fun nth_nat_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
 "nth_nat_loop_time 0 x = 2" |
-"nth_nat_loop_time (Suc n) x = 9 + IMP_Minus_fst_nat_time (x - 1) 
+"nth_nat_loop_time (Suc n) x = 9 + snd_nat_IMP_Minus_time (x - 1) 
   + nth_nat_loop_time n (tl_nat x)"
 
 fun drop_n_nat :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
@@ -166,15 +176,21 @@ lemma nth_nat_is_hd_of_drop_n_nat:
   by (induction n arbitrary: x)
     (auto simp: hd_nat_def)
 
+abbreviation nth_nat_loop_state_transformer where "nth_nat_loop_state_transformer p k x \<equiv>
+  (if k = 0 then (\<lambda>s. s)
+   else 
+        state_transformer p [
+        (''a'', drop_n_nat k x),
+        (''nth_nat'',  0)]
+        \<circ> state_transformer (''a'' @ p) [
+          (''snd_nat'', 0)]
+        \<circ> snd_nat_IMP_Minus_state_transformer (''a'' @ p) 0)"
+
 lemma nth_nat_loop_correct:
-  "s ''nth_nat'' = k
-  \<Longrightarrow> (WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration, s) 
-      \<Rightarrow>\<^bsup>nth_nat_loop_time (s ''nth_nat'') (s ''a'') \<^esup>
-      s(''a'' := drop_n_nat k (s ''a''),
-        ''b'' := (if k > 0 then 0 else s ''b''),
-        ''c'' := (if k > 0 then 0 else s ''c''),
-        ''snd_nat'' := (if k > 0 then 0 else s ''snd_nat''),
-        ''nth_nat'' := 0)"
+  "s (add_prefix p ''nth_nat'') = k
+  \<Longrightarrow> ((WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration) p, s) 
+      \<Rightarrow>\<^bsup>nth_nat_loop_time k (s (add_prefix p ''a''))\<^esup>
+      nth_nat_loop_state_transformer p k (s (add_prefix p ''a'')) s "
 proof(induction k arbitrary: s)
   case 0
   then show ?case
@@ -182,23 +198,11 @@ proof(induction k arbitrary: s)
         intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse])
 next
   case (Suc k)
-
-  have first_iteration: "(nth_nat_iteration, s)
-    \<Rightarrow>\<^bsup> 8 + IMP_Minus_fst_nat_time ((s ''a'') - 1) \<^esup>
-      s(''a'' := tl_nat (s ''a''),
-        ''b'' := 0,
-        ''c'' := 0,
-        ''snd_nat'' := 0,
-        ''nth_nat'' := k)"
-    unfolding nth_nat_iteration_def tl_nat_def
-    using \<open>s ''nth_nat'' = Suc k\<close>
-    by(force intro!: terminates_in_state_intro[OF Seq]
-        IMP_Minus_snd_nat_correct)
-
   show ?case
-    using \<open>s ''nth_nat'' = Suc k\<close>
-    by (force intro!: terminates_in_state_intro
-          [OF Big_StepT.WhileTrue[OF _ first_iteration Suc.IH]])
+    apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[OF _ _ Suc.IH]])
+    using \<open>s (add_prefix p ''nth_nat'') = Suc k\<close>
+    unfolding nth_nat_iteration_def
+    by (fastforce simp: tl_nat_def)+
 qed
 
 
@@ -206,67 +210,70 @@ definition nth_nat_IMP_Minus where "nth_nat_IMP_Minus \<equiv>
   ''nth_nat'' ::= (A (V ''a'')) ;;
   ''a'' ::= (A (V ''b'')) ;;
   WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration ;;
-  ''snd_nat'' ::= (A (N 0)) ;;
-  ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
-  IMP_Minus_fst_nat ;;
-  ''nth_nat'' ::= (A (V ''fst_nat'')) ;;
-  ''fst_nat'' ::= (A (N 0))"
+  [''b''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  invoke_subprogram ''b'' fst_nat_IMP_Minus ;;
+  ''nth_nat'' ::= [''b''] (A (V ''fst_nat'')) ;;
+  [''b''] ''fst_nat'' ::= (A (N 0)) ;;
+  zero_variables [''a'', ''b'']"
 
 definition nth_nat_IMP_Minus_time where "nth_nat_IMP_Minus_time n x \<equiv>
-  12 + nth_nat_loop_time n x + IMP_Minus_fst_nat_time ((drop_n_nat n x) - 1)"
+  10 + nth_nat_loop_time n x + fst_nat_IMP_Minus_time ((drop_n_nat n x) - 1)
+  + zero_variables_time [''a'', ''b'']"
+
+abbreviation nth_nat_IMP_Minus_state_transformer where "nth_nat_IMP_Minus_state_transformer p k x
+  \<equiv> state_transformer p [(''nth_nat'', nth_nat k x), (''a'', 0), (''b'', 0)]
+     \<circ> state_transformer (''b'' @ p) [(''fst_nat'', 0)]
+     \<circ> fst_nat_IMP_Minus_state_transformer (''b'' @ p) 0
+     \<circ> nth_nat_loop_state_transformer p k x"
 
 lemma nth_nat_IMP_Minus_correct:
-  "(nth_nat_IMP_Minus, s) \<Rightarrow>\<^bsup>nth_nat_IMP_Minus_time (s ''a'') (s ''b'') \<^esup>
-    s(''a'' := 0,
-      ''b'' := 0,
-      ''c'' := 0,
-      ''fst_nat'' := 0,
-      ''snd_nat'' := 0,
-      ''nth_nat'' := nth_nat (s ''a'') (s ''b''))"
-  apply(cases "s ''a'' = 0")
+  "(nth_nat_IMP_Minus p, s) 
+    \<Rightarrow>\<^bsup>nth_nat_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup>
+    nth_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
   unfolding nth_nat_IMP_Minus_def nth_nat_IMP_Minus_time_def tl_nat_def 
-  by (fastforce simp: hd_nat_def nth_nat_is_hd_of_drop_n_nat
-            intro!: terminates_in_state_intro[OF Seq] 
-              IMP_Minus_fst_nat_correct nth_nat_loop_correct)+
-
-definition cons_IMP_Minus :: "atomExp \<Rightarrow> atomExp \<Rightarrow> Com.com" 
-  where "cons_IMP_Minus h t \<equiv> 
-    ''a'' ::= (A h) ;;
-    ''b'' ::= (A t) ;;
-    IMP_Minus_prod_encode ;;
-    ''cons'' ::= ((V ''prod_encode'') \<oplus> (N 1)) ;;
-    ''prod_encode'' ::= (A (N 0))"
+  by (cases "s (add_prefix p ''a'') = 0") (fastforce 
+      simp: hd_nat_def nth_nat_is_hd_of_drop_n_nat
+      intro!: terminates_in_time_state_intro[OF Seq']
+      intro: nth_nat_loop_correct)+
+
+definition cons_IMP_Minus
+  where "cons_IMP_Minus \<equiv> 
+    [''a''] ''a'' ::= (A (V ''a'')) ;;
+    [''a''] ''b'' ::= (A (V ''b'')) ;;
+    invoke_subprogram ''a'' prod_encode_IMP_Minus ;;
+    ''cons'' ::= [''a''] ((V ''prod_encode'') \<oplus> (N 1)) ;;
+    [''a''] ''prod_encode'' ::= (A (N 0)) ;;
+    zero_variables [''a'', ''b'']"
 
 definition cons_IMP_Minus_time where "cons_IMP_Minus_time h t \<equiv>
-  8 + IMP_Minus_prod_encode_time h t"
+  8 + prod_encode_IMP_Minus_time h t + zero_variables_time [''a'', ''b'']"
 
-lemma cons_IMP_Minus_correct:
-  "t \<noteq> (V ''a'') \<Longrightarrow>
-    (cons_IMP_Minus h t, s) \<Rightarrow>\<^bsup>cons_IMP_Minus_time (atomVal h s) (atomVal t s)\<^esup>
-    s(''a'' := 0,
-      ''b'' := 0,
-      ''c'' := 0,
-      ''d'' := 0,
-      ''triangle'' := 0,
-      ''prod_encode'' := 0,
-      ''cons'' := (atomVal h s) ## (atomVal t s))"
+abbreviation cons_IMP_Minus_state_transformer where "cons_IMP_Minus_state_transformer p h t
+  \<equiv> state_transformer p [(''cons'', h ## t), (''a'', 0), (''b'', 0)]
+    \<circ> state_transformer (''a'' @ p) [(''prod_encode'', 0)]
+    \<circ> prod_encode_IMP_Minus_state_transformer (''a'' @ p) h t"
+
+lemma cons_IMP_Minus_correct[intro]:
+  "(cons_IMP_Minus p, s) 
+    \<Rightarrow>\<^bsup>cons_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup>
+     cons_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
   unfolding cons_IMP_Minus_def cons_IMP_Minus_time_def cons_def
-  by (cases t) (fastforce intro!: terminates_in_state_intro[OF Seq] IMP_Minus_prod_encode_correct)+
+  by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])
 
-fun cons_list_IMP_Minus :: "atomExp list \<Rightarrow> Com.com" where
-"cons_list_IMP_Minus [] = Com.SKIP" |
+fun cons_list_IMP_Minus :: "vname list \<Rightarrow> pcom" where
+"cons_list_IMP_Minus [] = SKIP" |
 "cons_list_IMP_Minus (a # as) = (if as = [] 
   then 
-    ''cons'' ::= (A a) ;;
-    ''a'' ::= (A (N 0)) ;;
-    ''b'' ::= (A (N 0)) ;;
-    ''c'' ::= (A (N 0)) ;;
-    ''d'' ::= (A (N 0)) ;;
-    ''triangle'' ::= (A (N 0)) ;;
-    ''prod_encode'' ::= (A (N 0))
+    ''cons_list'' ::= [''a''] (A (V a)) ;;
+    [''a''] a ::= (A (N 0))
   else
     cons_list_IMP_Minus as ;;
-    cons_IMP_Minus a (V ''cons''))"
+    [''b''] ''a'' ::= [''a''] (A (V a)) ;; 
+    [''b''] ''b'' ::= (A (V ''cons_list'')) ;;
+    invoke_subprogram ''b'' cons_IMP_Minus ;;
+    ''cons_list'' ::= [''b''] (A (V ''cons'')) ;;
+    [''b''] ''cons'' ::= (A (N 0)) ;;
+    [''a''] a ::= (A (N 0)))" (* TODO: don't zero here: will break if variable names not distinct*)
 
 fun cons_list :: "nat list \<Rightarrow> nat" where
 "cons_list [] = 0" |
@@ -279,42 +286,45 @@ fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
 "cons_list_IMP_Minus_time [] = 1" | 
 "cons_list_IMP_Minus_time (a # as) = 
   (if as = [] 
-   then 14
-   else cons_list_IMP_Minus_time as + cons_IMP_Minus_time a (cons_list as))"
-
-lemma cons_list_IMP_Minus_correct:
-  "as \<noteq> [] 
-    \<Longrightarrow> (\<forall>i \<in> set as. i \<notin> V ` { ''cons'', ''a'', ''b'', ''c'', ''d'', ''triangle'', ''prod_encode''}) 
-    \<Longrightarrow> (cons_list_IMP_Minus as, s) \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. atomVal i s) as)\<^esup>
-      s(''a'' := 0,
-        ''b'' := 0,
-        ''c'' := 0,
-        ''d'' := 0,
-        ''triangle'' := 0,
-        ''prod_encode'' := 0,
-        ''cons'' := cons_list (map (\<lambda>i. atomVal i s) as))"
-proof(induction as arbitrary: s)
-  case (Cons a as)
+   then 4
+   else cons_list_IMP_Minus_time as + 10 + cons_IMP_Minus_time a (cons_list as))"
+                                                  
+fun cons_list_IMP_Minus_state_transformer where 
+  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
+  "cons_list_IMP_Minus_state_transformer p (a # as) vs = (if as = [] then
+    state_transformer p [(''cons_list'', a)]
+    else
+      state_transformer p [(''cons_list'', cons_list (a # as))]
+      \<circ> cons_IMP_Minus_state_transformer (''b'' @ p) 0 0
+    )
+    \<circ> state_transformer (''a'' @ p) (map (\<lambda>v. (v, 0)) vs)"
+
+lemma cons_list_IMP_Minus_correct[intro]:
+    "(cons_list_IMP_Minus vs p, s) 
+      \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs)\<^esup>
+      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs) vs s"
+proof(induction vs arbitrary: s)
+  case (Cons v vs)
   then show ?case
-  proof (cases as)
+  proof (cases vs)
     case Nil
     then show ?thesis
-      by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])
+      by (auto 
+          simp: state_transformer_commutes'
+          intro!: terminates_in_time_state_intro[OF Seq'])
   next
     case (Cons b bs)
-
-    hence "as \<noteq> []" by simp
-    have *: "(\<forall>i \<in> set as. i \<notin> V ` { ''cons'', ''a'', ''b'', ''c'', ''d'',
-       ''triangle'', ''prod_encode''})"
-      using \<open>\<forall>i\<in>set (a # as). i \<notin> V ` {''cons'', ''a'', ''b'', ''c'', ''d'', ''triangle'',
-             ''prod_encode''}\<close>
-      by simp
-
-    show ?thesis
-      apply(cases a; rule terminates_in_state_intro)
-      using \<open>as \<noteq> []\<close> 
-        \<open>\<forall>i\<in>set (a # as). i \<notin> V ` {''cons'', ''a'', ''b'', ''c'', ''d'', ''triangle'',
-           ''prod_encode''}\<close> 
+    thus ?thesis
+      apply auto
+      subgoal
+        apply(rule terminates_in_time_state_intro[OF Seq'])
+        apply(rule Seq')+
+                 apply fastforce+
+        using Cons local.Cons
+      apply(auto)
+      using state_transformer_same_prefix_equal_commutes 
+      using local.Cons apply fastforce
+      apply(rule cons_IMP_Minus_correct)
       by(fastforce intro!: Cons.IH[OF _ *] cons_IMP_Minus_correct)+
   qed
 qed auto
@@ -322,26 +332,6 @@ qed auto
 declare cons_list_IMP_Minus.simps [simp del]
 declare cons_list_IMP_Minus_time.simps [simp del]
 
-fun zero_variables :: "vname list \<Rightarrow> Com.com" where
-"zero_variables [] = Com.SKIP" |
-"zero_variables (a # as) = (a ::= (A (N 0)) ;; zero_variables as)"
-
-definition zero_variables_time where "zero_variables_time vs \<equiv>
-  1 + 2 * length vs"
-
-lemma zero_variables_correct:
-  "(zero_variables vs, s) 
-    \<Rightarrow>\<^bsup>zero_variables_time vs\<^esup> (\<lambda>v. (if v \<in> set vs then 0 else s v))"
-proof (induction vs arbitrary: s)
-  case (Cons a vs)
-  show ?case
-    by(fastforce 
-        intro: terminates_in_state_intro[OF Seq[OF Big_StepT.Assign Cons.IH]] 
-        simp: zero_variables_time_def)
-qed (auto simp: zero_variables_time_def)
-
-declare zero_variables.simps [simp del]
-
 (*"reverse_nat_acc acc e  n f =
   (if n = 0 then acc 
    else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"*)
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index c58285ca..4667cecd 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -37,11 +37,11 @@ lemma max_a_min_b_IMP_Minus_correct[intro]:
 proof(cases "s (add_prefix p ''a'') \<le> s (add_prefix p ''b'')")
   case True
   then show ?thesis
-    by(force 
+    by(fastforce 
         simp: max_a_min_b_IMP_Minus_def numeral_eq_Suc
         max_a_min_b_IMP_Minus_time_def
         assign_t_simp
-        intro!: Seq[OF Big_StepT.Assign Big_StepT.IfFalse])
+        intro!: terminates_in_time_state_intro[OF Seq[OF Big_StepT.Assign Big_StepT.IfFalse]])
 next
   case False
   show ?thesis 
@@ -132,4 +132,27 @@ lemma IMP_minus_mul_correct[intro]:
   by(fastforce
       intro!: terminates_in_time_state_intro[OF Seq']
       intro: mul_loop_correct)
+
+fun zero_variables where
+"zero_variables [] = SKIP" |
+"zero_variables (a # as) = (a ::= (A (N 0)) ;; zero_variables as)"
+
+definition zero_variables_time where "zero_variables_time vs \<equiv>
+  1 + 2 * length vs"
+
+lemma zero_variables_correct[intro]:
+  "(zero_variables vs p, s) 
+    \<Rightarrow>\<^bsup>zero_variables_time vs\<^esup> 
+      state_transformer p (map (\<lambda>v. (v, 0)) vs) s"
+proof (induction vs arbitrary: s)
+  case (Cons a vs)
+  show ?case
+    by(auto 
+        intro!: terminates_in_state_intro[OF Seq[OF Big_StepT.Assign Cons.IH]] 
+        simp: zero_variables_time_def map_add_def
+        split: option.splits
+        dest!: map_of_SomeD)
+qed (auto simp: zero_variables_time_def)
+
+declare zero_variables.simps [simp del]
 end
\ No newline at end of file

From bf620ed364e39cebb7185bef2baf42b6a1aa6374 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Wed, 20 Oct 2021 00:09:05 +0200
Subject: [PATCH 078/103] left proof with "sorry"s

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 125 ++++++++++++++++++++++++++++++-
 1 file changed, 123 insertions(+), 2 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index c403db58..39323e6c 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -287,8 +287,129 @@ fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
 "cons_list_IMP_Minus_time (a # as) = 
   (if as = [] 
    then 4
-   else cons_list_IMP_Minus_time as + 10 + cons_IMP_Minus_time a (cons_list as))"
-                                                  
+   else cons_list_IMP_Minus_time as + 2 + 2 + cons_IMP_Minus_time a (cons_list as)) + 2 + 2 + 2"
+
+fun cons_list_IMP_Minus_state_transformer where 
+  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
+  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
+    state_transformer (''a'' @ p) [(v, 0)]
+  \<circ> state_transformer p [(''cons_list'', a)]
+    else
+  (\<lambda> s0 .
+      let s1 = cons_list_IMP_Minus_state_transformer p as vs s0;
+          s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V v))) s1);
+          s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+          s4 = cons_IMP_Minus_state_transformer (''b'' @ p)
+                (s3 (add_prefix (''b'' @ p) ''a''))
+                (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+          s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+          s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+          s7 = s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)
+  in s7 )
+  )
+"
+
+lemma cons_list_IMP_Minus_correct[intro]:
+assumes "distinct vs"
+shows
+    "(cons_list_IMP_Minus vs p, s) 
+      \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs)\<^esup>
+      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs) vs s"
+  using assms
+proof(induction vs arbitrary: s)
+  case ConsV: (Cons v vs)
+  show ?case
+  proof (cases vs)
+    case Nil
+    then show ?thesis
+      sorry
+  next
+    case ConsB: (Cons b bs)
+    define arg where "arg \<equiv> add_prefix (''a'' @ p)"
+
+    have "b \<noteq> v" using ConsB ConsV by auto
+
+    have d: "distinct vs" using ConsV by simp
+    define s1 where "s1 =
+      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s"
+    define s2 where "s2 =
+      s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V v))) s1)"
+    define s3 where "s3 =
+      s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2)"
+    define s4 where "s4 =
+      cons_IMP_Minus_state_transformer (''b'' @ p)
+                (s3 (add_prefix (''b'' @ p) ''a''))
+                (s3 (add_prefix (''b'' @ p) ''b'')) s3"
+    define s5 where "s5 =
+      s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4)"
+    define s6 where "s6 =
+      s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5)"
+    define s7 where "s7 =
+      s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
+
+    have c0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v)
+      = s (arg v)" sorry
+    have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
+        sorry
+    have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))" sorry
+
+    show ?thesis
+      apply(subst arg_def[symmetric])+
+
+      apply(subst cons_list_IMP_Minus.simps(2))
+      apply(subst ConsB)
+      apply(subst List.list.simps(3))
+      apply(subst HOL.if_False)
+      apply(subst List.list.map(2))
+      apply(subst cons_list_IMP_Minus_time.simps(2))
+      apply(subst ConsB)
+      apply(subst ConsB)
+      apply(subst ConsB[symmetric])
+      apply(subst List.list.map(2))
+      apply(subst List.list.simps(3))
+      apply(subst HOL.if_False)
+      apply(rule Seq')+
+            apply(subst arg_def)
+            apply(rule ConsV)
+            apply(simp add: d)
+
+           apply(subst arg_def[symmetric])
+           apply(subst s1_def[symmetric])
+
+           apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+            apply simp  apply(rule refl)
+          apply(subst s2_def[symmetric])
+          apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+           apply simp apply (rule refl)
+         apply(subst s3_def[symmetric])
+         apply(rule terminates_in_time_state_intro[OF cons_IMP_Minus_correct])
+          apply simp
+          apply(subst c1[symmetric]) apply(subst c2[symmetric]) apply simp
+         apply(rule refl)
+        apply(subst s4_def[symmetric])
+
+        apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+         apply simp
+        apply (rule refl)
+       apply(subst s5_def[symmetric])
+
+       apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+        apply simp apply (rule refl)
+      apply(subst s6_def[symmetric])
+
+      apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
+       apply simp
+      apply(subst s7_def[symmetric])
+      apply(subst List.list.map)
+      apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
+      apply(subst ConsB)
+      apply(subst List.list.map)
+      apply(subst List.list.simps(3))
+      apply(subst HOL.if_False)
+      apply(subst Let_def)+
+      apply(simp add: s7_def s6_def s5_def s4_def s3_def s2_def s1_def)
+      done
+
 fun cons_list_IMP_Minus_state_transformer where 
   "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
   "cons_list_IMP_Minus_state_transformer p (a # as) vs = (if as = [] then

From 3d1f66ab38b6aa6ca0feb936f569a7ccf49896af Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Wed, 20 Oct 2021 00:26:42 +0200
Subject: [PATCH 079/103] removed unnecessary parts

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 54 +++++---------------------------
 1 file changed, 7 insertions(+), 47 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 39323e6c..bc876c9e 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -330,6 +330,7 @@ proof(induction vs arbitrary: s)
     have "b \<noteq> v" using ConsB ConsV by auto
 
     have d: "distinct vs" using ConsV by simp
+
     define s1 where "s1 =
       cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s"
     define s2 where "s2 =
@@ -347,11 +348,10 @@ proof(induction vs arbitrary: s)
     define s7 where "s7 =
       s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
 
-    have c0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v)
-      = s (arg v)" sorry
     have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
         sorry
-    have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))" sorry
+      have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))"
+        sorry
 
     show ?thesis
       apply(subst arg_def[symmetric])+
@@ -379,11 +379,14 @@ proof(induction vs arbitrary: s)
            apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
             apply simp  apply(rule refl)
           apply(subst s2_def[symmetric])
+
           apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
            apply simp apply (rule refl)
          apply(subst s3_def[symmetric])
+
          apply(rule terminates_in_time_state_intro[OF cons_IMP_Minus_correct])
           apply simp
+
           apply(subst c1[symmetric]) apply(subst c2[symmetric]) apply simp
          apply(rule refl)
         apply(subst s4_def[symmetric])
@@ -409,53 +412,10 @@ proof(induction vs arbitrary: s)
       apply(subst Let_def)+
       apply(simp add: s7_def s6_def s5_def s4_def s3_def s2_def s1_def)
       done
-
-fun cons_list_IMP_Minus_state_transformer where 
-  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
-  "cons_list_IMP_Minus_state_transformer p (a # as) vs = (if as = [] then
-    state_transformer p [(''cons_list'', a)]
-    else
-      state_transformer p [(''cons_list'', cons_list (a # as))]
-      \<circ> cons_IMP_Minus_state_transformer (''b'' @ p) 0 0
-    )
-    \<circ> state_transformer (''a'' @ p) (map (\<lambda>v. (v, 0)) vs)"
-
-lemma cons_list_IMP_Minus_correct[intro]:
-    "(cons_list_IMP_Minus vs p, s) 
-      \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs)\<^esup>
-      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs) vs s"
-proof(induction vs arbitrary: s)
-  case (Cons v vs)
-  then show ?case
-  proof (cases vs)
-    case Nil
-    then show ?thesis
-      by (auto 
-          simp: state_transformer_commutes'
-          intro!: terminates_in_time_state_intro[OF Seq'])
-  next
-    case (Cons b bs)
-    thus ?thesis
-      apply auto
-      subgoal
-        apply(rule terminates_in_time_state_intro[OF Seq'])
-        apply(rule Seq')+
-                 apply fastforce+
-        using Cons local.Cons
-      apply(auto)
-      using state_transformer_same_prefix_equal_commutes 
-      using local.Cons apply fastforce
-      apply(rule cons_IMP_Minus_correct)
-      by(fastforce intro!: Cons.IH[OF _ *] cons_IMP_Minus_correct)+
   qed
-qed auto
+qed simp
 
-declare cons_list_IMP_Minus.simps [simp del]
-declare cons_list_IMP_Minus_time.simps [simp del]
 
-(*"reverse_nat_acc acc e  n f =
-  (if n = 0 then acc 
-   else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"*)
 
 definition reverse_nat_acc_IMP_Minus_iteration where "reverse_nat_acc_IMP_Minus_iteration \<equiv>
   ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;

From 93f57b835d0cec8a371fba8575412ca43f56335e Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 24 Oct 2021 04:10:18 +0200
Subject: [PATCH 080/103] proved c1

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 67 +++++++++++++++++++++++++++++++-
 1 file changed, 65 insertions(+), 2 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index bc876c9e..5fffb12b 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -348,10 +348,73 @@ proof(induction vs arbitrary: s)
     define s7 where "s7 =
       s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
 
-    have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
-        sorry
       have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))"
         sorry
+    have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
+      using ConsV(2)
+    proof(induct vs)
+      case Nil
+      then show ?case by simp
+    next
+      case (Cons b' bs')
+      then have x1: "v \<noteq> b'" by simp
+      have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (arg v) = s (arg v)"
+        using Cons by simp
+      show ?case
+        apply(subst List.list.map(2))
+        apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
+        apply(cases bs')
+        subgoal
+          apply(auto simp: arg_def x1)
+          done
+      proof -
+        fix c cs
+        assume ConsC: "bs' = c#cs"
+        then have "(if map (\<lambda>i. s (arg i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (arg b'))]
+        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s0;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7))
+        s (arg v) =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7) (arg v)
+" by simp
+        also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7 (arg v))
+" 
+          by metis
+        also have "\<dots> = s (arg v)" using ih  by (auto simp: arg_def x1)
+
+        finally show "(if map (\<lambda>i. s (arg i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (arg b'))]
+        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s0;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7))
+        s (arg v) =
+       s (arg v)" by simp
+      qed
+    qed
+
+    then have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
+      by (auto simp: s3_def s2_def s1_def arg_def)
 
     show ?thesis
       apply(subst arg_def[symmetric])+

From 70912f14483198bc93e380b7a094bec86cffa91f Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Sun, 24 Oct 2021 05:06:34 +0200
Subject: [PATCH 081/103] proved c2

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 153 ++++++++++++++++++++++++++++++-
 1 file changed, 151 insertions(+), 2 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 5fffb12b..f31b394f 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -348,8 +348,9 @@ proof(induction vs arbitrary: s)
     define s7 where "s7 =
       s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
 
-      have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))"
-        sorry
+(*
+    have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s (arg b) = (s (arg b))" sorry
+*)
     have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
       using ConsV(2)
     proof(induct vs)
@@ -416,6 +417,154 @@ proof(induction vs arbitrary: s)
     then have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
       by (auto simp: s3_def s2_def s1_def arg_def)
 
+    have c2a: "(s3 (add_prefix (''b'' @ p) ''b''))
+       = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs
+          s (add_prefix p ''cons_list'')"
+      using s1_def s2_def s3_def by simp
+
+    have c2b: "(vs = [] \<Longrightarrow> s (add_prefix p ''cons_list'') = 0) \<Longrightarrow>
+      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs
+          s (add_prefix p ''cons_list'') =
+ (cons_list (map (\<lambda>i. s (arg i)) vs))"
+    proof(induct vs rule: cons_list_IMP_Minus.induct)
+      case 1
+      then show ?case by simp
+    next
+      case (2 b bs)
+      then show ?case
+      proof(cases bs)
+        case Nil
+        then show ?thesis by auto
+      next
+        case (Cons c cs)
+        then have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s (add_prefix p ''cons_list'') = cons_list (map (\<lambda>i. s (arg i)) bs)"
+          using 2 by simp
+        show ?thesis
+          apply(subst List.list.map(2))
+          apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
+          apply(subst Cons)
+          apply(subst List.list.map(2))
+          apply(subst List.list.simps(3))
+          apply(subst HOL.if_False)
+        proof -
+          (*same as vs version*)
+          have "distinct (b # bs)" using ConsV(2) ConsB by simp
+          then have c2_0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s (arg b)
+      = s (arg b)"
+          proof(induct bs)
+            case Nil
+            then show ?case by simp
+          next
+            case (Cons c' cs')
+            then have x1: "b \<noteq> c'" by simp
+            have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s (arg b) = s (arg b)"
+              using Cons by simp
+            show ?case
+              apply(subst List.list.map(2))
+              apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
+              apply(cases cs')
+              subgoal
+                apply(auto simp: arg_def x1)
+                done
+            proof -
+              fix d ds
+              assume ConsC: "cs' = d#ds"
+              then have "(if map (\<lambda>i. s (arg i)) cs' = [] then state_transformer (''a'' @ p) [(c', 0)] \<circ> state_transformer p [(''cons_list'', s (arg c'))]
+        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s0;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7))
+        s (arg b) =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7) (arg b)
+" by simp
+              also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7 (arg b))
+" 
+                by metis
+              also have "\<dots> = s (arg b)" using ih by (auto simp: arg_def x1)
+
+              finally show "(if map (\<lambda>i. s (arg i)) cs' = [] then state_transformer (''a'' @ p) [(c', 0)] \<circ> state_transformer p [(''cons_list'', s (arg c'))]
+        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s0;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7))
+        s (arg b) =
+       s (arg b)" by simp
+            qed
+          qed
+
+          have "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
+         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4); s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+         s7 = s6(add_prefix (''a'' @ p) b := aval (aexp_add_prefix p (A (N 0))) s6)
+     in s7)
+     (add_prefix p ''cons_list'') =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
+         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4); s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+         s7 = s6(add_prefix (''a'' @ p) b := aval (aexp_add_prefix p (A (N 0))) s6)
+     in s7 (add_prefix p ''cons_list''))
+     " by metis
+          also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
+     in (s1 (add_prefix (''a'' @ p) b))
+              ##  (s1 (add_prefix p ''cons_list''))
+)
+" by simp
+          also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
+     in (s (arg b))
+              ##  (cons_list (map (\<lambda>i. s (arg i)) bs))
+)
+" using ih arg_def c2_0 by simp
+
+          also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
+     in  (cons_list ((s (arg b)) # map (\<lambda>i. s (arg i)) bs))
+)
+" using Cons by simp
+
+          also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
+     in  (cons_list (map (\<lambda>i. s (arg i)) (b#bs) ))
+)
+" using Cons by simp
+          finally show "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
+         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4); s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+         s7 = s6(add_prefix (''a'' @ p) b := aval (aexp_add_prefix p (A (N 0))) s6)
+     in s7)
+     (add_prefix p ''cons_list'') =
+    cons_list (map (\<lambda>i. s (arg i)) (b # bs))" by simp
+
+        qed
+      qed
+    qed
+
+    have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))"
+      using c2a c2b ConsB by auto
+
     show ?thesis
       apply(subst arg_def[symmetric])+
 

From 779a5a764364ca7f2f474b51b5ffb6761347d16f Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 10:06:23 +0200
Subject: [PATCH 082/103] marginally shortened c2 proof

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 35 +++++---------------------------
 1 file changed, 5 insertions(+), 30 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index f31b394f..0a57087c 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -310,8 +310,8 @@ fun cons_list_IMP_Minus_state_transformer where
 "
 
 lemma cons_list_IMP_Minus_correct[intro]:
-assumes "distinct vs"
-shows
+  assumes "distinct vs"
+  shows
     "(cons_list_IMP_Minus vs p, s) 
       \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs)\<^esup>
       cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs) vs s"
@@ -348,9 +348,6 @@ proof(induction vs arbitrary: s)
     define s7 where "s7 =
       s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
 
-(*
-    have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s (arg b) = (s (arg b))" sorry
-*)
     have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
       using ConsV(2)
     proof(induct vs)
@@ -526,29 +523,11 @@ proof(induction vs arbitrary: s)
      in s7 (add_prefix p ''cons_list''))
      " by metis
           also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
-     in (s1 (add_prefix (''a'' @ p) b))
-              ##  (s1 (add_prefix p ''cons_list''))
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s
+     in  (cons_list (map (\<lambda>i. s (arg i)) (b'#bs') ))
 )
-" by simp
-          also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
-     in (s (arg b))
-              ##  (cons_list (map (\<lambda>i. s (arg i)) bs))
-)
-" using ih arg_def c2_0 by simp
-
-          also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
-     in  (cons_list ((s (arg b)) # map (\<lambda>i. s (arg i)) bs))
-)
-" using Cons by simp
+" using Cons ih arg_def c2_0 by simp
 
-          also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s
-     in  (cons_list (map (\<lambda>i. s (arg i)) (b#bs) ))
-)
-" using Cons by simp
           finally show "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
          s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
@@ -591,14 +570,10 @@ proof(induction vs arbitrary: s)
            apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
             apply simp  apply(rule refl)
           apply(subst s2_def[symmetric])
-
           apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
            apply simp apply (rule refl)
          apply(subst s3_def[symmetric])
-
          apply(rule terminates_in_time_state_intro[OF cons_IMP_Minus_correct])
-          apply simp
-
           apply(subst c1[symmetric]) apply(subst c2[symmetric]) apply simp
          apply(rule refl)
         apply(subst s4_def[symmetric])

From e41606234844d5f4b858729e4c7e3876cb20eabf Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 10:07:32 +0200
Subject: [PATCH 083/103] corrected overridden local variable name and
 corresponding proof steps

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 57 ++++++++++++++++++--------------
 1 file changed, 32 insertions(+), 25 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 0a57087c..726f95c6 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -423,18 +423,19 @@ proof(induction vs arbitrary: s)
       cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs
           s (add_prefix p ''cons_list'') =
  (cons_list (map (\<lambda>i. s (arg i)) vs))"
+      using ConsV(2)
     proof(induct vs rule: cons_list_IMP_Minus.induct)
       case 1
       then show ?case by simp
     next
-      case (2 b bs)
+      case (2 b' bs')
       then show ?case
-      proof(cases bs)
+      proof(cases bs')
         case Nil
         then show ?thesis by auto
       next
         case (Cons c cs)
-        then have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s (add_prefix p ''cons_list'') = cons_list (map (\<lambda>i. s (arg i)) bs)"
+        then have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (add_prefix p ''cons_list'') = cons_list (map (\<lambda>i. s (arg i)) bs')"
           using 2 by simp
         show ?thesis
           apply(subst List.list.map(2))
@@ -445,16 +446,16 @@ proof(induction vs arbitrary: s)
           apply(subst HOL.if_False)
         proof -
           (*same as vs version*)
-          have "distinct (b # bs)" using ConsV(2) ConsB by simp
-          then have c2_0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s (arg b)
-      = s (arg b)"
-          proof(induct bs)
+          have "distinct (b' # bs')" using 2(3) by simp
+          then have c2_0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (arg b')
+      = s (arg b')"
+          proof(induct bs')
             case Nil
             then show ?case by simp
           next
             case (Cons c' cs')
-            then have x1: "b \<noteq> c'" by simp
-            have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s (arg b) = s (arg b)"
+            then have x1: "b' \<noteq> c'" by simp
+            have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s (arg b') = s (arg b')"
               using Cons by simp
             show ?case
               apply(subst List.list.map(2))
@@ -474,14 +475,14 @@ proof(induction vs arbitrary: s)
                         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
                         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
                     in s7))
-        s (arg b) =
+        s (arg b') =
 (let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s;
                         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
                         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
                         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
                         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
                         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7) (arg b)
+                    in s7) (arg b')
 " by simp
               also have "\<dots> =
 (let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s;
@@ -490,10 +491,10 @@ proof(induction vs arbitrary: s)
                         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
                         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
                         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7 (arg b))
+                    in s7 (arg b'))
 " 
                 by metis
-              also have "\<dots> = s (arg b)" using ih by (auto simp: arg_def x1)
+              also have "\<dots> = s (arg b')" using ih by (auto simp: arg_def x1)
 
               finally show "(if map (\<lambda>i. s (arg i)) cs' = [] then state_transformer (''a'' @ p) [(c', 0)] \<circ> state_transformer p [(''cons_list'', s (arg c'))]
         else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s0;
@@ -503,23 +504,27 @@ proof(induction vs arbitrary: s)
                         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
                         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
                     in s7))
-        s (arg b) =
-       s (arg b)" by simp
+        s (arg b') =
+       s (arg b')" by simp
             qed
           qed
 
-          have "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
+          have "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
+         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
          s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4); s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = s6(add_prefix (''a'' @ p) b := aval (aexp_add_prefix p (A (N 0))) s6)
+         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+          s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+         s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
      in s7)
      (add_prefix p ''cons_list'') =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
+         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
          s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4); s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = s6(add_prefix (''a'' @ p) b := aval (aexp_add_prefix p (A (N 0))) s6)
+         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+         s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
      in s7 (add_prefix p ''cons_list''))
      " by metis
           also have "\<dots> =
@@ -528,14 +533,16 @@ proof(induction vs arbitrary: s)
 )
 " using Cons ih arg_def c2_0 by simp
 
-          finally show "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs) bs s; s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b))) s1);
+          finally show "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
+         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
          s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4); s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = s6(add_prefix (''a'' @ p) b := aval (aexp_add_prefix p (A (N 0))) s6)
+         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+         s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
      in s7)
      (add_prefix p ''cons_list'') =
-    cons_list (map (\<lambda>i. s (arg i)) (b # bs))" by simp
+    cons_list (map (\<lambda>i. s (arg i)) (b' # bs'))" by simp
 
         qed
       qed

From 174464855c9f63ddbbfcd6ec669c3a9c0e86e02b Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 10:08:33 +0200
Subject: [PATCH 084/103] re-added formerly working proof before sorry

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 726f95c6..7aa82d82 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -322,6 +322,9 @@ proof(induction vs arbitrary: s)
   proof (cases vs)
     case Nil
     then show ?thesis
+      apply(auto
+          simp: state_transformer_commutes'
+          intro!: terminates_in_time_state_intro[OF Seq'])
       sorry
   next
     case ConsB: (Cons b bs)

From 2833d47f8d9739f17f726c47dc9d106093a8bc0d Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 10:24:35 +0200
Subject: [PATCH 085/103] factored out duplicate auxiliary proof

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 192 ++++++++++++-------------------
 1 file changed, 71 insertions(+), 121 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 7aa82d82..9e397604 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -309,6 +309,75 @@ fun cons_list_IMP_Minus_state_transformer where
   )
 "
 
+lemma aux:
+  assumes arg_def: "ar = add_prefix (''a'' @ p)"
+  assumes dist: "distinct (v#vs)"
+  shows "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) vs) vs s (ar v) = s (ar v)"
+  using dist
+proof(induct vs)
+  case Nil
+  then show ?case by simp
+next
+  case (Cons b' bs')
+  then have x1: "v \<noteq> b'" by simp
+  have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s (ar v) = s (ar v)"
+    using Cons by simp
+  show ?case
+    apply(subst List.list.map(2))
+    apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
+    apply(cases bs')
+    subgoal
+      apply(auto simp: arg_def x1)
+      done
+  proof -
+    fix c cs
+    assume ConsC: "bs' = c#cs"
+    then have "(if map (\<lambda>i. s (ar i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (ar b'))]
+        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s0;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7))
+        s (ar v) =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7) (ar v)
+" by simp
+    also have "\<dots> =
+(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7 (ar v))
+" 
+      by metis
+    also have "\<dots> = s (ar v)" using ih  by (auto simp: arg_def x1)
+
+    finally show "(if map (\<lambda>i. s (ar i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (ar b'))]
+        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s0;
+                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
+                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
+                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
+                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
+                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+                    in s7))
+        s (ar v) =
+       s (ar v)" by simp
+  qed
+qed
+
+
 lemma cons_list_IMP_Minus_correct[intro]:
   assumes "distinct vs"
   shows
@@ -352,67 +421,7 @@ proof(induction vs arbitrary: s)
       s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
 
     have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
-      using ConsV(2)
-    proof(induct vs)
-      case Nil
-      then show ?case by simp
-    next
-      case (Cons b' bs')
-      then have x1: "v \<noteq> b'" by simp
-      have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (arg v) = s (arg v)"
-        using Cons by simp
-      show ?case
-        apply(subst List.list.map(2))
-        apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
-        apply(cases bs')
-        subgoal
-          apply(auto simp: arg_def x1)
-          done
-      proof -
-        fix c cs
-        assume ConsC: "bs' = c#cs"
-        then have "(if map (\<lambda>i. s (arg i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (arg b'))]
-        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s0;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7))
-        s (arg v) =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7) (arg v)
-" by simp
-        also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7 (arg v))
-" 
-          by metis
-        also have "\<dots> = s (arg v)" using ih  by (auto simp: arg_def x1)
-
-        finally show "(if map (\<lambda>i. s (arg i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (arg b'))]
-        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s0;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7))
-        s (arg v) =
-       s (arg v)" by simp
-      qed
-    qed
+      using aux arg_def ConsV(2) by simp
 
     then have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
       by (auto simp: s3_def s2_def s1_def arg_def)
@@ -448,69 +457,10 @@ proof(induction vs arbitrary: s)
           apply(subst List.list.simps(3))
           apply(subst HOL.if_False)
         proof -
-          (*same as vs version*)
           have "distinct (b' # bs')" using 2(3) by simp
           then have c2_0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (arg b')
       = s (arg b')"
-          proof(induct bs')
-            case Nil
-            then show ?case by simp
-          next
-            case (Cons c' cs')
-            then have x1: "b' \<noteq> c'" by simp
-            have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s (arg b') = s (arg b')"
-              using Cons by simp
-            show ?case
-              apply(subst List.list.map(2))
-              apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
-              apply(cases cs')
-              subgoal
-                apply(auto simp: arg_def x1)
-                done
-            proof -
-              fix d ds
-              assume ConsC: "cs' = d#ds"
-              then have "(if map (\<lambda>i. s (arg i)) cs' = [] then state_transformer (''a'' @ p) [(c', 0)] \<circ> state_transformer p [(''cons_list'', s (arg c'))]
-        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s0;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7))
-        s (arg b') =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7) (arg b')
-" by simp
-              also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7 (arg b'))
-" 
-                by metis
-              also have "\<dots> = s (arg b')" using ih by (auto simp: arg_def x1)
-
-              finally show "(if map (\<lambda>i. s (arg i)) cs' = [] then state_transformer (''a'' @ p) [(c', 0)] \<circ> state_transformer p [(''cons_list'', s (arg c'))]
-        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) cs') cs' s0;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V c'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) c' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7))
-        s (arg b') =
-       s (arg b')" by simp
-            qed
-          qed
+            using aux arg_def ConsV(2) by simp
 
           have "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
          s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);

From a45cd88652956c97f92a8e5f0709c79515c8e664 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 11:39:05 +0200
Subject: [PATCH 086/103] improved readability of the
 cons_list_IMP_Minus_state_transformer and reduced proof length (esp. aux)

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 171 +++++++++++++++++--------------
 1 file changed, 94 insertions(+), 77 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 9e397604..44130231 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -289,6 +289,40 @@ fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
    then 4
    else cons_list_IMP_Minus_time as + 2 + 2 + cons_IMP_Minus_time a (cons_list as)) + 2 + 2 + 2"
 
+(*
+fun cons_list_IMP_Minus_state_transformer where 
+  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
+  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
+    state_transformer p [(''cons_list'', a)]
+    else
+      state_transformer p [(''cons_list'', cons_list (a # as))]
+      \<circ> cons_IMP_Minus_state_transformer (''b'' @ p) a (cons_list as)
+    )
+    \<circ> state_transformer (''a'' @ p) [(v, 0)]"
+*)
+(*
+fun cons_list_IMP_Minus_state_transformer where 
+  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
+  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
+    state_transformer (''a'' @ p) [(v, 0)]
+  \<circ> state_transformer p [(''cons_list'', a)]
+    else
+      let cons_list_s = cons_list_IMP_Minus_state_transformer p as vs ;
+          b_a_assign = state_transformer (''b'' @ p) [(''a'', a)] ;
+          b_b_assign = state_transformer (''b'' @ p) [(''b'', cons_list as)];
+          cons_sub = cons_IMP_Minus_state_transformer (''b'' @ p) a (cons_list as) ;
+          cons_list_assign = state_transformer p [(''cons_list'', cons a (cons_list as) )];
+          b_cons_assign = state_transformer (''b'' @ p) [(''cons'',0)] ;
+          a_a_assign = state_transformer (''a'' @ p) [(v, 0)]
+  in a_a_assign \<circ> b_cons_assign
+    \<circ> cons_list_assign
+    \<circ> cons_sub
+    \<circ> b_b_assign
+    \<circ> b_a_assign
+    \<circ> cons_list_s
+  )
+"
+*)
 fun cons_list_IMP_Minus_state_transformer where 
   "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
   "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
@@ -297,85 +331,68 @@ fun cons_list_IMP_Minus_state_transformer where
     else
   (\<lambda> s0 .
       let s1 = cons_list_IMP_Minus_state_transformer p as vs s0;
-          s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V v))) s1);
-          s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-          s4 = cons_IMP_Minus_state_transformer (''b'' @ p)
-                (s3 (add_prefix (''b'' @ p) ''a''))
-                (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-          s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-          s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-          s7 = s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)
+          s2 = state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) v))] s1;
+          s3 = state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2;
+          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+          s5 = state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4;
+          s6 = state_transformer (''b'' @ p) [(''cons'', 0)] s5;
+          s7 = state_transformer (''a'' @ p) [(v, 0)] s6
   in s7 )
   )
 "
 
+(*
+fun cons_list_IMP_Minus_state_transformer where 
+  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
+  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
+    state_transformer p [(''cons_list'', a)]
+    else
+      let cons_list_rec = cons_list_IMP_Minus_state_transformer p as vs ;
+          b_a_var = a ;
+          s2 = state_transformer (''b'' @ p) [(''a'', b_a_var)] ;
+          b_b_var = cons_list_rec ;
+          cons_var = cons a cons_list_rec ;
+          cons_list_var = cons_var ;
+          cons_var = 0 ;
+          a_a_var = 0
+  in
+    state_transformer (''b'' @ p) [(''a'', b_a_var)]  
+    o
+    cons_list_rec
+  )
+"
+*)
+(*
+      state_transformer p [(''cons_list'', cons_list (a # as))]
+      \<circ> cons_IMP_Minus_state_transformer (''b'' @ p) a (cons_list as)
+    )
+    \<circ> state_transformer (''a'' @ p) [(v, 0)]"
+*)
+
+lemma auxxx: "(let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
+                s5 = t5 s4; s6 = t6 s5; s7 = t7 s6 in s7) a
+ =
+(let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
+                s5 = t5 s4; s6 = t6 s5; s7 = t7 s6 in s7 a)" by simp
+
 lemma aux:
   assumes arg_def: "ar = add_prefix (''a'' @ p)"
   assumes dist: "distinct (v#vs)"
   shows "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) vs) vs s (ar v) = s (ar v)"
   using dist
 proof(induct vs)
-  case Nil
-  then show ?case by simp
-next
   case (Cons b' bs')
-  then have x1: "v \<noteq> b'" by simp
-  have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s (ar v) = s (ar v)"
-    using Cons by simp
-  show ?case
-    apply(subst List.list.map(2))
-    apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
-    apply(cases bs')
-    subgoal
-      apply(auto simp: arg_def x1)
-      done
-  proof -
-    fix c cs
-    assume ConsC: "bs' = c#cs"
-    then have "(if map (\<lambda>i. s (ar i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (ar b'))]
-        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s0;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7))
-        s (ar v) =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5); s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7) (ar v)
-" by simp
-    also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7 (ar v))
-" 
-      by metis
-    also have "\<dots> = s (ar v)" using ih  by (auto simp: arg_def x1)
-
-    finally show "(if map (\<lambda>i. s (ar i)) bs' = [] then state_transformer (''a'' @ p) [(b', 0)] \<circ> state_transformer p [(''cons_list'', s (ar b'))]
-        else (\<lambda>s0. let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s0;
-                        s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-                        s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-                        s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-                        s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-                        s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-                        s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
-                    in s7))
-        s (ar v) =
-       s (ar v)" by simp
-  qed
-qed
+  then have "v \<noteq> b'" by simp
+  then show ?case
+    using Cons
+      auxxx[of "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s"
+        "\<lambda> s1. state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) b'))] s1"
+        "\<lambda> s2. state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2"
+        "\<lambda> s3. cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3"
+        "\<lambda> s4. state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4"
+        "state_transformer (''b'' @ p) [(''cons'', 0)]" "state_transformer (''a'' @ p) [(b', 0)]" "ar v"] 
+    by (auto simp: arg_def)
+qed simp
 
 
 lemma cons_list_IMP_Minus_correct[intro]:
@@ -418,7 +435,7 @@ proof(induction vs arbitrary: s)
     define s6 where "s6 =
       s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5)"
     define s7 where "s7 =
-      s6(add_prefix (''a'' @ p) v := aval (aexp_add_prefix p (A (N 0))) s6)"
+      state_transformer (''a'' @ p) [(v, 0)] s6"
 
     have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
       using aux arg_def ConsV(2) by simp
@@ -468,7 +485,7 @@ proof(induction vs arbitrary: s)
          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
          s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
           s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+         s7 = state_transformer (''a'' @ p) [(b', 0)] s6
      in s7)
      (add_prefix p ''cons_list'') =
 (let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
@@ -477,7 +494,7 @@ proof(induction vs arbitrary: s)
          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
          s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
          s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+         s7 = state_transformer (''a'' @ p) [(b', 0)] s6
      in s7 (add_prefix p ''cons_list''))
      " by metis
           also have "\<dots> =
@@ -487,12 +504,12 @@ proof(induction vs arbitrary: s)
 " using Cons ih arg_def c2_0 by simp
 
           finally show "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
-         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = s6(add_prefix (''a'' @ p) b' := aval (aexp_add_prefix p (A (N 0))) s6)
+          s2 =  state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) b'))] s1;
+          s3 = state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2;
+          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
+          s5 = state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4;
+          s6 = state_transformer (''b'' @ p) [(''cons'', 0)] s5;
+         s7 = state_transformer (''a'' @ p) [(b', 0)] s6
      in s7)
      (add_prefix p ''cons_list'') =
     cons_list (map (\<lambda>i. s (arg i)) (b' # bs'))" by simp

From 5a9249434bdcde62ce4ddf8966480f150a841275 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 12:12:11 +0200
Subject: [PATCH 087/103] further shortened proof, gave meaningful name to
 aux->cons_list_state_arv

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 117 ++++++-------------------------
 1 file changed, 20 insertions(+), 97 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 44130231..be583291 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -375,7 +375,7 @@ lemma auxxx: "(let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
 (let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
                 s5 = t5 s4; s6 = t6 s5; s7 = t7 s6 in s7 a)" by simp
 
-lemma aux:
+lemma cons_list_state_arv:
   assumes arg_def: "ar = add_prefix (''a'' @ p)"
   assumes dist: "distinct (v#vs)"
   shows "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) vs) vs s (ar v) = s (ar v)"
@@ -394,7 +394,6 @@ proof(induct vs)
     by (auto simp: arg_def)
 qed simp
 
-
 lemma cons_list_IMP_Minus_correct[intro]:
   assumes "distinct vs"
   shows
@@ -416,29 +415,17 @@ proof(induction vs arbitrary: s)
     case ConsB: (Cons b bs)
     define arg where "arg \<equiv> add_prefix (''a'' @ p)"
 
-    have "b \<noteq> v" using ConsB ConsV by auto
-
-    have d: "distinct vs" using ConsV by simp
-
     define s1 where "s1 =
       cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s"
     define s2 where "s2 =
       s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V v))) s1)"
     define s3 where "s3 =
       s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2)"
-    define s4 where "s4 =
-      cons_IMP_Minus_state_transformer (''b'' @ p)
-                (s3 (add_prefix (''b'' @ p) ''a''))
-                (s3 (add_prefix (''b'' @ p) ''b'')) s3"
-    define s5 where "s5 =
-      s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4)"
-    define s6 where "s6 =
-      s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5)"
-    define s7 where "s7 =
-      state_transformer (''a'' @ p) [(v, 0)] s6"
+
+    have d: "distinct vs" using ConsV by simp
 
     have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
-      using aux arg_def ConsV(2) by simp
+      using cons_list_state_arv arg_def ConsV(2) by simp
 
     then have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
       by (auto simp: s3_def s2_def s1_def arg_def)
@@ -454,69 +441,24 @@ proof(induction vs arbitrary: s)
  (cons_list (map (\<lambda>i. s (arg i)) vs))"
       using ConsV(2)
     proof(induct vs rule: cons_list_IMP_Minus.induct)
-      case 1
-      then show ?case by simp
-    next
       case (2 b' bs')
       then show ?case
       proof(cases bs')
-        case Nil
-        then show ?thesis by auto
-      next
         case (Cons c cs)
         then have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (add_prefix p ''cons_list'') = cons_list (map (\<lambda>i. s (arg i)) bs')"
           using 2 by simp
+        have d: "distinct (b' # bs')" using 2(3) by simp
         show ?thesis
-          apply(subst List.list.map(2))
-          apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
-          apply(subst Cons)
-          apply(subst List.list.map(2))
-          apply(subst List.list.simps(3))
-          apply(subst HOL.if_False)
-        proof -
-          have "distinct (b' # bs')" using 2(3) by simp
-          then have c2_0: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (arg b')
-      = s (arg b')"
-            using aux arg_def ConsV(2) by simp
-
-          have "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
-         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-          s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = state_transformer (''a'' @ p) [(b', 0)] s6
-     in s7)
-     (add_prefix p ''cons_list'') =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
-         s2 = s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V b'))) s1);
-         s3 = s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2);
-         s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-         s5 = s4(add_prefix p ''cons_list'' := aval (aexp_add_prefix (''b'' @ p) (A (V ''cons''))) s4);
-         s6 = s5(add_prefix (''b'' @ p) ''cons'' := aval (aexp_add_prefix p (A (N 0))) s5);
-         s7 = state_transformer (''a'' @ p) [(b', 0)] s6
-     in s7 (add_prefix p ''cons_list''))
-     " by metis
-          also have "\<dots> =
-(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s
-     in  (cons_list (map (\<lambda>i. s (arg i)) (b'#bs') ))
-)
-" using Cons ih arg_def c2_0 by simp
-
-          finally show "(let s1 = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s;
-          s2 =  state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) b'))] s1;
-          s3 = state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2;
-          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-          s5 = state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4;
-          s6 = state_transformer (''b'' @ p) [(''cons'', 0)] s5;
-         s7 = state_transformer (''a'' @ p) [(b', 0)] s6
-     in s7)
-     (add_prefix p ''cons_list'') =
-    cons_list (map (\<lambda>i. s (arg i)) (b' # bs'))" by simp
-
-        qed
-      qed
-    qed
+          using cons_list_state_arv[of arg, OF _ d]
+            auxxx[of "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s"
+              "\<lambda> s1. state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) b'))] s1"
+              "\<lambda> s2. state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2"
+              "\<lambda> s3. cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3"
+              "\<lambda> s4. state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4"
+              "state_transformer (''b'' @ p) [(''cons'', 0)]" "state_transformer (''a'' @ p) [(b', 0)]"] 
+            Cons ih arg_def  by simp
+      qed simp
+    qed simp
 
     have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))"
       using c2a c2b ConsB by auto
@@ -551,30 +493,11 @@ proof(induction vs arbitrary: s)
            apply simp apply (rule refl)
          apply(subst s3_def[symmetric])
          apply(rule terminates_in_time_state_intro[OF cons_IMP_Minus_correct])
-          apply(subst c1[symmetric]) apply(subst c2[symmetric]) apply simp
-         apply(rule refl)
-        apply(subst s4_def[symmetric])
-
-        apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-         apply simp
-        apply (rule refl)
-       apply(subst s5_def[symmetric])
-
-       apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-        apply simp apply (rule refl)
-      apply(subst s6_def[symmetric])
-
-      apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-       apply simp
-      apply(subst s7_def[symmetric])
-      apply(subst List.list.map)
-      apply(subst cons_list_IMP_Minus_state_transformer.simps(2))
-      apply(subst ConsB)
-      apply(subst List.list.map)
-      apply(subst List.list.simps(3))
-      apply(subst HOL.if_False)
-      apply(subst Let_def)+
-      apply(simp add: s7_def s6_def s5_def s4_def s3_def s2_def s1_def)
+          apply(subst c1) apply(subst c2)
+
+          apply(fastforce intro!: terminates_in_time_state_intro[OF Big_StepT.Assign]
+          simp add: ConsB Let_def
+          s3_def s2_def s1_def)+
       done
   qed
 qed simp

From 660fdf84723b55f014a3279e52a390264174cca8 Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 12:27:14 +0200
Subject: [PATCH 088/103] corrected bracketing, reviving Nil-case proof
 (+marginally shortened)

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index be583291..037d7018 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -285,9 +285,9 @@ fun cons_list :: "nat list \<Rightarrow> nat" where
 fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
 "cons_list_IMP_Minus_time [] = 1" | 
 "cons_list_IMP_Minus_time (a # as) = 
-  (if as = [] 
+  (if as = []
    then 4
-   else cons_list_IMP_Minus_time as + 2 + 2 + cons_IMP_Minus_time a (cons_list as)) + 2 + 2 + 2"
+   else cons_list_IMP_Minus_time as + 2 + 2 + cons_IMP_Minus_time a (cons_list as) + 2 + 2 + 2)"
 
 (*
 fun cons_list_IMP_Minus_state_transformer where 
@@ -390,7 +390,7 @@ proof(induct vs)
         "\<lambda> s2. state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2"
         "\<lambda> s3. cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3"
         "\<lambda> s4. state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4"
-        "state_transformer (''b'' @ p) [(''cons'', 0)]" "state_transformer (''a'' @ p) [(b', 0)]" "ar v"] 
+        "state_transformer (''b'' @ p) [(''cons'', 0)]" "state_transformer (''a'' @ p) [(b', 0)]" ] 
     by (auto simp: arg_def)
 qed simp
 
@@ -407,10 +407,7 @@ proof(induction vs arbitrary: s)
   proof (cases vs)
     case Nil
     then show ?thesis
-      apply(auto
-          simp: state_transformer_commutes'
-          intro!: terminates_in_time_state_intro[OF Seq'])
-      sorry
+      by(auto intro!: terminates_in_time_state_intro[OF Seq'])
   next
     case ConsB: (Cons b bs)
     define arg where "arg \<equiv> add_prefix (''a'' @ p)"

From 5d33bdb64d818d746a0317ec9a412ae9637de90c Mon Sep 17 00:00:00 2001
From: lakiryt <lakiryt@icloud.com>
Date: Fri, 29 Oct 2021 12:50:45 +0200
Subject: [PATCH 089/103] removed commented out old/experimental
 state_transformers for cons_list

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 62 --------------------------------
 1 file changed, 62 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 037d7018..5b9ac6d4 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -289,40 +289,6 @@ fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
    then 4
    else cons_list_IMP_Minus_time as + 2 + 2 + cons_IMP_Minus_time a (cons_list as) + 2 + 2 + 2)"
 
-(*
-fun cons_list_IMP_Minus_state_transformer where 
-  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
-  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
-    state_transformer p [(''cons_list'', a)]
-    else
-      state_transformer p [(''cons_list'', cons_list (a # as))]
-      \<circ> cons_IMP_Minus_state_transformer (''b'' @ p) a (cons_list as)
-    )
-    \<circ> state_transformer (''a'' @ p) [(v, 0)]"
-*)
-(*
-fun cons_list_IMP_Minus_state_transformer where 
-  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
-  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
-    state_transformer (''a'' @ p) [(v, 0)]
-  \<circ> state_transformer p [(''cons_list'', a)]
-    else
-      let cons_list_s = cons_list_IMP_Minus_state_transformer p as vs ;
-          b_a_assign = state_transformer (''b'' @ p) [(''a'', a)] ;
-          b_b_assign = state_transformer (''b'' @ p) [(''b'', cons_list as)];
-          cons_sub = cons_IMP_Minus_state_transformer (''b'' @ p) a (cons_list as) ;
-          cons_list_assign = state_transformer p [(''cons_list'', cons a (cons_list as) )];
-          b_cons_assign = state_transformer (''b'' @ p) [(''cons'',0)] ;
-          a_a_assign = state_transformer (''a'' @ p) [(v, 0)]
-  in a_a_assign \<circ> b_cons_assign
-    \<circ> cons_list_assign
-    \<circ> cons_sub
-    \<circ> b_b_assign
-    \<circ> b_a_assign
-    \<circ> cons_list_s
-  )
-"
-*)
 fun cons_list_IMP_Minus_state_transformer where 
   "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
   "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
@@ -341,34 +307,6 @@ fun cons_list_IMP_Minus_state_transformer where
   )
 "
 
-(*
-fun cons_list_IMP_Minus_state_transformer where 
-  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
-  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
-    state_transformer p [(''cons_list'', a)]
-    else
-      let cons_list_rec = cons_list_IMP_Minus_state_transformer p as vs ;
-          b_a_var = a ;
-          s2 = state_transformer (''b'' @ p) [(''a'', b_a_var)] ;
-          b_b_var = cons_list_rec ;
-          cons_var = cons a cons_list_rec ;
-          cons_list_var = cons_var ;
-          cons_var = 0 ;
-          a_a_var = 0
-  in
-    state_transformer (''b'' @ p) [(''a'', b_a_var)]  
-    o
-    cons_list_rec
-  )
-"
-*)
-(*
-      state_transformer p [(''cons_list'', cons_list (a # as))]
-      \<circ> cons_IMP_Minus_state_transformer (''b'' @ p) a (cons_list as)
-    )
-    \<circ> state_transformer (''a'' @ p) [(v, 0)]"
-*)
-
 lemma auxxx: "(let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
                 s5 = t5 s4; s6 = t6 s5; s7 = t7 s6 in s7) a
  =

From e741b37a10ee4112e1b26013aafe96f101fdb6bd Mon Sep 17 00:00:00 2001
From: BilelGho <ghorbelbilel@gmail.com>
Date: Wed, 8 Dec 2021 22:21:19 +0100
Subject: [PATCH 090/103] working on first function in binary arithmetic theory

stuck on final state proof.
---
 #Untitled-1#                                  |   0
 #Untitled-2#                                  |   1 +
 .../IMP-_To_IMP--/Binary_Arithmetic_IMP.thy   | 205 +++++++++++++++++
 Cook_Levin/ROOT                               |   4 +-
 Cook_Levin/ROOT.save                          |  17 ++
 IMP-/#Big_StepT.thy#                          | 211 ++++++++++++++++++
 IMP-/IMP_Minus_Nat_Bijection.thy              |  85 +++++++
 IMP-/Multiplication.thy                       |  59 ++++-
 Lib/ROOT~                                     |  16 ++
 ROOT                                          |   5 +-
 ROOTS                                         |   3 +-
 ROOTS~                                        |   6 +
 12 files changed, 604 insertions(+), 8 deletions(-)
 create mode 100644 #Untitled-1#
 create mode 100644 #Untitled-2#
 create mode 100644 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
 create mode 100644 Cook_Levin/ROOT.save
 create mode 100644 IMP-/#Big_StepT.thy#
 create mode 100644 Lib/ROOT~
 create mode 100644 ROOTS~

diff --git a/#Untitled-1# b/#Untitled-1#
new file mode 100644
index 00000000..e69de29b
diff --git a/#Untitled-2# b/#Untitled-2#
new file mode 100644
index 00000000..bad7c65c
--- /dev/null
+++ b/#Untitled-2#
@@ -0,0 +1 @@
+xckdxcddsc*s
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
new file mode 100644
index 00000000..e7e147c1
--- /dev/null
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
@@ -0,0 +1,205 @@
+theory Binary_Arithmetic_IMP 
+  imports "../../../IMP-/IMP_Minus_Nat_Bijection"  Binary_Arithmetic_Nat
+begin
+
+unbundle IMP_Minus_Minus_Com.no_com_syntax
+unbundle Com.no_com_syntax
+
+fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_bit_of_num_nat x n  = (if x = 0 then (if n = 0 then 1 else 0) else
+                            if n = 0 then (if hd_nat x = 0 then 0 else 1) else
+                            nth_bit_of_num_nat (tl_nat x) (n-1)) "
+
+definition nth_bit_of_num_if ::pcom where "nth_bit_of_num_if \<equiv>
+ IF ''x''\<noteq>0 THEN 
+        (IF ''n''\<noteq>0 THEN ''b''::= A (N 1) ELSE ''b''::= A (N 0)) 
+        ELSE ''b''::= A (N 0) 
+"
+
+abbreviation nth_bit_of_num_if_state_transformer 
+  where "nth_bit_of_num_if_state_transformer p x n \<equiv>
+    state_transformer p [(''b'',if x >0 \<and> n>0 then 1 else 0)]
+"
+
+fun nth_bit_of_num_if_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_bit_of_num_if_time 0 _ = 3"|
+"nth_bit_of_num_if_time _ _ = 4"
+
+lemma nth_bit_of_num_if_correct[intro]:
+"\<lbrakk> s (add_prefix p ''x'')= x ; s (add_prefix p ''n'') = n  \<rbrakk> \<Longrightarrow>
+(nth_bit_of_num_if p, s) \<Rightarrow>\<^bsup>nth_bit_of_num_if_time x n \<^esup>
+nth_bit_of_num_if_state_transformer p x n s "
+  unfolding nth_bit_of_num_if_def 
+  apply (cases x;cases n)
+     apply (rule Big_StepT.IfFalse)
+       apply simp
+      apply (rule terminates_in_time_state_intro)
+        apply blast
+       apply simp
+      apply simp
+     apply simp
+ apply (rule Big_StepT.IfFalse)
+       apply simp
+      apply (rule terminates_in_time_state_intro)
+        apply blast
+       apply simp
+      apply simp
+    apply simp
+   apply (rule Big_StepT.IfTrue)
+     apply simp
+    apply (rule Big_StepT.IfFalse)
+      apply simp
+        apply (rule terminates_in_time_state_intro)
+       apply fast
+      apply fast
+     apply force
+    apply simp
+   apply simp
+      apply (rule Big_StepT.IfTrue)
+    apply simp
+            apply (rule Big_StepT.IfTrue)
+     apply simp
+              apply (rule terminates_in_time_state_intro)
+  apply blast
+     apply simp
+    apply simp
+  apply simp
+  by simp
+  
+definition nth_bit_of_num_iteration::pcom  where "nth_bit_of_num_iteration \<equiv>
+
+  [''tl''] ''xs'' ::=  (A ( V ''x'')) ;;
+   invoke_subprogram ''tl'' tl_IMP;;
+   ''x'' ::= [''tl''] (A (V ''ans''));;
+   ''n'' ::= (V ''n'' \<ominus> N 1 );; 
+    nth_bit_of_num_if
+"
+
+definition nth_bit_of_num_iteration_t :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_bit_of_num_iteration_t x n = 6 + tl_time x + nth_bit_of_num_if_time (tl_nat x) (n-1)"
+
+abbreviation nth_bit_of_num_iteration_state_transformer 
+  where "nth_bit_of_num_iteration_state_transformer p x n \<equiv>
+    state_transformer p [(''x'', tl_nat x),(''n'',n-1)] o tl_state_transformer (''tl'' @ p) x
+  o nth_bit_of_num_if_state_transformer p (tl_nat x) (n-1)
+"
+value "nth_bit_of_num_iteration_state_transformer"
+lemma nth_bit_of_num_iteration_correct[intro]:
+ " s (add_prefix p ''x'') = x \<Longrightarrow> s (add_prefix p ''n'') = n \<Longrightarrow>
+(nth_bit_of_num_iteration p,s)  \<Rightarrow>\<^bsup>nth_bit_of_num_iteration_t x n \<^esup> 
+nth_bit_of_num_iteration_state_transformer p x n s"
+  unfolding nth_bit_of_num_iteration_def nth_bit_of_num_iteration_t_def
+  apply (rule terminates_in_time_state_intro)
+    apply (rule Big_StepT.Seq)+
+  by fastforce+
+
+
+definition nth_bit_of_num_loop :: "pcom" where 
+"nth_bit_of_num_loop \<equiv> WHILE ''b''\<noteq>0 DO nth_bit_of_num_iteration"
+
+fun nth_bit_of_num_loop_t:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
+"nth_bit_of_num_loop_t 0 _ _  = 2 "|
+"nth_bit_of_num_loop_t (Suc b) x n  = (let x' = tl_nat x; 
+n' = n - 1 
+in ( if x'>0 \<and> n'>0 then 1 + nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t (Suc 0) x' n'
+else 1 + nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t 0 x' n'
+) ) "
+
+fun nth_bit_of_num_loop_state_transformer ::
+"char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where 
+"nth_bit_of_num_loop_state_transformer p 0 x n = id "|
+"nth_bit_of_num_loop_state_transformer p (Suc b) x n = (let x' = tl_nat x; n' = n-1;
+iteration = nth_bit_of_num_iteration_state_transformer p x n  in 
+(if x'>0 \<and> n'>0 then iteration o nth_bit_of_num_loop_state_transformer p (Suc 0) x' n' else
+iteration
+o nth_bit_of_num_loop_state_transformer p 0 x' n'
+ ))"
+
+lemma " (nth_bit_of_num_iteration_state_transformer p x n
+         o nth_bit_of_num_loop_state_transformer p (Suc 0) (tl_nat x) (n-1)) s = 
+      (nth_bit_of_num_loop_state_transformer p (Suc 0) (tl_nat x) (n-1)) s"
+  apply (induction p "Suc 0" "tl_nat x" "n-1" arbitrary: x n s rule:nth_bit_of_num_loop_state_transformer.induct)
+  apply auto
+fun nth_bit_of_num_loop_state_transformer' ::
+"char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where 
+"nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
+"nth_bit_of_num_loop_state_transformer' p b x n = (let x' = tl_nat x; n' = n-1;
+b' = (if x'>0 \<and> n'>0 then Suc 0 else 0); iteration = nth_bit_of_num_iteration_state_transformer p x n
+ in 
+ iteration o nth_bit_of_num_loop_state_transformer' p b' x' n')"
+
+
+thm Big_StepT.WhileTrue
+
+  
+  
+
+lemma 
+"\<lbrakk>s (add_prefix p ''x'') = x ; s (add_prefix p ''n'') = n ; s (add_prefix p ''b'') = b \<rbrakk>
+\<Longrightarrow> (nth_bit_of_num_loop p,s) \<Rightarrow>\<^bsup>nth_bit_of_num_loop_t b x n \<^esup>
+      nth_bit_of_num_loop_state_transformer p b x n s"
+  unfolding nth_bit_of_num_loop_def 
+  apply(induction b x n arbitrary:s rule: nth_bit_of_num_loop_t.induct)
+  apply(rule terminates_in_time_state_intro)
+     apply (rule Big_StepT.WhileFalse)
+     apply simp
+  apply simp
+   apply simp
+      apply(rule terminates_in_time_state_intro)
+    apply (rule Big_StepT.WhileTrue)
+       apply linarith
+      apply auto[1]
+     apply (split if_splits) apply (auto simp only:)
+  oops 
+
+lemma
+"(nth_bit_of_num_loop p,s) \<Rightarrow>\<^bsup>nth_bit_of_num_loop_t (s (add_prefix p ''b''))
+ (s (add_prefix p ''x''))
+ (s (add_prefix p ''n'')) \<^esup>
+      nth_bit_of_num_loop_state_transformer p (s (add_prefix p ''b'')) (s (add_prefix p ''x''))
+  (s (add_prefix p ''n'')) s"
+  unfolding nth_bit_of_num_loop_def 
+proof(induction "(s (add_prefix p ''b''))" "s (add_prefix p ''x'')" "s (add_prefix p ''n'')" arbitrary:s rule: nth_bit_of_num_loop_t.induct)
+case (1)
+  show ?case 
+  apply(rule terminates_in_time_state_intro)
+ apply (rule Big_StepT.WhileFalse)
+   using 1  by auto
+next
+  case (2 v)
+  obtain s' where s'_def: "s' =state_transformer p
+      [(''x'', tl_nat (s (add_prefix p ''x''))), (''n'', s (add_prefix p ''n'') - Suc 0)]
+      (state_transformer (CHR ''t'' # CHR ''l'' # p)
+        [(''ans'', tl_nat (s (add_prefix p ''x''))), (''xs'', 0)]
+        (snd_nat_IMP_Minus_state_transformer
+          (CHR ''s'' # CHR ''n'' # CHR ''d'' # CHR ''t'' # CHR ''l'' # p)
+          (s (add_prefix p ''x'') - Suc 0)
+          (state_transformer p [(''b'', Suc 0)] s)))" by simp
+    show ?case 
+      apply(rule terminates_in_time_state_intro [where s'= "if  0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then s1 else s2"  
+     for s1 s2] )
+        apply (rule Big_StepT.WhileTrue[where 
+ y= "if  0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then t1 else t2"  
+     for t1 t2])
+       using 2(3) apply linarith
+           apply rule
+            apply simp
+           apply simp
+       apply(rule terminates_split_if)
+       using 2(1)[of s'] s'_def  apply force
+       using 2(2)[of s'] s'_def apply force
+         apply fastforce
+       using 2(3)[symmetric] apply auto[1]
+       apply (smt (z3) One_nat_def less_diff_conv plus_1_eq_Suc) 
+       using 2(3)[symmetric] apply (simp only:)
+       apply (subst (2) nth_bit_of_num_loop_state_transformer.simps)
+        
+       apply (afuto simp add: Let_def simp del: nth_bit_of_num_loop_state_transformer.simps(2))
+       slefdgehammer
+         apply (auto simp only:Let_def One_nat_def  comp_apply One_nat_def less_diff_conv plus_1_eq_Suc)
+       apply (auto simp)    
+       
+qed
+
+thm If_tE
+end 
\ No newline at end of file
diff --git a/Cook_Levin/ROOT b/Cook_Levin/ROOT
index ee08c029..56af6ad1 100644
--- a/Cook_Levin/ROOT
+++ b/Cook_Levin/ROOT
@@ -4,7 +4,7 @@ session Cook_Levin = "HOL-Analysis" +
   sessions
     "Poly_Reductions_Lib"
     "IMP_Minus"
-    "HOL-Real_Asymp"    
+    "HOL-Real_Asymp"
     "Landau_Symbols"
     "Verified_SAT_Based_AI_Planning"
   directories
@@ -15,4 +15,4 @@ session Cook_Levin = "HOL-Analysis" +
     "IMP-_To_SAS+/SAS++_To_SAS+"
   theories
     "Complexity_classes/Cook_Levin"
-    "IMP-_To_SAS+/IMP_Minus_To_SAS_Plus"
\ No newline at end of file
+    "IMP-_To_SAS+/IMP_Minus_To_SAS_Plus"
diff --git a/Cook_Levin/ROOT.save b/Cook_Levin/ROOT.save
new file mode 100644
index 00000000..10d3fc60
--- /dev/null
+++ b/Cook_Levin/ROOT.save
@@ -0,0 +1,17 @@
+chapter Poly_Reductions
+
+session Cook_Levin = "HOL-Analysis" + 
+  sessions
+    "Poly_Reductions_Lib"
+    "IMP_Minus"
+    "HOL-Real_Asymp"
+    "Verified_SAT_Based_AI_Planning"
+  directories
+    "Complexity_classes"
+    "IMP-_To_SAS+"
+    "IMP-_To_SAS+/IMP-_To_IMP--"
+    "IMP-_To_SAS+/IMP--_To_SAS++"
+    "IMP-_To_SAS+/SAS++_To_SAS+"
+  theories
+    "Complexity_classes/Cook_Levin"
+    "IMP-_To_SAS+/IMP_Minus_To_SAS_Plus"
diff --git a/IMP-/#Big_StepT.thy# b/IMP-/#Big_StepT.thy#
new file mode 100644
index 00000000..c8dc3531
--- /dev/null
+++ b/IMP-/#Big_StepT.thy#
@@ -0,0 +1,211 @@
+\<^marker>\<open>creator Bilel Ghorbel, Florian Kessler\<close>
+section "Big step semantics of IMP-"
+theory Big_StepT imports Main Com begin
+
+paragraph "Summary"
+text\<open>We define big step semantics with time for IMP-. 
+Based on the big step semantics definition with time of IMP\<close>
+
+subsection "Big step semantics definition:"
+
+text "In IMP- Branching is only based on whether a variable's value equals 0."
+
+inductive
+  big_step_t :: "com \<times> state \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> bool"  ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
+where
+Skip: "(SKIP,s) \<Rightarrow>\<^bsup> Suc (0::nat) \<^esup> s"|
+Assign: "(x ::= a,s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s(x := aval a s)" |
+Seq: "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3 ; z=x+y \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" |
+IfTrue: "\<lbrakk> s b \<noteq> 0;  (c1,s) \<Rightarrow>\<^bsup> x \<^esup> t; y=x+1 \<rbrakk> \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" |
+IfFalse: "\<lbrakk> s b = 0; (c2,s) \<Rightarrow>\<^bsup> x \<^esup> t; y=x+1  \<rbrakk> \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" |
+WhileFalse: "\<lbrakk> s b = 0 \<rbrakk> \<Longrightarrow> (WHILE b \<noteq>0 DO c,s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s" |
+WhileTrue: "\<lbrakk> s1 b \<noteq> 0;  (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3; 1+x+y=z  \<rbrakk> 
+    \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
+
+bundle big_step_syntax 
+begin
+notation big_step_t ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
+end
+
+bundle no_big_step_syntax 
+begin
+no_notation big_step_t ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
+end
+
+code_pred big_step_t .
+
+text "Some examples using the big step semantics"
+experiment
+begin
+
+text "finding out the final state and running time of a command:"
+schematic_goal ex: "(''x'' ::= A (N 5);; ''y'' ::= A (V ''x''), s) \<Rightarrow>\<^bsup> ?t \<^esup> ?s"
+  apply(rule Seq)
+    apply(rule Assign)
+   apply simp
+   apply(rule Assign)
+  apply simp
+  done
+
+
+values "{(t, x). big_step_t (SKIP, \<lambda>_. 0) x t}"
+
+values "{map t [''x''] |t x. (SKIP, <''x'' := 42>) \<Rightarrow>\<^bsup> x \<^esup> t}"
+
+values "{map t [''x''] |t x. (''x'' ::=A (N 2), <''x'' := 42>) \<Rightarrow>\<^bsup> x \<^esup> t}"
+
+values "{(map t [''x''],x) |t x. (WHILE ''x''\<noteq>0 DO ''x''::= Sub (V ''x'') (N 1),<''x'':=5>) \<Rightarrow>\<^bsup> x \<^esup> t }"
+
+end
+
+text "proof automation:"
+
+text "Introduction rules:"
+declare big_step_t.intros [intro]
+
+text "Induction rules with pair splitting"
+lemmas big_step_t_induct = big_step_t.induct[split_format(complete)]
+
+subsection "Rule inversion"
+inductive_cases Skip_tE[elim!]: "(SKIP,s) \<Rightarrow>\<^bsup> x \<^esup> t"
+inductive_cases Assign_tE[elim!]: "(x ::= a,s) \<Rightarrow>\<^bsup> p \<^esup> t"
+inductive_cases Seq_tE[elim!]: "(c1;;c2,s1) \<Rightarrow>\<^bsup> p \<^esup> s3"
+inductive_cases If_tE[elim!]: "(IF b \<noteq>0 THEN c1 ELSE c2,s) \<Rightarrow>\<^bsup> x \<^esup> t"
+inductive_cases While_tE[elim]: "(WHILE b \<noteq>0 DO c,s) \<Rightarrow>\<^bsup> x \<^esup> t"
+lemma Seq': "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3  \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3"
+  by auto
+
+text "Rule inversion use examples:"
+lemma "(IF b \<noteq>0 THEN SKIP ELSE SKIP, s) \<Rightarrow>\<^bsup> x \<^esup> t \<Longrightarrow> t = s"
+  by blast
+
+lemma assumes "(IF b \<noteq>0 THEN SKIP ELSE SKIP, s) \<Rightarrow>\<^bsup> x \<^esup> t"
+  shows "t = s"
+  using assms apply cases by auto
+
+lemma assign_t_simp:
+  "((x ::= a,s) \<Rightarrow>\<^bsup> Suc(Suc 0) \<^esup>  s') \<longleftrightarrow> (s' = s(x := aval a s))"
+  by (auto)
+
+subsection "Determinism of Big semantics of IMP-"
+theorem big_step_t_determ2: "\<lbrakk> (c,s) \<Rightarrow>\<^bsup> p \<^esup> t; (c,s) \<Rightarrow>\<^bsup> q \<^esup> u \<rbrakk> \<Longrightarrow> (u = t \<and> p=q)"
+  apply  (induction arbitrary: u q rule: big_step_t_induct)
+    apply(elim Skip_tE) apply(simp)
+    apply(elim Assign_tE) apply(simp)
+  apply blast
+    apply(elim If_tE) apply(simp) apply blast
+    apply(elim If_tE)  apply (linarith) apply simp
+    apply(erule While_tE) apply(simp) apply simp
+  subgoal premises p for s1 b c x s2 y s3 z u q
+    using p(7) apply(safe) 
+      apply(erule While_tE)
+        using p(1-6) apply fast
+        using p(1-6) apply (simp)
+      apply(erule While_tE)
+        using p(1-6) apply fast
+        using p(1-6) by (simp)
+done
+
+lemma bigstep_det: "(c1, s) \<Rightarrow>\<^bsup> p1 \<^esup> t1 \<Longrightarrow> (c1, s) \<Rightarrow>\<^bsup> p \<^esup> t \<Longrightarrow> p1=p \<and> t1=t"
+  using big_step_t_determ2 by simp
+
+lemma seq_assign_t_simp:
+  "((c ;; x ::= a, s) \<Rightarrow>\<^bsup> Suc(Suc t) \<^esup>  s') 
+  \<longleftrightarrow> (\<exists>s''. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<and> s' = s''(x := aval a s''))"
+proof
+  assume "(c;; x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc t) \<^esup> s'"
+  then obtain s'' where "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''" by auto
+  have "s' = s''(x := aval a s'')" using \<open>(c;; x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc t) \<^esup> s'\<close>
+    using bigstep_det \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''\<close> 
+    by blast
+  thus "\<exists>s''. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<and> s' = s''(x := aval a s'')"
+    using \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''\<close> 
+    by blast
+qed auto
+
+lemma seq_assign_t_intro: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<Longrightarrow> s' = s''(x := aval a s'')
+  \<Longrightarrow>(c ;; x ::= a, s) \<Rightarrow>\<^bsup> Suc(Suc t) \<^esup>  s'"
+  using seq_assign_t_simp 
+  by auto
+
+lemma seq_is_noop[simp]: "(SKIP, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<longleftrightarrow> (t = Suc 0 \<and> s = s')" by auto
+
+lemma seq_skip[simp]: "(c ;; SKIP, s) \<Rightarrow>\<^bsup>Suc t\<^esup> s' \<longleftrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s'" by auto
+
+subsection "Progress property"
+text "every command costs time"
+lemma bigstep_progress: "(c, s) \<Rightarrow>\<^bsup> p \<^esup> t \<Longrightarrow> p > 0"
+  apply(induct rule: big_step_t.induct, auto) done
+
+subsection "abbreviations and properties"
+abbreviation terminates ("\<down>") where "terminates cs \<equiv> (\<exists>n a. (cs \<Rightarrow>\<^bsup> n \<^esup> a))"
+abbreviation thestate ("\<down>\<^sub>s") where "thestate cs \<equiv> (THE a. \<exists>n. (cs \<Rightarrow>\<^bsup> n \<^esup> a))" 
+abbreviation thetime ("\<down>\<^sub>t") where "thetime cs \<equiv> (THE n. \<exists>a. (cs \<Rightarrow>\<^bsup> n \<^esup> a))"
+
+
+lemma bigstepT_the_cost: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> \<down>\<^sub>t(c, s) = t"
+  using bigstep_det by blast 
+
+lemma bigstepT_the_state: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> \<down>\<^sub>s(c, s) = s'"
+  using bigstep_det by blast 
+
+lemma SKIPnot: "(\<not> (SKIP, s) \<Rightarrow>\<^bsup> p \<^esup> t) \<longleftrightarrow> (s\<noteq>t \<or> p\<noteq>Suc 0)" by blast
+
+lemma SKIPp: "\<down>\<^sub>t(SKIP,s) = Suc 0"
+  apply(rule the_equality)
+  apply fast
+  apply auto done 
+
+lemma SKIPt: "\<down>\<^sub>s(SKIP,s) = s"
+  apply(rule the_equality)
+  apply fast
+  apply auto done 
+
+
+lemma ASSp: "(THE p. Ex (big_step_t (x ::= e, s) p)) = Suc(Suc 0)"
+  apply(rule the_equality)
+  apply fast
+  apply auto done 
+
+lemma ASSt: "(THE t. \<exists>p. (x ::= e, s) \<Rightarrow>\<^bsup> p \<^esup> t) = s(x := aval e s)"
+  apply(rule the_equality)
+  apply fast
+  apply auto done 
+
+lemma ASSnot: "( \<not> (x ::= e, s) \<Rightarrow>\<^bsup> p \<^esup> t ) = (p\<noteq>Suc(Suc 0) \<or> t\<noteq>s(x := aval e s))"
+  apply auto done
+
+lemma If_THE_True: "Suc (THE n. \<exists>a. (c1, s) \<Rightarrow>\<^bsup> n \<^esup> a) =  (THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a)"
+     if T: "s b \<noteq> 0" and c1_t: "terminates (c1,s)" for s l
+proof -
+  from c1_t obtain p t where a: "(c1, s) \<Rightarrow>\<^bsup> p \<^esup> t" by blast
+  with T have b: "(IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> p+1 \<^esup> t"  using IfTrue by simp
+  from a bigstepT_the_cost have "(THE n. \<exists>a. (c1, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p" by simp
+  moreover from b bigstepT_the_cost have "(THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p+1" by simp
+  ultimately show ?thesis by simp
+qed
+
+lemma If_THE_False:
+ "Suc (THE n. \<exists>a. (c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) =  (THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a)"
+     if T: "s b = 0" and c2_t: "\<down> (c2,s)" for s l
+proof -
+  from c2_t obtain p t where a: "(c2, s) \<Rightarrow>\<^bsup> p \<^esup> t"  by blast
+  with T have b: "(IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> p+1 \<^esup> t"  using IfFalse by simp
+  from a bigstepT_the_cost have "(THE n. \<exists>a. (c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p" by simp
+  moreover from b bigstepT_the_cost have "(THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p+1" by simp
+  ultimately show ?thesis by simp
+qed
+
+
+lemma terminates_in_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' = s'' \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s''"
+  by simp
+
+lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = t' \<Longrightarrow> s' = s'' 
+  \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
+  by simp
+
+lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
+(\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
+  by auto
+
+end
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 5b9ac6d4..8d55b721 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -15,8 +15,33 @@ definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
   ''triangle'' ::= [''a''] ((V ''c'') \<then>) ;;
   ''a'' ::= (A (N 0))"
 
+thm add.commute
+lemma comp_add:"(\<lambda>x::'a::ab_semigroup_add. f (x +c)) = f o ((+) c)"
+  by (auto simp add: comp_def add.commute[symmetric])
+
+lemma poly_const:"poly ((+) c)"
+proof -
+  have 1:"poly (\<lambda>x. x)"
+    by (rule poly_linear)
+  have 2:"poly (\<lambda>x. c)" by simp
+  have "((+)c) = (\<lambda>x . x + c)"  by auto
+  moreover from 1 2 have "poly (\<lambda>x. x + c) " by auto
+  ultimately show ?thesis by auto
+qed
+find_theorems poly  "(o)" 
+
+lemma poly_shift: "poly f \<Longrightarrow> poly (\<lambda>x. f(x + c))"
+  by (subst comp_add) (auto intro: poly_const)
+
+   
+  
+
+lemma "poly (f o g) \<Longrightarrow> poly ((\<lambda>x. f(x + c)) o g)"
+  oops
 definition triangle_IMP_Minus_time where "triangle_IMP_Minus_time x \<equiv>
   mul_IMP_Minus_time (1 + x) + 8"
+lemma "poly (triangle_IMP_Minus_time o exp2)"
+  unfolding triangle_IMP_Minus_time_def 
 
 abbreviation triangle_IMP_Minus_state_transformer where 
   "triangle_IMP_Minus_state_transformer p n  \<equiv>
@@ -128,6 +153,40 @@ lemma fst_nat_IMP_Minus_correct[intro]:
       intro!: prod_decode_aux_loop_correct
       terminates_in_time_state_intro[OF Seq'])
 
+definition hd_IMP where "hd_IMP \<equiv>
+  [''fst''] ''a'' ::=  (V ''xs'' \<ominus> N 1) ;;
+  invoke_subprogram ''fst'' fst_nat_IMP_Minus ;;
+  ''ans'' ::= [''fst''] A (V ''fst_nat'');;
+  ''xs'' ::= A (N 0)
+"
+
+
+abbreviation hd_state_transformer where 
+"hd_state_transformer p xs \<equiv> 
+state_transformer p [(''ans'',hd_nat xs) , (''xs'',0)] o
+fst_nat_IMP_Minus_state_transformer (''fst''@ p) (xs -1)
+"
+
+definition hd_time where "
+hd_time x \<equiv> fst_nat_IMP_Minus_time (x-1) + 6 "
+
+lemma hd_nat_IMP_Minus_correct[intro]: 
+  "(hd_IMP p, s) 
+      \<Rightarrow>\<^bsup>  hd_time (s (add_prefix p ''xs''))\<^esup> 
+   hd_state_transformer p (s (add_prefix p ''xs'')) s"
+  unfolding hd_IMP_def hd_time_def  hd_nat_def
+  apply (rule terminates_in_time_state_intro)
+    apply (rule Big_StepT.Seq)+
+  by fastforce+
+  
+  
+  
+fun f::"real\<Rightarrow>real" where "f x = x^3  -4x^2 + x+3"
+
+value "f (-2)"
+value "f (4)"
+value "f ((-2* f(4) + 4*f(-2))/ (f(4)-f(-2)))"
+
 definition snd_nat_IMP_Minus where "snd_nat_IMP_Minus \<equiv>
   ''b'' ::= (A (V ''a'')) ;; 
   ''a'' ::= (A (N 0)) ;;
@@ -155,6 +214,32 @@ lemma snd_nat_IMP_Minus_correct[intro]:
       intro!: prod_decode_aux_loop_correct
       terminates_in_time_state_intro[OF Seq'])
 
+definition tl_IMP where "tl_IMP \<equiv>
+  [''snd''] ''a'' ::=  (V ''xs'' \<ominus> N 1) ;;
+  invoke_subprogram ''snd'' snd_nat_IMP_Minus ;;
+  ''ans'' ::= [''snd''] A (V ''snd_nat'');;
+  ''xs'' ::= A (N 0)
+"
+
+
+abbreviation tl_state_transformer where 
+"tl_state_transformer p xs \<equiv> 
+state_transformer p [(''ans'',tl_nat xs) , (''xs'',0)] o
+snd_nat_IMP_Minus_state_transformer (''snd''@ p) (xs -1)
+"
+
+definition tl_time where "
+tl_time x \<equiv> snd_nat_IMP_Minus_time (x-1) + 6 "
+
+lemma tl_nat_IMP_Minus_correct[intro]: 
+  "(tl_IMP p, s) 
+      \<Rightarrow>\<^bsup>  tl_time (s (add_prefix p ''xs''))\<^esup> 
+   tl_state_transformer p (s (add_prefix p ''xs'')) s"
+  unfolding tl_IMP_def tl_time_def  tl_nat_def 
+  apply (rule terminates_in_time_state_intro)
+    apply (rule Big_StepT.Seq)+
+  by fastforce+
+
 definition nth_nat_iteration where "nth_nat_iteration \<equiv>
   [''a''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
   invoke_subprogram ''a'' snd_nat_IMP_Minus ;;
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index 4667cecd..d88555dd 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -2,7 +2,7 @@
 
 theory Multiplication
   imports Big_Step_Small_Step_Equivalence "HOL-Library.Discrete"
-    Canonical_State_Transformers
+    Canonical_State_Transformers "../Lib/Polynomial_Growth_Functions"
 begin
 
 unbundle no_com_syntax
@@ -114,9 +114,64 @@ definition mul_IMP_minus where "mul_IMP_minus =
   ''a'' ::= A (N 0) ;;
   ''d'' ::= A (N 0)" 
 
-definition mul_IMP_Minus_time where "mul_IMP_Minus_time y 
+definition mul_IMP_Minus_time :: "nat \<Rightarrow> nat" where "mul_IMP_Minus_time y 
   \<equiv> 12 * (if y = 0 then 0 else 1 + Discrete.log y) + 8"
 
+definition exp2::"nat\<Rightarrow>nat"  where "exp2 y \<equiv> 2^y"
+
+lemma log_exp_id: "Discrete.log  (exp2 x) = id x"
+  apply(induct x)
+  unfolding exp2_def by auto
+
+
+lemma exp2_0: "exp2 x \<noteq> 0"
+  unfolding exp2_def
+  by auto
+
+lemma poly_general_form:"poly (\<lambda>x. a*x+b)"
+proof
+  show "poly ((*) a)"
+  proof (induct a)
+    case 0
+    then show ?case by auto
+  next
+    case (Suc a)
+    have distrib_add: "((*) (Suc a)) = (\<lambda>x. (*) a x + x)" by auto
+    from Suc have "poly (\<lambda>x. (*) a x)" by simp
+    moreover have "poly (\<lambda>x. x)"  by (simp add: poly_linear)
+    ultimately have "poly  (\<lambda>x. (*) a x + x)" by (simp add: poly_add)
+    with distrib_add show ?case by simp 
+  qed
+next
+  show "poly (\<lambda>x. b)" by simp
+qed
+
+lemma poly_intro: "(\<forall>x. f x = a*x + b) \<Longrightarrow> poly f"
+proof -
+  assume "\<forall>x. f x = a*x + b"
+  hence "f = (\<lambda>x . a*x+b)" by auto
+  with poly_general_form show "poly f" by auto
+qed
+
+lemma "poly (mul_IMP_Minus_time o exp2)"
+  unfolding mul_IMP_Minus_time_def comp_def log_exp_id
+  apply (auto simp add: exp2_0 )
+  apply (rule poly_intro)
+  by (auto simp add:algebra_simps)
+
+definition polye:: "(nat \<Rightarrow>nat) \<Rightarrow> bool" where 
+"polye f \<equiv> poly (f o exp2)"
+
+lemma polye_comp1: 
+"poly g \<Longrightarrow> polye f \<Longrightarrow> polye (g o f)"
+  unfolding polye_def 
+  by (simp add: comp_assoc poly_compose)
+
+lemma polye_comp2: 
+"mono f \<Longrightarrow> polye f \<Longrightarrow> polye (\<lambda>x . f (x + b))"
+  unfolding polye_def  exp2_def comp_def
+  oops
+
 abbreviation mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p a b \<equiv>
   state_transformer p  
     [(''a'', 0),
diff --git a/Lib/ROOT~ b/Lib/ROOT~
new file mode 100644
index 00000000..d5765f02
--- /dev/null
+++ b/Lib/ROOT~
@@ -0,0 +1,16 @@
+chapter Poly_Reductions
+
+session Poly_Reductions_Lib = "HOL-Analysis" + 
+  sessions
+    "HOL-Real_Asymp"    
+    "Landau_Symbols"
+    "Graph_Theory"
+  directories
+    "Auxiliaries"
+    "Graph_Extensions"  
+  theories
+    "Auxiliaries/Graph_Auxiliaries"
+    "Graph_Extensions/Vwalk_Cycle"
+    "Polynomial_Growth_Functions"
+    "SAT_Definition"
+    
\ No newline at end of file
diff --git a/ROOT b/ROOT
index 3724850b..4007d863 100644
--- a/ROOT
+++ b/ROOT
@@ -1,4 +1,3 @@
-session Poly_Reductions_Base = HOL + sessions NREST "HOL-Real_Asymp" Landau_Symbols
+session Poly_Reductions_Base = HOL + sessions NREST "HOL-Real_Asymp" Landau_Symbols 
+
 
-theories 
-Polynomial_Growth_Functions Polynomial_Reductions
\ No newline at end of file
diff --git a/ROOTS b/ROOTS
index 0d9b29ed..155fec84 100644
--- a/ROOTS
+++ b/ROOTS
@@ -1,4 +1,5 @@
 Lib
 Karp21
-Cook_Levin
 IMP-
+Cook_Levin
+
diff --git a/ROOTS~ b/ROOTS~
new file mode 100644
index 00000000..c0dcb438
--- /dev/null
+++ b/ROOTS~
@@ -0,0 +1,6 @@
+NREST
+Lib
+Karp21
+IMP-
+Cook_Levin
+

From dab17709d37da8e7ee5de504b7ad7275018d31dc Mon Sep 17 00:00:00 2001
From: BilelGho <ghorbelbilel@gmail.com>
Date: Thu, 9 Dec 2021 16:15:05 +0100
Subject: [PATCH 091/103] fixing state transformers

composition was applied in the wrong direction + not all side effects were zeroed-out
---
 .../IMP-_To_IMP--/Binary_Arithmetic_IMP.thy   |  75 ++++---
 IMP-/#Big_StepT.thy#                          | 211 ------------------
 IMP-/Big_StepT.thy                            |   5 +-
 IMP-/Canonical_State_Transformers.thy         |   1 +
 IMP-/IMP_Minus_Nat_Bijection.thy              |   4 +-
 5 files changed, 55 insertions(+), 241 deletions(-)
 delete mode 100644 IMP-/#Big_StepT.thy#

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
index e7e147c1..9cd1020e 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
@@ -71,17 +71,18 @@ definition nth_bit_of_num_iteration::pcom  where "nth_bit_of_num_iteration \<equ
   [''tl''] ''xs'' ::=  (A ( V ''x'')) ;;
    invoke_subprogram ''tl'' tl_IMP;;
    ''x'' ::= [''tl''] (A (V ''ans''));;
+   [''tl''] ''ans'' ::= A (N 0);;
    ''n'' ::= (V ''n'' \<ominus> N 1 );; 
     nth_bit_of_num_if
 "
 
 definition nth_bit_of_num_iteration_t :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"nth_bit_of_num_iteration_t x n = 6 + tl_time x + nth_bit_of_num_if_time (tl_nat x) (n-1)"
+"nth_bit_of_num_iteration_t x n = 8 + tl_time x + nth_bit_of_num_if_time (tl_nat x) (n-1)"
 
 abbreviation nth_bit_of_num_iteration_state_transformer 
   where "nth_bit_of_num_iteration_state_transformer p x n \<equiv>
-    state_transformer p [(''x'', tl_nat x),(''n'',n-1)] o tl_state_transformer (''tl'' @ p) x
-  o nth_bit_of_num_if_state_transformer p (tl_nat x) (n-1)
+     nth_bit_of_num_if_state_transformer p (tl_nat x) (n-1) o  state_transformer (''tl'' @ p) [( ''ans'', 0)] o
+ tl_state_transformer (''tl'' @ p) x o  state_transformer p [(''x'', tl_nat x),(''n'',n-1)] 
 "
 value "nth_bit_of_num_iteration_state_transformer"
 lemma nth_bit_of_num_iteration_correct[intro]:
@@ -91,7 +92,23 @@ nth_bit_of_num_iteration_state_transformer p x n s"
   unfolding nth_bit_of_num_iteration_def nth_bit_of_num_iteration_t_def
   apply (rule terminates_in_time_state_intro)
     apply (rule Big_StepT.Seq)+
-  by fastforce+
+              apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+ apply fastforce
+   apply fastforce
+by fastforce
+  
+  
+
+
 
 
 definition nth_bit_of_num_loop :: "pcom" where 
@@ -110,16 +127,22 @@ fun nth_bit_of_num_loop_state_transformer ::
 "nth_bit_of_num_loop_state_transformer p 0 x n = id "|
 "nth_bit_of_num_loop_state_transformer p (Suc b) x n = (let x' = tl_nat x; n' = n-1;
 iteration = nth_bit_of_num_iteration_state_transformer p x n  in 
-(if x'>0 \<and> n'>0 then iteration o nth_bit_of_num_loop_state_transformer p (Suc 0) x' n' else
-iteration
-o nth_bit_of_num_loop_state_transformer p 0 x' n'
+(if x'>0 \<and> n'>0 then nth_bit_of_num_loop_state_transformer p (Suc 0) x' n' o iteration else
+nth_bit_of_num_loop_state_transformer p 0 x' n' o iteration
  ))"
 
-lemma " (nth_bit_of_num_iteration_state_transformer p x n
-         o nth_bit_of_num_loop_state_transformer p (Suc 0) (tl_nat x) (n-1)) s = 
-      (nth_bit_of_num_loop_state_transformer p (Suc 0) (tl_nat x) (n-1)) s"
-  apply (induction p "Suc 0" "tl_nat x" "n-1" arbitrary: x n s rule:nth_bit_of_num_loop_state_transformer.induct)
+lemma "
+(nth_bit_of_num_iteration_state_transformer p (tl_nat x) (n-1) o
+     nth_bit_of_num_iteration_state_transformer p x n) s = nth_bit_of_num_iteration_state_transformer p (tl_nat x) (n-1) s 
+"
+  sledgehammer
+lemma " x' = tl_nat x \<Longrightarrow> n' = n-1 \<Longrightarrow> x>0 \<Longrightarrow> n> 0 \<Longrightarrow>
+             (nth_bit_of_num_loop_state_transformer p (Suc 0) x' n'
+o nth_bit_of_num_iteration_state_transformer p x n ) s = 
+      (nth_bit_of_num_loop_state_transformer p (Suc 0) x' n') s"
+  apply (induction  x' n' arbitrary: x n s rule:nth_bit_of_num_nat.induct)
   apply auto
+  apply fastforce
 fun nth_bit_of_num_loop_state_transformer' ::
 "char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where 
 "nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
@@ -167,14 +190,15 @@ case (1)
    using 1  by auto
 next
   case (2 v)
-  obtain s' where s'_def: "s' =state_transformer p
-      [(''x'', tl_nat (s (add_prefix p ''x''))), (''n'', s (add_prefix p ''n'') - Suc 0)]
-      (state_transformer (CHR ''t'' # CHR ''l'' # p)
-        [(''ans'', tl_nat (s (add_prefix p ''x''))), (''xs'', 0)]
-        (snd_nat_IMP_Minus_state_transformer
-          (CHR ''s'' # CHR ''n'' # CHR ''d'' # CHR ''t'' # CHR ''l'' # p)
-          (s (add_prefix p ''x'') - Suc 0)
-          (state_transformer p [(''b'', Suc 0)] s)))" by simp
+  obtain s' where s'_def: "s' = (state_transformer p
+       [(''b'',
+         if 0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then 1
+         else 0)] \<circ>
+      state_transformer (''tl'' @ p) [(''ans'', 0)] \<circ>
+      tl_state_transformer (''tl'' @ p) (s (add_prefix p ''x'')) \<circ>
+      state_transformer p
+       [(''x'', tl_nat (s (add_prefix p ''x''))), (''n'', s (add_prefix p ''n'') - 1)])
+      s" by simp
     show ?case 
       apply(rule terminates_in_time_state_intro [where s'= "if  0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then s1 else s2"  
      for s1 s2] )
@@ -186,18 +210,13 @@ next
             apply simp
            apply simp
        apply(rule terminates_split_if)
-       using 2(1)[of s'] s'_def  apply force
-       using 2(2)[of s'] s'_def apply force
+       using 2(1)[of s'] s'_def apply fastforce
+       using 2(2)[of s'] s'_def apply fastforce
          apply fastforce
        using 2(3)[symmetric] apply auto[1]
        apply (smt (z3) One_nat_def less_diff_conv plus_1_eq_Suc) 
-       using 2(3)[symmetric] apply (simp only:)
-       apply (subst (2) nth_bit_of_num_loop_state_transformer.simps)
-        
-       apply (afuto simp add: Let_def simp del: nth_bit_of_num_loop_state_transformer.simps(2))
-       slefdgehammer
-         apply (auto simp only:Let_def One_nat_def  comp_apply One_nat_def less_diff_conv plus_1_eq_Suc)
-       apply (auto simp)    
+       using 2(3)[symmetric] apply auto
+       apply (auto simp only:Let_def comp_apply)
        
 qed
 
diff --git a/IMP-/#Big_StepT.thy# b/IMP-/#Big_StepT.thy#
deleted file mode 100644
index c8dc3531..00000000
--- a/IMP-/#Big_StepT.thy#
+++ /dev/null
@@ -1,211 +0,0 @@
-\<^marker>\<open>creator Bilel Ghorbel, Florian Kessler\<close>
-section "Big step semantics of IMP-"
-theory Big_StepT imports Main Com begin
-
-paragraph "Summary"
-text\<open>We define big step semantics with time for IMP-. 
-Based on the big step semantics definition with time of IMP\<close>
-
-subsection "Big step semantics definition:"
-
-text "In IMP- Branching is only based on whether a variable's value equals 0."
-
-inductive
-  big_step_t :: "com \<times> state \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> bool"  ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
-where
-Skip: "(SKIP,s) \<Rightarrow>\<^bsup> Suc (0::nat) \<^esup> s"|
-Assign: "(x ::= a,s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s(x := aval a s)" |
-Seq: "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3 ; z=x+y \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" |
-IfTrue: "\<lbrakk> s b \<noteq> 0;  (c1,s) \<Rightarrow>\<^bsup> x \<^esup> t; y=x+1 \<rbrakk> \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" |
-IfFalse: "\<lbrakk> s b = 0; (c2,s) \<Rightarrow>\<^bsup> x \<^esup> t; y=x+1  \<rbrakk> \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" |
-WhileFalse: "\<lbrakk> s b = 0 \<rbrakk> \<Longrightarrow> (WHILE b \<noteq>0 DO c,s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s" |
-WhileTrue: "\<lbrakk> s1 b \<noteq> 0;  (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3; 1+x+y=z  \<rbrakk> 
-    \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
-
-bundle big_step_syntax 
-begin
-notation big_step_t ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
-end
-
-bundle no_big_step_syntax 
-begin
-no_notation big_step_t ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
-end
-
-code_pred big_step_t .
-
-text "Some examples using the big step semantics"
-experiment
-begin
-
-text "finding out the final state and running time of a command:"
-schematic_goal ex: "(''x'' ::= A (N 5);; ''y'' ::= A (V ''x''), s) \<Rightarrow>\<^bsup> ?t \<^esup> ?s"
-  apply(rule Seq)
-    apply(rule Assign)
-   apply simp
-   apply(rule Assign)
-  apply simp
-  done
-
-
-values "{(t, x). big_step_t (SKIP, \<lambda>_. 0) x t}"
-
-values "{map t [''x''] |t x. (SKIP, <''x'' := 42>) \<Rightarrow>\<^bsup> x \<^esup> t}"
-
-values "{map t [''x''] |t x. (''x'' ::=A (N 2), <''x'' := 42>) \<Rightarrow>\<^bsup> x \<^esup> t}"
-
-values "{(map t [''x''],x) |t x. (WHILE ''x''\<noteq>0 DO ''x''::= Sub (V ''x'') (N 1),<''x'':=5>) \<Rightarrow>\<^bsup> x \<^esup> t }"
-
-end
-
-text "proof automation:"
-
-text "Introduction rules:"
-declare big_step_t.intros [intro]
-
-text "Induction rules with pair splitting"
-lemmas big_step_t_induct = big_step_t.induct[split_format(complete)]
-
-subsection "Rule inversion"
-inductive_cases Skip_tE[elim!]: "(SKIP,s) \<Rightarrow>\<^bsup> x \<^esup> t"
-inductive_cases Assign_tE[elim!]: "(x ::= a,s) \<Rightarrow>\<^bsup> p \<^esup> t"
-inductive_cases Seq_tE[elim!]: "(c1;;c2,s1) \<Rightarrow>\<^bsup> p \<^esup> s3"
-inductive_cases If_tE[elim!]: "(IF b \<noteq>0 THEN c1 ELSE c2,s) \<Rightarrow>\<^bsup> x \<^esup> t"
-inductive_cases While_tE[elim]: "(WHILE b \<noteq>0 DO c,s) \<Rightarrow>\<^bsup> x \<^esup> t"
-lemma Seq': "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3  \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3"
-  by auto
-
-text "Rule inversion use examples:"
-lemma "(IF b \<noteq>0 THEN SKIP ELSE SKIP, s) \<Rightarrow>\<^bsup> x \<^esup> t \<Longrightarrow> t = s"
-  by blast
-
-lemma assumes "(IF b \<noteq>0 THEN SKIP ELSE SKIP, s) \<Rightarrow>\<^bsup> x \<^esup> t"
-  shows "t = s"
-  using assms apply cases by auto
-
-lemma assign_t_simp:
-  "((x ::= a,s) \<Rightarrow>\<^bsup> Suc(Suc 0) \<^esup>  s') \<longleftrightarrow> (s' = s(x := aval a s))"
-  by (auto)
-
-subsection "Determinism of Big semantics of IMP-"
-theorem big_step_t_determ2: "\<lbrakk> (c,s) \<Rightarrow>\<^bsup> p \<^esup> t; (c,s) \<Rightarrow>\<^bsup> q \<^esup> u \<rbrakk> \<Longrightarrow> (u = t \<and> p=q)"
-  apply  (induction arbitrary: u q rule: big_step_t_induct)
-    apply(elim Skip_tE) apply(simp)
-    apply(elim Assign_tE) apply(simp)
-  apply blast
-    apply(elim If_tE) apply(simp) apply blast
-    apply(elim If_tE)  apply (linarith) apply simp
-    apply(erule While_tE) apply(simp) apply simp
-  subgoal premises p for s1 b c x s2 y s3 z u q
-    using p(7) apply(safe) 
-      apply(erule While_tE)
-        using p(1-6) apply fast
-        using p(1-6) apply (simp)
-      apply(erule While_tE)
-        using p(1-6) apply fast
-        using p(1-6) by (simp)
-done
-
-lemma bigstep_det: "(c1, s) \<Rightarrow>\<^bsup> p1 \<^esup> t1 \<Longrightarrow> (c1, s) \<Rightarrow>\<^bsup> p \<^esup> t \<Longrightarrow> p1=p \<and> t1=t"
-  using big_step_t_determ2 by simp
-
-lemma seq_assign_t_simp:
-  "((c ;; x ::= a, s) \<Rightarrow>\<^bsup> Suc(Suc t) \<^esup>  s') 
-  \<longleftrightarrow> (\<exists>s''. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<and> s' = s''(x := aval a s''))"
-proof
-  assume "(c;; x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc t) \<^esup> s'"
-  then obtain s'' where "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''" by auto
-  have "s' = s''(x := aval a s'')" using \<open>(c;; x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc t) \<^esup> s'\<close>
-    using bigstep_det \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''\<close> 
-    by blast
-  thus "\<exists>s''. (c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<and> s' = s''(x := aval a s'')"
-    using \<open>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s''\<close> 
-    by blast
-qed auto
-
-lemma seq_assign_t_intro: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s'' \<Longrightarrow> s' = s''(x := aval a s'')
-  \<Longrightarrow>(c ;; x ::= a, s) \<Rightarrow>\<^bsup> Suc(Suc t) \<^esup>  s'"
-  using seq_assign_t_simp 
-  by auto
-
-lemma seq_is_noop[simp]: "(SKIP, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<longleftrightarrow> (t = Suc 0 \<and> s = s')" by auto
-
-lemma seq_skip[simp]: "(c ;; SKIP, s) \<Rightarrow>\<^bsup>Suc t\<^esup> s' \<longleftrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s'" by auto
-
-subsection "Progress property"
-text "every command costs time"
-lemma bigstep_progress: "(c, s) \<Rightarrow>\<^bsup> p \<^esup> t \<Longrightarrow> p > 0"
-  apply(induct rule: big_step_t.induct, auto) done
-
-subsection "abbreviations and properties"
-abbreviation terminates ("\<down>") where "terminates cs \<equiv> (\<exists>n a. (cs \<Rightarrow>\<^bsup> n \<^esup> a))"
-abbreviation thestate ("\<down>\<^sub>s") where "thestate cs \<equiv> (THE a. \<exists>n. (cs \<Rightarrow>\<^bsup> n \<^esup> a))" 
-abbreviation thetime ("\<down>\<^sub>t") where "thetime cs \<equiv> (THE n. \<exists>a. (cs \<Rightarrow>\<^bsup> n \<^esup> a))"
-
-
-lemma bigstepT_the_cost: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> \<down>\<^sub>t(c, s) = t"
-  using bigstep_det by blast 
-
-lemma bigstepT_the_state: "(c, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> \<down>\<^sub>s(c, s) = s'"
-  using bigstep_det by blast 
-
-lemma SKIPnot: "(\<not> (SKIP, s) \<Rightarrow>\<^bsup> p \<^esup> t) \<longleftrightarrow> (s\<noteq>t \<or> p\<noteq>Suc 0)" by blast
-
-lemma SKIPp: "\<down>\<^sub>t(SKIP,s) = Suc 0"
-  apply(rule the_equality)
-  apply fast
-  apply auto done 
-
-lemma SKIPt: "\<down>\<^sub>s(SKIP,s) = s"
-  apply(rule the_equality)
-  apply fast
-  apply auto done 
-
-
-lemma ASSp: "(THE p. Ex (big_step_t (x ::= e, s) p)) = Suc(Suc 0)"
-  apply(rule the_equality)
-  apply fast
-  apply auto done 
-
-lemma ASSt: "(THE t. \<exists>p. (x ::= e, s) \<Rightarrow>\<^bsup> p \<^esup> t) = s(x := aval e s)"
-  apply(rule the_equality)
-  apply fast
-  apply auto done 
-
-lemma ASSnot: "( \<not> (x ::= e, s) \<Rightarrow>\<^bsup> p \<^esup> t ) = (p\<noteq>Suc(Suc 0) \<or> t\<noteq>s(x := aval e s))"
-  apply auto done
-
-lemma If_THE_True: "Suc (THE n. \<exists>a. (c1, s) \<Rightarrow>\<^bsup> n \<^esup> a) =  (THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a)"
-     if T: "s b \<noteq> 0" and c1_t: "terminates (c1,s)" for s l
-proof -
-  from c1_t obtain p t where a: "(c1, s) \<Rightarrow>\<^bsup> p \<^esup> t" by blast
-  with T have b: "(IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> p+1 \<^esup> t"  using IfTrue by simp
-  from a bigstepT_the_cost have "(THE n. \<exists>a. (c1, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p" by simp
-  moreover from b bigstepT_the_cost have "(THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p+1" by simp
-  ultimately show ?thesis by simp
-qed
-
-lemma If_THE_False:
- "Suc (THE n. \<exists>a. (c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) =  (THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a)"
-     if T: "s b = 0" and c2_t: "\<down> (c2,s)" for s l
-proof -
-  from c2_t obtain p t where a: "(c2, s) \<Rightarrow>\<^bsup> p \<^esup> t"  by blast
-  with T have b: "(IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> p+1 \<^esup> t"  using IfFalse by simp
-  from a bigstepT_the_cost have "(THE n. \<exists>a. (c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p" by simp
-  moreover from b bigstepT_the_cost have "(THE n. \<exists>a. (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> n \<^esup> a) = p+1" by simp
-  ultimately show ?thesis by simp
-qed
-
-
-lemma terminates_in_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' = s'' \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t\<^esup> s''"
-  by simp
-
-lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = t' \<Longrightarrow> s' = s'' 
-  \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
-  by simp
-
-lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
-(\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
-  by auto
-
-end
\ No newline at end of file
diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 34e24fc2..c8dc3531 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -72,7 +72,6 @@ inductive_cases Assign_tE[elim!]: "(x ::= a,s) \<Rightarrow>\<^bsup> p \<^esup>
 inductive_cases Seq_tE[elim!]: "(c1;;c2,s1) \<Rightarrow>\<^bsup> p \<^esup> s3"
 inductive_cases If_tE[elim!]: "(IF b \<noteq>0 THEN c1 ELSE c2,s) \<Rightarrow>\<^bsup> x \<^esup> t"
 inductive_cases While_tE[elim]: "(WHILE b \<noteq>0 DO c,s) \<Rightarrow>\<^bsup> x \<^esup> t"
-
 lemma Seq': "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3  \<rbrakk> \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3"
   by auto
 
@@ -205,4 +204,8 @@ lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s'
   \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
   by simp
 
+lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
+(\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
+  by auto
+
 end
\ No newline at end of file
diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
index 6f5f1987..9ce979b2 100644
--- a/IMP-/Canonical_State_Transformers.thy
+++ b/IMP-/Canonical_State_Transformers.thy
@@ -102,6 +102,7 @@ definition state_transformer :: "string \<Rightarrow> (vname * nat) list \<Right
     (Some y) \<Rightarrow> y |
     None \<Rightarrow> s v))"
 
+lemma "state_transformer p xs o state_transformer p ys = state_transformer "
 (* Only use for intermediate states. State transformer definitions of sub-programs
    should not depend on the state before the program invocation, because we do not
    want to compute that when composing state transformers *) 
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 8d55b721..eddba7d2 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -218,6 +218,7 @@ definition tl_IMP where "tl_IMP \<equiv>
   [''snd''] ''a'' ::=  (V ''xs'' \<ominus> N 1) ;;
   invoke_subprogram ''snd'' snd_nat_IMP_Minus ;;
   ''ans'' ::= [''snd''] A (V ''snd_nat'');;
+  [''snd''] ''snd_nat'' ::= A (N 0);;
   ''xs'' ::= A (N 0)
 "
 
@@ -225,11 +226,12 @@ definition tl_IMP where "tl_IMP \<equiv>
 abbreviation tl_state_transformer where 
 "tl_state_transformer p xs \<equiv> 
 state_transformer p [(''ans'',tl_nat xs) , (''xs'',0)] o
+state_transformer (''snd'' @ p) [(''snd_nat'',0)] o
 snd_nat_IMP_Minus_state_transformer (''snd''@ p) (xs -1)
 "
 
 definition tl_time where "
-tl_time x \<equiv> snd_nat_IMP_Minus_time (x-1) + 6 "
+tl_time x \<equiv> snd_nat_IMP_Minus_time (x-1) + 8 "
 
 lemma tl_nat_IMP_Minus_correct[intro]: 
   "(tl_IMP p, s) 

From 9afe3a4cda64adaea5ba9966c54cd6ca6cd3b3e5 Mon Sep 17 00:00:00 2001
From: BilelGho <ghorbelbilel@gmail.com>
Date: Thu, 9 Dec 2021 17:21:50 +0100
Subject: [PATCH 092/103] test

---
 IMP-/IMP_Minus_Nat_Bijection.thy | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index eddba7d2..8e81aecd 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -42,7 +42,7 @@ definition triangle_IMP_Minus_time where "triangle_IMP_Minus_time x \<equiv>
   mul_IMP_Minus_time (1 + x) + 8"
 lemma "poly (triangle_IMP_Minus_time o exp2)"
   unfolding triangle_IMP_Minus_time_def 
-
+  oops
 abbreviation triangle_IMP_Minus_state_transformer where 
   "triangle_IMP_Minus_state_transformer p n  \<equiv>
     state_transformer p [(''triangle'', triangle n), (''a'', 0)] \<circ> 

From 6e554617899e5e69ccd33ca6f50bbe7c0dde3531 Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Wed, 15 Dec 2021 17:49:47 +0100
Subject: [PATCH 093/103] Added experimental proofs to deal with IH, if and
 while

---
 IMP-/Big_StepT.thy                    |  37 +++++-
 IMP-/Canonical_State_Transformers.thy |  13 +-
 IMP-/IMP_Minus_Nat_Bijection.thy      | 161 ++++++++++++++++++++++++-
 IMP-/Multiplication.thy               | 165 +++++++++++++++++++++++++-
 IMP-/ROOT                             |   3 +-
 5 files changed, 363 insertions(+), 16 deletions(-)

diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index c8dc3531..f4af9839 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -1,6 +1,6 @@
 \<^marker>\<open>creator Bilel Ghorbel, Florian Kessler\<close>
 section "Big step semantics of IMP-"
-theory Big_StepT imports Main Com begin
+theory Big_StepT imports Main Com "HOL-Eisbach.Eisbach_Tools" begin
 
 paragraph "Summary"
 text\<open>We define big step semantics with time for IMP-. 
@@ -22,7 +22,32 @@ WhileFalse: "\<lbrakk> s b = 0 \<rbrakk> \<Longrightarrow> (WHILE b \<noteq>0 DO
 WhileTrue: "\<lbrakk> s1 b \<noteq> 0;  (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3; 1+x+y=z  \<rbrakk> 
     \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
 
-bundle big_step_syntax 
+lemma WhileI: 
+"\<lbrakk>(s1 b \<noteq> 0 \<Longrightarrow> (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<and> (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3);
+  (s1 b = 0 \<Longrightarrow> s1 = s3);
+  z = (if s1 b \<noteq> 0 then 1+x+y else 2)\<rbrakk>
+        \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
+  by (auto simp add: WhileTrue WhileFalse numeral_2_eq_2)
+
+lemma IfI: 
+"\<lbrakk>s b \<noteq> 0 \<Longrightarrow> (c1,s) \<Rightarrow>\<^bsup> x1 \<^esup> t1;
+  s b = 0 \<Longrightarrow> (c2,s) \<Rightarrow>\<^bsup> x2 \<^esup> t2;
+  y = (if s b \<noteq> 0 then x1 else x2) + 1;
+  t = (if s b \<noteq> 0 then t1 else t2)\<rbrakk>
+        \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" 
+  by (auto simp add: IfTrue IfFalse)
+
+lemma AssignI: 
+"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
+        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s'" 
+  by (auto simp add: Assign)
+
+lemma AssignI': 
+"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
+        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s'" 
+  by (auto simp add: Assign eval_nat_numeral)
+
+bundle big_step_syntax
 begin
 notation big_step_t ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
 end
@@ -204,6 +229,14 @@ lemma terminates_in_time_state_intro: "(c, s) \<Rightarrow>\<^bsup>t\<^esup> s'
   \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
   by simp
 
+lemma terminates_in_time_state_intro': "(c', s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = t' \<Longrightarrow> s' = s'' \<Longrightarrow> c' = c
+  \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t'\<^esup> s''"
+  by simp
+
+method dest_com  = 
+  (match premises in a: "\<lbrakk>loop_cond; state_upd\<rbrakk> \<Longrightarrow> (_, s) \<Rightarrow>\<^bsup>t\<^esup> s'"
+    for s s' t loop_cond state_upd \<Rightarrow> \<open>rule terminates_in_time_state_intro'[OF a]\<close>)
+
 lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
 (\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
   by auto
diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
index 9ce979b2..9927a5a8 100644
--- a/IMP-/Canonical_State_Transformers.thy
+++ b/IMP-/Canonical_State_Transformers.thy
@@ -97,15 +97,16 @@ lemma add_prefix_equal_iff[simp]: "add_prefix p a = add_prefix p' b \<longleftri
   by blast
 
 definition state_transformer :: "string \<Rightarrow> (vname * nat) list \<Rightarrow> state \<Rightarrow> state" where
-"state_transformer p vs s = 
-  (\<lambda>v. (case (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) v of
-    (Some y) \<Rightarrow> y |
-    None \<Rightarrow> s v))"
+  "state_transformer p vs s = 
+    (\<lambda>v. (case 
+           (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) v of
+             (Some y) \<Rightarrow> y
+             | None \<Rightarrow> s v))"
 
-lemma "state_transformer p xs o state_transformer p ys = state_transformer "
 (* Only use for intermediate states. State transformer definitions of sub-programs
    should not depend on the state before the program invocation, because we do not
-   want to compute that when composing state transformers *) 
+   want to compute that when composing state transformers *)
+
 abbreviation state_transformer' where "state_transformer' p vs s \<equiv>
   state_transformer p (vs (\<lambda>v. s (add_prefix p v))) s"
 
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 8e81aecd..ef18b4e2 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -7,13 +7,164 @@ begin
 
 unbundle IMP_Minus_Minus_Com.no_com_syntax
 unbundle Com.no_com_syntax
+                                                 
+record triangle_state = triangle_mul_state::mul_state triangle_a::nat triangle_triangle::nat
+                                            
+term Nat_Bijection.triangle
 
-definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
+(*definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
   [''a''] ''a'' ::= (A (V ''a'')) ;;
   [''a''] ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
   invoke_subprogram ''a'' mul_IMP_minus ;;
   ''triangle'' ::= [''a''] ((V ''c'') \<then>) ;;
   ''a'' ::= (A (N 0))"
+*)
+
+definition "triangle_state_upd (s::triangle_state) \<equiv>
+      let
+        mul_a' = triangle_a s;
+        mul_b' = (triangle_a s) + 1;
+        mul_c' = 0;
+        mul_d' = 0;
+        (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c', mul_d = mul_d'\<rparr>;
+        mul_ret = (mul_imp triangle_mul_state);
+        triangle_triangle = (mul_c mul_ret) div 2;
+        ret = \<lparr>triangle_mul_state = mul_ret, triangle_a = triangle_a s,triangle_triangle = triangle_triangle\<rparr>
+      in
+        ret
+"
+
+fun triangle_imp:: "triangle_state \<Rightarrow> triangle_state" where
+"triangle_imp s = 
+  (let
+     ret = triangle_state_upd s
+   in
+     ret
+  )"
+
+lemma triangle_imp_correct: "triangle_triangle (triangle_imp s) = Nat_Bijection.triangle (triangle_a s)"
+proof (induction s rule: triangle_imp.induct)
+  case (1 s)
+  then show ?case
+    by (auto simp: triangle_def triangle_state_upd_def Let_def mul_imp_correct simp del: mul_imp.simps split: if_splits)
+qed 
+
+fun triangle_imp_time:: "triangle_state \<Rightarrow> nat \<Rightarrow> nat" where
+"triangle_imp_time s t = 
+  (let
+     mul_a' = triangle_a s;
+     t = t + 2;
+     mul_b' = (triangle_a s) + 1;
+     t = t + 2;
+     mul_c' = 0;
+     t = t + 2;
+     mul_d' = 0;
+     t = t + 2;
+     (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c', mul_d = mul_d'\<rparr>;
+     mul_ret = (mul_imp triangle_mul_state);
+     t = t + mul_imp_time triangle_mul_state 0;
+     triangle_triangle = mul_c mul_ret div 2;
+     t = t + 2;
+     triangle_a = triangle_a s;
+     t = t + 2;
+     ret = t
+   in
+     ret
+  )"
+
+
+lemma triangle_imp_time_acc: "(triangle_imp_time s (Suc t)) = Suc (triangle_imp_time s t)"
+  by (induction s "t" arbitrary:  rule: triangle_imp_time.induct)
+     (auto simp add: mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition triangle_IMP_minus where
+"triangle_IMP_minus \<equiv>
+  (
+   \<comment> \<open>mul_a' = triangle_a s;\<close>
+   [''mul''] ''a'' ::= (A (V ''a'')) ;;
+   \<comment> \<open>mul_b' = (triangle_a s) + 1;\<close>
+   [''mul''] ''b'' ::= ((V ''a'') \<oplus> (N 1));;
+   \<comment> \<open>mul_c' = 0;\<close>
+   [''mul''] ''c'' ::= (A (N 0)) ;;
+   \<comment> \<open>mul_d' = 0;\<close>
+   [''mul''] ''d'' ::= (A (N 0));;
+   \<comment> \<open>(mul_state::mul_state) = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = 0, mul_d = 0\<rparr>;\<close>
+   \<comment> \<open>mul_ret = (mul_imp mul_state);\<close>
+   invoke_subprogram ''mul'' mul_IMP_minus ;;
+   \<comment> \<open>triangle_triangle = mul_c mul_ret div 2;\<close>
+  ''triangle'' ::= [''mul''] ((V ''c'') \<then>);;
+  ''a'' ::= A (V ''a'')
+  )"
+
+
+definition triangle_IMP_Minus_state_transformer where "triangle_IMP_Minus_state_transformer p s \<equiv>
+ (mul_IMP_Minus_state_transformer (''mul'' @ p) (triangle_mul_state s)) o
+ (state_transformer p [(''a'',  triangle_a s), (''triangle'',  triangle_triangle s)])"
+
+definition "triangle_imp_to_HOL_state p s =
+              \<lparr>triangle_mul_state = mul_imp_to_HOL_state (''mul'' @ p) s, 
+               triangle_a = s (add_prefix p ''a''), triangle_triangle = (s (add_prefix p ''triangle''))\<rparr>"
+
+(*notation add_prefix ("_ _" [1000, 61] 61) *)
+
+(*lemma xxx: "aval e (s (y:= v)) = aval e s"
+  sorry*)
+
+lemma triangle_IMP_Minus_correct: 
+   "(triangle_IMP_minus p, s) 
+      \<Rightarrow>\<^bsup>triangle_imp_time (triangle_imp_to_HOL_state p s) 0\<^esup> 
+      triangle_IMP_Minus_state_transformer p (triangle_imp (triangle_imp_to_HOL_state p s)) s"
+  apply(subst triangle_imp.simps)
+  apply(subst triangle_imp_time.simps)
+  apply(subst Let_def)+
+  apply(subst triangle_IMP_minus_def)
+  apply(rule Seq')
+   apply(rule Seq')
+    apply(rule Seq')
+     apply(rule Seq')
+      apply(rule Seq')
+       apply(rule Seq')
+        apply(subst add_0)
+        apply(rule AssignI')
+        apply rule
+       apply(rule AssignI')
+       apply rule
+      apply(rule AssignI')
+      apply rule
+     apply(rule AssignI')
+     apply rule
+    apply(rule mul_IMP_minus_correct')
+    apply(simp add: triangle_imp_to_HOL_state_def mul_imp_to_HOL_state_def)
+   apply(rule AssignI')
+   apply rule
+  apply(subst triangle_IMP_Minus_state_transformer_def)
+  apply(subst comp_def)
+  apply(rule AssignI')
+  apply(subst mul_IMP_Minus_state_transformer_def)+
+  apply(subst state_transformer_commutes')
+   apply(simp add: triangle_imp_to_HOL_state_def triangle_state_upd_def Let_def
+              del: mul_imp.simps)+
+  done
+
+lemma triangle_IMP_Minus_correct': 
+  shows
+   "\<lbrakk>s_HOL = (triangle_imp_to_HOL_state p s)\<rbrakk> \<Longrightarrow>
+   (triangle_IMP_minus p, s) 
+    \<Rightarrow>\<^bsup>(triangle_imp_time s_HOL 0)\<^esup> 
+      triangle_IMP_Minus_state_transformer p (triangle_imp s_HOL) s"
+  using triangle_IMP_Minus_correct
+  by (auto simp del: mul_imp.simps)
+
+
+(*definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
+  [''a''] ''a'' ::= (A (V ''a'')) ;;
+  [''a''] ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
+  invoke_subprogram ''a'' mul_IMP_minus ;;
+  ''triangle'' ::= [''a''] ((V ''c'') \<then>) ;;
+  ''a'' ::= (A (N 0))"
+
+
+
 
 thm add.commute
 lemma comp_add:"(\<lambda>x::'a::ab_semigroup_add. f (x +c)) = f o ((+) c)"
@@ -53,7 +204,7 @@ lemma triangle_IMP_Minus_correct[intro]:
       \<Rightarrow>\<^bsup>triangle_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
       triangle_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
   unfolding triangle_IMP_Minus_def triangle_def triangle_IMP_Minus_time_def
-  by (fastforce intro!: terminates_in_time_state_intro[OF Seq])
+  by (fastforce intro!: terminates_in_t ime_state_intro[OF Seq])
 
 definition prod_encode_IMP_Minus where "prod_encode_IMP_Minus \<equiv>
   [''a''] ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
@@ -215,11 +366,11 @@ lemma snd_nat_IMP_Minus_correct[intro]:
       terminates_in_time_state_intro[OF Seq'])
 
 definition tl_IMP where "tl_IMP \<equiv>
-  [''snd''] ''a'' ::=  (V ''xs'' \<ominus> N 1) ;;
+  [''snd''] ''a'' ::=  (V ''input1'' \<ominus> N 1) ;;
   invoke_subprogram ''snd'' snd_nat_IMP_Minus ;;
   ''ans'' ::= [''snd''] A (V ''snd_nat'');;
   [''snd''] ''snd_nat'' ::= A (N 0);;
-  ''xs'' ::= A (N 0)
+  ''input1'' ::= A (N 0)
 "
 
 
@@ -647,5 +798,5 @@ lemma reverse_nat_acc_IMP_Minus_correct:
       intro!: HOL.ext terminates_in_time_state_intro[OF Seq'] 
       zero_variables_correct reverse_nat_acc_IMP_Minus_loop_correct
       intro:  reverse_nat_acc_IMP_Minus_loop_correct)+
-  
+  *)
 end
\ No newline at end of file
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index d88555dd..a5151b56 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -7,7 +7,8 @@ begin
 
 unbundle no_com_syntax
 
-definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus = 
+(*
+definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus =
   ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
   IF ''c''\<noteq>0 
   THEN
@@ -48,8 +49,170 @@ next
     unfolding max_a_min_b_IMP_Minus_def max_a_min_b_IMP_Minus_time_def
     using False
     by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])+
+qed*)
+
+record mul_state = mul_a::nat mul_b::nat mul_c::nat mul_d::nat
+
+definition "mul_state_upd s \<equiv>
+      let
+        mul_d = (mul_b s) mod 2;
+        mul_c = (if mul_d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
+        mul_a = mul_a s + mul_a s;
+        mul_b = (mul_b s) div 2;
+        ret = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = mul_c, mul_d = mul_d\<rparr>
+      in
+        ret
+"
+
+function mul_imp:: "mul_state \<Rightarrow> mul_state" where
+"mul_imp s = 
+  (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
+    (
+      let
+        next_iteration = mul_imp (mul_state_upd s)
+      in
+        next_iteration
+    )
+  else
+    (
+      let
+        ret = s
+      in
+        ret
+    )
+  )"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>s. mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
+
+lemma mul_imp_correct: "mul_c (mul_imp s) = mul_c s + mul_a s * mul_b s"
+proof (induction s rule: mul_imp.induct)
+  case (1 s)
+  then show ?case
+    apply(subst mul_imp.simps)
+    apply (auto simp: mul_state_upd_def Let_def simp del: mul_imp.simps split: if_splits)
+    by (metis (no_types, lifting) One_nat_def add.commute add_mult_distrib2 distrib_right mult.right_neutral mult_2 mult_div_mod_eq)
+qed 
+
+function mul_imp_time:: "mul_state \<Rightarrow> nat \<Rightarrow> nat" where
+"mul_imp_time s t = 
+(
+    (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
+      (
+        let
+          t = t + 1; \<comment> \<open>To account for while loop condition checking\<close>
+          mul_d = (mul_b s) mod 2::nat;
+          t = t + 2;
+          mul_c = (if mul_d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
+          t = t + 1 + (if mul_d \<noteq> 0 then 2 else 2);
+          mul_a = mul_a s + mul_a s;
+          t = t + 2;
+          mul_b = mul_b s div 2;
+          t = t + 2;
+          next_iteration = mul_imp_time (mul_state_upd s) t
+        in
+          next_iteration
+      )
+    else
+      (
+         \<comment> \<open>To account for the two steps of checking the condition and skipping the loop\<close>
+        let
+          t = t + 2;
+          ret = t
+        in
+          ret
+      )
+    )
+)"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>(s, t). mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
+
+lemma mul_imp_time_acc: "(mul_imp_time s (Suc t)) = Suc (mul_imp_time s t)"
+  by (induction s "t" arbitrary:  rule: mul_imp_time.induct)
+     (auto simp add: mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition mul_IMP_minus where
+"mul_IMP_minus \<equiv>
+  (\<comment> \<open>if b \<noteq> 0 then\<close>
+   WHILE ''b''\<noteq>0 DO
+        \<comment> \<open>d = b mod 2;\<close>
+        (''d'' ::= ((V ''b'') \<doteq>1);;
+        \<comment> \<open>c = (if d \<noteq> 0 then c + a else c);\<close>
+        IF ''d''\<noteq>0 THEN ''c'' ::= ((V ''c'') \<oplus> (V ''a'')) ELSE ''c'' ::= A (V ''c'');;
+        \<comment> \<open>a = a + a;\<close>
+        ''a'' ::= ((V ''a'') \<oplus> (V ''a''));;
+        \<comment> \<open>b = b div 2;\<close>
+        ''b'' ::= ((V ''b'') \<then>))
+  )"
+
+definition mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p s \<equiv>
+  state_transformer p  
+    [(''a'', mul_a s),(''b'',  mul_b s),(''c'',  mul_c s),(''d'', mul_d s)]"
+
+definition "mul_imp_to_HOL_state p s =
+  \<lparr>mul_a = s (add_prefix p ''a''), mul_b = (s (add_prefix p ''b'')),
+   mul_c = (s (add_prefix p ''c'')), mul_d =  (s (add_prefix p ''d''))\<rparr>"
+
+lemma mul_IMP_minus_correct: 
+  shows
+   "(mul_IMP_minus p, s) 
+    \<Rightarrow>\<^bsup>(mul_imp_time (mul_imp_to_HOL_state p s) 0)\<^esup> 
+      mul_IMP_Minus_state_transformer p (mul_imp (mul_imp_to_HOL_state p s)) s"
+proof(induction "mul_imp_to_HOL_state p s" arbitrary: s rule: mul_imp.induct)
+  case 1
+  then show ?case
+    apply(subst mul_IMP_Minus_state_transformer_def)
+    apply(subst mul_imp.simps)
+    apply(subst mul_imp_time.simps)
+    apply(subst Let_def)+
+    apply(subst mul_IMP_minus_def)
+    apply(rule WhileI[where y = "mul_imp_time (mul_state_upd (mul_imp_to_HOL_state p s)) 0"])
+     apply(intro conjI)
+       apply(rule Seq')
+       apply(rule Seq')
+         apply(rule Seq')
+           apply(rule Big_StepT.Assign)
+         apply(rule IfI)
+                apply(rule Big_StepT.Assign)
+                   apply(rule Big_StepT.Assign)
+            apply rule
+            apply rule
+            apply(rule Big_StepT.Assign)
+       apply(rule Big_StepT.Assign)
+  apply(dest_com)
+  apply(simp add: mul_imp_to_HOL_state_def)
+         apply(simp add: mul_state_upd_def mul_imp_to_HOL_state_def)
+        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
+                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
+        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
+                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
+    apply (simp add: mul_state_upd_def mul_IMP_Minus_state_transformer_def)
+    apply (simp add: mul_state_upd_def mul_IMP_Minus_state_transformer_def)
+    apply (simp add: mul_state_upd_def mul_IMP_Minus_state_transformer_def)
+    apply (simp add: mul_IMP_minus_def)
+        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def state_transformer_def
+                   simp del: mul_imp_time.simps split: if_splits)[1]
+        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def state_transformer_def
+                   simp del: mul_imp_time.simps split: if_splits)[1]
+    apply(subst mul_imp_time_acc)+
+        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
+                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
+    apply(subst mul_imp_time_acc)+
+        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
+                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
+    done
 qed
 
+lemma mul_IMP_minus_correct':
+  shows
+   "\<lbrakk>s_HOL = (mul_imp_to_HOL_state p s)\<rbrakk> \<Longrightarrow>
+   (mul_IMP_minus p, s) 
+    \<Rightarrow>\<^bsup>(mul_imp_time s_HOL 0)\<^esup> 
+      mul_IMP_Minus_state_transformer p (mul_imp s_HOL) s"
+  using mul_IMP_minus_correct
+  by (auto simp del: mul_imp.simps)
+
 definition mul_iteration where
 "mul_iteration = 
   ''d'' ::= ((V ''b'') \<doteq>1) ;;
diff --git a/IMP-/ROOT b/IMP-/ROOT
index d8a6c45d..0c9f5bd3 100644
--- a/IMP-/ROOT
+++ b/IMP-/ROOT
@@ -5,5 +5,4 @@ session IMP_Minus = HOL +
     Com
     Big_StepT
     Small_StepT
-    Big_Step_Small_Step_Equivalence
-    
\ No newline at end of file
+    Big_Step_Small_Step_Equivalence
\ No newline at end of file

From 5c8654c86e969b78e3fdb88d5f0848b4bba5f1d8 Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Tue, 21 Dec 2021 20:06:20 +0100
Subject: [PATCH 094/103] New approach instaed of state transformers

---
 IMP-/Big_StepT.thy                    | 102 +++-
 IMP-/Canonical_State_Transformers.thy |  42 +-
 IMP-/IMP_Minus_Nat_Bijection.thy      | 786 +++-----------------------
 IMP-/Multiplication.thy               | 298 +++-------
 4 files changed, 267 insertions(+), 961 deletions(-)

diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index f4af9839..82f34709 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -1,6 +1,6 @@
-\<^marker>\<open>creator Bilel Ghorbel, Florian Kessler\<close>
+\<^marker>\<open>creator Mohammad Abdulaziz, Bilel Ghorbel, Florian Kessler\<close>
 section "Big step semantics of IMP-"
-theory Big_StepT imports Main Com "HOL-Eisbach.Eisbach_Tools" begin
+theory Big_StepT imports Main Max_Constant Com "HOL-Eisbach.Eisbach_Tools" begin
 
 paragraph "Summary"
 text\<open>We define big step semantics with time for IMP-. 
@@ -22,31 +22,6 @@ WhileFalse: "\<lbrakk> s b = 0 \<rbrakk> \<Longrightarrow> (WHILE b \<noteq>0 DO
 WhileTrue: "\<lbrakk> s1 b \<noteq> 0;  (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2;  (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3; 1+x+y=z  \<rbrakk> 
     \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
 
-lemma WhileI: 
-"\<lbrakk>(s1 b \<noteq> 0 \<Longrightarrow> (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<and> (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3);
-  (s1 b = 0 \<Longrightarrow> s1 = s3);
-  z = (if s1 b \<noteq> 0 then 1+x+y else 2)\<rbrakk>
-        \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
-  by (auto simp add: WhileTrue WhileFalse numeral_2_eq_2)
-
-lemma IfI: 
-"\<lbrakk>s b \<noteq> 0 \<Longrightarrow> (c1,s) \<Rightarrow>\<^bsup> x1 \<^esup> t1;
-  s b = 0 \<Longrightarrow> (c2,s) \<Rightarrow>\<^bsup> x2 \<^esup> t2;
-  y = (if s b \<noteq> 0 then x1 else x2) + 1;
-  t = (if s b \<noteq> 0 then t1 else t2)\<rbrakk>
-        \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" 
-  by (auto simp add: IfTrue IfFalse)
-
-lemma AssignI: 
-"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
-        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s'" 
-  by (auto simp add: Assign)
-
-lemma AssignI': 
-"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
-        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s'" 
-  by (auto simp add: Assign eval_nat_numeral)
-
 bundle big_step_syntax
 begin
 notation big_step_t ("_ \<Rightarrow>\<^bsup> _ \<^esup> _" 55)
@@ -237,8 +212,81 @@ method dest_com  =
   (match premises in a: "\<lbrakk>loop_cond; state_upd\<rbrakk> \<Longrightarrow> (_, s) \<Rightarrow>\<^bsup>t\<^esup> s'"
     for s s' t loop_cond state_upd \<Rightarrow> \<open>rule terminates_in_time_state_intro'[OF a]\<close>)
 
+method dest_com' = 
+  (match premises in a[thin]: "\<lbrakk>loop_cond; state_upd; (_, s) \<Rightarrow>\<^bsup>t\<^esup> s'\<rbrakk> \<Longrightarrow> P" 
+    for s s' t loop_cond state_upd P  \<Rightarrow>
+   \<open>match premises in b[thin]: "(While _ _, s2) \<Rightarrow>\<^bsup>t2\<^esup> s2'"
+      for s2 s2' t2 \<Rightarrow> \<open>insert a[OF _ _ b]\<close>\<close>)
+
+
 lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
 (\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
   by auto
 
+lemma AssignD': 
+"(x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s' \<Longrightarrow> s' = s (x:= aval a s)"
+  by (auto simp add: eval_nat_numeral)
+
+lemma com_only_vars: "\<lbrakk>(c, s) \<Rightarrow>\<^bsup> t \<^esup> s'; x \<notin> set (Max_Constant.all_variables c)\<rbrakk> \<Longrightarrow> s x = s' x"
+  by (induction arbitrary: t rule: big_step_t_induct)  auto
+
+lemma Seq'': "\<lbrakk> (c1,s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<and> P s2; P s2 \<Longrightarrow> (c2,s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<and> Q s3; Q s3 \<Longrightarrow> R s3 \<rbrakk>
+             \<Longrightarrow> (c1;;c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3 \<and> R s3"
+  by auto
+
+lemma WhileI:
+"\<lbrakk>(s1 b \<noteq> 0 \<Longrightarrow> (c,s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<and> (WHILE b \<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> s3);
+  (s1 b = 0 \<Longrightarrow> s1 = s3);
+  z = (if s1 b \<noteq> 0 then 1+x+y else 2)\<rbrakk>
+        \<Longrightarrow> (WHILE b \<noteq>0 DO c, s1) \<Rightarrow>\<^bsup> z \<^esup> s3" 
+  by (auto simp add: WhileTrue WhileFalse numeral_2_eq_2)
+
+lemma IfI:
+"\<lbrakk>s b \<noteq> 0 \<Longrightarrow> (c1,s) \<Rightarrow>\<^bsup> x1 \<^esup> t1;
+  s b = 0 \<Longrightarrow> (c2,s) \<Rightarrow>\<^bsup> x2 \<^esup> t2;
+  y = (if s b \<noteq> 0 then x1 else x2) + 1;
+  t = (if s b \<noteq> 0 then t1 else t2)\<rbrakk>
+        \<Longrightarrow> (IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> y \<^esup> t" 
+  by (auto simp add: IfTrue IfFalse)
+
+lemma IfE: 
+"(IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> (if s b \<noteq> 0 then x1 else x2) + 1 \<^esup> (if s b \<noteq> 0 then s1 else s2) \<Longrightarrow> 
+ \<lbrakk>\<lbrakk>s b \<noteq> 0; (if s b \<noteq> 0 then x1 else x2) + 1 = x1 + 1; 
+  (if s b \<noteq> 0 then s1 else s2) = s1; (c1,s) \<Rightarrow>\<^bsup> x1 \<^esup> s1\<rbrakk> \<Longrightarrow> P;
+  \<lbrakk>s b = 0; (if s b \<noteq> 0 then x1 else x2) + 1 = x2 + 1;
+   (if s b \<noteq> 0 then s1 else s2) = s2; (c2,s) \<Rightarrow>\<^bsup> x2 \<^esup> s2\<rbrakk> \<Longrightarrow> P\<rbrakk>
+        \<Longrightarrow> P"
+  by (auto simp add: IfTrue IfFalse)
+
+thm Seq_tE
+
+lemma IfD:
+"(IF b \<noteq>0 THEN c1 ELSE c2, s) \<Rightarrow>\<^bsup> (if s b \<noteq> 0 then x1 else x2) + 1 \<^esup> (if s b \<noteq> 0 then t1 else t2) \<Longrightarrow> 
+ \<lbrakk>\<lbrakk>s b \<noteq> 0; (c1,s) \<Rightarrow>\<^bsup> x1 \<^esup> t1\<rbrakk> \<Longrightarrow> P;
+  \<lbrakk>s b = 0; (c2,s) \<Rightarrow>\<^bsup> x2 \<^esup> t2\<rbrakk> \<Longrightarrow> P\<rbrakk>
+        \<Longrightarrow> P" 
+  by (auto simp add: IfTrue IfFalse)
+
+
+
+
+lemma AssignI:
+"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
+        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> Suc (Suc 0) \<^esup> s'" 
+  by (auto simp add: Assign)
+
+lemma AssignI': 
+"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
+        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s'" 
+  by (auto simp add: Assign eval_nat_numeral)
+
+lemma AssignI'': 
+"\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
+        \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s' \<and> s' = s'" 
+  by (auto simp add: Assign eval_nat_numeral)
+thm Assign_tE
+
+lemma AssignD: "(x ::= a, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> t = 2 \<and> s' = s(x := aval a s)"
+  sorry
+
 end
\ No newline at end of file
diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
index 9927a5a8..93ed9cd0 100644
--- a/IMP-/Canonical_State_Transformers.thy
+++ b/IMP-/Canonical_State_Transformers.thy
@@ -1,8 +1,10 @@
+(*Authors: Mohammad Abdulaziz, Florian Keßler*)
+
 theory Canonical_State_Transformers
-  imports Com
+  imports Com Big_StepT
 begin
 
-definition add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
+(*definition add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
 "add_prefix p s = (concat (map (\<lambda>i. i # ''!'') p)) @ ''**'' @ s"
 
 lemma length_concat_map[simp]: 
@@ -452,8 +454,12 @@ lemma updated_state_as_state_transformer[simp]:
   "s(add_prefix p x := y) = state_transformer p [(x, y)] s"
   unfolding state_transformer_def
   by auto
+*)
+
+abbreviation add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
+"add_prefix p s \<equiv> p @ s"
 
-type_synonym pcom = "string \<Rightarrow> com"
+(*type_synonym pcom = "string \<Rightarrow> com"*)
 
 fun atomExp_add_prefix where
 "atomExp_add_prefix p (N a) = N a" |
@@ -466,6 +472,13 @@ fun aexp_add_prefix where
 "aexp_add_prefix p (Parity a) = Parity (atomExp_add_prefix p a)" |
 "aexp_add_prefix p (RightShift a) = RightShift (atomExp_add_prefix p a)"
 
+fun com_add_prefix where
+"com_add_prefix p SKIP = SKIP"
+|"com_add_prefix p (Assign v aexp) = (Assign (add_prefix p v) (aexp_add_prefix p aexp))"
+|"com_add_prefix p (Seq c1 c2) = (Seq (com_add_prefix p c1) (com_add_prefix p c2))"
+|"com_add_prefix p (If v c1 c2) = (If (add_prefix p v) (com_add_prefix p c1) (com_add_prefix p c2))"
+|"com_add_prefix p (While v c) = (While (add_prefix p v) (com_add_prefix p c))"
+
 abbreviation pcom_SKIP where "pcom_SKIP p \<equiv> SKIP"
 
 abbreviation pcom_Assign where "pcom_Assign v aexp p \<equiv>
@@ -478,9 +491,6 @@ abbreviation pcom_If where "pcom_If v a b p \<equiv>
 
 abbreviation pcom_While where "pcom_While v a p \<equiv> While (add_prefix p v) (a p)"
 
-abbreviation invoke_subprogram :: "string \<Rightarrow> pcom \<Rightarrow> pcom" 
-  where "invoke_subprogram p' c \<equiv> (\<lambda>p. c (p' @ p))"
-
 abbreviation write_subprogram_param where "write_subprogram_param p' a  b \<equiv>
   (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix p b))"
 
@@ -518,4 +528,24 @@ end
 
 unbundle pcom_syntax
 
+lemma atomExp_add_prefix_valid: "(\<And>v. v \<in> set (atomExp_var x1) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
+          atomVal x1 s1 = atomVal (atomExp_add_prefix p x1) s1'"
+  by (cases x1) auto
+
+lemma aexp_add_prefix_valid: "(\<And>v. v \<in> set (aexp_vars aexp) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
+       aval aexp s1 = aval (aexp_add_prefix p aexp) s1'"
+  by (cases aexp) (auto simp: atomExp_add_prefix_valid)
+
+lemma atomExp_add_prefix_valid': "v \<in> set (atomExp_var (atomExp_add_prefix p x1)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (cases x1) (auto simp:)
+
+lemma aexp_add_prefix_valid':"v \<in> set (aexp_vars (aexp_add_prefix p aexp)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (cases aexp) (auto simp: atomExp_add_prefix_valid')
+
+lemma invoke_subprogram_valid: "v \<in> set (all_variables (com_add_prefix p c)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (induction p c rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid')
+
+abbreviation invoke_subprogram 
+  where "invoke_subprogram p c \<equiv> (c o (add_prefix p))"
+
 end
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index ef18b4e2..71f58cca 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -5,13 +5,24 @@ theory IMP_Minus_Nat_Bijection
     "../Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives"
 begin
 
+lemma xxx: "x \<noteq> y \<Longrightarrow> (s (x := aval a s)) y = s y"
+  by auto
+
+(*lemma AssignI'': 
+  "\<exists>s'.((x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s' \<and> (s' = s (x := aval a s)))"
+  by (auto simp add: Assign eval_nat_numeral)
+*)
+
 unbundle IMP_Minus_Minus_Com.no_com_syntax
+
 unbundle Com.no_com_syntax
-                                                 
+
 record triangle_state = triangle_mul_state::mul_state triangle_a::nat triangle_triangle::nat
-                                            
+
 term Nat_Bijection.triangle
 
+find_theorems Max_Constant.all_variables
+
 (*definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
   [''a''] ''a'' ::= (A (V ''a'')) ;;
   [''a''] ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
@@ -42,15 +53,17 @@ fun triangle_imp:: "triangle_state \<Rightarrow> triangle_state" where
      ret
   )"
 
+lemmas [simp del] = triangle_imp.simps
+
 lemma triangle_imp_correct: "triangle_triangle (triangle_imp s) = Nat_Bijection.triangle (triangle_a s)"
 proof (induction s rule: triangle_imp.induct)
   case (1 s)
   then show ?case
-    by (auto simp: triangle_def triangle_state_upd_def Let_def mul_imp_correct simp del: mul_imp.simps split: if_splits)
+    by (auto simp: triangle_imp.simps triangle_def triangle_state_upd_def Let_def mul_imp_correct split: if_splits)
 qed 
 
-fun triangle_imp_time:: "triangle_state \<Rightarrow> nat \<Rightarrow> nat" where
-"triangle_imp_time s t = 
+fun triangle_imp_time:: "nat \<Rightarrow> triangle_state \<Rightarrow> nat" where
+"triangle_imp_time t s = 
   (let
      mul_a' = triangle_a s;
      t = t + 2;
@@ -62,7 +75,7 @@ fun triangle_imp_time:: "triangle_state \<Rightarrow> nat \<Rightarrow> nat" whe
      t = t + 2;
      (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c', mul_d = mul_d'\<rparr>;
      mul_ret = (mul_imp triangle_mul_state);
-     t = t + mul_imp_time triangle_mul_state 0;
+     t = t + mul_imp_time 0 triangle_mul_state;
      triangle_triangle = mul_c mul_ret div 2;
      t = t + 2;
      triangle_a = triangle_a s;
@@ -72,10 +85,11 @@ fun triangle_imp_time:: "triangle_state \<Rightarrow> nat \<Rightarrow> nat" whe
      ret
   )"
 
+lemmas [simp del] = triangle_imp_time.simps
 
-lemma triangle_imp_time_acc: "(triangle_imp_time s (Suc t)) = Suc (triangle_imp_time s t)"
-  by (induction s "t" arbitrary:  rule: triangle_imp_time.induct)
-     (auto simp add: mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
+lemma triangle_imp_time_acc: "(triangle_imp_time (Suc t) s) = Suc (triangle_imp_time t s)"
+  by (induction t s rule: triangle_imp_time.induct)
+     (auto simp add: triangle_imp_time.simps mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
 
 definition triangle_IMP_minus where
 "triangle_IMP_minus \<equiv>
@@ -90,713 +104,85 @@ definition triangle_IMP_minus where
    [''mul''] ''d'' ::= (A (N 0));;
    \<comment> \<open>(mul_state::mul_state) = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = 0, mul_d = 0\<rparr>;\<close>
    \<comment> \<open>mul_ret = (mul_imp mul_state);\<close>
-   invoke_subprogram ''mul'' mul_IMP_minus ;;
+   invoke_subprogram ''mul'' mul_IMP_minus;;
    \<comment> \<open>triangle_triangle = mul_c mul_ret div 2;\<close>
   ''triangle'' ::= [''mul''] ((V ''c'') \<then>);;
   ''a'' ::= A (V ''a'')
   )"
 
 
-definition triangle_IMP_Minus_state_transformer where "triangle_IMP_Minus_state_transformer p s \<equiv>
- (mul_IMP_Minus_state_transformer (''mul'' @ p) (triangle_mul_state s)) o
- (state_transformer p [(''a'',  triangle_a s), (''triangle'',  triangle_triangle s)])"
+(*definition triangle_IMP_Minus_state_transformer where "triangle_IMP_Minus_state_transformer p s \<equiv>
+ (state_transformer p [(''a'',  triangle_a s), (''triangle'',  triangle_triangle s)]) o
+ (mul_IMP_Minus_state_transformer (''mul'' @ p) (triangle_mul_state s))"*)
 
 definition "triangle_imp_to_HOL_state p s =
-              \<lparr>triangle_mul_state = mul_imp_to_HOL_state (''mul'' @ p) s, 
+              \<lparr>triangle_mul_state = mul_imp_to_HOL_state (p @ ''mul'') s, 
                triangle_a = s (add_prefix p ''a''), triangle_triangle = (s (add_prefix p ''triangle''))\<rparr>"
 
-(*notation add_prefix ("_ _" [1000, 61] 61) *)
-
-(*lemma xxx: "aval e (s (y:= v)) = aval e s"
-  sorry*)
-
-lemma triangle_IMP_Minus_correct: 
-   "(triangle_IMP_minus p, s) 
-      \<Rightarrow>\<^bsup>triangle_imp_time (triangle_imp_to_HOL_state p s) 0\<^esup> 
-      triangle_IMP_Minus_state_transformer p (triangle_imp (triangle_imp_to_HOL_state p s)) s"
-  apply(subst triangle_imp.simps)
-  apply(subst triangle_imp_time.simps)
-  apply(subst Let_def)+
-  apply(subst triangle_IMP_minus_def)
-  apply(rule Seq')
-   apply(rule Seq')
-    apply(rule Seq')
-     apply(rule Seq')
-      apply(rule Seq')
-       apply(rule Seq')
-        apply(subst add_0)
-        apply(rule AssignI')
-        apply rule
-       apply(rule AssignI')
-       apply rule
-      apply(rule AssignI')
-      apply rule
-     apply(rule AssignI')
-     apply rule
-    apply(rule mul_IMP_minus_correct')
-    apply(simp add: triangle_imp_to_HOL_state_def mul_imp_to_HOL_state_def)
-   apply(rule AssignI')
-   apply rule
-  apply(subst triangle_IMP_Minus_state_transformer_def)
-  apply(subst comp_def)
-  apply(rule AssignI')
-  apply(subst mul_IMP_Minus_state_transformer_def)+
-  apply(subst state_transformer_commutes')
-   apply(simp add: triangle_imp_to_HOL_state_def triangle_state_upd_def Let_def
-              del: mul_imp.simps)+
-  done
-
-lemma triangle_IMP_Minus_correct': 
-  shows
-   "\<lbrakk>s_HOL = (triangle_imp_to_HOL_state p s)\<rbrakk> \<Longrightarrow>
-   (triangle_IMP_minus p, s) 
-    \<Rightarrow>\<^bsup>(triangle_imp_time s_HOL 0)\<^esup> 
-      triangle_IMP_Minus_state_transformer p (triangle_imp s_HOL) s"
-  using triangle_IMP_Minus_correct
-  by (auto simp del: mul_imp.simps)
-
-
-(*definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
-  [''a''] ''a'' ::= (A (V ''a'')) ;;
-  [''a''] ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
-  invoke_subprogram ''a'' mul_IMP_minus ;;
-  ''triangle'' ::= [''a''] ((V ''c'') \<then>) ;;
-  ''a'' ::= (A (N 0))"
-
-
-
-
-thm add.commute
-lemma comp_add:"(\<lambda>x::'a::ab_semigroup_add. f (x +c)) = f o ((+) c)"
-  by (auto simp add: comp_def add.commute[symmetric])
-
-lemma poly_const:"poly ((+) c)"
-proof -
-  have 1:"poly (\<lambda>x. x)"
-    by (rule poly_linear)
-  have 2:"poly (\<lambda>x. c)" by simp
-  have "((+)c) = (\<lambda>x . x + c)"  by auto
-  moreover from 1 2 have "poly (\<lambda>x. x + c) " by auto
-  ultimately show ?thesis by auto
-qed
-find_theorems poly  "(o)" 
-
-lemma poly_shift: "poly f \<Longrightarrow> poly (\<lambda>x. f(x + c))"
-  by (subst comp_add) (auto intro: poly_const)
-
-   
-  
-
-lemma "poly (f o g) \<Longrightarrow> poly ((\<lambda>x. f(x + c)) o g)"
-  oops
-definition triangle_IMP_Minus_time where "triangle_IMP_Minus_time x \<equiv>
-  mul_IMP_Minus_time (1 + x) + 8"
-lemma "poly (triangle_IMP_Minus_time o exp2)"
-  unfolding triangle_IMP_Minus_time_def 
-  oops
-abbreviation triangle_IMP_Minus_state_transformer where 
-  "triangle_IMP_Minus_state_transformer p n  \<equiv>
-    state_transformer p [(''triangle'', triangle n), (''a'', 0)] \<circ> 
-    mul_IMP_Minus_state_transformer (''a'' @ p) n (n + 1)"
-
-lemma triangle_IMP_Minus_correct[intro]: 
-   "(triangle_IMP_Minus p, s) 
-      \<Rightarrow>\<^bsup>triangle_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
-      triangle_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
-  unfolding triangle_IMP_Minus_def triangle_def triangle_IMP_Minus_time_def
-  by (fastforce intro!: terminates_in_t ime_state_intro[OF Seq])
-
-definition prod_encode_IMP_Minus where "prod_encode_IMP_Minus \<equiv>
-  [''a''] ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
-  invoke_subprogram ''a'' triangle_IMP_Minus ;;
-  ''prod_encode'' ::= [''a''] (A (V ''triangle'')) ;;
-  [''a''] ''triangle'' ::= (A (N 0)) ;;
-  ''prod_encode'' ::= ((V ''a'') \<oplus> (V ''prod_encode'')) ;;
-  zero_variables [''a'', ''b'']"
-
-definition prod_encode_IMP_Minus_time where "prod_encode_IMP_Minus_time x y \<equiv>
-  triangle_IMP_Minus_time (x + y) + 8 + zero_variables_time [''a'', ''b'']"
-
-abbreviation prod_encode_IMP_Minus_state_transformer where 
-  "prod_encode_IMP_Minus_state_transformer p x y \<equiv>
-    state_transformer p [(''prod_encode'', prod_encode (x, y)), (''a'', 0), (''b'', 0)] \<circ>
-    state_transformer (''a'' @ p) [(''triangle'', 0)] \<circ> 
-    triangle_IMP_Minus_state_transformer (''a'' @ p) (x + y)"
-
-lemma prod_encode_IMP_Minus_correct[intro]: 
-  "(prod_encode_IMP_Minus p, s) 
-      \<Rightarrow>\<^bsup>prod_encode_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup> 
-      prod_encode_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
-  unfolding prod_encode_IMP_Minus_def prod_encode_def prod_encode_IMP_Minus_time_def
-  by(fastforce intro!: terminates_in_time_state_intro[OF Seq])
-
-fun prod_decode_aux_iterations :: "nat \<Rightarrow> nat \<Rightarrow> nat"
-  where "prod_decode_aux_iterations k m =
-    (if m \<le> k then 0 else Suc (prod_decode_aux_iterations (Suc k) (m - Suc k)))"
-
-declare prod_decode_aux_iterations.simps [simp del]
-
-definition prod_decode_aux_iteration where "prod_decode_aux_iteration \<equiv>
-  ''a'' ::= ((V ''a'') \<oplus> (N 1)) ;;
-  ''b'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
-  ''c'' ::= ((V ''b'') \<ominus> (V ''a''))"
-
-abbreviation prod_decode_aux_loop_state_transformer 
-  where "prod_decode_aux_loop_state_transformer p x y \<equiv>
-    state_transformer p [(''a'', fst (prod_decode_aux x y)
-                               + snd (prod_decode_aux x y)),
-                         (''b'', fst (prod_decode_aux x y)),
-                         (''c'', 0)]"
-
-lemma prod_decode_aux_loop_correct: 
-  "s (add_prefix p ''a'') = k \<Longrightarrow> s (add_prefix p ''b'') = m \<Longrightarrow> s (add_prefix p ''c'') = m - k 
-  \<Longrightarrow> ((WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration) p, s) 
-      \<Rightarrow>\<^bsup>2 + 7 * prod_decode_aux_iterations k m\<^esup> 
-      (if m - k \<noteq> 0 then prod_decode_aux_loop_state_transformer p k m s else s)"
-proof(induction k m arbitrary: s rule: prod_decode_aux.induct)
-  case (1 k m)
-  then show ?case
-  proof(cases "m - k")
-    case 0
-    then show ?thesis
-      using 1 terminates_in_state_intro[OF Big_StepT.WhileFalse]
-      by(auto simp:  prod_decode_aux.simps numeral_eq_Suc 
-          prod_decode_aux_iterations.simps)
-  next
-    case (Suc nat)
-
-    show ?thesis
-      apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[OF _ _ "1.IH"]])
-      unfolding prod_decode_aux_iteration_def
-      using \<open>s (add_prefix p ''a'') = k\<close>  \<open>s (add_prefix p ''b'') = m\<close>  
-        \<open>s (add_prefix p ''c'') = m - k\<close> \<open>m - k = Suc nat\<close>
-        prod_decode_aux_iterations.simps[where ?k = k]
-        prod_decode_aux.simps[where ?k = k]
-        prod_decode_aux.simps[where ?k = "(Suc (s (add_prefix p ''a'')))"]
-      by fastforce+
-  qed
-qed
-
-definition fst_nat_IMP_Minus where "fst_nat_IMP_Minus \<equiv>
-  ''b'' ::= (A (V ''a'')) ;; 
-  ''a'' ::= (A (N 0)) ;;
-  ''c'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
-  WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration ;;
-  ''fst_nat'' ::= (A (V ''b'')) ;;
-  ''a'' ::= (A (N 0)) ;;
-  ''b'' ::= (A (N 0))"
-
-definition fst_nat_IMP_Minus_time where "fst_nat_IMP_Minus_time x \<equiv>
-  14 + 7 * prod_decode_aux_iterations 0 x"
-
-abbreviation fst_nat_IMP_Minus_state_transformer where "fst_nat_IMP_Minus_state_transformer p x
-  \<equiv> state_transformer p [(''a'', 0),
-                          (''b'', 0),
-                          (''c'', 0),
-                          (''fst_nat'', fst_nat x)]"
-
-lemma fst_nat_IMP_Minus_correct[intro]: 
-  "(fst_nat_IMP_Minus p, s) 
-      \<Rightarrow>\<^bsup>fst_nat_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
-    fst_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
-  unfolding fst_nat_IMP_Minus_def fst_nat_def fst_nat_IMP_Minus_time_def
-  by (fastforce simp: prod_decode_def prod_decode_aux.simps[of 0 0] 
-      intro!: prod_decode_aux_loop_correct
-      terminates_in_time_state_intro[OF Seq'])
-
-definition hd_IMP where "hd_IMP \<equiv>
-  [''fst''] ''a'' ::=  (V ''xs'' \<ominus> N 1) ;;
-  invoke_subprogram ''fst'' fst_nat_IMP_Minus ;;
-  ''ans'' ::= [''fst''] A (V ''fst_nat'');;
-  ''xs'' ::= A (N 0)
-"
-
-
-abbreviation hd_state_transformer where 
-"hd_state_transformer p xs \<equiv> 
-state_transformer p [(''ans'',hd_nat xs) , (''xs'',0)] o
-fst_nat_IMP_Minus_state_transformer (''fst''@ p) (xs -1)
-"
-
-definition hd_time where "
-hd_time x \<equiv> fst_nat_IMP_Minus_time (x-1) + 6 "
-
-lemma hd_nat_IMP_Minus_correct[intro]: 
-  "(hd_IMP p, s) 
-      \<Rightarrow>\<^bsup>  hd_time (s (add_prefix p ''xs''))\<^esup> 
-   hd_state_transformer p (s (add_prefix p ''xs'')) s"
-  unfolding hd_IMP_def hd_time_def  hd_nat_def
-  apply (rule terminates_in_time_state_intro)
-    apply (rule Big_StepT.Seq)+
-  by fastforce+
-  
-  
-  
-fun f::"real\<Rightarrow>real" where "f x = x^3  -4x^2 + x+3"
-
-value "f (-2)"
-value "f (4)"
-value "f ((-2* f(4) + 4*f(-2))/ (f(4)-f(-2)))"
-
-definition snd_nat_IMP_Minus where "snd_nat_IMP_Minus \<equiv>
-  ''b'' ::= (A (V ''a'')) ;; 
-  ''a'' ::= (A (N 0)) ;;
-  ''c'' ::= ((V ''b'') \<ominus> (V ''a'')) ;;
-  WHILE ''c'' \<noteq>0 DO prod_decode_aux_iteration ;;
-  ''snd_nat'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
-  ''a'' ::= (A (N 0)) ;;
-  ''b'' ::= (A (N 0))"
-
-definition snd_nat_IMP_Minus_time where "snd_nat_IMP_Minus_time x \<equiv>
-  14 + 7 * prod_decode_aux_iterations 0 x"
-
-abbreviation snd_nat_IMP_Minus_state_transformer where "snd_nat_IMP_Minus_state_transformer p x
-  \<equiv> state_transformer p [(''a'', 0),
-                          (''b'', 0),
-                          (''c'', 0),
-                          (''snd_nat'', snd_nat x)]"
+lemma triangle_imp_to_HOL_state_add_prefix: 
+  "triangle_imp_to_HOL_state (add_prefix p1 p2) s = triangle_imp_to_HOL_state p2 (s o (add_prefix p1))"
+  by (auto simp only: triangle_imp_to_HOL_state_def append.assoc[symmetric] comp_def
+                      mul_imp_to_HOL_state_add_prefix)
 
-lemma snd_nat_IMP_Minus_correct[intro]: 
-  "(snd_nat_IMP_Minus p, s) 
-      \<Rightarrow>\<^bsup>snd_nat_IMP_Minus_time (s (add_prefix p ''a''))\<^esup> 
-    snd_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) s"
-  unfolding snd_nat_IMP_Minus_def snd_nat_def snd_nat_IMP_Minus_time_def
-  by (fastforce simp: prod_decode_def prod_decode_aux.simps[of 0 0] 
-      intro!: prod_decode_aux_loop_correct
-      terminates_in_time_state_intro[OF Seq'])
+(*lemma rev_add_prefix_all_variables:
+  "p1 \<noteq> [] \<Longrightarrow> (add_prefix p2 v \<notin> set (all_variables (invoke_subprogram p1 (c::pcom) p2)))"
+  nitpick
+  apply(induction p1 arbitrary: c p2)
+  subgoal by auto
+  subgoal apply auto
 
-definition tl_IMP where "tl_IMP \<equiv>
-  [''snd''] ''a'' ::=  (V ''input1'' \<ominus> N 1) ;;
-  invoke_subprogram ''snd'' snd_nat_IMP_Minus ;;
-  ''ans'' ::= [''snd''] A (V ''snd_nat'');;
-  [''snd''] ''snd_nat'' ::= A (N 0);;
-  ''input1'' ::= A (N 0)
-"
-
-
-abbreviation tl_state_transformer where 
-"tl_state_transformer p xs \<equiv> 
-state_transformer p [(''ans'',tl_nat xs) , (''xs'',0)] o
-state_transformer (''snd'' @ p) [(''snd_nat'',0)] o
-snd_nat_IMP_Minus_state_transformer (''snd''@ p) (xs -1)
-"
-
-definition tl_time where "
-tl_time x \<equiv> snd_nat_IMP_Minus_time (x-1) + 8 "
-
-lemma tl_nat_IMP_Minus_correct[intro]: 
-  "(tl_IMP p, s) 
-      \<Rightarrow>\<^bsup>  tl_time (s (add_prefix p ''xs''))\<^esup> 
-   tl_state_transformer p (s (add_prefix p ''xs'')) s"
-  unfolding tl_IMP_def tl_time_def  tl_nat_def 
-  apply (rule terminates_in_time_state_intro)
-    apply (rule Big_StepT.Seq)+
-  by fastforce+
-
-definition nth_nat_iteration where "nth_nat_iteration \<equiv>
-  [''a''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
-  invoke_subprogram ''a'' snd_nat_IMP_Minus ;;
-  ''a'' ::= [''a''] (A (V ''snd_nat'')) ;;
-  [''a''] ''snd_nat'' ::= (A (N 0)) ;;
-  ''nth_nat'' ::= ((V ''nth_nat'') \<ominus> (N 1))"
-
-fun nth_nat_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_nat_loop_time 0 x = 2" |
-"nth_nat_loop_time (Suc n) x = 9 + snd_nat_IMP_Minus_time (x - 1) 
-  + nth_nat_loop_time n (tl_nat x)"
-
-fun drop_n_nat :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
-"drop_n_nat 0 x = x "|
-"drop_n_nat (Suc n) x = drop_n_nat n (tl_nat x)"
-
-lemma nth_nat_is_hd_of_drop_n_nat:
-  "nth_nat n x = fst_nat (drop_n_nat n x - Suc 0)"
-  by (induction n arbitrary: x)
-    (auto simp: hd_nat_def)
-
-abbreviation nth_nat_loop_state_transformer where "nth_nat_loop_state_transformer p k x \<equiv>
-  (if k = 0 then (\<lambda>s. s)
-   else 
-        state_transformer p [
-        (''a'', drop_n_nat k x),
-        (''nth_nat'',  0)]
-        \<circ> state_transformer (''a'' @ p) [
-          (''snd_nat'', 0)]
-        \<circ> snd_nat_IMP_Minus_state_transformer (''a'' @ p) 0)"
-
-lemma nth_nat_loop_correct:
-  "s (add_prefix p ''nth_nat'') = k
-  \<Longrightarrow> ((WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration) p, s) 
-      \<Rightarrow>\<^bsup>nth_nat_loop_time k (s (add_prefix p ''a''))\<^esup>
-      nth_nat_loop_state_transformer p k (s (add_prefix p ''a'')) s "
-proof(induction k arbitrary: s)
-  case 0
-  then show ?case
-    by(auto simp: numeral_eq_Suc fun_eq_iff 
-        intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse])
-next
-  case (Suc k)
-  show ?case
-    apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[OF _ _ Suc.IH]])
-    using \<open>s (add_prefix p ''nth_nat'') = Suc k\<close>
-    unfolding nth_nat_iteration_def
-    by (fastforce simp: tl_nat_def)+
-qed
-
-
-definition nth_nat_IMP_Minus where "nth_nat_IMP_Minus \<equiv>
-  ''nth_nat'' ::= (A (V ''a'')) ;;
-  ''a'' ::= (A (V ''b'')) ;;
-  WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration ;;
-  [''b''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
-  invoke_subprogram ''b'' fst_nat_IMP_Minus ;;
-  ''nth_nat'' ::= [''b''] (A (V ''fst_nat'')) ;;
-  [''b''] ''fst_nat'' ::= (A (N 0)) ;;
-  zero_variables [''a'', ''b'']"
-
-definition nth_nat_IMP_Minus_time where "nth_nat_IMP_Minus_time n x \<equiv>
-  10 + nth_nat_loop_time n x + fst_nat_IMP_Minus_time ((drop_n_nat n x) - 1)
-  + zero_variables_time [''a'', ''b'']"
-
-abbreviation nth_nat_IMP_Minus_state_transformer where "nth_nat_IMP_Minus_state_transformer p k x
-  \<equiv> state_transformer p [(''nth_nat'', nth_nat k x), (''a'', 0), (''b'', 0)]
-     \<circ> state_transformer (''b'' @ p) [(''fst_nat'', 0)]
-     \<circ> fst_nat_IMP_Minus_state_transformer (''b'' @ p) 0
-     \<circ> nth_nat_loop_state_transformer p k x"
-
-lemma nth_nat_IMP_Minus_correct:
-  "(nth_nat_IMP_Minus p, s) 
-    \<Rightarrow>\<^bsup>nth_nat_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup>
-    nth_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
-  unfolding nth_nat_IMP_Minus_def nth_nat_IMP_Minus_time_def tl_nat_def 
-  by (cases "s (add_prefix p ''a'') = 0") (fastforce 
-      simp: hd_nat_def nth_nat_is_hd_of_drop_n_nat
-      intro!: terminates_in_time_state_intro[OF Seq']
-      intro: nth_nat_loop_correct)+
-
-definition cons_IMP_Minus
-  where "cons_IMP_Minus \<equiv> 
-    [''a''] ''a'' ::= (A (V ''a'')) ;;
-    [''a''] ''b'' ::= (A (V ''b'')) ;;
-    invoke_subprogram ''a'' prod_encode_IMP_Minus ;;
-    ''cons'' ::= [''a''] ((V ''prod_encode'') \<oplus> (N 1)) ;;
-    [''a''] ''prod_encode'' ::= (A (N 0)) ;;
-    zero_variables [''a'', ''b'']"
-
-definition cons_IMP_Minus_time where "cons_IMP_Minus_time h t \<equiv>
-  8 + prod_encode_IMP_Minus_time h t + zero_variables_time [''a'', ''b'']"
-
-abbreviation cons_IMP_Minus_state_transformer where "cons_IMP_Minus_state_transformer p h t
-  \<equiv> state_transformer p [(''cons'', h ## t), (''a'', 0), (''b'', 0)]
-    \<circ> state_transformer (''a'' @ p) [(''prod_encode'', 0)]
-    \<circ> prod_encode_IMP_Minus_state_transformer (''a'' @ p) h t"
-
-lemma cons_IMP_Minus_correct[intro]:
-  "(cons_IMP_Minus p, s) 
-    \<Rightarrow>\<^bsup>cons_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup>
-     cons_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
-  unfolding cons_IMP_Minus_def cons_IMP_Minus_time_def cons_def
-  by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])
-
-fun cons_list_IMP_Minus :: "vname list \<Rightarrow> pcom" where
-"cons_list_IMP_Minus [] = SKIP" |
-"cons_list_IMP_Minus (a # as) = (if as = [] 
-  then 
-    ''cons_list'' ::= [''a''] (A (V a)) ;;
-    [''a''] a ::= (A (N 0))
-  else
-    cons_list_IMP_Minus as ;;
-    [''b''] ''a'' ::= [''a''] (A (V a)) ;; 
-    [''b''] ''b'' ::= (A (V ''cons_list'')) ;;
-    invoke_subprogram ''b'' cons_IMP_Minus ;;
-    ''cons_list'' ::= [''b''] (A (V ''cons'')) ;;
-    [''b''] ''cons'' ::= (A (N 0)) ;;
-    [''a''] a ::= (A (N 0)))" (* TODO: don't zero here: will break if variable names not distinct*)
-
-fun cons_list :: "nat list \<Rightarrow> nat" where
-"cons_list [] = 0" |
-"cons_list (a # as) = 
-  (if as = [] 
-   then a
-   else a ## cons_list as)"
-
-fun cons_list_IMP_Minus_time :: "nat list \<Rightarrow> nat" where
-"cons_list_IMP_Minus_time [] = 1" | 
-"cons_list_IMP_Minus_time (a # as) = 
-  (if as = []
-   then 4
-   else cons_list_IMP_Minus_time as + 2 + 2 + cons_IMP_Minus_time a (cons_list as) + 2 + 2 + 2)"
-
-fun cons_list_IMP_Minus_state_transformer where 
-  "cons_list_IMP_Minus_state_transformer p [] vs = (\<lambda>s. s)" |
-  "cons_list_IMP_Minus_state_transformer p (a # as) (v#vs) = (if as = [] then
-    state_transformer (''a'' @ p) [(v, 0)]
-  \<circ> state_transformer p [(''cons_list'', a)]
-    else
-  (\<lambda> s0 .
-      let s1 = cons_list_IMP_Minus_state_transformer p as vs s0;
-          s2 = state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) v))] s1;
-          s3 = state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2;
-          s4 = cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3;
-          s5 = state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4;
-          s6 = state_transformer (''b'' @ p) [(''cons'', 0)] s5;
-          s7 = state_transformer (''a'' @ p) [(v, 0)] s6
-  in s7 )
-  )
-"
-
-lemma auxxx: "(let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
-                s5 = t5 s4; s6 = t6 s5; s7 = t7 s6 in s7) a
- =
-(let s1 = t1; s2 = t2 s1; s3 = t3 s2; s4 = t4 s3;
-                s5 = t5 s4; s6 = t6 s5; s7 = t7 s6 in s7 a)" by simp
 
-lemma cons_list_state_arv:
-  assumes arg_def: "ar = add_prefix (''a'' @ p)"
-  assumes dist: "distinct (v#vs)"
-  shows "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) vs) vs s (ar v) = s (ar v)"
-  using dist
-proof(induct vs)
-  case (Cons b' bs')
-  then have "v \<noteq> b'" by simp
-  then show ?case
-    using Cons
-      auxxx[of "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (ar i)) bs') bs' s"
-        "\<lambda> s1. state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) b'))] s1"
-        "\<lambda> s2. state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2"
-        "\<lambda> s3. cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3"
-        "\<lambda> s4. state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4"
-        "state_transformer (''b'' @ p) [(''cons'', 0)]" "state_transformer (''a'' @ p) [(b', 0)]" ] 
-    by (auto simp: arg_def)
-qed simp
-
-lemma cons_list_IMP_Minus_correct[intro]:
-  assumes "distinct vs"
-  shows
-    "(cons_list_IMP_Minus vs p, s) 
-      \<Rightarrow>\<^bsup>cons_list_IMP_Minus_time (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs)\<^esup>
-      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (add_prefix (''a'' @ p) i)) vs) vs s"
-  using assms
-proof(induction vs arbitrary: s)
-  case ConsV: (Cons v vs)
-  show ?case
-  proof (cases vs)
-    case Nil
-    then show ?thesis
-      by(auto intro!: terminates_in_time_state_intro[OF Seq'])
-  next
-    case ConsB: (Cons b bs)
-    define arg where "arg \<equiv> add_prefix (''a'' @ p)"
-
-    define s1 where "s1 =
-      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s"
-    define s2 where "s2 =
-      s1(add_prefix (''b'' @ p) ''a'' := aval (aexp_add_prefix (''a'' @ p) (A (V v))) s1)"
-    define s3 where "s3 =
-      s2(add_prefix (''b'' @ p) ''b'' := aval (aexp_add_prefix p (A (V ''cons_list''))) s2)"
-
-    have d: "distinct vs" using ConsV by simp
-
-    have "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs s (arg v) = s (arg v)"
-      using cons_list_state_arv arg_def ConsV(2) by simp
-
-    then have c1: "(s3 (add_prefix (''b'' @ p) ''a'')) = (s (arg v))"
-      by (auto simp: s3_def s2_def s1_def arg_def)
-
-    have c2a: "(s3 (add_prefix (''b'' @ p) ''b''))
-       = cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs
-          s (add_prefix p ''cons_list'')"
-      using s1_def s2_def s3_def by simp
-
-    have c2b: "(vs = [] \<Longrightarrow> s (add_prefix p ''cons_list'') = 0) \<Longrightarrow>
-      cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) vs) vs
-          s (add_prefix p ''cons_list'') =
- (cons_list (map (\<lambda>i. s (arg i)) vs))"
-      using ConsV(2)
-    proof(induct vs rule: cons_list_IMP_Minus.induct)
-      case (2 b' bs')
-      then show ?case
-      proof(cases bs')
-        case (Cons c cs)
-        then have ih: "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s (add_prefix p ''cons_list'') = cons_list (map (\<lambda>i. s (arg i)) bs')"
-          using 2 by simp
-        have d: "distinct (b' # bs')" using 2(3) by simp
-        show ?thesis
-          using cons_list_state_arv[of arg, OF _ d]
-            auxxx[of "cons_list_IMP_Minus_state_transformer p (map (\<lambda>i. s (arg i)) bs') bs' s"
-              "\<lambda> s1. state_transformer (''b'' @ p) [(''a'', s1 (add_prefix (''a'' @ p) b'))] s1"
-              "\<lambda> s2. state_transformer (''b'' @ p) [(''b'', s2 (add_prefix p ''cons_list''))] s2"
-              "\<lambda> s3. cons_IMP_Minus_state_transformer (''b'' @ p) (s3 (add_prefix (''b'' @ p) ''a'')) (s3 (add_prefix (''b'' @ p) ''b'')) s3"
-              "\<lambda> s4. state_transformer p [(''cons_list'', s4 (add_prefix (''b'' @ p) ''cons''))] s4"
-              "state_transformer (''b'' @ p) [(''cons'', 0)]" "state_transformer (''a'' @ p) [(b', 0)]"] 
-            Cons ih arg_def  by simp
-      qed simp
-    qed simp
-
-    have c2: "(s3 (add_prefix (''b'' @ p) ''b'')) = (cons_list (map (\<lambda>i. s (arg i)) vs))"
-      using c2a c2b ConsB by auto
-
-    show ?thesis
-      apply(subst arg_def[symmetric])+
-
-      apply(subst cons_list_IMP_Minus.simps(2))
-      apply(subst ConsB)
-      apply(subst List.list.simps(3))
-      apply(subst HOL.if_False)
-      apply(subst List.list.map(2))
-      apply(subst cons_list_IMP_Minus_time.simps(2))
-      apply(subst ConsB)
-      apply(subst ConsB)
-      apply(subst ConsB[symmetric])
-      apply(subst List.list.map(2))
-      apply(subst List.list.simps(3))
-      apply(subst HOL.if_False)
-      apply(rule Seq')+
-            apply(subst arg_def)
-            apply(rule ConsV)
-            apply(simp add: d)
-
-           apply(subst arg_def[symmetric])
-           apply(subst s1_def[symmetric])
-
-           apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-            apply simp  apply(rule refl)
-          apply(subst s2_def[symmetric])
-          apply(rule terminates_in_time_state_intro[OF Big_StepT.Assign])
-           apply simp apply (rule refl)
-         apply(subst s3_def[symmetric])
-         apply(rule terminates_in_time_state_intro[OF cons_IMP_Minus_correct])
-          apply(subst c1) apply(subst c2)
-
-          apply(fastforce intro!: terminates_in_time_state_intro[OF Big_StepT.Assign]
-          simp add: ConsB Let_def
-          s3_def s2_def s1_def)+
-      done
-  qed
-qed simp
-
-
-
-definition reverse_nat_acc_IMP_Minus_iteration where "reverse_nat_acc_IMP_Minus_iteration \<equiv>
-  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
-  IMP_Minus_fst_nat ;;
-  
-  cons_IMP_Minus (V ''fst_nat'') (V ''e'') ;;
-
-  ''a'' ::= ((V ''f'') \<ominus> (N 1)) ;;
-  IMP_Minus_snd_nat ;;
-  
-  ''e'' ::= (A (V ''cons'')) ;;
-  ''f'' ::= (A (V ''snd_nat'')) ;;
-
-  zero_variables [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'']"
-
-definition reverse_nat_acc_IMP_Minus_iteration_time where 
-  "reverse_nat_acc_IMP_Minus_iteration_time acc n \<equiv>
-    8 + IMP_Minus_fst_nat_time (n - 1) + cons_IMP_Minus_time (hd_nat n) acc
-    + IMP_Minus_fst_nat_time (n - 1)
-    + zero_variables_time [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'']"
-
-(*"reverse_nat_acc acc e  n f =
-  (if n = 0 then acc 
-   else reverse_nat_acc ((hd_nat n) ## acc) (tl_nat n) )"*)
-
-lemma reverse_nat_acc_IMP_Minus_iteration_correct: 
-  "(reverse_nat_acc_IMP_Minus_iteration, s) 
-    \<Rightarrow>\<^bsup>reverse_nat_acc_IMP_Minus_iteration_time (s ''e'') (s ''f'')\<^esup>
-    s(''a'' := 0,
-      ''b'' := 0,
-      ''c'' := 0,
-      ''d'' := 0,
-      ''e'' := ((hd_nat (s ''f'')) ## (s ''e'')),
-      ''f'' := (tl_nat (s ''f'')),
-      ''triangle'' := 0,
-      ''prod_encode'' := 0,
-      ''cons'' := 0,
-      ''fst_nat'' := 0,
-      ''snd_nat'' := 0)"
-  unfolding reverse_nat_acc_IMP_Minus_iteration_def 
-    reverse_nat_acc_IMP_Minus_iteration_time_def
-  by(fastforce 
-       simp: hd_nat_def tl_nat_def 
-       intro!: terminates_in_time_state_intro[OF Seq']
-       intro: IMP_Minus_fst_nat_correct IMP_Minus_snd_nat_correct zero_variables_correct
-       cons_IMP_Minus_correct)
-
-(* WHILE ''f'' \<noteq>0 DO reverse_nat_acc_IMP_Minus_loop_iteration *)
+lemma rev_add_prefix_all_variables:"(add_prefix p v \<in> set (all_variables (invoke_subprogram p1 c p2)))
+       = (rev (add_prefix p v) \<in> set (map rev (all_variables (invoke_subprogram p1 c p2))))"
+  by auto
+*)
 
-fun reverse_nat_acc_IMP_Minus_loop_time where 
-"reverse_nat_acc_IMP_Minus_loop_time acc n = 
-  (if n = 0 then 2 
-   else 1 + reverse_nat_acc_IMP_Minus_iteration_time acc n + 
-    reverse_nat_acc_IMP_Minus_loop_time ((hd_nat n) ## acc) (tl_nat n))"
+lemma cons_append: "xs \<noteq> [] \<Longrightarrow> x # xs = [x] @ xs"
+  by simp
+
+lemma triangle_IMP_Minus_correct_function: 
+  "(triangle_IMP_minus p, s) 
+      \<Rightarrow>\<^bsup>t \<^esup> s'
+    \<Longrightarrow> s' (add_prefix p ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state p s))"
+  apply(simp only: triangle_IMP_minus_def triangle_imp.simps)
+  apply(erule Seq_tE)+
+  \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
+     program we call. If automation fails, this should be manually chosen variables.\<close>
+  apply(simp only: comp_def, erule mul_IMP_minus_correct'[where vars = "{''traingle''}"])
+  apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: triangle_state_upd_def Let_def triangle_imp_to_HOL_state_def)[1]
+  apply(auto simp: mul_imp_to_HOL_state_def)[1]
+  done
 
-lemma reverse_nat_acc_IMP_Minus_loop_correct[intro]: 
-  "(WHILE ''f'' \<noteq>0 DO reverse_nat_acc_IMP_Minus_iteration, s) 
-    \<Rightarrow>\<^bsup>reverse_nat_acc_IMP_Minus_loop_time (s ''e'') (s ''f'')\<^esup>
-    (if s ''f'' \<noteq> 0 then
-      s(''a'' := 0,
-        ''b'' := 0,
-        ''c'' := 0,
-        ''d'' := 0,
-        ''e'' := reverse_nat_acc (s ''e'') (s ''f''),
-        ''f'' := 0,
-        ''triangle'' := 0,
-        ''prod_encode'' := 0,
-        ''cons'' := 0,
-        ''fst_nat'' := 0,
-        ''snd_nat'' := 0)
-      else s)"
-proof(induction "s ''e''" "s ''f''" arbitrary: s rule: reverse_nat_acc.induct)
-  case 1
-  then show ?case
-  proof(cases "s ''f''")
-    case 0
-    then show ?thesis
-      by (fastforce intro: terminates_in_time_state_intro[OF Big_StepT.WhileFalse])
-  next
-    case (Suc nat)
-        
-    then show ?thesis
-      by(fastforce intro!: terminates_in_time_state_intro[OF
-        Big_StepT.WhileTrue[OF _ reverse_nat_acc_IMP_Minus_iteration_correct 1(1)]])
-  qed
-qed
+lemma triangle_IMP_Minus_correct_time: 
+  "(triangle_IMP_minus p, s) 
+      \<Rightarrow>\<^bsup>t\<^esup> s'
+    \<Longrightarrow> t = triangle_imp_time 0 (triangle_imp_to_HOL_state p s)"
+  apply(simp only: triangle_IMP_minus_def)
+  apply(erule Seq_tE)+
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst triangle_imp_time.simps)
+  apply(subst (asm) comp_def, erule mul_IMP_minus_correct'[where vars = "(set (all_variables (triangle_IMP_minus p))) - (set (all_variables (mul_IMP_minus p)))"])
+  \<comment> \<open>Warning: in the following, I am unfolding mul_imp_to_HOL_state_def. With more experiments, it
+      should become clear if this will cascade down multiple layers\<close>
+  apply(simp add: triangle_imp_time_acc triangle_imp_to_HOL_state_def triangle_state_upd_def)[1]
+  apply (auto simp: mul_imp_to_HOL_state_def)[1]
+  done
 
-definition "reverse_nat_acc_IMP_Minus" where "reverse_nat_acc_IMP_Minus \<equiv>
-  ''e'' ::= (A (V ''a'')) ;;
-  ''f'' ::= (A (V ''b'')) ;;
-  WHILE ''f'' \<noteq>0 DO reverse_nat_acc_IMP_Minus_iteration ;;
-  ''reverse_nat_acc'' ::= (A (V ''e'')) ;;
-  zero_variables [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'', ''e'',
-    ''triangle'', ''prod_encode'']"
+lemma triangle_IMP_Minus_correct_effects:
+  "(triangle_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> (vars \<inter> set (all_variables (triangle_IMP_minus p)) = {} \<longrightarrow> (\<forall>v\<in>vars. s v = s' v))"
+  by (auto intro: com_only_vars)
 
-definition reverse_nat_acc_IMP_Minus_time where "reverse_nat_acc_IMP_Minus_time acc n \<equiv>
-  6 + reverse_nat_acc_IMP_Minus_loop_time acc n
-  + zero_variables_time 
-    [''a'', ''b'', ''c'', ''d'', ''fst_nat'', ''snd_nat'', ''cons'', ''e'',
-      ''triangle'', ''prod_encode'']"
+lemma triangle_IMP_minus_correct':
+  "\<lbrakk>(triangle_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (triangle_imp_time 0 (triangle_imp_to_HOL_state p s));
+      s' (add_prefix p ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state p s));
+      (vars \<inter> set (all_variables (triangle_IMP_minus p)) = {} \<Longrightarrow> (\<forall>v\<in>vars. s v = s' v))\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using triangle_IMP_Minus_correct_time triangle_IMP_Minus_correct_function
+        triangle_IMP_Minus_correct_effects
+  by auto
 
-lemma reverse_nat_acc_IMP_Minus_correct:
-  "(reverse_nat_acc_IMP_Minus, s) 
-    \<Rightarrow>\<^bsup>reverse_nat_acc_IMP_Minus_time (s ''a'') (s ''b'')\<^esup>
-      s(''a'' := 0,
-        ''b'' := 0,
-        ''c'' := 0,
-        ''d'' := 0,
-        ''e'' := 0,
-        ''f'' := 0,
-        ''triangle'' := 0,
-        ''prod_encode'' := 0,
-        ''cons'' := 0,
-        ''fst_nat'' := 0,
-        ''snd_nat'' := 0,
-        ''reverse_nat_acc'' := reverse_nat_acc (s ''a'') (s ''b''))"
-  unfolding reverse_nat_acc_IMP_Minus_def reverse_nat_acc_IMP_Minus_time_def
-  apply(cases "s ''b''") 
-  by(fastforce 
-      intro!: HOL.ext terminates_in_time_state_intro[OF Seq'] 
-      zero_variables_correct reverse_nat_acc_IMP_Minus_loop_correct
-      intro:  reverse_nat_acc_IMP_Minus_loop_correct)+
-  *)
 end
\ No newline at end of file
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index a5151b56..498c2047 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -1,14 +1,14 @@
-\<^marker>\<open>creator Florian Kessler\<close>
+\<^marker>\<open>creator Florian Kessler, Mohammad Abdulaziz\<close>
 
 theory Multiplication
   imports Big_Step_Small_Step_Equivalence "HOL-Library.Discrete"
     Canonical_State_Transformers "../Lib/Polynomial_Growth_Functions"
 begin
 
+
 unbundle no_com_syntax
 
-(*
-definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus =
+(*definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus =
   ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
   IF ''c''\<noteq>0 
   THEN
@@ -85,17 +85,19 @@ function mul_imp:: "mul_state \<Rightarrow> mul_state" where
 termination
   by  (relation "measure (\<lambda>s. mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
 
+lemmas [simp del] = mul_imp.simps
+
 lemma mul_imp_correct: "mul_c (mul_imp s) = mul_c s + mul_a s * mul_b s"
 proof (induction s rule: mul_imp.induct)
   case (1 s)
   then show ?case
     apply(subst mul_imp.simps)
-    apply (auto simp: mul_state_upd_def Let_def simp del: mul_imp.simps split: if_splits)
+    apply (auto simp: mul_state_upd_def Let_def split: if_splits)
     by (metis (no_types, lifting) One_nat_def add.commute add_mult_distrib2 distrib_right mult.right_neutral mult_2 mult_div_mod_eq)
 qed 
 
-function mul_imp_time:: "mul_state \<Rightarrow> nat \<Rightarrow> nat" where
-"mul_imp_time s t = 
+function mul_imp_time:: "nat \<Rightarrow> mul_state\<Rightarrow> nat" where
+"mul_imp_time t s = 
 (
     (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
       (
@@ -109,7 +111,7 @@ function mul_imp_time:: "mul_state \<Rightarrow> nat \<Rightarrow> nat" where
           t = t + 2;
           mul_b = mul_b s div 2;
           t = t + 2;
-          next_iteration = mul_imp_time (mul_state_upd s) t
+          next_iteration = mul_imp_time t (mul_state_upd s)
         in
           next_iteration
       )
@@ -126,11 +128,13 @@ function mul_imp_time:: "mul_state \<Rightarrow> nat \<Rightarrow> nat" where
 )"
   by pat_completeness auto
 termination
-  by  (relation "measure (\<lambda>(s, t). mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
+  by  (relation "measure (\<lambda>(t, s). mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
 
-lemma mul_imp_time_acc: "(mul_imp_time s (Suc t)) = Suc (mul_imp_time s t)"
-  by (induction s "t" arbitrary:  rule: mul_imp_time.induct)
-     (auto simp add: mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
+lemmas [simp del] = mul_imp_time.simps
+
+lemma mul_imp_time_acc: "(mul_imp_time (Suc t) s) = Suc (mul_imp_time t s)"
+  by (induction t s arbitrary:  rule: mul_imp_time.induct)
+     (auto simp add: mul_imp_time.simps mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
 
 definition mul_IMP_minus where
 "mul_IMP_minus \<equiv>
@@ -146,231 +150,69 @@ definition mul_IMP_minus where
         ''b'' ::= ((V ''b'') \<then>))
   )"
 
-definition mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p s \<equiv>
+(*definition mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p s \<equiv>
   state_transformer p  
-    [(''a'', mul_a s),(''b'',  mul_b s),(''c'',  mul_c s),(''d'', mul_d s)]"
+    [(''a'', mul_a s),(''b'',  mul_b s),(''c'',  mul_c s),(''d'', mul_d s)]"*)
 
 definition "mul_imp_to_HOL_state p s =
   \<lparr>mul_a = s (add_prefix p ''a''), mul_b = (s (add_prefix p ''b'')),
    mul_c = (s (add_prefix p ''c'')), mul_d =  (s (add_prefix p ''d''))\<rparr>"
 
-lemma mul_IMP_minus_correct: 
-  shows
-   "(mul_IMP_minus p, s) 
-    \<Rightarrow>\<^bsup>(mul_imp_time (mul_imp_to_HOL_state p s) 0)\<^esup> 
-      mul_IMP_Minus_state_transformer p (mul_imp (mul_imp_to_HOL_state p s)) s"
-proof(induction "mul_imp_to_HOL_state p s" arbitrary: s rule: mul_imp.induct)
-  case 1
-  then show ?case
-    apply(subst mul_IMP_Minus_state_transformer_def)
-    apply(subst mul_imp.simps)
-    apply(subst mul_imp_time.simps)
-    apply(subst Let_def)+
-    apply(subst mul_IMP_minus_def)
-    apply(rule WhileI[where y = "mul_imp_time (mul_state_upd (mul_imp_to_HOL_state p s)) 0"])
-     apply(intro conjI)
-       apply(rule Seq')
-       apply(rule Seq')
-         apply(rule Seq')
-           apply(rule Big_StepT.Assign)
-         apply(rule IfI)
-                apply(rule Big_StepT.Assign)
-                   apply(rule Big_StepT.Assign)
-            apply rule
-            apply rule
-            apply(rule Big_StepT.Assign)
-       apply(rule Big_StepT.Assign)
-  apply(dest_com)
-  apply(simp add: mul_imp_to_HOL_state_def)
-         apply(simp add: mul_state_upd_def mul_imp_to_HOL_state_def)
-        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
-                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
-        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
-                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
-    apply (simp add: mul_state_upd_def mul_IMP_Minus_state_transformer_def)
-    apply (simp add: mul_state_upd_def mul_IMP_Minus_state_transformer_def)
-    apply (simp add: mul_state_upd_def mul_IMP_Minus_state_transformer_def)
-    apply (simp add: mul_IMP_minus_def)
-        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def state_transformer_def
-                   simp del: mul_imp_time.simps split: if_splits)[1]
-        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def state_transformer_def
-                   simp del: mul_imp_time.simps split: if_splits)[1]
-    apply(subst mul_imp_time_acc)+
-        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
-                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
-    apply(subst mul_imp_time_acc)+
-        apply(auto simp add: Let_def mul_state_upd_def mul_imp_to_HOL_state_def
-                   simp del: mul_imp.simps mul_imp_time.simps split: if_splits)[1]
-    done
-qed
+lemma mul_imp_to_HOL_state_add_prefix: 
+  "mul_imp_to_HOL_state (add_prefix p1 p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix p1))"
+  by (auto simp: mul_imp_to_HOL_state_def)
+
+lemma mul_imp_to_HOL_state_add_prefix':
+  "mul_imp_to_HOL_state (x # p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix [x]))"
+  by (auto simp: mul_imp_to_HOL_state_def)
+
+lemma mul_IMP_minus_correct_time:
+  "(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = (mul_imp_time 0 (mul_imp_to_HOL_state p s))"
+  apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
+  apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
+  apply(erule While_tE)
+   apply(subst mul_imp_time.simps)
+   apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule If_tE)
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst mul_imp_time.simps)
+   apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  apply(subst mul_imp_time.simps)
+  apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  done
+
+lemma mul_IMP_minus_correct_function:
+  "(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s))"
+  apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
+  apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
+  apply(erule While_tE)
+   apply(subst mul_imp.simps)
+   apply(auto simp: mul_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule If_tE)
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst mul_imp.simps mul_imp_time.simps)
+   apply(auto simp: mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  apply(subst mul_imp.simps mul_imp_time.simps)
+  apply(auto simp: mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  done
+
+lemma mul_IMP_minus_correct_effects:
+  "(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> (vars \<inter> set (all_variables (mul_IMP_minus p)) = {} \<longrightarrow> (\<forall>v\<in>vars. s v = s' v))"
+ by (auto intro: com_only_vars)
 
 lemma mul_IMP_minus_correct':
-  shows
-   "\<lbrakk>s_HOL = (mul_imp_to_HOL_state p s)\<rbrakk> \<Longrightarrow>
-   (mul_IMP_minus p, s) 
-    \<Rightarrow>\<^bsup>(mul_imp_time s_HOL 0)\<^esup> 
-      mul_IMP_Minus_state_transformer p (mul_imp s_HOL) s"
-  using mul_IMP_minus_correct
-  by (auto simp del: mul_imp.simps)
-
-definition mul_iteration where
-"mul_iteration = 
-  ''d'' ::= ((V ''b'') \<doteq>1) ;;
-  IF ''d'' \<noteq>0
-  THEN 
-    ''c'' ::= ((V ''c'') \<oplus> (V ''a''))
-  ELSE
-    (SKIP ;; SKIP) ;;
-  ''a'' ::= ((V ''a'') \<oplus> (V ''a'')) ;;
-  ''b'' ::= ((V ''b'') \<then>) ;;
-  ''d'' ::= A (N 0)"
-
-lemma mul_iteration_effect:
-  "(mul_iteration p, s) \<Rightarrow>\<^bsup>11\<^esup> state_transformer' p
-                                 (\<lambda>s. 
-                                  [(''a'', 2 * s ''a''),
-                                   (''b'', s ''b'' div 2),
-                                   (''c'', 
-                                     (if s ''b'' mod 2 \<noteq> 0 
-                                      then s ''c'' + s ''a''
-                                      else s ''c'')),
-                                   (''d'', 0)]) s"
-    unfolding mul_iteration_def
-    by (cases "s (add_prefix p ''b'') mod 2 \<noteq> 0")
-       (fastforce intro!: terminates_in_time_state_intro[OF Seq'])+
-
-lemma mul_loop_correct:
-  assumes "s (add_prefix p ''b'') = k"
-  shows "((WHILE ''b'' \<noteq>0 DO mul_iteration) p, s) 
-    \<Rightarrow>\<^bsup>12 * (if s (add_prefix p ''b'') = 0 then 0 
-             else 1 + Discrete.log (s (add_prefix p ''b''))) + 2\<^esup> 
-    state_transformer' p
-    (\<lambda>s. [(''a'', (s ''a'') * (2 :: nat)^(if s ''b'' = 0 then 0 else 1 + Discrete.log (s ''b''))),
-          (''b'', 0),
-          (''c'', s ''c'' + s ''a'' * s ''b''),
-          (''d'', (if s ''b'' = 0 then s ''d'' else 0))]) s"
-  using assms
-proof(induction k arbitrary: s rule: less_induct )
-  case (less x)
-  thus ?case
-  proof (cases x)
-  next
-    case (Suc nat)
-
-    show ?thesis
-      apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[
-              OF _ mul_iteration_effect less.IH[where ?y = "x div 2"]]])
-      using \<open>x = Suc nat\<close> \<open>s (add_prefix p ''b'') = x\<close> log_rec 
-           apply auto
-        apply(auto 
-          simp add: Euclidean_Division.div_eq_0_iff 
-          intro!: HOL.ext)
-       apply(presburger)
-      using odd_two_times_div_two_nat[where ?n=nat] mult.commute
-      by (smt (z3) One_nat_def Suc_pred mult.assoc mult_Suc_right)
-  qed (force intro: terminates_in_state_intro)
-qed
-
-definition mul_IMP_minus where "mul_IMP_minus =
-  ''c'' ::= A (N 0) ;;
-  WHILE ''b'' \<noteq>0 DO mul_iteration ;;
-  ''a'' ::= A (N 0) ;;
-  ''d'' ::= A (N 0)" 
-
-definition mul_IMP_Minus_time :: "nat \<Rightarrow> nat" where "mul_IMP_Minus_time y 
-  \<equiv> 12 * (if y = 0 then 0 else 1 + Discrete.log y) + 8"
-
-definition exp2::"nat\<Rightarrow>nat"  where "exp2 y \<equiv> 2^y"
-
-lemma log_exp_id: "Discrete.log  (exp2 x) = id x"
-  apply(induct x)
-  unfolding exp2_def by auto
-
-
-lemma exp2_0: "exp2 x \<noteq> 0"
-  unfolding exp2_def
+  "\<lbrakk>(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (mul_imp_time 0 (mul_imp_to_HOL_state p s));
+      s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s));
+      (vars \<inter> set (all_variables (mul_IMP_minus p)) = {} \<Longrightarrow> (\<forall>v\<in>vars. s v = s' v))\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using mul_IMP_minus_correct_time mul_IMP_minus_correct_function mul_IMP_minus_correct_effects
   by auto
 
-lemma poly_general_form:"poly (\<lambda>x. a*x+b)"
-proof
-  show "poly ((*) a)"
-  proof (induct a)
-    case 0
-    then show ?case by auto
-  next
-    case (Suc a)
-    have distrib_add: "((*) (Suc a)) = (\<lambda>x. (*) a x + x)" by auto
-    from Suc have "poly (\<lambda>x. (*) a x)" by simp
-    moreover have "poly (\<lambda>x. x)"  by (simp add: poly_linear)
-    ultimately have "poly  (\<lambda>x. (*) a x + x)" by (simp add: poly_add)
-    with distrib_add show ?case by simp 
-  qed
-next
-  show "poly (\<lambda>x. b)" by simp
-qed
-
-lemma poly_intro: "(\<forall>x. f x = a*x + b) \<Longrightarrow> poly f"
-proof -
-  assume "\<forall>x. f x = a*x + b"
-  hence "f = (\<lambda>x . a*x+b)" by auto
-  with poly_general_form show "poly f" by auto
-qed
-
-lemma "poly (mul_IMP_Minus_time o exp2)"
-  unfolding mul_IMP_Minus_time_def comp_def log_exp_id
-  apply (auto simp add: exp2_0 )
-  apply (rule poly_intro)
-  by (auto simp add:algebra_simps)
-
-definition polye:: "(nat \<Rightarrow>nat) \<Rightarrow> bool" where 
-"polye f \<equiv> poly (f o exp2)"
-
-lemma polye_comp1: 
-"poly g \<Longrightarrow> polye f \<Longrightarrow> polye (g o f)"
-  unfolding polye_def 
-  by (simp add: comp_assoc poly_compose)
-
-lemma polye_comp2: 
-"mono f \<Longrightarrow> polye f \<Longrightarrow> polye (\<lambda>x . f (x + b))"
-  unfolding polye_def  exp2_def comp_def
-  oops
-
-abbreviation mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p a b \<equiv>
-  state_transformer p  
-    [(''a'', 0),
-     (''b'', 0),
-     (''c'',  a * b),
-     (''d'', 0)]" 
-
-lemma IMP_minus_mul_correct[intro]: 
-  shows "(mul_IMP_minus p, s) 
-    \<Rightarrow>\<^bsup>mul_IMP_Minus_time (s (add_prefix p ''b''))\<^esup> 
-      mul_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
-  unfolding mul_IMP_Minus_time_def mul_IMP_minus_def
-  by(fastforce
-      intro!: terminates_in_time_state_intro[OF Seq']
-      intro: mul_loop_correct)
-
-fun zero_variables where
-"zero_variables [] = SKIP" |
-"zero_variables (a # as) = (a ::= (A (N 0)) ;; zero_variables as)"
-
-definition zero_variables_time where "zero_variables_time vs \<equiv>
-  1 + 2 * length vs"
-
-lemma zero_variables_correct[intro]:
-  "(zero_variables vs p, s) 
-    \<Rightarrow>\<^bsup>zero_variables_time vs\<^esup> 
-      state_transformer p (map (\<lambda>v. (v, 0)) vs) s"
-proof (induction vs arbitrary: s)
-  case (Cons a vs)
-  show ?case
-    by(auto 
-        intro!: terminates_in_state_intro[OF Seq[OF Big_StepT.Assign Cons.IH]] 
-        simp: zero_variables_time_def map_add_def
-        split: option.splits
-        dest!: map_of_SomeD)
-qed (auto simp: zero_variables_time_def)
-
-declare zero_variables.simps [simp del]
 end
\ No newline at end of file

From ef5481292a77548ec3cf8f9cd37f77c012a18ad2 Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Wed, 22 Dec 2021 20:28:35 +0100
Subject: [PATCH 095/103] Finished prod_encode

---
 #Untitled-1#                                  |   0
 .../IMP-_To_IMP--/Binary_Arithmetic_IMP.thy   | 170 +++++++++++++++-
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     |   2 +-
 IMP-/Big_StepT.thy                            |   2 +-
 IMP-/Canonical_State_Transformers.thy         |  70 ++++++-
 IMP-/IMP_Minus_Nat_Bijection.thy              | 192 ++++++++++++++----
 IMP-/Multiplication.thy                       |  22 +-
 7 files changed, 403 insertions(+), 55 deletions(-)
 delete mode 100644 #Untitled-1#

diff --git a/#Untitled-1# b/#Untitled-1#
deleted file mode 100644
index e69de29b..00000000
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
index 9cd1020e..677c63ea 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
@@ -5,10 +5,147 @@ begin
 unbundle IMP_Minus_Minus_Com.no_com_syntax
 unbundle Com.no_com_syntax
 
+
 fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_bit_of_num_nat x n  = (if x = 0 then (if n = 0 then 1 else 0) else
-                            if n = 0 then (if hd_nat x = 0 then 0 else 1) else
-                            nth_bit_of_num_nat (tl_nat x) (n-1)) "
+"nth_bit_of_num_nat x n  = 
+  (if x = 0 then
+    (if n = 0 then
+       1
+     else
+       0)
+   else
+     if n = 0 then
+       (if hd_nat x = 0 then
+          0
+        else
+          1)
+     else
+        nth_bit_of_num_nat (tl_nat x) (n-1)
+   )"
+
+fun nth_bit_of_num_nat_imp :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_bit_of_num_nat_imp x n  = 
+(
+  let
+    next_iteration = (0::nat)
+  in
+    (if x \<noteq> 0 then
+       if n \<noteq> 0 then
+         (let
+            x = tl_nat x;
+            n = n - 1;
+            next_iteration = nth_bit_of_num_nat x n
+          in 
+            next_iteration
+         )
+       else
+         let
+           hd_x = hd_nat x
+         in
+           (if hd_x \<noteq> 0 then
+             (let
+                ret = 1
+              in 
+                ret
+             )
+            else
+             (let
+                ret = 0
+              in 
+                ret
+             )
+           )
+     else
+       if n \<noteq> 0 then
+         (let
+            ret = 0
+          in 
+            ret
+         )
+       else
+         (let
+            ret = 1
+          in 
+            ret
+         )
+     )
+)"
+
+lemma nth_bit_of_num_nat_imp_correct:
+  "nth_bit_of_num_nat x n = nth_bit_of_num_nat_imp x n"
+  by (auto simp: Let_def)
+
+
+(* [''tl''] ''xs'' ::=  (A ( V ''x'')) ;;
+   invoke_subprogram ''tl'' tl_IMP;;
+   ''x'' ::= [''tl''] (A (V ''ans''));;
+   [''tl''] ''ans'' ::= A (N 0);;
+   ''n'' ::= (V ''n'' \<ominus> N 1 );; 
+   IF ''x''\<noteq>0 THEN 
+        (IF ''n''\<noteq>0 THEN ''b''::= A (N 1) ELSE ''b''::= A (N 0)) 
+        ELSE ''b''::= A (N 0) 
+   
+*)
+
+term invoke_subprogram
+
+abbreviation "invoke_program_1 pfx prog input1 output \<equiv>
+          [pfx] ''input1'' ::=  (A ( V input1)) ;;
+          invoke_subprogram pfx tl_IMP;;
+          output ::= [pfx] (A (V ''ans''));;
+          [pfx] ''ans'' ::= A (N 0)
+"
+
+
+definition nth_bit_of_num_iteration::pcom  where "nth_bit_of_num_iteration \<equiv>
+     ''next_iteration'' ::= A (N 0);;
+     IF ''x''\<noteq>0 THEN
+       IF ''n''\<noteq>0 THEN
+            invoke_program_1 ''tl'' tl_IMP ''x'' ''x'';;
+            ''n'' ::= (V ''n'' \<ominus> N 1 );;
+            ''next_iteration'' ::= A(N 1)
+       ELSE
+            invoke_program_1 ''hd'' hd_IMP ''x'' ''hd_x'';;
+            IF ''hd_x''\<noteq>0 THEN
+                ''ret'' ::= A (N 1)
+            ELSE
+                ''ret'' ::= A (N 0)
+     ELSE
+       IF ''n''\<noteq>0 THEN
+            ''ret'' ::= A (N 0)
+       ELSE
+            ''ret'' ::= A (N 1)
+"
+
+definition nth_bit_of_num_loop :: "pcom" where 
+"nth_bit_of_num_loop \<equiv> WHILE ''b''\<noteq>0 DO nth_bit_of_num_iteration"
+
+lemma tl_nat_le: "tl_nat x \<le> x"
+  sorry
+
+function (sequential) nth_bit_of_num_loop_t':: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_bit_of_num_loop_t' 0 _ _  = 2 "|
+"nth_bit_of_num_loop_t' (Suc b) x n  = (let
+  x' = tl_nat x; n' = n - 1; b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
+in
+  b' + (nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t' b' x' n')) "
+  by pat_completeness simp_all
+termination (* Proof proceeds by noticing that the sum of the three arguments is always decreasing, rest is hammering *)
+  by(relation "measure (\<lambda>(b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le)
+
+
+function (sequential) nth_bit_of_num_loop_state_transformer' ::
+    "char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where
+  "nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
+  "nth_bit_of_num_loop_state_transformer' p b x n = (let
+    x' = tl_nat x; n' = n-1;
+    b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
+  in
+    nth_bit_of_num_iteration_state_transformer p x n o nth_bit_of_num_loop_state_transformer' p b' x' n')"
+ by pat_completeness simp_all
+termination (* Proof proceeds by noticing that the sum of the last three arguments is always decreasing, rest is hammering *)
+  by (relation "measure (\<lambda>(p, b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le) 
+
 
 definition nth_bit_of_num_if ::pcom where "nth_bit_of_num_if \<equiv>
  IF ''x''\<noteq>0 THEN 
@@ -67,7 +204,6 @@ nth_bit_of_num_if_state_transformer p x n s "
   by simp
   
 definition nth_bit_of_num_iteration::pcom  where "nth_bit_of_num_iteration \<equiv>
-
   [''tl''] ''xs'' ::=  (A ( V ''x'')) ;;
    invoke_subprogram ''tl'' tl_IMP;;
    ''x'' ::= [''tl''] (A (V ''ans''));;
@@ -114,6 +250,32 @@ by fastforce
 definition nth_bit_of_num_loop :: "pcom" where 
 "nth_bit_of_num_loop \<equiv> WHILE ''b''\<noteq>0 DO nth_bit_of_num_iteration"
 
+lemma tl_nat_le: "tl_nat x \<le> x"
+  sorry
+
+function (sequential) nth_bit_of_num_loop_t':: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_bit_of_num_loop_t' 0 _ _  = 2 "|
+"nth_bit_of_num_loop_t' (Suc b) x n  = (let
+  x' = tl_nat x; n' = n - 1; b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
+in
+  b' + (nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t' b' x' n')) "
+  by pat_completeness simp_all
+termination (* Proof proceeds by noticing that the sum of the three arguments is always decreasing, rest is hammering *)
+  by(relation "measure (\<lambda>(b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le)
+
+
+function (sequential) nth_bit_of_num_loop_state_transformer' ::
+    "char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where
+  "nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
+  "nth_bit_of_num_loop_state_transformer' p b x n = (let
+    x' = tl_nat x; n' = n-1;
+    b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
+  in
+    nth_bit_of_num_iteration_state_transformer p x n o nth_bit_of_num_loop_state_transformer' p b' x' n')"
+ by pat_completeness simp_all
+termination (* Proof proceeds by noticing that the sum of the last three arguments is always decreasing, rest is hammering *)
+  by (relation "measure (\<lambda>(p, b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le) 
+
 fun nth_bit_of_num_loop_t:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "nth_bit_of_num_loop_t 0 _ _  = 2 "|
 "nth_bit_of_num_loop_t (Suc b) x n  = (let x' = tl_nat x; 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
index b39ce3d7..73b57011 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -682,5 +682,5 @@ lemma main_lemma_hol_tail:
        \<and> (\<forall>x. \<exists>f.  bit_length (encode_sat f) \<le> s_red ( bit_length x ) \<and> imp_to_sat_tail(com_encode c) (prod_encode pt) (prod_encode p_cer) x = sat_formula_encode f
                    \<and> (Sema.sat {f}  \<longleftrightarrow> in_lang x = 0))"
   using assms main_lemma_hol_nat by (auto simp add:subtail_imp_to_sat inj_formula_simp)
-
+                                 
 end
\ No newline at end of file
diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 82f34709..0e4e4b77 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -287,6 +287,6 @@ lemma AssignI'':
 thm Assign_tE
 
 lemma AssignD: "(x ::= a, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> t = 2 \<and> s' = s(x := aval a s)"
-  sorry
+  by auto
 
 end
\ No newline at end of file
diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
index 93ed9cd0..7dc959cc 100644
--- a/IMP-/Canonical_State_Transformers.thy
+++ b/IMP-/Canonical_State_Transformers.thy
@@ -479,6 +479,8 @@ fun com_add_prefix where
 |"com_add_prefix p (If v c1 c2) = (If (add_prefix p v) (com_add_prefix p c1) (com_add_prefix p c2))"
 |"com_add_prefix p (While v c) = (While (add_prefix p v) (com_add_prefix p c))"
 
+
+(*
 abbreviation pcom_SKIP where "pcom_SKIP p \<equiv> SKIP"
 
 abbreviation pcom_Assign where "pcom_Assign v aexp p \<equiv>
@@ -526,7 +528,7 @@ no_notation pcom_SKIP ("SKIP" [] 61) and
             pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
 end
 
-unbundle pcom_syntax
+unbundle pcom_syntax*)
 
 lemma atomExp_add_prefix_valid: "(\<And>v. v \<in> set (atomExp_var x1) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
           atomVal x1 s1 = atomVal (atomExp_add_prefix p x1) s1'"
@@ -542,10 +544,72 @@ lemma atomExp_add_prefix_valid': "v \<in> set (atomExp_var (atomExp_add_prefix p
 lemma aexp_add_prefix_valid':"v \<in> set (aexp_vars (aexp_add_prefix p aexp)) \<Longrightarrow> \<exists>v'. v = p @ v'"
   by (cases aexp) (auto simp: atomExp_add_prefix_valid')
 
-lemma invoke_subprogram_valid: "v \<in> set (all_variables (com_add_prefix p c)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+lemma com_add_prefix_valid': "v \<in> set (all_variables (com_add_prefix p c)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (induction p c rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid')
+
+lemma atomExp_add_prefix_valid'': "add_prefix p1 v \<in> set (atomExp_var (atomExp_add_prefix (p1 @ p2) x1)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
+  by (cases x1) (auto simp:)
+
+lemma aexp_add_prefix_valid'':"add_prefix p1 v \<in> set (aexp_vars (aexp_add_prefix (p1 @ p2) aexp)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
+  by (cases aexp) (auto simp: atomExp_add_prefix_valid'')
+
+
+lemma com_add_prefix_valid'': "add_prefix p1 v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
+  by (induction "p1 @ p2" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid'')
+
+
+(*lemma com_add_prefix_valid: "v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> \<exists>v'. rev v = (rev p2) @ v'"
+  sledgehammer
   by (induction p c rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid')
+*)
+
+lemma com_add_prefix_valid_subset: "add_prefix p1 v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> set p2 \<subseteq> set v"
+  using com_add_prefix_valid''
+  by (metis set_append sup_ge1)
+
+abbreviation invoke_subprogram
+  where "invoke_subprogram \<equiv> com_add_prefix"
+
+lemma atomExp_add_prefix_append: "atomExp_add_prefix p1 (atomExp_add_prefix p2 x1) = atomExp_add_prefix (add_prefix p1 p2) x1"
+  by (cases x1) auto
 
-abbreviation invoke_subprogram 
+lemma aexp_add_prefix_append: "aexp_add_prefix p1 (aexp_add_prefix p2 aexp) = (aexp_add_prefix (add_prefix p1 p2) aexp)"
+  by (cases aexp) (auto simp: atomExp_add_prefix_append) 
+
+lemma invoke_subprogram_append: "invoke_subprogram p1 (invoke_subprogram p2 c) = (invoke_subprogram (p1 @ p2) c)"
+  by (induction "(p1 @ p2)" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_append)
+
+(*abbreviation invoke_subprogram
   where "invoke_subprogram p c \<equiv> (c o (add_prefix p))"
 
+lemma all_variables_append: "(all_variables (c (p1 @ p2))) = map (\<lambda>v. p1 @ v) (all_variables (c p2))"
+proof (induction "(c (p1 @ p2))" arbitrary: c p1 p2 rule: all_variables.induct)
+  case 1
+  then show ?case
+
+    by auto
+next
+  case (2 v aexp)
+  then show ?case sorry
+next
+case (3 c1 c2)
+  then show ?case sorry
+next
+  case (4 v c1 c2)
+then show ?case sorry
+next
+case (5 v c)
+  then show ?case sorry
+qed
+  apply (auto simp: )
+
+
+lemma all_variables_valid: "v \<in> set (all_variables (c p2)) \<Longrightarrow> \<exists>v'. v = add_prefix p2 v'"
+  apply (induction p2)
+  apply (auto simp: aexp_add_prefix_valid')
+
+lemma invoke_subprogram_valid: "v \<in> set (all_variables ((invoke_subprogram p1 c) p2)) \<Longrightarrow> \<exists>v'. v = p1 @ p2 @ v'"
+  apply (induction p1)
+  apply (auto simp: aexp_add_prefix_valid')*)
+
 end
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 71f58cca..1b539cfd 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -13,11 +13,11 @@ lemma xxx: "x \<noteq> y \<Longrightarrow> (s (x := aval a s)) y = s y"
   by (auto simp add: Assign eval_nat_numeral)
 *)
 
-unbundle IMP_Minus_Minus_Com.no_com_syntax
+(*unbundle IMP_Minus_Minus_Com.no_com_syntax
 
-unbundle Com.no_com_syntax
+unbundle Com.no_com_syntax*)
 
-record triangle_state = triangle_mul_state::mul_state triangle_a::nat triangle_triangle::nat
+record triangle_state = triangle_a::nat triangle_triangle::nat
 
 term Nat_Bijection.triangle
 
@@ -36,11 +36,10 @@ definition "triangle_state_upd (s::triangle_state) \<equiv>
         mul_a' = triangle_a s;
         mul_b' = (triangle_a s) + 1;
         mul_c' = 0;
-        mul_d' = 0;
-        (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c', mul_d = mul_d'\<rparr>;
+        (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c'\<rparr>;
         mul_ret = (mul_imp triangle_mul_state);
         triangle_triangle = (mul_c mul_ret) div 2;
-        ret = \<lparr>triangle_mul_state = mul_ret, triangle_a = triangle_a s,triangle_triangle = triangle_triangle\<rparr>
+        ret = \<lparr>triangle_a = triangle_a s,triangle_triangle = triangle_triangle\<rparr>
       in
         ret
 "
@@ -71,9 +70,7 @@ fun triangle_imp_time:: "nat \<Rightarrow> triangle_state \<Rightarrow> nat" whe
      t = t + 2;
      mul_c' = 0;
      t = t + 2;
-     mul_d' = 0;
-     t = t + 2;
-     (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c', mul_d = mul_d'\<rparr>;
+     (triangle_mul_state::mul_state) = \<lparr>mul_a = mul_a', mul_b = mul_b', mul_c = mul_c'\<rparr>;
      mul_ret = (mul_imp triangle_mul_state);
      t = t + mul_imp_time 0 triangle_mul_state;
      triangle_triangle = mul_c mul_ret div 2;
@@ -91,22 +88,20 @@ lemma triangle_imp_time_acc: "(triangle_imp_time (Suc t) s) = Suc (triangle_imp_
   by (induction t s rule: triangle_imp_time.induct)
      (auto simp add: triangle_imp_time.simps mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
 
-definition triangle_IMP_minus where
-"triangle_IMP_minus \<equiv>
+definition triangle_IMP_Minus where
+"triangle_IMP_Minus \<equiv>
   (
    \<comment> \<open>mul_a' = triangle_a s;\<close>
-   [''mul''] ''a'' ::= (A (V ''a'')) ;;
+   (''mul'' @ ''a'') ::= (A (V ''a'')) ;;
    \<comment> \<open>mul_b' = (triangle_a s) + 1;\<close>
-   [''mul''] ''b'' ::= ((V ''a'') \<oplus> (N 1));;
+   (''mul'' @ ''b'') ::= ((V ''a'') \<oplus> (N 1));;
    \<comment> \<open>mul_c' = 0;\<close>
-   [''mul''] ''c'' ::= (A (N 0)) ;;
-   \<comment> \<open>mul_d' = 0;\<close>
-   [''mul''] ''d'' ::= (A (N 0));;
-   \<comment> \<open>(mul_state::mul_state) = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = 0, mul_d = 0\<rparr>;\<close>
+   (''mul'' @  ''c'') ::= (A (N 0)) ;;
+   \<comment> \<open>(mul_state::mul_state) = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = 0\<rparr>;\<close>
    \<comment> \<open>mul_ret = (mul_imp mul_state);\<close>
    invoke_subprogram ''mul'' mul_IMP_minus;;
    \<comment> \<open>triangle_triangle = mul_c mul_ret div 2;\<close>
-  ''triangle'' ::= [''mul''] ((V ''c'') \<then>);;
+  ''triangle'' ::= (V (''mul'' @ ''c'') \<then>);;
   ''a'' ::= A (V ''a'')
   )"
 
@@ -116,8 +111,7 @@ definition triangle_IMP_minus where
  (mul_IMP_Minus_state_transformer (''mul'' @ p) (triangle_mul_state s))"*)
 
 definition "triangle_imp_to_HOL_state p s =
-              \<lparr>triangle_mul_state = mul_imp_to_HOL_state (p @ ''mul'') s, 
-               triangle_a = s (add_prefix p ''a''), triangle_triangle = (s (add_prefix p ''triangle''))\<rparr>"
+              \<lparr>triangle_a = s (add_prefix p ''a''), triangle_triangle = (s (add_prefix p ''triangle''))\<rparr>"
 
 lemma triangle_imp_to_HOL_state_add_prefix: 
   "triangle_imp_to_HOL_state (add_prefix p1 p2) s = triangle_imp_to_HOL_state p2 (s o (add_prefix p1))"
@@ -141,14 +135,14 @@ lemma cons_append: "xs \<noteq> [] \<Longrightarrow> x # xs = [x] @ xs"
   by simp
 
 lemma triangle_IMP_Minus_correct_function: 
-  "(triangle_IMP_minus p, s) 
+  "(invoke_subprogram p triangle_IMP_Minus, s) 
       \<Rightarrow>\<^bsup>t \<^esup> s'
     \<Longrightarrow> s' (add_prefix p ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state p s))"
-  apply(simp only: triangle_IMP_minus_def triangle_imp.simps)
+  apply(simp only: triangle_IMP_Minus_def triangle_imp.simps com_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
   \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
      program we call. If automation fails, this should be manually chosen variables.\<close>
-  apply(simp only: comp_def, erule mul_IMP_minus_correct'[where vars = "{''traingle''}"])
+  apply(erule mul_IMP_minus_correct[where vars = "{''traingle''}"])
   apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: triangle_state_upd_def Let_def triangle_imp_to_HOL_state_def)[1]
@@ -156,15 +150,15 @@ lemma triangle_IMP_Minus_correct_function:
   done
 
 lemma triangle_IMP_Minus_correct_time: 
-  "(triangle_IMP_minus p, s) 
+  "(invoke_subprogram p triangle_IMP_Minus, s) 
       \<Rightarrow>\<^bsup>t\<^esup> s'
     \<Longrightarrow> t = triangle_imp_time 0 (triangle_imp_to_HOL_state p s)"
-  apply(simp only: triangle_IMP_minus_def)
+  apply(simp only: triangle_IMP_Minus_def com_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
    apply(drule AssignD)+
    apply(elim conjE)
    apply(subst triangle_imp_time.simps)
-  apply(subst (asm) comp_def, erule mul_IMP_minus_correct'[where vars = "(set (all_variables (triangle_IMP_minus p))) - (set (all_variables (mul_IMP_minus p)))"])
+  apply(erule mul_IMP_minus_correct[where vars = "{''triangle''}"])
   \<comment> \<open>Warning: in the following, I am unfolding mul_imp_to_HOL_state_def. With more experiments, it
       should become clear if this will cascade down multiple layers\<close>
   apply(simp add: triangle_imp_time_acc triangle_imp_to_HOL_state_def triangle_state_upd_def)[1]
@@ -172,17 +166,145 @@ lemma triangle_IMP_Minus_correct_time:
   done
 
 lemma triangle_IMP_Minus_correct_effects:
-  "(triangle_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> (vars \<inter> set (all_variables (triangle_IMP_minus p)) = {} \<longrightarrow> (\<forall>v\<in>vars. s v = s' v))"
-  by (auto intro: com_only_vars)
-
-lemma triangle_IMP_minus_correct':
-  "\<lbrakk>(triangle_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s';
-     \<lbrakk>t = (triangle_imp_time 0 (triangle_imp_to_HOL_state p s));
-      s' (add_prefix p ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state p s));
-      (vars \<inter> set (all_variables (triangle_IMP_minus p)) = {} \<Longrightarrow> (\<forall>v\<in>vars. s v = s' v))\<rbrakk>
+  "(invoke_subprogram (p @ triangle_pref) triangle_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set triangle_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma triangle_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) triangle_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (triangle_imp_time 0 (triangle_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using triangle_IMP_Minus_correct_time triangle_IMP_Minus_correct_function
-        triangle_IMP_Minus_correct_effects
+        triangle_IMP_Minus_correct_effects 
+  by auto
+
+record prod_encode_state = prod_encode_a::nat prod_encode_b::nat prod_encode_ret::nat
+
+(*  [''a''] ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
+  invoke_subprogram ''a'' triangle_IMP_Minus ;;
+  ''prod_encode'' ::= [''a''] (A (V ''triangle'')) ;;
+  [''a''] ''triangle'' ::= (A (N 0)) ;;
+  ''prod_encode'' ::= ((V ''a'') \<oplus> (V ''prod_encode''))"*)
+
+definition "prod_encode_state_upd (s::prod_encode_state) \<equiv>
+      let
+        triangle_a = prod_encode_a s + prod_encode_b s;
+        triangle_triangle' = 0;
+        (triangle_state::triangle_state) = \<lparr>triangle_a = triangle_a, triangle_triangle = triangle_triangle'\<rparr>;
+        triangle_ret = (triangle_imp triangle_state);
+        prod_encode_ret = triangle_triangle triangle_ret;
+        prod_encode_ret = prod_encode_ret + prod_encode_a s;
+        ret = \<lparr>prod_encode_a = prod_encode_a s,prod_encode_b = prod_encode_b s, prod_encode_ret = prod_encode_ret\<rparr>
+      in
+        ret
+"
+
+fun prod_encode_imp:: "prod_encode_state \<Rightarrow> prod_encode_state" where
+"prod_encode_imp s = 
+  (let
+     ret = prod_encode_state_upd s
+   in
+     ret
+  )"
+
+lemmas [simp del] = prod_encode_imp.simps
+
+lemma prod_encode_imp_correct: "prod_encode_ret (prod_encode_imp s) = prod_encode (prod_encode_a s, prod_encode_b s)"
+proof (induction s rule: prod_encode_imp.induct)
+  case (1 s)
+  then show ?case
+    by (auto simp: prod_encode_imp.simps prod_encode_def prod_encode_state_upd_def Let_def triangle_imp_correct split: if_splits)
+qed 
+
+fun prod_encode_imp_time:: "nat \<Rightarrow> prod_encode_state \<Rightarrow> nat" where
+"prod_encode_imp_time t s = 
+  (let
+     triangle_a = prod_encode_a s + prod_encode_b s;
+     t = t + 2;
+     triangle_triangle' = 0;
+     t = t + 2;
+     (triangle_state::triangle_state) = \<lparr>triangle_a = triangle_a, triangle_triangle = triangle_triangle'\<rparr>;
+     triangle_ret = (triangle_imp triangle_state);
+     t = t + triangle_imp_time 0 triangle_state;
+     prod_encode_ret = triangle_triangle triangle_ret;
+     t = t + 2;
+     prod_encode_ret = prod_encode_ret + prod_encode_a s;
+     t = t + 2;
+     ret = t
+   in
+     ret
+  )"
+
+lemmas [simp del] = prod_encode_imp_time.simps
+
+lemma prod_encode_imp_time_acc: "(prod_encode_imp_time (Suc t) s) = Suc (prod_encode_imp_time t s)"
+  by (induction t s rule: prod_encode_imp_time.induct)
+     (auto simp add: prod_encode_imp_time.simps Let_def eval_nat_numeral split: if_splits)
+
+(*        triangle_a = prod_encode_a s + prod_encode_b s;
+        (triangle_state::triangle_state) = \<lparr>triangle_a = triangle_a, triangle_triangle = 0\<rparr>;
+        triangle_ret = (triangle_imp triangle_state);
+        prod_encode_ret = triangle_triangle triangle_ret + prod_encode_a s;
+*)
+
+definition prod_encode_IMP_Minus where "prod_encode_IMP_Minus \<equiv>
+  (''triangle.'' @ ''a'') ::= ((V ''a'') \<oplus> (V ''b'')) ;;
+  (''triangle.'' @ ''triangle'') ::= (A (N 0)) ;;
+  invoke_subprogram ''triangle.'' triangle_IMP_Minus ;;
+  ''prod_encode'' ::= (A (V (''triangle.'' @ ''triangle''))) ;;
+  ''prod_encode'' ::= ((V ''a'') \<oplus> (V ''prod_encode''))"
+
+definition "prod_encode_imp_to_HOL_state p s =
+  \<lparr>prod_encode_a = s (add_prefix p ''a''), prod_encode_b = s (add_prefix p ''b''), prod_encode_ret = (s (add_prefix p ''prod_encode''))\<rparr>"
+
+lemma notD: "x \<notin> s \<Longrightarrow> (x \<in> s \<Longrightarrow> False)"
+  by auto
+
+lemma prod_encode_IMP_Minus_correct_function: 
+  "(invoke_subprogram p prod_encode_IMP_Minus, s) 
+      \<Rightarrow>\<^bsup>t \<^esup> s'
+    \<Longrightarrow> s' (add_prefix p ''prod_encode'') = prod_encode_ret (prod_encode_imp (prod_encode_imp_to_HOL_state p s))"
+  apply(simp only: prod_encode_IMP_Minus_def prod_encode_imp.simps com_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
+     program we call. If automation fails, this should be manually chosen variables.\<close>
+  apply(erule triangle_IMP_Minus_correct[where vars = "{p @ ''a''}"])
+  apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: prod_encode_state_upd_def Let_def prod_encode_imp_to_HOL_state_def)[1]
+  apply(auto simp: triangle_imp_to_HOL_state_def)[1]
+  done
+
+lemma prod_encode_IMP_Minus_correct_time: 
+  "(invoke_subprogram p prod_encode_IMP_Minus, s) 
+      \<Rightarrow>\<^bsup>t\<^esup> s'
+    \<Longrightarrow> t = prod_encode_imp_time 0 (prod_encode_imp_to_HOL_state p s)"
+  apply(simp only: prod_encode_IMP_Minus_def prod_encode_imp_time.simps com_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
+     program we call. If automation fails, this should be manually chosen variables.\<close>
+  apply(erule triangle_IMP_Minus_correct[where vars = "{p @ ''a''}"])
+  apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: prod_encode_state_upd_def Let_def prod_encode_imp_to_HOL_state_def)[1]
+  apply(auto simp: triangle_imp_to_HOL_state_def)[1]
+  done
+
+lemma prod_encode_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ prod_encode_pref) prod_encode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set prod_encode_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma prod_encode_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) prod_encode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (prod_encode_imp_time 0 (prod_encode_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''prod_encode'') = prod_encode_ret (prod_encode_imp (prod_encode_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using prod_encode_IMP_Minus_correct_time prod_encode_IMP_Minus_correct_function
+        prod_encode_IMP_Minus_correct_effects 
   by auto
 
 end
\ No newline at end of file
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index 498c2047..48dce48e 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -6,7 +6,7 @@ theory Multiplication
 begin
 
 
-unbundle no_com_syntax
+(*unbundle no_com_syntax*)
 
 (*definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus =
   ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
@@ -51,15 +51,15 @@ next
     by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])+
 qed*)
 
-record mul_state = mul_a::nat mul_b::nat mul_c::nat mul_d::nat
+record mul_state = mul_a::nat mul_b::nat mul_c::nat
 
 definition "mul_state_upd s \<equiv>
       let
-        mul_d = (mul_b s) mod 2;
-        mul_c = (if mul_d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
+        d = (mul_b s) mod 2;
+        mul_c = (if d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
         mul_a = mul_a s + mul_a s;
         mul_b = (mul_b s) div 2;
-        ret = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = mul_c, mul_d = mul_d\<rparr>
+        ret = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = mul_c\<rparr>
       in
         ret
 "
@@ -156,7 +156,7 @@ definition mul_IMP_minus where
 
 definition "mul_imp_to_HOL_state p s =
   \<lparr>mul_a = s (add_prefix p ''a''), mul_b = (s (add_prefix p ''b'')),
-   mul_c = (s (add_prefix p ''c'')), mul_d =  (s (add_prefix p ''d''))\<rparr>"
+   mul_c = (s (add_prefix p ''c''))\<rparr>"
 
 lemma mul_imp_to_HOL_state_add_prefix: 
   "mul_imp_to_HOL_state (add_prefix p1 p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix p1))"
@@ -167,7 +167,7 @@ lemma mul_imp_to_HOL_state_add_prefix':
   by (auto simp: mul_imp_to_HOL_state_def)
 
 lemma mul_IMP_minus_correct_time:
-  "(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = (mul_imp_time 0 (mul_imp_to_HOL_state p s))"
+  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = (mul_imp_time 0 (mul_imp_to_HOL_state p s))"
   apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
   apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
   apply(erule While_tE)
@@ -185,7 +185,7 @@ lemma mul_IMP_minus_correct_time:
   done
 
 lemma mul_IMP_minus_correct_function:
-  "(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s))"
+  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s))"
   apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
   apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
   apply(erule While_tE)
@@ -203,14 +203,14 @@ lemma mul_IMP_minus_correct_function:
   done
 
 lemma mul_IMP_minus_correct_effects:
-  "(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> (vars \<inter> set (all_variables (mul_IMP_minus p)) = {} \<longrightarrow> (\<forall>v\<in>vars. s v = s' v))"
+  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> (vars \<inter> set (all_variables (invoke_subprogram p mul_IMP_minus)) = {} \<longrightarrow> (\<forall>v\<in>vars. s v = s' v))"
  by (auto intro: com_only_vars)
 
 lemma mul_IMP_minus_correct':
-  "\<lbrakk>(mul_IMP_minus p, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+  "\<lbrakk>(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
      \<lbrakk>t = (mul_imp_time 0 (mul_imp_to_HOL_state p s));
       s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s));
-      (vars \<inter> set (all_variables (mul_IMP_minus p)) = {} \<Longrightarrow> (\<forall>v\<in>vars. s v = s' v))\<rbrakk>
+      (vars \<inter> set (all_variables (invoke_subprogram p mul_IMP_minus)) = {} \<Longrightarrow> (\<forall>v\<in>vars. s v = s' v))\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using mul_IMP_minus_correct_time mul_IMP_minus_correct_function mul_IMP_minus_correct_effects
   by auto

From 5a4e162a491e314a3c3f924c35306078a04b95b5 Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Wed, 22 Dec 2021 20:32:35 +0100
Subject: [PATCH 096/103] Mul is standard now

---
 IMP-/IMP_Minus_Nat_Bijection.thy |  4 ++--
 IMP-/Multiplication.thy          | 17 +++++++++--------
 2 files changed, 11 insertions(+), 10 deletions(-)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 1b539cfd..16ad291c 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -142,7 +142,7 @@ lemma triangle_IMP_Minus_correct_function:
   apply(erule Seq_tE)+
   \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
      program we call. If automation fails, this should be manually chosen variables.\<close>
-  apply(erule mul_IMP_minus_correct[where vars = "{''traingle''}"])
+  apply(erule mul_IMP_minus_correct[where vars = "{p @ ''traingle''}"])
   apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: triangle_state_upd_def Let_def triangle_imp_to_HOL_state_def)[1]
@@ -158,7 +158,7 @@ lemma triangle_IMP_Minus_correct_time:
    apply(drule AssignD)+
    apply(elim conjE)
    apply(subst triangle_imp_time.simps)
-  apply(erule mul_IMP_minus_correct[where vars = "{''triangle''}"])
+  apply(erule mul_IMP_minus_correct[where vars = "{p @ ''triangle''}"])
   \<comment> \<open>Warning: in the following, I am unfolding mul_imp_to_HOL_state_def. With more experiments, it
       should become clear if this will cascade down multiple layers\<close>
   apply(simp add: triangle_imp_time_acc triangle_imp_to_HOL_state_def triangle_state_upd_def)[1]
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index 48dce48e..d7073386 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -203,14 +203,15 @@ lemma mul_IMP_minus_correct_function:
   done
 
 lemma mul_IMP_minus_correct_effects:
-  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> (vars \<inter> set (all_variables (invoke_subprogram p mul_IMP_minus)) = {} \<longrightarrow> (\<forall>v\<in>vars. s v = s' v))"
- by (auto intro: com_only_vars)
-
-lemma mul_IMP_minus_correct':
-  "\<lbrakk>(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
-     \<lbrakk>t = (mul_imp_time 0 (mul_imp_to_HOL_state p s));
-      s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s));
-      (vars \<inter> set (all_variables (invoke_subprogram p mul_IMP_minus)) = {} \<Longrightarrow> (\<forall>v\<in>vars. s v = s' v))\<rbrakk>
+  "(invoke_subprogram (p @ mul_pref) mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set mul_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma mul_IMP_minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (mul_imp_time 0 (mul_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using mul_IMP_minus_correct_time mul_IMP_minus_correct_function mul_IMP_minus_correct_effects
   by auto

From 36e4aca4996eeb44f2b8848b0aca585897d4fc5d Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Thu, 23 Dec 2021 13:39:56 +0100
Subject: [PATCH 097/103] prod decode

---
 IMP-/Big_StepT.thy               |  21 ++++
 IMP-/IMP_Minus_Nat_Bijection.thy | 165 +++++++++++++++++++++++++++++--
 2 files changed, 180 insertions(+), 6 deletions(-)

diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 0e4e4b77..57a4c5e6 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -219,6 +219,20 @@ method dest_com' =
       for s2 s2' t2 \<Rightarrow> \<open>insert a[OF _ _ b]\<close>\<close>)
 
 
+method dest_com_init_while = 
+  (match premises in a[thin]: "\<lbrakk>loop_cond; state_upd; ((_ ;; While _ _), s) \<Rightarrow>\<^bsup>t\<^esup> s'\<rbrakk> \<Longrightarrow> P" 
+    for s s' t loop_cond state_upd P  \<Rightarrow>
+   \<open>match premises in b[thin]: "((_ ;; While _ _), s2) \<Rightarrow>\<^bsup>t2\<^esup> s2'"
+      for s2 s2' t2 \<Rightarrow> \<open>insert a[OF _ _ b]\<close>\<close>)
+
+(*method dest_com_init_while = 
+  (match premises in a[thin]: "\<lbrakk>loop_cond; state_upd; (v ::= a;; WHILE v \<noteq>0 DO _, s) \<Rightarrow>\<^bsup>t\<^esup> s'\<rbrakk> \<Longrightarrow> P" 
+    for v a s s' t loop_cond state_upd P  \<Rightarrow>
+   \<open>match premises in b[thin]: "(v ::= a;; WHILE v \<noteq>0 DO _, s2) \<Rightarrow>\<^bsup>t2\<^esup> s2'"
+      for s2 s2' t2 \<Rightarrow> \<open>insert a\<close>\<close>)*)
+
+
+
 lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
 (\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
   by auto
@@ -289,4 +303,11 @@ thm Assign_tE
 lemma AssignD: "(x ::= a, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> t = 2 \<and> s' = s(x := aval a s)"
   by auto
 
+thm Seq_tE
+
+lemma Seq_tE2: 
+  "(WHILE v \<noteq>0 DO c2, s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<Longrightarrow> (c1, s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<Longrightarrow> 
+    ((c1;; WHILE v \<noteq>0 DO c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3 \<Longrightarrow> P)
+   \<Longrightarrow> P"
+  by auto
 end
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index 16ad291c..f3c20b56 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -182,12 +182,6 @@ lemma triangle_IMP_Minus_correct:
 
 record prod_encode_state = prod_encode_a::nat prod_encode_b::nat prod_encode_ret::nat
 
-(*  [''a''] ''a'' ::= ((V ''a'') \<oplus> (V ''b'')) ;;
-  invoke_subprogram ''a'' triangle_IMP_Minus ;;
-  ''prod_encode'' ::= [''a''] (A (V ''triangle'')) ;;
-  [''a''] ''triangle'' ::= (A (N 0)) ;;
-  ''prod_encode'' ::= ((V ''a'') \<oplus> (V ''prod_encode''))"*)
-
 definition "prod_encode_state_upd (s::prod_encode_state) \<equiv>
       let
         triangle_a = prod_encode_a s + prod_encode_b s;
@@ -307,4 +301,163 @@ lemma prod_encode_IMP_Minus_correct:
         prod_encode_IMP_Minus_correct_effects 
   by auto
 
+record prod_decode_state = prod_decode_k::nat prod_decode_m::nat
+
+
+definition "prod_decode_aux_state_upd s \<equiv>
+      let
+        prod_decode_k' = Suc (prod_decode_k s);
+        prod_decode_m' = (prod_decode_m s) - prod_decode_k';
+        ret = \<lparr>prod_decode_k = prod_decode_k', prod_decode_m = prod_decode_m'\<rparr>
+      in
+        ret
+"
+
+function prod_decode_aux_imp :: "prod_decode_state \<Rightarrow> prod_decode_state"
+  where "prod_decode_aux_imp s =    
+    (if prod_decode_m s - prod_decode_k s  \<noteq> 0 \<comment> \<open>while condition\<close>
+     then
+       let
+         next_iteration = prod_decode_aux_imp (prod_decode_aux_state_upd s)
+       in
+         next_iteration
+     else
+       s)"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>s. prod_decode_m s)")  (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+
+declare prod_decode_aux_imp.simps [simp del]
+
+lemma prod_decode_imp_correct:
+   "(prod_decode_m (prod_decode_aux_imp s), prod_decode_k (prod_decode_aux_imp s) - prod_decode_m (prod_decode_aux_imp s)) =
+      (prod_decode_aux (prod_decode_k s) (prod_decode_m s))"
+proof (induction s rule: prod_decode_aux_imp.induct)
+  case (1 s)
+  then show ?case
+    apply(subst prod_decode_aux_imp.simps)
+    apply (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+    apply (metis diff_is_0_eq prod_decode_aux.simps prod_decode_aux_imp.simps prod_decode_aux_state_upd_def)
+    by (simp add: prod_decode_aux.simps prod_decode_aux_imp.simps)
+qed 
+
+function prod_decode_aux_imp_time:: "nat \<Rightarrow> prod_decode_state\<Rightarrow> nat" where
+"prod_decode_aux_imp_time t s = 
+(
+    (if prod_decode_m s - prod_decode_k s \<noteq> 0 then \<comment> \<open>While\<close>
+      (
+        let
+          t = t + 3; \<comment> \<open>To account for while loop condition checking and difference computation\<close>
+          prod_decode_k' = Suc (prod_decode_k s);
+          t = t + 2;
+          prod_decode_m' = (prod_decode_m s) - prod_decode_k';
+          t = t + 2;
+          next_iteration = prod_decode_aux_imp_time t (prod_decode_aux_state_upd s)
+        in
+          next_iteration
+      )
+    else
+      (
+         \<comment> \<open>To account for the two steps of checking the condition, skipping the loop, and the difference computation\<close>
+        let
+          t = t + 4;
+          ret = t
+        in
+          ret
+      )
+    )
+)"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>(t, s). prod_decode_m s)")  (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+
+lemmas [simp del] = prod_decode_aux_imp_time.simps
+
+lemma prod_decode_aux_imp_time_acc: "(prod_decode_aux_imp_time (Suc t) s) = Suc (prod_decode_aux_imp_time t s)"
+  by (induction t s arbitrary:  rule: prod_decode_aux_imp_time.induct)
+     (auto simp add: prod_decode_aux_imp_time.simps prod_decode_aux_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition prod_decode_aux_IMP_Minus where
+"prod_decode_aux_IMP_Minus \<equiv>
+  (\<comment> \<open>if prod_decode_m s - prod_decode_k s \<noteq> 0 then\<close>
+   ''diff'' ::= ((V ''m'') \<ominus> (V ''k''));;
+   WHILE ''diff''\<noteq>0 DO (
+        \<comment> \<open>prod_decode_k' = Suc (prod_decode_k s);\<close>
+        ''k'' ::= ((V ''k'') \<oplus> (N 1));;
+        \<comment> \<open>prod_decode_m' = (prod_decode_m s) - prod_decode_k';\<close>
+        ''m'' ::= ((V ''m'') \<ominus> (V ''k''));;
+        ''diff'' ::= ((V ''m'') \<ominus> (V ''k'')))
+  )"
+
+definition "prod_decode_aux_imp_to_HOL_state p s =
+  \<lparr>prod_decode_k = s (add_prefix p ''k''), prod_decode_m = (s (add_prefix p ''m''))\<rparr>"
+
+lemma prod_decode_aux_correct_functional_1: 
+  "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p ''m'') = 
+       prod_decode_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
+  apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
+  apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
+  apply(erule Seq_tE)
+  apply(erule While_tE)
+   apply(drule AssignD)+
+   apply(subst prod_decode_aux_imp.simps)
+   apply(auto simp: prod_decode_aux_imp_to_HOL_state_def)[1]
+  apply(erule Seq_tE)
+  apply(erule Seq_tE2)
+  apply simp
+  apply(dest_com_init_while)
+  apply(erule Seq_tE)+
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst prod_decode_aux_imp.simps mul_imp_time.simps)
+   apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def)[1]
+  done
+
+lemma prod_decode_aux_correct_functional_2: 
+  "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p ''k'') = 
+       prod_decode_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
+  apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
+  apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
+  apply(erule Seq_tE)
+  apply(erule While_tE)
+   apply(drule AssignD)+
+   apply(subst prod_decode_aux_imp.simps)
+   apply(auto simp: prod_decode_aux_imp_to_HOL_state_def)[1]
+  apply(erule Seq_tE)
+  apply(erule Seq_tE2)
+  apply simp
+  apply(dest_com_init_while)
+  apply(erule Seq_tE)+
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst prod_decode_aux_imp.simps mul_imp_time.simps)
+   apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def)[1]
+  done
+
+lemma prod_decode_aux_correct_time: 
+  "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = 
+       prod_decode_aux_imp_time 0 (prod_decode_aux_imp_to_HOL_state p s)"
+  apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
+  apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
+  apply(erule Seq_tE)
+  apply(erule While_tE)
+   apply(drule AssignD)+
+   apply(subst prod_decode_aux_imp_time.simps)
+   apply(auto simp: prod_decode_aux_imp_to_HOL_state_def)[1]
+  apply(erule Seq_tE)
+  apply(erule Seq_tE2)
+  apply simp
+  apply(dest_com_init_while)
+  apply(erule Seq_tE)+
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst prod_decode_aux_imp_time.simps mul_imp_time.simps)
+  apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def
+                   eval_nat_numeral prod_decode_aux_imp_time_acc)[1]
+  done
+
+
 end
\ No newline at end of file

From 8b97418e0b4a2b41a3cded84228e44826804020b Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Thu, 23 Dec 2021 18:57:46 +0100
Subject: [PATCH 098/103] hd and tl

---
 IMP-/Big_StepT.thy               |   3 +-
 IMP-/IMP_Minus_Nat_Bijection.thy | 456 ++++++++++++++++++++++++++++---
 2 files changed, 421 insertions(+), 38 deletions(-)

diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 57a4c5e6..659a58f0 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -305,9 +305,10 @@ lemma AssignD: "(x ::= a, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarro
 
 thm Seq_tE
 
-lemma Seq_tE2: 
+lemma Seq_tE_While_init: 
   "(WHILE v \<noteq>0 DO c2, s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<Longrightarrow> (c1, s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<Longrightarrow> 
     ((c1;; WHILE v \<noteq>0 DO c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3 \<Longrightarrow> P)
    \<Longrightarrow> P"
   by auto
+
 end
\ No newline at end of file
diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/IMP-/IMP_Minus_Nat_Bijection.thy
index f3c20b56..a69f1ae0 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/IMP-/IMP_Minus_Nat_Bijection.thy
@@ -301,21 +301,20 @@ lemma prod_encode_IMP_Minus_correct:
         prod_encode_IMP_Minus_correct_effects 
   by auto
 
-record prod_decode_state = prod_decode_k::nat prod_decode_m::nat
-
+record prod_decode_aux_state = prod_decode_aux_k::nat prod_decode_aux_m::nat
 
 definition "prod_decode_aux_state_upd s \<equiv>
       let
-        prod_decode_k' = Suc (prod_decode_k s);
-        prod_decode_m' = (prod_decode_m s) - prod_decode_k';
-        ret = \<lparr>prod_decode_k = prod_decode_k', prod_decode_m = prod_decode_m'\<rparr>
+        prod_decode_aux_k' = Suc (prod_decode_aux_k s);
+        prod_decode_aux_m' = (prod_decode_aux_m s) - prod_decode_aux_k';
+        ret = \<lparr>prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\<rparr>
       in
         ret
 "
 
-function prod_decode_aux_imp :: "prod_decode_state \<Rightarrow> prod_decode_state"
+function prod_decode_aux_imp :: "prod_decode_aux_state \<Rightarrow> prod_decode_aux_state"
   where "prod_decode_aux_imp s =    
-    (if prod_decode_m s - prod_decode_k s  \<noteq> 0 \<comment> \<open>while condition\<close>
+    (if prod_decode_aux_m s - prod_decode_aux_k s  \<noteq> 0 \<comment> \<open>while condition\<close>
      then
        let
          next_iteration = prod_decode_aux_imp (prod_decode_aux_state_upd s)
@@ -325,32 +324,44 @@ function prod_decode_aux_imp :: "prod_decode_state \<Rightarrow> prod_decode_sta
        s)"
   by pat_completeness auto
 termination
-  by  (relation "measure (\<lambda>s. prod_decode_m s)")  (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+  by  (relation "measure (\<lambda>s. prod_decode_aux_m s)")  (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
 
 declare prod_decode_aux_imp.simps [simp del]
 
-lemma prod_decode_imp_correct:
-   "(prod_decode_m (prod_decode_aux_imp s), prod_decode_k (prod_decode_aux_imp s) - prod_decode_m (prod_decode_aux_imp s)) =
-      (prod_decode_aux (prod_decode_k s) (prod_decode_m s))"
-proof (induction s rule: prod_decode_aux_imp.induct)
-  case (1 s)
-  then show ?case
-    apply(subst prod_decode_aux_imp.simps)
-    apply (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
-    apply (metis diff_is_0_eq prod_decode_aux.simps prod_decode_aux_imp.simps prod_decode_aux_state_upd_def)
-    by (simp add: prod_decode_aux.simps prod_decode_aux_imp.simps)
+lemma prod_decode_aux_imp_correct:
+  "prod_decode_aux_m (prod_decode_aux_imp s) = fst (prod_decode_aux (prod_decode_aux_k s) (prod_decode_aux_m s))"(is ?g1)
+  "prod_decode_aux_k (prod_decode_aux_imp s) - prod_decode_aux_m (prod_decode_aux_imp s) = snd (prod_decode_aux (prod_decode_aux_k s) (prod_decode_aux_m s))" (is ?g2)
+proof-
+  show ?g1
+  proof (induction s rule: prod_decode_aux_imp.induct)
+    case (1 s)
+    then show ?case
+      apply(subst prod_decode_aux_imp.simps)
+      apply (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+       apply (metis diff_is_0_eq prod_decode_aux.simps prod_decode_aux_imp.simps prod_decode_aux_state_upd_def)
+      by (simp add: prod_decode_aux.simps prod_decode_aux_imp.simps)
+  qed
+  show ?g2
+  proof (induction s rule: prod_decode_aux_imp.induct)
+    case (1 s)
+    then show ?case
+      apply(subst prod_decode_aux_imp.simps)
+      apply (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+       apply (metis diff_is_0_eq prod_decode_aux.simps prod_decode_aux_imp.simps prod_decode_aux_state_upd_def)
+      by (simp add: prod_decode_aux.simps prod_decode_aux_imp.simps)
+  qed
 qed 
 
-function prod_decode_aux_imp_time:: "nat \<Rightarrow> prod_decode_state\<Rightarrow> nat" where
+function prod_decode_aux_imp_time:: "nat \<Rightarrow> prod_decode_aux_state\<Rightarrow> nat" where
 "prod_decode_aux_imp_time t s = 
 (
-    (if prod_decode_m s - prod_decode_k s \<noteq> 0 then \<comment> \<open>While\<close>
+    (if prod_decode_aux_m s - prod_decode_aux_k s \<noteq> 0 then \<comment> \<open>While\<close>
       (
         let
           t = t + 3; \<comment> \<open>To account for while loop condition checking and difference computation\<close>
-          prod_decode_k' = Suc (prod_decode_k s);
+          prod_decode_aux_k' = Suc (prod_decode_aux_k s);
           t = t + 2;
-          prod_decode_m' = (prod_decode_m s) - prod_decode_k';
+          prod_decode_aux_m' = (prod_decode_aux_m s) - prod_decode_aux_k';
           t = t + 2;
           next_iteration = prod_decode_aux_imp_time t (prod_decode_aux_state_upd s)
         in
@@ -369,7 +380,7 @@ function prod_decode_aux_imp_time:: "nat \<Rightarrow> prod_decode_state\<Righta
 )"
   by pat_completeness auto
 termination
-  by  (relation "measure (\<lambda>(t, s). prod_decode_m s)")  (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
+  by  (relation "measure (\<lambda>(t, s). prod_decode_aux_m s)")  (auto simp: prod_decode_aux_state_upd_def Let_def split: if_splits)
 
 lemmas [simp del] = prod_decode_aux_imp_time.simps
 
@@ -379,23 +390,23 @@ lemma prod_decode_aux_imp_time_acc: "(prod_decode_aux_imp_time (Suc t) s) = Suc
 
 definition prod_decode_aux_IMP_Minus where
 "prod_decode_aux_IMP_Minus \<equiv>
-  (\<comment> \<open>if prod_decode_m s - prod_decode_k s \<noteq> 0 then\<close>
+  (\<comment> \<open>if prod_decode_aux_m s - prod_decode_aux_k s \<noteq> 0 then\<close>
    ''diff'' ::= ((V ''m'') \<ominus> (V ''k''));;
    WHILE ''diff''\<noteq>0 DO (
-        \<comment> \<open>prod_decode_k' = Suc (prod_decode_k s);\<close>
+        \<comment> \<open>prod_decode_aux_k' = Suc (prod_decode_aux_k s);\<close>
         ''k'' ::= ((V ''k'') \<oplus> (N 1));;
-        \<comment> \<open>prod_decode_m' = (prod_decode_m s) - prod_decode_k';\<close>
+        \<comment> \<open>prod_decode_aux_m' = (prod_decode_aux_m s) - prod_decode_aux_k';\<close>
         ''m'' ::= ((V ''m'') \<ominus> (V ''k''));;
         ''diff'' ::= ((V ''m'') \<ominus> (V ''k'')))
   )"
 
 definition "prod_decode_aux_imp_to_HOL_state p s =
-  \<lparr>prod_decode_k = s (add_prefix p ''k''), prod_decode_m = (s (add_prefix p ''m''))\<rparr>"
+  \<lparr>prod_decode_aux_k = s (add_prefix p ''k''), prod_decode_aux_m = (s (add_prefix p ''m''))\<rparr>"
 
-lemma prod_decode_aux_correct_functional_1: 
+lemma prod_decode_aux_IMP_Minus_correct_function_1: 
   "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
      s' (add_prefix p ''m'') = 
-       prod_decode_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
+       prod_decode_aux_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
   apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
   apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
   apply(erule Seq_tE)
@@ -404,7 +415,7 @@ lemma prod_decode_aux_correct_functional_1:
    apply(subst prod_decode_aux_imp.simps)
    apply(auto simp: prod_decode_aux_imp_to_HOL_state_def)[1]
   apply(erule Seq_tE)
-  apply(erule Seq_tE2)
+  apply(erule Seq_tE_While_init)
   apply simp
   apply(dest_com_init_while)
   apply(erule Seq_tE)+
@@ -414,10 +425,10 @@ lemma prod_decode_aux_correct_functional_1:
    apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def)[1]
   done
 
-lemma prod_decode_aux_correct_functional_2: 
+lemma prod_decode_aux_IMP_Minus_correct_function_2: 
   "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
      s' (add_prefix p ''k'') = 
-       prod_decode_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
+       prod_decode_aux_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
   apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
   apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
   apply(erule Seq_tE)
@@ -426,8 +437,8 @@ lemma prod_decode_aux_correct_functional_2:
    apply(subst prod_decode_aux_imp.simps)
    apply(auto simp: prod_decode_aux_imp_to_HOL_state_def)[1]
   apply(erule Seq_tE)
-  apply(erule Seq_tE2)
-  apply simp
+  apply(erule Seq_tE_While_init)
+  apply assumption
   apply(dest_com_init_while)
   apply(erule Seq_tE)+
    apply(drule AssignD)+
@@ -436,7 +447,7 @@ lemma prod_decode_aux_correct_functional_2:
    apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def)[1]
   done
 
-lemma prod_decode_aux_correct_time: 
+lemma prod_decode_aux_IMP_Minus_correct_time: 
   "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
      t = 
        prod_decode_aux_imp_time 0 (prod_decode_aux_imp_to_HOL_state p s)"
@@ -448,8 +459,8 @@ lemma prod_decode_aux_correct_time:
    apply(subst prod_decode_aux_imp_time.simps)
    apply(auto simp: prod_decode_aux_imp_to_HOL_state_def)[1]
   apply(erule Seq_tE)
-  apply(erule Seq_tE2)
-  apply simp
+  apply(erule Seq_tE_While_init)
+  apply assumption
   apply(dest_com_init_while)
   apply(erule Seq_tE)+
    apply(drule AssignD)+
@@ -459,5 +470,376 @@ lemma prod_decode_aux_correct_time:
                    eval_nat_numeral prod_decode_aux_imp_time_acc)[1]
   done
 
+lemma prod_decode_aux_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ prod_decode_aux_pref) prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set prod_decode_aux_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma prod_decode_aux_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (prod_decode_aux_imp_time 0 (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''m'') = prod_decode_aux_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''k'') = prod_decode_aux_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using prod_decode_aux_IMP_Minus_correct_time prod_decode_aux_IMP_Minus_correct_function_1
+        prod_decode_aux_IMP_Minus_correct_function_2
+        prod_decode_aux_IMP_Minus_correct_effects 
+  by auto
+
+record prod_decode_state = prod_decode_m::nat prod_decode_fst_ret::nat prod_decode_snd_ret::nat
+
+definition "prod_decode_state_upd s \<equiv>
+      let
+        prod_decode_aux_k' = 0;
+        prod_decode_aux_m' = (prod_decode_m s);
+        prod_decode_aux_state = \<lparr>prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\<rparr>;
+        prod_decode_aux_ret = prod_decode_aux_imp prod_decode_aux_state;
+        fst_ret' = prod_decode_aux_m prod_decode_aux_ret;
+        snd_ret' = prod_decode_aux_k prod_decode_aux_ret - prod_decode_aux_m prod_decode_aux_ret;
+        ret = \<lparr>prod_decode_m = prod_decode_m s, fst_ret = fst_ret', snd_ret = snd_ret'\<rparr>
+      in
+        ret
+"
+
+fun prod_decode_imp :: "prod_decode_state \<Rightarrow> prod_decode_state"
+  where "prod_decode_imp s =    
+    (let
+       ret = (prod_decode_state_upd s)
+     in
+         ret)
+"
+
+declare prod_decode_imp.simps [simp del]
+
+lemma prod_decode_imp_correct:
+   "prod_decode_fst_ret (prod_decode_imp s) = fst (prod_decode (prod_decode_m s))"
+   "prod_decode_snd_ret (prod_decode_imp s) = snd (prod_decode (prod_decode_m s))"
+   apply(subst prod_decode_imp.simps)
+  apply (auto simp: prod_decode_aux_imp_correct(1) prod_decode_def prod_decode_imp.simps prod_decode_state_upd_def  Let_def split: if_splits)[1]
+   apply(subst prod_decode_imp.simps)
+  apply (auto simp: prod_decode_aux_imp_correct(2) prod_decode_def prod_decode_imp.simps prod_decode_state_upd_def  Let_def split: if_splits)[1]
+  done
+
+
+fun prod_decode_imp_time:: "nat \<Rightarrow> prod_decode_state\<Rightarrow> nat" where
+  "prod_decode_imp_time t s = 
+(
+        let
+          prod_decode_aux_k' = 0;
+          t = t + 2;
+          prod_decode_aux_m' = (prod_decode_m s);
+          t = t + 2;
+          prod_decode_aux_state = \<lparr>prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\<rparr>;
+          prod_decode_aux_ret = prod_decode_aux_imp prod_decode_aux_state;
+          t = t + prod_decode_aux_imp_time 0 prod_decode_aux_state;
+          fst_ret' = prod_decode_aux_m prod_decode_aux_ret;
+          t = t + 2;
+          snd_ret' = prod_decode_aux_k prod_decode_aux_ret - prod_decode_aux_m prod_decode_aux_ret;
+          t = t + 2;
+          ret = t
+        in
+          ret
+      )
+"
+
+lemmas [simp del] = prod_decode_imp_time.simps
+
+lemma prod_decode_imp_time_acc: "(prod_decode_imp_time (Suc t) s) = Suc (prod_decode_imp_time t s)"
+  by (induction t s arbitrary:  rule: prod_decode_imp_time.induct)
+     (auto simp add: prod_decode_imp_time.simps prod_decode_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition prod_decode_IMP_Minus where
+"prod_decode_IMP_Minus \<equiv>
+  (     \<comment> \<open>prod_decode_aux_k' = 0;\<close>
+   (''prod_decode_aux.'' @ ''k'') ::= (A (N 0));;
+        \<comment> \<open>prod_decode_aux_m' = (prod_decode_m s);\<close>
+   (''prod_decode_aux.'' @ ''m'') ::= (A (V ''m''));;
+        \<comment> \<open>prod_decode_aux_state = \<lparr>prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\<rparr>;\<close>
+        \<comment> \<open>prod_decode_aux_ret = prod_decode_aux_imp prod_decode_aux_state;\<close>
+   invoke_subprogram ''prod_decode_aux.'' prod_decode_aux_IMP_Minus;;
+        \<comment> \<open>fst_ret' = prod_decode_aux_m prod_decode_aux_ret;\<close>
+   ''fst_ret'' ::= (A (V (''prod_decode_aux.'' @ ''m'')));;
+        \<comment> \<open>snd_ret' = prod_decode_aux_k prod_decode_aux_ret - prod_decode_aux_m prod_decode_aux_ret;\<close>
+   ''snd_ret'' ::= ((V (''prod_decode_aux.'' @ ''k'')) \<ominus> (V (''prod_decode_aux.'' @ ''m'')))
+  )"
+
+definition "prod_decode_imp_to_HOL_state p s =
+  \<lparr>prod_decode_m = (s (add_prefix p ''m'')), prod_decode_fst_ret = (s (add_prefix p ''fst_ret'')) , prod_decode_snd_ret = (s (add_prefix p ''snd_ret''))\<rparr>"
+
+lemma prod_decode_IMP_Minus_correct_function_1: 
+  "(invoke_subprogram p prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p ''fst_ret'') = prod_decode_fst_ret (prod_decode_imp (prod_decode_imp_to_HOL_state p s))"
+  apply(simp only: prod_decode_IMP_Minus_def prod_decode_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ ''m''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: prod_decode_state_upd_def Let_def prod_decode_aux_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma prod_decode_IMP_Minus_correct_function_2: 
+  "(invoke_subprogram p prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p ''snd_ret'') = prod_decode_snd_ret (prod_decode_imp (prod_decode_imp_to_HOL_state p s))"
+  apply(simp only: prod_decode_IMP_Minus_def prod_decode_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ ''m''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: prod_decode_state_upd_def Let_def prod_decode_aux_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma prod_decode_IMP_Minus_correct_time: 
+  "(invoke_subprogram p prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = (prod_decode_imp_time 0 (prod_decode_imp_to_HOL_state p s))"
+  apply(simp only: prod_decode_IMP_Minus_def prod_decode_imp_time.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ ''m''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: prod_decode_state_upd_def Let_def prod_decode_aux_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma prod_decode_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ prod_decode_pref) prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set prod_decode_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma prod_decode_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (prod_decode_imp_time 0 (prod_decode_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''fst_ret'') = prod_decode_fst_ret (prod_decode_imp (prod_decode_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''snd_ret'') = prod_decode_snd_ret (prod_decode_imp (prod_decode_imp_to_HOL_state (p1 @ p2) s));      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using prod_decode_IMP_Minus_correct_time prod_decode_IMP_Minus_correct_function_1
+        prod_decode_IMP_Minus_correct_function_2
+        prod_decode_IMP_Minus_correct_effects 
+  by auto
+
+record hd_state = hd_xs::nat hd_ret::nat
+
+definition "hd_state_upd s \<equiv>
+      let
+        prod_decode_m' = hd_xs s - 1;
+        prod_decode_fst_ret' = 0;
+        prod_decode_snd_ret' = 0;
+        prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;
+        prod_decode_ret = prod_decode_imp prod_decode_state;
+        hd_ret' = prod_decode_fst_ret prod_decode_ret;
+        ret = \<lparr>hd_xs = hd_xs s, hd_ret = hd_ret'\<rparr>
+      in
+        ret
+"
+
+fun hd_imp :: "hd_state \<Rightarrow> hd_state"
+  where "hd_imp s =    
+    (let
+       ret = (hd_state_upd s)
+     in
+         ret)
+"
+
+declare hd_imp.simps [simp del]
+
+lemma hd_imp_correct:
+   "hd_ret (hd_imp s) = hd_nat (hd_xs s)"
+  by (subst hd_imp.simps) (auto simp: prod_decode_imp_correct hd_nat_def fst_nat_def hd_imp.simps hd_state_upd_def Let_def split: if_splits)[1]
+
+fun hd_imp_time:: "nat \<Rightarrow> hd_state\<Rightarrow> nat" where
+  "hd_imp_time t s = 
+(
+      let
+        prod_decode_m' = hd_xs s - 1;
+        t = t + 2;
+        prod_decode_fst_ret' = 0;
+        t = t + 2;
+        prod_decode_snd_ret' = 0;
+        t = t + 2;
+        prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;
+        prod_decode_ret = prod_decode_imp prod_decode_state;
+        t = t + prod_decode_imp_time 0 prod_decode_state;
+        hd_ret' = prod_decode_fst_ret prod_decode_ret;
+        t = t + 2;
+        ret = t
+      in
+        ret
+      )
+"
+
+lemmas [simp del] = hd_imp_time.simps
+
+lemma hd_imp_time_acc: "(hd_imp_time (Suc t) s) = Suc (hd_imp_time t s)"
+  by (induction t s arbitrary:  rule: hd_imp_time.induct)
+     (auto simp add: hd_imp_time.simps split: if_splits)
+
+definition hd_IMP_Minus where
+"hd_IMP_Minus \<equiv>
+  (     \<comment> \<open>prod_decode_m' = hd_xs s - 1;\<close>
+        (''prod_decode.'' @ ''m'') ::= ((V ''xs'') \<ominus> (N 1));;
+        \<comment> \<open>prod_decode_fst_ret' = 0;\<close>
+        (''prod_decode.'' @ ''fst_ret'') ::= (A (N 0));;
+        \<comment> \<open>prod_decode_snd_ret' = 0;\<close>
+        (''prod_decode.'' @ ''snd_ret'') ::= (A (N 0));;
+        \<comment> \<open>prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;\<close>
+        \<comment> \<open>prod_decode_ret = prod_decode_imp prod_decode_state;\<close>
+        invoke_subprogram ''prod_decode.'' prod_decode_IMP_Minus;;
+        \<comment> \<open>hd_ret' = prod_decode_fst_ret prod_decode_ret;\<close>
+        (''hd_ret'') ::= (A (V (''prod_decode.'' @ ''fst_ret'')))
+  )"
+
+definition "hd_imp_to_HOL_state p s =
+  \<lparr>hd_xs = (s (add_prefix p ''xs'')), hd_ret = (s (add_prefix p ''hd_ret''))\<rparr>"
+
+lemma hd_IMP_Minus_correct_function: 
+  "(invoke_subprogram p hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p ''hd_ret'') = hd_ret (hd_imp (hd_imp_to_HOL_state p s))"
+  apply(simp only: hd_IMP_Minus_def hd_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: hd_state_upd_def Let_def hd_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma hd_IMP_Minus_correct_time: 
+  "(invoke_subprogram p hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = hd_imp_time 0 (hd_imp_to_HOL_state p s)"
+  apply(simp only: hd_IMP_Minus_def hd_imp_time.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: hd_state_upd_def Let_def hd_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma hd_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ hd_pref) hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set hd_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma hd_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (hd_imp_time 0 (hd_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''hd_ret'') = hd_ret (hd_imp (hd_imp_to_HOL_state (p1 @ p2) s))\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using hd_IMP_Minus_correct_time hd_IMP_Minus_correct_function
+        hd_IMP_Minus_correct_effects 
+  by auto
+
+record tl_state = tl_xs::nat tl_ret::nat
+
+definition "tl_state_upd s \<equiv>
+      let
+        prod_decode_m' = tl_xs s - 1;
+        prod_decode_fst_ret' = 0;
+        prod_decode_snd_ret' = 0;
+        prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;
+        prod_decode_ret = prod_decode_imp prod_decode_state;
+        tl_ret' = prod_decode_snd_ret prod_decode_ret;
+        ret = \<lparr>tl_xs = tl_xs s, tl_ret = tl_ret'\<rparr>
+      in
+        ret
+"
+
+fun tl_imp :: "tl_state \<Rightarrow> tl_state"
+  where "tl_imp s =    
+    (let
+       ret = (tl_state_upd s)
+     in
+         ret)
+"
+
+declare tl_imp.simps [simp del]
+
+lemma tl_imp_correct:
+   "tl_ret (tl_imp s) = tl_nat (tl_xs s)"
+  by (subst tl_imp.simps) (auto simp: prod_decode_imp_correct tl_nat_def snd_nat_def tl_imp.simps tl_state_upd_def Let_def split: if_splits)[1]
+
+fun tl_imp_time:: "nat \<Rightarrow> tl_state\<Rightarrow> nat" where
+  "tl_imp_time t s = 
+(
+      let
+        prod_decode_m' = tl_xs s - 1;
+        t = t + 2;
+        prod_decode_fst_ret' = 0;
+        t = t + 2;
+        prod_decode_snd_ret' = 0;
+        t = t + 2;
+        prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;
+        prod_decode_ret = prod_decode_imp prod_decode_state;
+        t = t + prod_decode_imp_time 0 prod_decode_state;
+        tl_ret' = prod_decode_snd_ret prod_decode_ret;
+        t = t + 2;
+        ret = t
+      in
+        ret
+      )
+"
+
+lemmas [simp del] = tl_imp_time.simps
+
+lemma tl_imp_time_acc: "(tl_imp_time (Suc t) s) = Suc (tl_imp_time t s)"
+  by (induction t s arbitrary:  rule: tl_imp_time.induct)
+     (auto simp add: tl_imp_time.simps split: if_splits)
+
+definition tl_IMP_Minus where
+"tl_IMP_Minus \<equiv>
+  (     \<comment> \<open>prod_decode_m' = tl_xs s - 1;\<close>
+        (''prod_decode.'' @ ''m'') ::= ((V ''xs'') \<ominus> (N 1));;
+        \<comment> \<open>prod_decode_snd_ret' = 0;\<close>
+        (''prod_decode.'' @ ''fst_ret'') ::= (A (N 0));;
+        \<comment> \<open>prod_decode_snd_ret' = 0;\<close>
+        (''prod_decode.'' @ ''snd_ret'') ::= (A (N 0));;
+        \<comment> \<open>prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_snd_ret = prod_decode_snd_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;\<close>
+        \<comment> \<open>prod_decode_ret = prod_decode_imp prod_decode_state;\<close>
+        invoke_subprogram ''prod_decode.'' prod_decode_IMP_Minus;;
+        \<comment> \<open>tl_ret' = prod_decode_snd_ret prod_decode_ret;\<close>
+        (''tl_ret'') ::= (A (V (''prod_decode.'' @ ''snd_ret'')))
+  )"
+
+definition "tl_imp_to_HOL_state p s =
+  \<lparr>tl_xs = (s (add_prefix p ''xs'')), tl_ret = (s (add_prefix p ''tl_ret''))\<rparr>"
+
+lemma tl_IMP_Minus_correct_function: 
+  "(invoke_subprogram p tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p ''tl_ret'') = tl_ret (tl_imp (tl_imp_to_HOL_state p s))"
+  apply(simp only: tl_IMP_Minus_def tl_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: tl_state_upd_def Let_def tl_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma tl_IMP_Minus_correct_time: 
+  "(invoke_subprogram p tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = tl_imp_time 0 (tl_imp_to_HOL_state p s)"
+  apply(simp only: tl_IMP_Minus_def tl_imp_time.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+   apply(drule AssignD)+
+  apply(elim conjE impE)
+  apply(auto simp: tl_state_upd_def Let_def tl_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_decode_imp_to_HOL_state_def)[1]
+  done
+
+lemma tl_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ tl_pref) tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set tl_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma tl_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (tl_imp_time 0 (tl_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) ''tl_ret'') = tl_ret (tl_imp (tl_imp_to_HOL_state (p1 @ p2) s))\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using tl_IMP_Minus_correct_time tl_IMP_Minus_correct_function
+        tl_IMP_Minus_correct_effects 
+  by auto
 
 end
\ No newline at end of file

From fbd00b3c727e88fcd72a8c7e474e628d2dc6c064 Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Fri, 24 Dec 2021 10:45:02 +0100
Subject: [PATCH 099/103] IMP- primitives in a new file

---
 .../IMP-_To_IMP--/Primitives_IMP_Minus.thy    | 120 ++++++++++++++----
 1 file changed, 97 insertions(+), 23 deletions(-)
 rename IMP-/IMP_Minus_Nat_Bijection.thy => Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy (91%)

diff --git a/IMP-/IMP_Minus_Nat_Bijection.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
similarity index 91%
rename from IMP-/IMP_Minus_Nat_Bijection.thy
rename to Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
index a69f1ae0..bb6b4996 100644
--- a/IMP-/IMP_Minus_Nat_Bijection.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
@@ -5,32 +5,10 @@ theory IMP_Minus_Nat_Bijection
     "../Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives"
 begin
 
-lemma xxx: "x \<noteq> y \<Longrightarrow> (s (x := aval a s)) y = s y"
-  by auto
-
-(*lemma AssignI'': 
-  "\<exists>s'.((x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s' \<and> (s' = s (x := aval a s)))"
-  by (auto simp add: Assign eval_nat_numeral)
-*)
-
-(*unbundle IMP_Minus_Minus_Com.no_com_syntax
-
-unbundle Com.no_com_syntax*)
+subsection \<open>Encoding and decoding natural numbers\<close>
 
 record triangle_state = triangle_a::nat triangle_triangle::nat
 
-term Nat_Bijection.triangle
-
-find_theorems Max_Constant.all_variables
-
-(*definition triangle_IMP_Minus where "triangle_IMP_Minus \<equiv>
-  [''a''] ''a'' ::= (A (V ''a'')) ;;
-  [''a''] ''b'' ::= ((V ''a'') \<oplus> (N 1)) ;;
-  invoke_subprogram ''a'' mul_IMP_minus ;;
-  ''triangle'' ::= [''a''] ((V ''c'') \<then>) ;;
-  ''a'' ::= (A (N 0))"
-*)
-
 definition "triangle_state_upd (s::triangle_state) \<equiv>
       let
         mul_a' = triangle_a s;
@@ -618,6 +596,8 @@ lemma prod_decode_IMP_Minus_correct:
         prod_decode_IMP_Minus_correct_effects 
   by auto
 
+subsection \<open>Head and tail of lists\<close>
+
 record hd_state = hd_xs::nat hd_ret::nat
 
 definition "hd_state_upd s \<equiv>
@@ -842,4 +822,98 @@ lemma tl_IMP_Minus_correct:
         tl_IMP_Minus_correct_effects 
   by auto
 
+subsection \<open>Nth Natural number\<close>
+
+term nth_nat
+
+fun nth_nat_imp :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"nth_nat 0 x = hd_nat x "|
+"nth_nat (Suc n) x = nth_nat n (tl_nat x)"
+
+
+
+(*
+definition nth_nat_iteration where "nth_nat_iteration \<equiv>
+  [''a''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  invoke_subprogram ''a'' snd_nat_IMP_Minus ;;
+  ''a'' ::= [''a''] (A (V ''snd_nat'')) ;;
+  [''a''] ''snd_nat'' ::= (A (N 0)) ;;
+  ''nth_nat'' ::= ((V ''nth_nat'') \<ominus> (N 1))"
+
+fun nth_nat_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+"nth_nat_loop_time 0 x = 2" |
+"nth_nat_loop_time (Suc n) x = 9 + snd_nat_IMP_Minus_time (x - 1) 
+  + nth_nat_loop_time n (tl_nat x)"
+
+fun drop_n_nat :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
+"drop_n_nat 0 x = x "|
+"drop_n_nat (Suc n) x = drop_n_nat n (tl_nat x)"
+
+lemma nth_nat_is_hd_of_drop_n_nat:
+  "nth_nat n x = fst_nat (drop_n_nat n x - Suc 0)"
+  by (induction n arbitrary: x)
+    (auto simp: hd_nat_def)
+
+abbreviation nth_nat_loop_state_transformer where "nth_nat_loop_state_transformer p k x \<equiv>
+  (if k = 0 then (\<lambda>s. s)
+   else 
+        state_transformer p [
+        (''a'', drop_n_nat k x),
+        (''nth_nat'',  0)]
+        \<circ> state_transformer (''a'' @ p) [
+          (''snd_nat'', 0)]
+        \<circ> snd_nat_IMP_Minus_state_transformer (''a'' @ p) 0)"
+
+lemma nth_nat_loop_correct:
+  "s (add_prefix p ''nth_nat'') = k
+  \<Longrightarrow> ((WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration) p, s) 
+      \<Rightarrow>\<^bsup>nth_nat_loop_time k (s (add_prefix p ''a''))\<^esup>
+      nth_nat_loop_state_transformer p k (s (add_prefix p ''a'')) s "
+proof(induction k arbitrary: s)
+  case 0
+  then show ?case
+    by(auto simp: numeral_eq_Suc fun_eq_iff 
+        intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse])
+next
+  case (Suc k)
+  show ?case
+    apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[OF _ _ Suc.IH]])
+    using \<open>s (add_prefix p ''nth_nat'') = Suc k\<close>
+    unfolding nth_nat_iteration_def
+    by (fastforce simp: tl_nat_def)+
+qed
+
+
+definition nth_nat_IMP_Minus where "nth_nat_IMP_Minus \<equiv>
+  ''nth_nat'' ::= (A (V ''a'')) ;;
+  ''a'' ::= (A (V ''b'')) ;;
+  WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration ;;
+  [''b''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
+  invoke_subprogram ''b'' fst_nat_IMP_Minus ;;
+  ''nth_nat'' ::= [''b''] (A (V ''fst_nat'')) ;;
+  [''b''] ''fst_nat'' ::= (A (N 0)) ;;
+  zero_variables [''a'', ''b'']"
+
+definition nth_nat_IMP_Minus_time where "nth_nat_IMP_Minus_time n x \<equiv>
+  10 + nth_nat_loop_time n x + fst_nat_IMP_Minus_time ((drop_n_nat n x) - 1)
+  + zero_variables_time [''a'', ''b'']"
+
+abbreviation nth_nat_IMP_Minus_state_transformer where "nth_nat_IMP_Minus_state_transformer p k x
+  \<equiv> state_transformer p [(''nth_nat'', nth_nat k x), (''a'', 0), (''b'', 0)]
+     \<circ> state_transformer (''b'' @ p) [(''fst_nat'', 0)]
+     \<circ> fst_nat_IMP_Minus_state_transformer (''b'' @ p) 0
+     \<circ> nth_nat_loop_state_transformer p k x"
+
+lemma nth_nat_IMP_Minus_correct:
+  "(nth_nat_IMP_Minus p, s) 
+    \<Rightarrow>\<^bsup>nth_nat_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup>
+    nth_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
+  unfolding nth_nat_IMP_Minus_def nth_nat_IMP_Minus_time_def tl_nat_def 
+  by (cases "s (add_prefix p ''a'') = 0") (fastforce 
+      simp: hd_nat_def nth_nat_is_hd_of_drop_n_nat
+      intro!: terminates_in_time_state_intro[OF Seq']
+      intro: nth_nat_loop_correct)+
+*)
+
+
 end
\ No newline at end of file

From 59dc8a3555fe2c2d99de787449b0389bb2ef60bb Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Fri, 24 Dec 2021 10:50:08 +0100
Subject: [PATCH 100/103] Call by prefixes in IMP-

---
 IMP-/Call_By_Prefixes.thy             | 124 ++++++
 IMP-/Canonical_State_Transformers.thy | 615 --------------------------
 2 files changed, 124 insertions(+), 615 deletions(-)
 create mode 100644 IMP-/Call_By_Prefixes.thy
 delete mode 100644 IMP-/Canonical_State_Transformers.thy

diff --git a/IMP-/Call_By_Prefixes.thy b/IMP-/Call_By_Prefixes.thy
new file mode 100644
index 00000000..24e79bc6
--- /dev/null
+++ b/IMP-/Call_By_Prefixes.thy
@@ -0,0 +1,124 @@
+(*Authors: Mohammad Abdulaziz*)
+
+theory Call_By_Prefixes
+  imports Com Big_StepT
+begin
+
+abbreviation add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
+"add_prefix p s \<equiv> p @ s"
+
+(*type_synonym pcom = "string \<Rightarrow> com"*)
+
+fun atomExp_add_prefix where
+"atomExp_add_prefix p (N a) = N a" |
+"atomExp_add_prefix p (V v) = V (add_prefix p v)"
+
+fun aexp_add_prefix where
+"aexp_add_prefix p (A a) = A (atomExp_add_prefix p a)" |
+"aexp_add_prefix p (Plus a b) = Plus (atomExp_add_prefix p a) (atomExp_add_prefix p b)" |
+"aexp_add_prefix p (Sub a b) = Sub (atomExp_add_prefix p a) (atomExp_add_prefix p b)"  | 
+"aexp_add_prefix p (Parity a) = Parity (atomExp_add_prefix p a)" |
+"aexp_add_prefix p (RightShift a) = RightShift (atomExp_add_prefix p a)"
+
+fun com_add_prefix where
+"com_add_prefix p SKIP = SKIP"
+|"com_add_prefix p (Assign v aexp) = (Assign (add_prefix p v) (aexp_add_prefix p aexp))"
+|"com_add_prefix p (Seq c1 c2) = (Seq (com_add_prefix p c1) (com_add_prefix p c2))"
+|"com_add_prefix p (If v c1 c2) = (If (add_prefix p v) (com_add_prefix p c1) (com_add_prefix p c2))"
+|"com_add_prefix p (While v c) = (While (add_prefix p v) (com_add_prefix p c))"
+
+
+(*
+abbreviation pcom_SKIP where "pcom_SKIP p \<equiv> SKIP"
+
+abbreviation pcom_Assign where "pcom_Assign v aexp p \<equiv>
+  Assign (add_prefix p v) (aexp_add_prefix p aexp)"
+
+abbreviation pcom_Seq where "pcom_Seq a b p \<equiv> (a  p) ;; (b p)"
+
+abbreviation pcom_If where "pcom_If v a b p \<equiv> 
+  If (add_prefix p v) (a p) (b p)"
+
+abbreviation pcom_While where "pcom_While v a p \<equiv> While (add_prefix p v) (a p)"
+
+abbreviation write_subprogram_param where "write_subprogram_param p' a  b \<equiv>
+  (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix p b))"
+
+abbreviation read_subprogram_param where "read_subprogram_param a p' b \<equiv> 
+  (\<lambda>p. Assign (add_prefix p a) (aexp_add_prefix (p' @ p) b))"
+
+abbreviation read_write_subprogram_param where "read_write_subprogram_param p' a p'' b \<equiv>
+  (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix (p'' @ p) b))"
+
+unbundle no_com_syntax
+
+bundle pcom_syntax
+begin
+notation pcom_SKIP ("SKIP" [] 61) and
+         pcom_Assign ("_ ::= _" [1000, 61] 61) and
+         write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
+         read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
+         read_write_subprogram_param ("[_] _ ::= [_] _" [1000, 61, 61, 61] 61) and
+         pcom_Seq ("_;;/ _"  [60, 61] 60) and
+         pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
+         pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
+end
+
+bundle no_pcom_syntax
+begin
+no_notation pcom_SKIP ("SKIP" [] 61) and
+            pcom_Assign ("_ ::= _" [1000, 61] 61) and
+            write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
+            read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
+            read_write_subprogram_param ("[_] _ ::= [_] _" [1000, 61, 61, 61] 61) and
+            pcom_Seq ("_;;/ _"  [60, 61] 60) and
+            pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
+            pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
+end
+
+unbundle pcom_syntax*)
+
+lemma atomExp_add_prefix_valid: "(\<And>v. v \<in> set (atomExp_var x1) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
+          atomVal x1 s1 = atomVal (atomExp_add_prefix p x1) s1'"
+  by (cases x1) auto
+
+lemma aexp_add_prefix_valid: "(\<And>v. v \<in> set (aexp_vars aexp) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
+       aval aexp s1 = aval (aexp_add_prefix p aexp) s1'"
+  by (cases aexp) (auto simp: atomExp_add_prefix_valid)
+
+lemma atomExp_add_prefix_valid': "v \<in> set (atomExp_var (atomExp_add_prefix p x1)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (cases x1) (auto simp:)
+
+lemma aexp_add_prefix_valid':"v \<in> set (aexp_vars (aexp_add_prefix p aexp)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (cases aexp) (auto simp: atomExp_add_prefix_valid')
+
+lemma com_add_prefix_valid': "v \<in> set (all_variables (com_add_prefix p c)) \<Longrightarrow> \<exists>v'. v = p @ v'"
+  by (induction p c rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid')
+
+lemma atomExp_add_prefix_valid'': "add_prefix p1 v \<in> set (atomExp_var (atomExp_add_prefix (p1 @ p2) x1)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
+  by (cases x1) (auto simp:)
+
+lemma aexp_add_prefix_valid'':"add_prefix p1 v \<in> set (aexp_vars (aexp_add_prefix (p1 @ p2) aexp)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
+  by (cases aexp) (auto simp: atomExp_add_prefix_valid'')
+
+
+lemma com_add_prefix_valid'': "add_prefix p1 v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
+  by (induction "p1 @ p2" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid'')
+
+lemma com_add_prefix_valid_subset: "add_prefix p1 v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> set p2 \<subseteq> set v"
+  using com_add_prefix_valid''
+  by (metis set_append sup_ge1)
+
+abbreviation invoke_subprogram
+  where "invoke_subprogram \<equiv> com_add_prefix"
+
+lemma atomExp_add_prefix_append: "atomExp_add_prefix p1 (atomExp_add_prefix p2 x1) = atomExp_add_prefix (add_prefix p1 p2) x1"
+  by (cases x1) auto
+
+lemma aexp_add_prefix_append: "aexp_add_prefix p1 (aexp_add_prefix p2 aexp) = (aexp_add_prefix (add_prefix p1 p2) aexp)"
+  by (cases aexp) (auto simp: atomExp_add_prefix_append) 
+
+lemma invoke_subprogram_append: "invoke_subprogram p1 (invoke_subprogram p2 c) = (invoke_subprogram (p1 @ p2) c)"
+  by (induction "(p1 @ p2)" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_append)
+
+end
\ No newline at end of file
diff --git a/IMP-/Canonical_State_Transformers.thy b/IMP-/Canonical_State_Transformers.thy
deleted file mode 100644
index 7dc959cc..00000000
--- a/IMP-/Canonical_State_Transformers.thy
+++ /dev/null
@@ -1,615 +0,0 @@
-(*Authors: Mohammad Abdulaziz, Florian Keßler*)
-
-theory Canonical_State_Transformers
-  imports Com Big_StepT
-begin
-
-(*definition add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
-"add_prefix p s = (concat (map (\<lambda>i. i # ''!'') p)) @ ''**'' @ s"
-
-lemma length_concat_map[simp]: 
-  "length (concat (map (\<lambda>i. [i, x]) p)) = 2 * length p" 
-  by (induction p) auto
-
-lemma take_concat_map[simp]:
-  "take (2 * x) (concat (map (\<lambda>i. [i, y]) p)) = (concat (map (\<lambda>i. [i, y]) (take x p)))"
-proof (induction x arbitrary: p)
-  case (Suc x)
-  then show ?case
-    by (cases p) auto
-qed auto
-
-lemma drop_concat_map[simp]:
-  "drop (2 * x) (concat (map (\<lambda>i. [i, y]) p)) = (concat (map (\<lambda>i. [i, y]) (drop x p)))"
-proof (induction x arbitrary: p)
-  case (Suc x)
-  then show ?case
-    by (cases p) auto
-qed auto
-
-lemma drop_add_prefix[simp]:
-  "drop (2 + 2 * length p) (add_prefix p x) = x"
-  unfolding add_prefix_def
-  by auto
-
-declare drop_add_prefix[simplified, simp]
-
-lemma concat_map_eq_iff[simp]:
-  "(concat (map (\<lambda>i. [i, y]) p) = concat (map (\<lambda>i. [i, y]) p'))
-    \<longleftrightarrow> p = p'"
-proof(induction p arbitrary: p')
-  case (Cons a p)
-  then show ?case
-    by (cases p') auto
-qed auto
-
-lemma add_prefix_equal_then_prefix_equal: 
-  assumes "add_prefix p v = add_prefix p' v'"
-  shows "p = p'"
-proof -
-  have "length p < length p' \<or> length p = length p' \<or> length p > length p'"
-    by auto
-  thus ?thesis
-  proof(elim disjE)
-    assume "length p < length p'"
-
-    then obtain p'' p''' x where "drop (length p) p' = p''" "p'' = x # p'''"
-      by (metis Cons_nth_drop_Suc)
-
-    thus ?thesis
-      using assms \<open>length p < length p'\<close> 
-      unfolding add_prefix_def 
-      by(auto simp: append_eq_append_conv_if)
-  next
-    assume "length p = length p'"
-    thus ?thesis
-      using assms  
-      unfolding add_prefix_def 
-      by(auto simp: append_eq_append_conv_if)
-  next 
-    assume "length p > length p'"
-
-    then obtain p'' p''' x where "drop (length p') p = p''" "p'' = x # p'''"
-      by (metis Cons_nth_drop_Suc)
-
-    thus ?thesis
-      using assms \<open>length p > length p'\<close> 
-      unfolding add_prefix_def 
-      by(auto simp: append_eq_append_conv_if)
-  qed
-qed
-
-lemma add_prefix_same_prefix_eq_iff[simp]: "add_prefix p x = add_prefix p y
-  \<longleftrightarrow> x = y"
-proof
-  assume "add_prefix p x = add_prefix p y"
-  hence "drop (2 * length p + 2) (add_prefix p x) = drop (2 * length p + 2) (add_prefix p y)"
-    by auto
-  thus "x = y" 
-    unfolding add_prefix_def
-    by simp
-qed auto
-
-lemma add_prefix_inj: "inj (add_prefix p)"
-  by (auto intro: injI)
-
-lemma add_prefix_equal_iff[simp]: "add_prefix p a = add_prefix p' b \<longleftrightarrow>
-  p = p' \<and> a = b"
-  using add_prefix_equal_then_prefix_equal add_prefix_same_prefix_eq_iff
-  by blast
-
-definition state_transformer :: "string \<Rightarrow> (vname * nat) list \<Rightarrow> state \<Rightarrow> state" where
-  "state_transformer p vs s = 
-    (\<lambda>v. (case 
-           (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) v of
-             (Some y) \<Rightarrow> y
-             | None \<Rightarrow> s v))"
-
-(* Only use for intermediate states. State transformer definitions of sub-programs
-   should not depend on the state before the program invocation, because we do not
-   want to compute that when composing state transformers *)
-
-abbreviation state_transformer' where "state_transformer' p vs s \<equiv>
-  state_transformer p (vs (\<lambda>v. s (add_prefix p v))) s"
-
-lemma state_transformer_no_update[simp]:
-  "state_transformer p [] s = s"
-  unfolding state_transformer_def
-  by auto
-
-lemma state_transformer_commutes:
-  assumes "p \<noteq> p'"
-  shows "state_transformer p vs \<circ> state_transformer p' vs' 
-          = state_transformer p' vs' \<circ> state_transformer p vs"
-  unfolding state_transformer_def comp_def
-  using \<open>p \<noteq> p'\<close>
-  by(fastforce 
-      dest: map_of_SomeD add_prefix_equal_then_prefix_equal
-      split: option.splits)
-
-lemma state_transformer_commutes':
-  assumes "p \<noteq> p'"
-  shows "state_transformer p vs (state_transformer p' vs' s)  
-          = state_transformer p' vs' (state_transformer p vs s)"
-  using state_transformer_commutes[OF \<open>p \<noteq> p'\<close>]
-  by (metis comp_eq_dest)
-
-lemma state_transformer_comp_same_prefix[simp]: 
-  "state_transformer p vs (state_transformer p vs' s)
-    = state_transformer p (vs @ vs') s"
-  unfolding state_transformer_def
-  by(fastforce split: option.splits)
-
-lemma state_transformer_commutes_comp[simp]:
-  assumes "p \<noteq> p'" 
-  shows "state_transformer p vs (state_transformer p' vs' (state_transformer p vs'' s))
-    = state_transformer p (vs @ vs'') (state_transformer p' vs' s)"
-  using state_transformer_commutes'[OF \<open>p \<noteq> p'\<close>]
-  by simp
-
-lemma map_of_eq_then_map_of_map_of_add_prefix_eq:
-  assumes "map_of vs = map_of vs'" 
-  shows "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) 
-          = map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs')"
-proof -
-  have "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) x
-          = map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs') x" for x
-  proof(cases "\<exists>x'. x = add_prefix p x'")
-    case True
-    then obtain x' where "x = add_prefix p x'"
-      by auto
-    then show ?thesis
-    proof (cases "(map_of vs) x'")
-      case None
-      thus ?thesis
-        using  \<open>map_of vs = map_of vs'\<close>
-      proof(cases "(map_of vs') x'")
-        case None
-        hence "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) x = None"
-          "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs') x = None"
-          using \<open>map_of vs x' = None\<close> \<open>map_of vs' x' = None\<close>
-            \<open>x = add_prefix p x'\<close>
-          by(force simp add: map_of_eq_None_iff)+
-        then show ?thesis 
-          by simp
-      qed auto
-    next
-      case (Some y)
-      thus ?thesis
-        using \<open>map_of vs = map_of vs'\<close>
-      proof (cases "(map_of vs') x'")
-        case (Some y')
-        thus ?thesis
-          using
-            map_of_mapk_SomeI[OF add_prefix_inj]  \<open>map_of vs x' = Some y\<close>
-            \<open>map_of vs' x' = Some y'\<close>  \<open>x = add_prefix p x'\<close>
-            \<open>map_of vs = map_of vs'\<close> \<open>map_of vs x' = Some y\<close>
-          by metis
-      qed auto
-    qed
-  next
-    case False
-    hence "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs) x = None"
-      "map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs') x = None"
-      by(force simp add: map_of_eq_None_iff)+
-    then show ?thesis
-      by simp
-  qed
-  thus ?thesis 
-    by auto
-qed
-
-lemma state_transformer_same_prefix_equal_intro[intro]:
-  assumes "map_of vs = map_of vs'"
-  shows  "state_transformer p vs = state_transformer p vs'"
-  unfolding state_transformer_def
-  using map_of_eq_then_map_of_map_of_add_prefix_eq[OF \<open>map_of vs = map_of vs'\<close>]
-  by(auto intro!: HOL.ext  split: option.splits)
-
-lemma state_transformer_same_prefix_equal_commutes[simp]:
-  assumes "p \<noteq> p'"
-  shows "state_transformer p vs (state_transformer p' vs' s) = 
-    state_transformer p' vs'' (state_transformer p vs''' s')
-    \<longleftrightarrow> 
-      state_transformer p vs (state_transformer p' vs' s) = 
-      state_transformer p vs''' (state_transformer p' vs'' s')"
-  using state_transformer_commutes'[OF \<open>p \<noteq> p'\<close>]
-  by simp
-
-declare fun_cong[OF state_transformer_same_prefix_equal_intro, intro]
-
-declare cong[OF cong[OF cong [OF refl[of state_transformer] refl] refl], intro]
-
-declare cong[OF state_transformer_same_prefix_equal_intro, intro]
-
-lemma map_of_map_add_prefix_of_add_prefix[simp]:
-  "map_of (map (\<lambda>(i, y). (add_prefix p i, y)) vs) (add_prefix p x) = map_of vs x"
-proof(cases "map_of vs x")
-  case None
-  hence "map_of (map (\<lambda>(i, y). (add_prefix p i, y)) vs) (add_prefix p x) = None"
-    by(force simp: map_of_eq_None_iff)
-  thus ?thesis
-    using None
-    by simp
-next
-  case (Some a)
-  hence "map_of (map (\<lambda>(i, y). (add_prefix p i, y)) vs) (add_prefix p x) = Some a"
-    using map_of_mapk_SomeI[OF add_prefix_inj]
-    by fastforce
-  then show ?thesis
-    using Some
-    by simp
-qed
-
-lemma state_transformers_same_prefix_equal_iff[simp]:
-  "state_transformer p vs s = state_transformer p vs' s \<longleftrightarrow>
-    (\<forall>x \<in> set (map fst (vs @ vs')). (map_of vs x = map_of vs' x) 
-        \<or> (map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)))
-        \<or> (map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x))))"
-proof
-  assume "state_transformer p vs s = state_transformer p vs' s"
-
-  have "x \<in> set (map fst (vs @ vs')) \<Longrightarrow> 
-    map_of vs x = map_of vs' x \<or>
-      map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)) \<or>
-      map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x))" for x
-  proof -
-    assume "x \<in> set (map fst (vs @ vs'))"
-    have "state_transformer p vs s (add_prefix p x) = state_transformer p vs' s (add_prefix p x)"
-      using \<open>state_transformer p vs s = state_transformer p vs' s\<close>
-      by auto
-    thus ?thesis
-      unfolding state_transformer_def
-      by(auto split: option.splits)
-  qed
-  thus "(\<forall>x \<in> set (map fst (vs @ vs')).
-      map_of vs x = map_of vs' x \<or>
-      map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)) \<or>
-      map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x)))"
-    by auto
-next
-  assume *: "\<forall>x\<in>set (map fst (vs @ vs')).
-       map_of vs x = map_of vs' x \<or>
-       map_of vs x = None \<and> map_of vs' x = Some (s (add_prefix p x)) \<or>
-       map_of vs' x = None \<and> map_of vs x = Some (s (add_prefix p x))"
-
-  hence "state_transformer p vs s x = state_transformer p vs' s x" for x
-  proof(cases "\<exists>x'. x = add_prefix p x'")
-    case True
-    then obtain x' where "x = add_prefix p x'"
-      by auto
-    then show ?thesis
-      unfolding state_transformer_def
-      using *
-      apply(auto split: option.splits)
-      by (metis UnCI UnI2 domI domIff map_of_eq_None_iff option.inject)+
-  next
-    case False
-    thus ?thesis
-      unfolding state_transformer_def
-      using *
-      by(auto dest!: map_of_SomeD split: option.splits)
-  qed
-  thus "state_transformer p vs s = state_transformer p vs' s"
-    by auto
-qed
-
-lemma state_transformers_of_x_same_prefix_equal_iff[simp]:
-  "state_transformer p vs s x = state_transformer p vs' s' x \<longleftrightarrow>
-    (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
-            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
-            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
-          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-             s x = s' x)"
-proof
-  assume "state_transformer p vs s x = state_transformer p vs' s' x"
-
-  have "x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<Longrightarrow> 
-   (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
-            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
-            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x))"
-  proof -
-    assume "x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs'))"
-    then obtain x' where "x = add_prefix p x'" "x' \<in> set (map fst (vs @ vs'))"
-      by auto
-    thus ?thesis
-      using \<open>state_transformer p vs s x = state_transformer p vs' s' x\<close> 
-      unfolding state_transformer_def
-      by(auto split: option.splits)
-  qed
-
-  moreover have "x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<Longrightarrow> s x = s' x"
-  proof -
-    assume "x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs'))"
-    hence "state_transformer p vs s x = s x" "state_transformer p vs' s' x = s' x" 
-      unfolding state_transformer_def
-      by(force dest!: map_of_SomeD split: option.splits)+
-    thus "s x = s' x"
-      using \<open>state_transformer p vs s x = state_transformer p vs' s' x\<close>
-      by simp
-  qed
-
-  ultimately show " 
-          (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
-            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
-            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
-          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-             s x = s' x)"
-    by simp
-next
-  assume *: "
-          (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
-            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
-            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
-          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-             s x = s' x)"
-
-  have "state_transformer p vs s x = state_transformer p vs' s' x" 
-  proof(cases "x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs'))")
-    case True
-    then obtain x' where "x = add_prefix p x'"
-      by auto
-    then show ?thesis
-      unfolding state_transformer_def
-      using * True \<open>x = add_prefix p x'\<close>
-      apply(auto split: option.splits)
-      by (metis option.distinct weak_map_of_SomeI)+
-  next
-    case False
-    thus ?thesis
-      unfolding state_transformer_def
-      using * False
-      by(auto simp: rev_image_eqI dest!: map_of_SomeD split: option.splits)
-  qed
-  thus "state_transformer p vs s x = state_transformer p vs' s' x"
-    by auto
-qed
-
-lemma state_transformers_same_prefix_equal_iff'[simp]:
-  "state_transformer p vs s = state_transformer p vs' s'
-    \<longleftrightarrow> (\<forall>x. 
-          (x \<in> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-              (map_of vs (drop (2 + 2 * length p) x) = map_of vs' (drop (2 + 2 * length p) x)) 
-            \<or> (map_of vs (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs' (drop (2 + 2 * length p) x) = Some (s x))
-            \<or> (map_of vs' (drop (2 + 2 * length p) x) = None 
-               \<and> map_of vs (drop (2 + 2 * length p) x) = Some (s' x)))
-          \<and> (x \<notin> set (map ((add_prefix p) \<circ> fst) (vs @ vs')) \<longrightarrow>
-             s x = s' x))"
-  by(auto simp: fun_eq_iff)
-
-lemma state_transformer_of_same_prefix[simp]: "state_transformer p vs s (add_prefix p v)
-  = (case (map_of (map (\<lambda>(i, j). (add_prefix p i, j)) vs)) (add_prefix p v) of
-      (Some y) \<Rightarrow> y |
-       None \<Rightarrow> s (add_prefix p v))"
-  by(auto simp: state_transformer_def split: option.splits)
-
-lemma state_transformer_of_different_prefix[simp]: "p \<noteq> p'
-  \<Longrightarrow> state_transformer p vs s (add_prefix p' v) = s (add_prefix p' v)"
-  by(auto dest!: map_of_SomeD simp: state_transformer_def split: option.splits)
-
-lemma unchanged_by_state_transformer_intro[intro!]: 
-  "list_all (\<lambda>(i, j). x \<noteq> (add_prefix p i) \<or> j = s x) vs 
-    \<Longrightarrow> state_transformer p vs s x = s x"
-  by(auto 
-      dest!: map_of_SomeD 
-      simp: state_transformer_def list_all_def 
-      split: option.splits)
-
-lemma state_transformer_of_update_same_prefix[simp]:
-  "state_transformer p vs (s((add_prefix p v) := y)) = state_transformer p (vs @ [(v, y)]) s"
-  unfolding state_transformer_def
-  by (auto intro!: HOL.ext split: option.splits)
-
-(* TODO: more elegant / general way of doing this *)
-lemma state_transformer_of_update_same_prefix'[simp]:
-  assumes "p \<noteq> p'"
-  shows "state_transformer p vs 
-    (state_transformer p' vs' (s((add_prefix p v) := y))) 
-    = state_transformer p (vs @ [(v, y)]) (state_transformer p' vs' s)"
-proof -
-  have "state_transformer p vs 
-    (state_transformer p' vs' (s((add_prefix p v) := y))) =
-      state_transformer p' vs' (state_transformer p (vs @ [(v, y)]) s)"
-    using \<open>p \<noteq> p'\<close> state_transformer_commutes' 
-    by (metis state_transformer_of_update_same_prefix)
-  thus ?thesis
-    using \<open>p \<noteq> p'\<close> state_transformer_commutes' 
-    by simp
-qed
-
-lemma state_transformer_update_same_prefix[simp]:
-  "(state_transformer p vs s)((add_prefix p v) := y) = state_transformer p ((v, y) # vs) s"
-  unfolding state_transformer_def
-  by (auto intro!: HOL.ext split: option.splits)
-
-lemma state_transformer_update_different_prefix[simp]:
-  "p \<noteq> p' 
-    \<Longrightarrow>(state_transformer p vs s)((add_prefix p' v) := y) 
-         = state_transformer p' [(v, y)] (state_transformer p vs s)"
-  unfolding state_transformer_def
-  by (auto intro!: HOL.ext split: option.splits)
-
-declare unchanged_by_state_transformer_intro[symmetric, intro]
-
-lemma lambda_as_state_transformer[simp]:
-  "(\<lambda>x. if x = add_prefix p a
-           then y
-           else s x) = state_transformer p [(a, y)] s"
-  unfolding state_transformer_def
-  by auto
-
-lemma updated_state_as_state_transformer[simp]:
-  "s(add_prefix p x := y) = state_transformer p [(x, y)] s"
-  unfolding state_transformer_def
-  by auto
-*)
-
-abbreviation add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
-"add_prefix p s \<equiv> p @ s"
-
-(*type_synonym pcom = "string \<Rightarrow> com"*)
-
-fun atomExp_add_prefix where
-"atomExp_add_prefix p (N a) = N a" |
-"atomExp_add_prefix p (V v) = V (add_prefix p v)"
-
-fun aexp_add_prefix where
-"aexp_add_prefix p (A a) = A (atomExp_add_prefix p a)" |
-"aexp_add_prefix p (Plus a b) = Plus (atomExp_add_prefix p a) (atomExp_add_prefix p b)" |
-"aexp_add_prefix p (Sub a b) = Sub (atomExp_add_prefix p a) (atomExp_add_prefix p b)"  | 
-"aexp_add_prefix p (Parity a) = Parity (atomExp_add_prefix p a)" |
-"aexp_add_prefix p (RightShift a) = RightShift (atomExp_add_prefix p a)"
-
-fun com_add_prefix where
-"com_add_prefix p SKIP = SKIP"
-|"com_add_prefix p (Assign v aexp) = (Assign (add_prefix p v) (aexp_add_prefix p aexp))"
-|"com_add_prefix p (Seq c1 c2) = (Seq (com_add_prefix p c1) (com_add_prefix p c2))"
-|"com_add_prefix p (If v c1 c2) = (If (add_prefix p v) (com_add_prefix p c1) (com_add_prefix p c2))"
-|"com_add_prefix p (While v c) = (While (add_prefix p v) (com_add_prefix p c))"
-
-
-(*
-abbreviation pcom_SKIP where "pcom_SKIP p \<equiv> SKIP"
-
-abbreviation pcom_Assign where "pcom_Assign v aexp p \<equiv>
-  Assign (add_prefix p v) (aexp_add_prefix p aexp)"
-
-abbreviation pcom_Seq where "pcom_Seq a b p \<equiv> (a  p) ;; (b p)"
-
-abbreviation pcom_If where "pcom_If v a b p \<equiv> 
-  If (add_prefix p v) (a p) (b p)"
-
-abbreviation pcom_While where "pcom_While v a p \<equiv> While (add_prefix p v) (a p)"
-
-abbreviation write_subprogram_param where "write_subprogram_param p' a  b \<equiv>
-  (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix p b))"
-
-abbreviation read_subprogram_param where "read_subprogram_param a p' b \<equiv> 
-  (\<lambda>p. Assign (add_prefix p a) (aexp_add_prefix (p' @ p) b))"
-
-abbreviation read_write_subprogram_param where "read_write_subprogram_param p' a p'' b \<equiv>
-  (\<lambda>p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix (p'' @ p) b))"
-
-unbundle no_com_syntax
-
-bundle pcom_syntax
-begin
-notation pcom_SKIP ("SKIP" [] 61) and
-         pcom_Assign ("_ ::= _" [1000, 61] 61) and
-         write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
-         read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
-         read_write_subprogram_param ("[_] _ ::= [_] _" [1000, 61, 61, 61] 61) and
-         pcom_Seq ("_;;/ _"  [60, 61] 60) and
-         pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
-         pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
-end
-
-bundle no_pcom_syntax
-begin
-no_notation pcom_SKIP ("SKIP" [] 61) and
-            pcom_Assign ("_ ::= _" [1000, 61] 61) and
-            write_subprogram_param ("[_] _ ::= _" [1000, 61, 61] 61) and
-            read_subprogram_param ("_ ::= [_] _" [1000, 61, 61] 61) and
-            read_write_subprogram_param ("[_] _ ::= [_] _" [1000, 61, 61, 61] 61) and
-            pcom_Seq ("_;;/ _"  [60, 61] 60) and
-            pcom_If ("(IF _/\<noteq>0 THEN _/ ELSE _)"  [0, 0, 61] 61) and
-            pcom_While ("(WHILE _/\<noteq>0 DO _)"  [0, 61] 61)
-end
-
-unbundle pcom_syntax*)
-
-lemma atomExp_add_prefix_valid: "(\<And>v. v \<in> set (atomExp_var x1) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
-          atomVal x1 s1 = atomVal (atomExp_add_prefix p x1) s1'"
-  by (cases x1) auto
-
-lemma aexp_add_prefix_valid: "(\<And>v. v \<in> set (aexp_vars aexp) \<Longrightarrow> s1 v = s1' (add_prefix p v)) \<Longrightarrow>
-       aval aexp s1 = aval (aexp_add_prefix p aexp) s1'"
-  by (cases aexp) (auto simp: atomExp_add_prefix_valid)
-
-lemma atomExp_add_prefix_valid': "v \<in> set (atomExp_var (atomExp_add_prefix p x1)) \<Longrightarrow> \<exists>v'. v = p @ v'"
-  by (cases x1) (auto simp:)
-
-lemma aexp_add_prefix_valid':"v \<in> set (aexp_vars (aexp_add_prefix p aexp)) \<Longrightarrow> \<exists>v'. v = p @ v'"
-  by (cases aexp) (auto simp: atomExp_add_prefix_valid')
-
-lemma com_add_prefix_valid': "v \<in> set (all_variables (com_add_prefix p c)) \<Longrightarrow> \<exists>v'. v = p @ v'"
-  by (induction p c rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid')
-
-lemma atomExp_add_prefix_valid'': "add_prefix p1 v \<in> set (atomExp_var (atomExp_add_prefix (p1 @ p2) x1)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
-  by (cases x1) (auto simp:)
-
-lemma aexp_add_prefix_valid'':"add_prefix p1 v \<in> set (aexp_vars (aexp_add_prefix (p1 @ p2) aexp)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
-  by (cases aexp) (auto simp: atomExp_add_prefix_valid'')
-
-
-lemma com_add_prefix_valid'': "add_prefix p1 v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> \<exists>v'. v = p2 @ v'"
-  by (induction "p1 @ p2" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid'')
-
-
-(*lemma com_add_prefix_valid: "v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> \<exists>v'. rev v = (rev p2) @ v'"
-  sledgehammer
-  by (induction p c rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_valid')
-*)
-
-lemma com_add_prefix_valid_subset: "add_prefix p1 v \<in> set (all_variables (com_add_prefix (p1 @ p2) c)) \<Longrightarrow> set p2 \<subseteq> set v"
-  using com_add_prefix_valid''
-  by (metis set_append sup_ge1)
-
-abbreviation invoke_subprogram
-  where "invoke_subprogram \<equiv> com_add_prefix"
-
-lemma atomExp_add_prefix_append: "atomExp_add_prefix p1 (atomExp_add_prefix p2 x1) = atomExp_add_prefix (add_prefix p1 p2) x1"
-  by (cases x1) auto
-
-lemma aexp_add_prefix_append: "aexp_add_prefix p1 (aexp_add_prefix p2 aexp) = (aexp_add_prefix (add_prefix p1 p2) aexp)"
-  by (cases aexp) (auto simp: atomExp_add_prefix_append) 
-
-lemma invoke_subprogram_append: "invoke_subprogram p1 (invoke_subprogram p2 c) = (invoke_subprogram (p1 @ p2) c)"
-  by (induction "(p1 @ p2)" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_append)
-
-(*abbreviation invoke_subprogram
-  where "invoke_subprogram p c \<equiv> (c o (add_prefix p))"
-
-lemma all_variables_append: "(all_variables (c (p1 @ p2))) = map (\<lambda>v. p1 @ v) (all_variables (c p2))"
-proof (induction "(c (p1 @ p2))" arbitrary: c p1 p2 rule: all_variables.induct)
-  case 1
-  then show ?case
-
-    by auto
-next
-  case (2 v aexp)
-  then show ?case sorry
-next
-case (3 c1 c2)
-  then show ?case sorry
-next
-  case (4 v c1 c2)
-then show ?case sorry
-next
-case (5 v c)
-  then show ?case sorry
-qed
-  apply (auto simp: )
-
-
-lemma all_variables_valid: "v \<in> set (all_variables (c p2)) \<Longrightarrow> \<exists>v'. v = add_prefix p2 v'"
-  apply (induction p2)
-  apply (auto simp: aexp_add_prefix_valid')
-
-lemma invoke_subprogram_valid: "v \<in> set (all_variables ((invoke_subprogram p1 c) p2)) \<Longrightarrow> \<exists>v'. v = p1 @ p2 @ v'"
-  apply (induction p1)
-  apply (auto simp: aexp_add_prefix_valid')*)
-
-end
\ No newline at end of file

From 1490a3a97ca46773390e72094591b3583c508689 Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Fri, 24 Dec 2021 19:56:53 +0100
Subject: [PATCH 101/103] Moved IMP- primitives to new file; Refined some more
 primitives; New session for Cook Levin Nat

---
 .../IMP_Minus_Minus_Subprograms.thy           |   3 +-
 .../IMP_Minus_Minus_Subprograms_Nat.thy       |   2 +-
 ...nus_Minus_To_SAS_Plus_Plus_Correctness.thy |   2 +-
 ...s_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy |   3 +-
 ...us_To_SAS_Plus_Plus_State_Translations.thy |   2 +-
 ...o_SAS_Plus_Plus_State_Translations_Nat.thy |   3 +-
 ...theory IMP_Minus_Minus_Subprograms_Nat.thy |   4 -
 .../IMP-_To_IMP--/Binary_Arithmetic.thy       |   2 +-
 .../IMP-_To_IMP--/Binary_Operations.thy       |   4 +-
 .../IMP-_To_IMP--/Binary_Operations_Nat.thy   |   3 +-
 .../IMP_Minus_To_IMP_Minus_Minus_nat.thy      |   2 +-
 .../IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy |   9 +-
 .../IMP-_To_IMP--/Primitives_IMP_Minus.thy    | 989 +++++++++++++++---
 .../IMP_Minus_Max_Constant_Nat.thy            |   2 +-
 .../IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy    |   6 +-
 .../IMP_Minus_To_SAS_Plus_Nat.thy             |   7 +-
 Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy  |   4 +-
 .../IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy     |   2 +-
 .../SAS_Plus_Plus_To_SAS_Plus.thy             |   3 +-
 .../SAS_Plus_Plus_To_SAS_Plus_Nat.thy         |   2 +-
 .../IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy      |   2 +-
 Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy |   2 +-
 Cook_Levin/ROOT                               |   7 +-
 IMP-/Call_By_Prefixes.thy                     |   2 +-
 IMP-/Multiplication.thy                       | 211 ----
 IMP-/ROOT                                     |   2 +-
 26 files changed, 869 insertions(+), 411 deletions(-)
 delete mode 100644 Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms.thy
index 153814aa..ddf6e18d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms.thy
@@ -2,7 +2,8 @@
 
 section \<open>IMP-- Subprograms\<close>
 
-theory IMP_Minus_Minus_Subprograms imports "../IMP_Minus_Minus_Small_StepT"
+theory IMP_Minus_Minus_Subprograms
+  imports IMP_Minus_Minus_Small_StepT
 begin
 
 text \<open>We give functions that enumerate all subprograms of an IMP-- program, that is, all 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
index 1e29ee99..eec15906 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy
@@ -1,5 +1,5 @@
 theory IMP_Minus_Minus_Subprograms_Nat
-  imports "../IMP-_To_IMP--/Primitives" IMP_Minus_Minus_Subprograms 
+  imports Primitives IMP_Minus_Minus_Subprograms 
 begin 
 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness.thy
index dbef3f13..7f3e83b4 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness.thy
@@ -3,7 +3,7 @@
 section "IMP-- to SAS++ Correctness"
 
 theory IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness 
-  imports IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction "../SAS_Plus_Plus"
+  imports IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction SAS_Plus_Plus
 begin 
 
 text \<open> We show correctness for the IMP-- to SAS++ reduction. \<close>
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
index b3f0a07b..71f9d047 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy
@@ -1,5 +1,6 @@
 theory IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat
-  imports "../IMP-_To_IMP--/Primitives" IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat  IMP_Minus_Minus_Subprograms_Nat
+  imports 
+    Primitives IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat  IMP_Minus_Minus_Subprograms_Nat
  IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction  
 begin                               
 definition domain_nat :: "nat" where
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy
index 0a1028e2..ee6253a3 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy
@@ -3,7 +3,7 @@
 section "IMP-- to SAS++ State Translations"
 
 theory IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations 
-  imports "../SAS_Plus_Plus" "../IMP_Minus_Minus_Small_StepT"
+  imports SAS_Plus_Plus IMP_Minus_Minus_Small_StepT
 begin
 
 text \<open> We define a translation between IMP-- states and SAS++ states. For this purpose, it is useful
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
index d83ae1f2..cbb10f00 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat.thy
@@ -1,5 +1,6 @@
 theory IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat
-  imports  IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations "../IMP-_To_IMP--/Primitives"
+  imports IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations 
+          Primitives
 begin
 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy
deleted file mode 100644
index 91d9e9e3..00000000
--- a/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/theory IMP_Minus_Minus_Subprograms_Nat.thy	
+++ /dev/null
@@ -1,4 +0,0 @@
-theory IMP_Minus_Minus_Subprograms_Nat
-  imports IMP_Minus_Minus_Subprograms "../IMP-_To_IMP--/Primitives"
-begin 
-end 
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy
index 8f77abef..1d671a7a 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy
@@ -3,7 +3,7 @@
 section "Binary Arithmetic"
                                                     
 theory Binary_Arithmetic 
-  imports Main "../IMP_Minus_Minus_Small_StepT" "HOL-Library.Discrete"
+  imports Main IMP_Minus_Minus_Small_StepT "HOL-Library.Discrete"
 
 begin 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations.thy
index ecdeebf1..cb55067d 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations.thy
@@ -3,8 +3,8 @@
 section "Binary Operations in IMP--"
                                                     
 theory Binary_Operations 
-  imports IMP_Minus_To_IMP_Minus_Minus_State_Translations "IMP_Minus.Max_Constant" 
-    "../IMP--_To_SAS++/IMP_Minus_Minus_Subprograms"
+  imports IMP_Minus_To_IMP_Minus_Minus_State_Translations IMP_Minus.Max_Constant
+    IMP_Minus_Minus_Subprograms
 begin 
 
 text \<open> We give programs in IMP-- that work on states translated from IMP- to IMP-- and simulate 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
index c718563f..bc88066a 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy
@@ -1,6 +1,7 @@
 theory Binary_Operations_Nat
   imports Binary_Operations Primitives Binary_Arithmetic_Nat
-IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat "../IMP_Minus_Max_Constant_Nat"
+          IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat
+          IMP_Minus_Max_Constant_Nat
 begin
 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
index c6ee1a27..9068641c 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy
@@ -1,5 +1,5 @@
 theory IMP_Minus_To_IMP_Minus_Minus_nat 
-  imports  IMP_Minus_To_IMP_Minus_Minus  "../IMP_Minus_Max_Constant_Nat" "Binary_Operations_Nat"
+  imports  IMP_Minus_To_IMP_Minus_Minus  IMP_Minus_Max_Constant_Nat Binary_Operations_Nat
 begin
 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
index a6a9e281..08e03115 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy
@@ -1,11 +1,12 @@
 theory Primitives
-  imports Main  "HOL-Library.Nat_Bijection" "../../../IMP-/Com" "../IMP_Minus_Minus_Com"
+  imports Main  "HOL-Library.Nat_Bijection"
+         IMP_Minus.Com IMP_Minus_Minus_Com
  "HOL.String"
  "Verified_SAT_Based_AI_Planning.SAT_Plan_Base"
 "Verified_SAT_Based_AI_Planning.STRIPS_Representation"
- "../SAS_Plus_Plus" "HOL-Library.Mapping"
-"../SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus"
-"../IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations"
+ SAS_Plus_Plus "HOL-Library.Mapping"
+SAS_Plus_Plus_To_SAS_Plus
+IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations
 
 begin 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
index bb6b4996..45989287 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
@@ -1,14 +1,190 @@
-\<^marker>\<open>creator Florian Kessler\<close>
+\<^marker>\<open>creator Mohammad Abdulaziz, Florian Keßler\<close>
 
-theory IMP_Minus_Nat_Bijection
-  imports Multiplication "HOL-Library.Nat_Bijection" 
-    "../Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives"
+theory Primitives_IMP_Minus
+  imports "HOL-Library.Nat_Bijection" Primitives IMP_Minus.Call_By_Prefixes
 begin
+subsection \<open>Multiplication\<close>
+
+record mul_state = mul_a::nat mul_b::nat mul_c::nat
+
+abbreviation "mul_prefix \<equiv> ''mul.''"
+abbreviation "mul_a_str \<equiv> ''a''"
+abbreviation "mul_b_str \<equiv> ''b''"
+abbreviation "mul_c_str \<equiv> ''c''"
+
+
+definition "mul_state_upd s \<equiv>
+      let
+        d = (mul_b s) mod 2;
+        mul_c = (if d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
+        mul_a = mul_a s + mul_a s;
+        mul_b = (mul_b s) div 2;
+        ret = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = mul_c\<rparr>
+      in
+        ret
+"
+
+function mul_imp:: "mul_state \<Rightarrow> mul_state" where
+"mul_imp s = 
+  (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
+    (
+      let
+        next_iteration = mul_imp (mul_state_upd s)
+      in
+        next_iteration
+    )
+  else
+    (
+      let
+        ret = s
+      in
+        ret
+    )
+  )"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>s. mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
+
+lemmas [simp del] = mul_imp.simps
+
+lemma mul_imp_correct: "mul_c (mul_imp s) = mul_c s + mul_a s * mul_b s"
+proof (induction s rule: mul_imp.induct)
+  case (1 s)
+  then show ?case
+    apply(subst mul_imp.simps)
+    apply (auto simp: mul_state_upd_def Let_def split: if_splits)
+    by (metis (no_types, lifting) One_nat_def add.commute add_mult_distrib2 distrib_right mult.right_neutral mult_2 mult_div_mod_eq)
+qed 
+
+function mul_imp_time:: "nat \<Rightarrow> mul_state\<Rightarrow> nat" where
+"mul_imp_time t s = 
+(
+    (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
+      (
+        let
+          t = t + 1; \<comment> \<open>To account for while loop condition checking\<close>
+          mul_d = (mul_b s) mod 2::nat;
+          t = t + 2;
+          mul_c = (if mul_d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
+          t = t + 1 + (if mul_d \<noteq> 0 then 2 else 2);
+          mul_a = mul_a s + mul_a s;
+          t = t + 2;
+          mul_b = mul_b s div 2;
+          t = t + 2;
+          next_iteration = mul_imp_time t (mul_state_upd s)
+        in
+          next_iteration
+      )
+    else
+      (
+         \<comment> \<open>To account for the two steps of checking the condition and skipping the loop\<close>
+        let
+          t = t + 2;
+          ret = t
+        in
+          ret
+      )
+    )
+)"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>(t, s). mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
+
+lemmas [simp del] = mul_imp_time.simps
+
+lemma mul_imp_time_acc: "(mul_imp_time (Suc t) s) = Suc (mul_imp_time t s)"
+  by (induction t s arbitrary:  rule: mul_imp_time.induct)
+     (auto simp add: mul_imp_time.simps mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition mul_IMP_minus where
+"mul_IMP_minus \<equiv>
+  (\<comment> \<open>if b \<noteq> 0 then\<close>
+   WHILE mul_b_str\<noteq>0 DO
+        \<comment> \<open>d = b mod 2;\<close>
+        (''d'' ::= ((V mul_b_str) \<doteq>1);;
+        \<comment> \<open>c = (if d \<noteq> 0 then c + a else c);\<close>
+        IF ''d''\<noteq>0 THEN mul_c_str ::= ((V mul_c_str) \<oplus> (V mul_a_str)) ELSE mul_c_str ::= A (V mul_c_str);;
+        \<comment> \<open>a = a + a;\<close>
+        mul_a_str ::= ((V mul_a_str) \<oplus> (V mul_a_str));;
+        \<comment> \<open>b = b div 2;\<close>
+        mul_b_str ::= ((V mul_b_str) \<then>))
+  )"
+
+(*definition mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p s \<equiv>
+  state_transformer p  
+    [(''a'', mul_a s),(''b'',  mul_b s),(''c'',  mul_c s),(''d'', mul_d s)]"*)
+
+definition "mul_imp_to_HOL_state p s =
+  \<lparr>mul_a = s (add_prefix p mul_a_str), mul_b = (s (add_prefix p mul_b_str)),
+   mul_c = (s (add_prefix p mul_c_str))\<rparr>"
+
+lemma mul_imp_to_HOL_state_add_prefix: 
+  "mul_imp_to_HOL_state (add_prefix p1 p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix p1))"
+  by (auto simp: mul_imp_to_HOL_state_def)
+
+lemma mul_imp_to_HOL_state_add_prefix':
+  "mul_imp_to_HOL_state (x # p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix [x]))"
+  by (auto simp: mul_imp_to_HOL_state_def)
+
+lemma mul_IMP_minus_correct_time:
+  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = (mul_imp_time 0 (mul_imp_to_HOL_state p s))"
+  apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
+  apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
+  apply(erule While_tE)
+   apply(subst mul_imp_time.simps)
+   apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule If_tE)
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst mul_imp_time.simps)
+   apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  apply(subst mul_imp_time.simps)
+  apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  done
+
+lemma mul_IMP_minus_correct_function:
+  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' (add_prefix p mul_c_str) = mul_c (mul_imp (mul_imp_to_HOL_state p s))"
+  apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
+  apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
+  apply(erule While_tE)
+   apply(subst mul_imp.simps)
+   apply(auto simp: mul_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule If_tE)
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(subst mul_imp.simps mul_imp_time.simps)
+   apply(auto simp: mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  apply(subst mul_imp.simps mul_imp_time.simps)
+  apply(auto simp: mul_imp_to_HOL_state_def mul_state_upd_def)[1]
+  done
+
+lemma mul_IMP_minus_correct_effects:
+  "(invoke_subprogram (p @ mul_pref) mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set mul_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma mul_IMP_minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (mul_imp_time 0 (mul_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) mul_c_str) = mul_c (mul_imp (mul_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using mul_IMP_minus_correct_time mul_IMP_minus_correct_function mul_IMP_minus_correct_effects
+  by auto
 
 subsection \<open>Encoding and decoding natural numbers\<close>
 
 record triangle_state = triangle_a::nat triangle_triangle::nat
 
+abbreviation "triangle_prefix \<equiv> ''triangle.''"
+abbreviation "triangle_a_str \<equiv> ''a''"
+abbreviation "triangle_triangle_str \<equiv> ''triangle''"
+
+
 definition "triangle_state_upd (s::triangle_state) \<equiv>
       let
         mul_a' = triangle_a s;
@@ -70,17 +246,17 @@ definition triangle_IMP_Minus where
 "triangle_IMP_Minus \<equiv>
   (
    \<comment> \<open>mul_a' = triangle_a s;\<close>
-   (''mul'' @ ''a'') ::= (A (V ''a'')) ;;
+   (mul_prefix @ mul_a_str) ::= (A (V mul_a_str)) ;;
    \<comment> \<open>mul_b' = (triangle_a s) + 1;\<close>
-   (''mul'' @ ''b'') ::= ((V ''a'') \<oplus> (N 1));;
+   (mul_prefix @ mul_b_str) ::= ((V mul_a_str) \<oplus> (N 1));;
    \<comment> \<open>mul_c' = 0;\<close>
-   (''mul'' @  ''c'') ::= (A (N 0)) ;;
+   (mul_prefix @  mul_c_str) ::= (A (N 0)) ;;
    \<comment> \<open>(mul_state::mul_state) = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = 0\<rparr>;\<close>
    \<comment> \<open>mul_ret = (mul_imp mul_state);\<close>
-   invoke_subprogram ''mul'' mul_IMP_minus;;
+   invoke_subprogram mul_prefix mul_IMP_minus;;
    \<comment> \<open>triangle_triangle = mul_c mul_ret div 2;\<close>
-  ''triangle'' ::= (V (''mul'' @ ''c'') \<then>);;
-  ''a'' ::= A (V ''a'')
+  triangle_triangle_str ::= (V (mul_prefix @ mul_c_str) \<then>);;
+  triangle_a_str ::= A (V mul_a_str)
   )"
 
 
@@ -89,7 +265,7 @@ definition triangle_IMP_Minus where
  (mul_IMP_Minus_state_transformer (''mul'' @ p) (triangle_mul_state s))"*)
 
 definition "triangle_imp_to_HOL_state p s =
-              \<lparr>triangle_a = s (add_prefix p ''a''), triangle_triangle = (s (add_prefix p ''triangle''))\<rparr>"
+              \<lparr>triangle_a = s (add_prefix p triangle_a_str), triangle_triangle = (s (add_prefix p triangle_triangle_str))\<rparr>"
 
 lemma triangle_imp_to_HOL_state_add_prefix: 
   "triangle_imp_to_HOL_state (add_prefix p1 p2) s = triangle_imp_to_HOL_state p2 (s o (add_prefix p1))"
@@ -115,7 +291,7 @@ lemma cons_append: "xs \<noteq> [] \<Longrightarrow> x # xs = [x] @ xs"
 lemma triangle_IMP_Minus_correct_function: 
   "(invoke_subprogram p triangle_IMP_Minus, s) 
       \<Rightarrow>\<^bsup>t \<^esup> s'
-    \<Longrightarrow> s' (add_prefix p ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state p s))"
+    \<Longrightarrow> s' (add_prefix p triangle_triangle_str) = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state p s))"
   apply(simp only: triangle_IMP_Minus_def triangle_imp.simps com_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
   \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
@@ -136,7 +312,7 @@ lemma triangle_IMP_Minus_correct_time:
    apply(drule AssignD)+
    apply(elim conjE)
    apply(subst triangle_imp_time.simps)
-  apply(erule mul_IMP_minus_correct[where vars = "{p @ ''triangle''}"])
+  apply(erule mul_IMP_minus_correct[where vars = "{p @ triangle_triangle_str}"])
   \<comment> \<open>Warning: in the following, I am unfolding mul_imp_to_HOL_state_def. With more experiments, it
       should become clear if this will cascade down multiple layers\<close>
   apply(simp add: triangle_imp_time_acc triangle_imp_to_HOL_state_def triangle_state_upd_def)[1]
@@ -151,7 +327,7 @@ lemma triangle_IMP_Minus_correct_effects:
 lemma triangle_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) triangle_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
      \<lbrakk>t = (triangle_imp_time 0 (triangle_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''triangle'') = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) triangle_triangle_str) = triangle_triangle (triangle_imp (triangle_imp_to_HOL_state (p1 @ p2) s));
       \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using triangle_IMP_Minus_correct_time triangle_IMP_Minus_correct_function
@@ -160,6 +336,11 @@ lemma triangle_IMP_Minus_correct:
 
 record prod_encode_state = prod_encode_a::nat prod_encode_b::nat prod_encode_ret::nat
 
+abbreviation "prod_encode_prefix \<equiv> ''prod_encode.''"
+abbreviation "prod_encode_a_str \<equiv> ''a''"
+abbreviation "prod_encode_b_str \<equiv> ''b''"
+abbreviation "prod_encode_ret_str \<equiv> ''prod_encode_ret''"
+
 definition "prod_encode_state_upd (s::prod_encode_state) \<equiv>
       let
         triangle_a = prod_encode_a s + prod_encode_b s;
@@ -222,14 +403,14 @@ lemma prod_encode_imp_time_acc: "(prod_encode_imp_time (Suc t) s) = Suc (prod_en
 *)
 
 definition prod_encode_IMP_Minus where "prod_encode_IMP_Minus \<equiv>
-  (''triangle.'' @ ''a'') ::= ((V ''a'') \<oplus> (V ''b'')) ;;
-  (''triangle.'' @ ''triangle'') ::= (A (N 0)) ;;
-  invoke_subprogram ''triangle.'' triangle_IMP_Minus ;;
-  ''prod_encode'' ::= (A (V (''triangle.'' @ ''triangle''))) ;;
-  ''prod_encode'' ::= ((V ''a'') \<oplus> (V ''prod_encode''))"
+  (triangle_prefix @ triangle_a_str) ::= ((V prod_encode_a_str) \<oplus> (V prod_encode_b_str)) ;;
+  (triangle_prefix @ triangle_triangle_str) ::= (A (N 0)) ;;
+  invoke_subprogram triangle_prefix triangle_IMP_Minus ;;
+  prod_encode_ret_str ::= (A (V (triangle_prefix @ triangle_triangle_str))) ;;
+  prod_encode_ret_str ::= ((V prod_encode_a_str) \<oplus> (V prod_encode_ret_str))"
 
 definition "prod_encode_imp_to_HOL_state p s =
-  \<lparr>prod_encode_a = s (add_prefix p ''a''), prod_encode_b = s (add_prefix p ''b''), prod_encode_ret = (s (add_prefix p ''prod_encode''))\<rparr>"
+  \<lparr>prod_encode_a = s (add_prefix p prod_encode_a_str), prod_encode_b = s (add_prefix p prod_encode_b_str), prod_encode_ret = (s (add_prefix p prod_encode_ret_str))\<rparr>"
 
 lemma notD: "x \<notin> s \<Longrightarrow> (x \<in> s \<Longrightarrow> False)"
   by auto
@@ -237,12 +418,12 @@ lemma notD: "x \<notin> s \<Longrightarrow> (x \<in> s \<Longrightarrow> False)"
 lemma prod_encode_IMP_Minus_correct_function: 
   "(invoke_subprogram p prod_encode_IMP_Minus, s) 
       \<Rightarrow>\<^bsup>t \<^esup> s'
-    \<Longrightarrow> s' (add_prefix p ''prod_encode'') = prod_encode_ret (prod_encode_imp (prod_encode_imp_to_HOL_state p s))"
+    \<Longrightarrow> s' (add_prefix p prod_encode_ret_str) = prod_encode_ret (prod_encode_imp (prod_encode_imp_to_HOL_state p s))"
   apply(simp only: prod_encode_IMP_Minus_def prod_encode_imp.simps com_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
   \<comment> \<open>Variables that we want to preserve: variables of this program minus the variables of the
      program we call. If automation fails, this should be manually chosen variables.\<close>
-  apply(erule triangle_IMP_Minus_correct[where vars = "{p @ ''a''}"])
+  apply(erule triangle_IMP_Minus_correct[where vars = "{p @ prod_encode_a_str}"])
   apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: prod_encode_state_upd_def Let_def prod_encode_imp_to_HOL_state_def)[1]
@@ -272,7 +453,7 @@ lemma prod_encode_IMP_Minus_correct_effects:
 lemma prod_encode_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) prod_encode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
      \<lbrakk>t = (prod_encode_imp_time 0 (prod_encode_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''prod_encode'') = prod_encode_ret (prod_encode_imp (prod_encode_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) prod_encode_ret_str) = prod_encode_ret (prod_encode_imp (prod_encode_imp_to_HOL_state (p1 @ p2) s));
       \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using prod_encode_IMP_Minus_correct_time prod_encode_IMP_Minus_correct_function
@@ -281,6 +462,10 @@ lemma prod_encode_IMP_Minus_correct:
 
 record prod_decode_aux_state = prod_decode_aux_k::nat prod_decode_aux_m::nat
 
+abbreviation "prod_decode_aux_pref \<equiv> ''prod_decode_aux.''"
+abbreviation "prod_decode_aux_k_str \<equiv> ''k''"
+abbreviation "prod_decode_aux_m_str \<equiv> ''m''"
+
 definition "prod_decode_aux_state_upd s \<equiv>
       let
         prod_decode_aux_k' = Suc (prod_decode_aux_k s);
@@ -369,21 +554,21 @@ lemma prod_decode_aux_imp_time_acc: "(prod_decode_aux_imp_time (Suc t) s) = Suc
 definition prod_decode_aux_IMP_Minus where
 "prod_decode_aux_IMP_Minus \<equiv>
   (\<comment> \<open>if prod_decode_aux_m s - prod_decode_aux_k s \<noteq> 0 then\<close>
-   ''diff'' ::= ((V ''m'') \<ominus> (V ''k''));;
+   ''diff'' ::= ((V prod_decode_aux_m_str) \<ominus> (V prod_decode_aux_k_str));;
    WHILE ''diff''\<noteq>0 DO (
         \<comment> \<open>prod_decode_aux_k' = Suc (prod_decode_aux_k s);\<close>
-        ''k'' ::= ((V ''k'') \<oplus> (N 1));;
+        prod_decode_aux_k_str ::= ((V prod_decode_aux_k_str) \<oplus> (N 1));;
         \<comment> \<open>prod_decode_aux_m' = (prod_decode_aux_m s) - prod_decode_aux_k';\<close>
-        ''m'' ::= ((V ''m'') \<ominus> (V ''k''));;
-        ''diff'' ::= ((V ''m'') \<ominus> (V ''k'')))
+        prod_decode_aux_m_str ::= ((V prod_decode_aux_m_str) \<ominus> (V prod_decode_aux_k_str));;
+        ''diff'' ::= ((V prod_decode_aux_m_str) \<ominus> (V prod_decode_aux_k_str)))
   )"
 
 definition "prod_decode_aux_imp_to_HOL_state p s =
-  \<lparr>prod_decode_aux_k = s (add_prefix p ''k''), prod_decode_aux_m = (s (add_prefix p ''m''))\<rparr>"
+  \<lparr>prod_decode_aux_k = s (add_prefix p prod_decode_aux_k_str), prod_decode_aux_m = (s (add_prefix p prod_decode_aux_m_str))\<rparr>"
 
 lemma prod_decode_aux_IMP_Minus_correct_function_1: 
   "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
-     s' (add_prefix p ''m'') = 
+     s' (add_prefix p prod_decode_aux_m_str) = 
        prod_decode_aux_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
   apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
   apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
@@ -405,7 +590,7 @@ lemma prod_decode_aux_IMP_Minus_correct_function_1:
 
 lemma prod_decode_aux_IMP_Minus_correct_function_2: 
   "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
-     s' (add_prefix p ''k'') = 
+     s' (add_prefix p prod_decode_aux_k_str) = 
        prod_decode_aux_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state p s))"
   apply(induction "prod_decode_aux_imp_to_HOL_state p s" arbitrary: s s' t rule: prod_decode_aux_imp.induct)
   apply(simp only: prod_decode_aux_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps)
@@ -421,7 +606,7 @@ lemma prod_decode_aux_IMP_Minus_correct_function_2:
   apply(erule Seq_tE)+
    apply(drule AssignD)+
    apply(elim conjE)
-   apply(subst prod_decode_aux_imp.simps mul_imp_time.simps)
+   apply(subst prod_decode_aux_imp.simps)
    apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def)[1]
   done
 
@@ -443,21 +628,24 @@ lemma prod_decode_aux_IMP_Minus_correct_time:
   apply(erule Seq_tE)+
    apply(drule AssignD)+
    apply(elim conjE)
-   apply(subst prod_decode_aux_imp_time.simps mul_imp_time.simps)
+   apply(subst prod_decode_aux_imp_time.simps)
   apply(auto simp: prod_decode_aux_imp_to_HOL_state_def prod_decode_aux_state_upd_def
                    eval_nat_numeral prod_decode_aux_imp_time_acc)[1]
   done
 
 lemma prod_decode_aux_IMP_Minus_correct_effects:
-  "(invoke_subprogram (p @ prod_decode_aux_pref) prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set prod_decode_aux_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  "(invoke_subprogram (p @ p2) prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
   using com_add_prefix_valid_subset com_only_vars
   by blast
 
 lemma prod_decode_aux_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) prod_decode_aux_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
      \<lbrakk>t = (prod_decode_aux_imp_time 0 (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''m'') = prod_decode_aux_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''k'') = prod_decode_aux_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+      s' (add_prefix (p1 @ p2) prod_decode_aux_m_str) =
+         prod_decode_aux_m (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) prod_decode_aux_k_str) =
+         prod_decode_aux_k (prod_decode_aux_imp (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using prod_decode_aux_IMP_Minus_correct_time prod_decode_aux_IMP_Minus_correct_function_1
         prod_decode_aux_IMP_Minus_correct_function_2
@@ -466,6 +654,11 @@ lemma prod_decode_aux_IMP_Minus_correct:
 
 record prod_decode_state = prod_decode_m::nat prod_decode_fst_ret::nat prod_decode_snd_ret::nat
 
+abbreviation "prod_decode_prefix \<equiv> ''prod_decode.''"
+abbreviation "prod_decode_m_str \<equiv> ''m''"
+abbreviation "prod_decode_fst_ret_str \<equiv> ''fst_ret''"
+abbreviation "prod_decode_snd_ret_str \<equiv> ''snd_ret''"
+
 definition "prod_decode_state_upd s \<equiv>
       let
         prod_decode_aux_k' = 0;
@@ -529,27 +722,27 @@ lemma prod_decode_imp_time_acc: "(prod_decode_imp_time (Suc t) s) = Suc (prod_de
 definition prod_decode_IMP_Minus where
 "prod_decode_IMP_Minus \<equiv>
   (     \<comment> \<open>prod_decode_aux_k' = 0;\<close>
-   (''prod_decode_aux.'' @ ''k'') ::= (A (N 0));;
+   (prod_decode_aux_pref @ prod_decode_aux_k_str) ::= (A (N 0));;
         \<comment> \<open>prod_decode_aux_m' = (prod_decode_m s);\<close>
-   (''prod_decode_aux.'' @ ''m'') ::= (A (V ''m''));;
+   (prod_decode_aux_pref @ prod_decode_aux_m_str) ::= (A (V prod_decode_m_str));;
         \<comment> \<open>prod_decode_aux_state = \<lparr>prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\<rparr>;\<close>
         \<comment> \<open>prod_decode_aux_ret = prod_decode_aux_imp prod_decode_aux_state;\<close>
-   invoke_subprogram ''prod_decode_aux.'' prod_decode_aux_IMP_Minus;;
+   invoke_subprogram prod_decode_aux_pref prod_decode_aux_IMP_Minus;;
         \<comment> \<open>fst_ret' = prod_decode_aux_m prod_decode_aux_ret;\<close>
-   ''fst_ret'' ::= (A (V (''prod_decode_aux.'' @ ''m'')));;
+   prod_decode_fst_ret_str ::= (A (V (prod_decode_aux_pref @ prod_decode_aux_m_str)));;
         \<comment> \<open>snd_ret' = prod_decode_aux_k prod_decode_aux_ret - prod_decode_aux_m prod_decode_aux_ret;\<close>
-   ''snd_ret'' ::= ((V (''prod_decode_aux.'' @ ''k'')) \<ominus> (V (''prod_decode_aux.'' @ ''m'')))
+   prod_decode_snd_ret_str ::= ((V (prod_decode_aux_pref @ prod_decode_aux_k_str)) \<ominus> (V (prod_decode_aux_pref @ prod_decode_aux_m_str)))
   )"
 
 definition "prod_decode_imp_to_HOL_state p s =
-  \<lparr>prod_decode_m = (s (add_prefix p ''m'')), prod_decode_fst_ret = (s (add_prefix p ''fst_ret'')) , prod_decode_snd_ret = (s (add_prefix p ''snd_ret''))\<rparr>"
+  \<lparr>prod_decode_m = (s (add_prefix p prod_decode_m_str)), prod_decode_fst_ret = (s (add_prefix p prod_decode_fst_ret_str)) , prod_decode_snd_ret = (s (add_prefix p prod_decode_snd_ret_str))\<rparr>"
 
 lemma prod_decode_IMP_Minus_correct_function_1: 
   "(invoke_subprogram p prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
-     s' (add_prefix p ''fst_ret'') = prod_decode_fst_ret (prod_decode_imp (prod_decode_imp_to_HOL_state p s))"
+     s' (add_prefix p prod_decode_fst_ret_str) = prod_decode_fst_ret (prod_decode_imp (prod_decode_imp_to_HOL_state p s))"
   apply(simp only: prod_decode_IMP_Minus_def prod_decode_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ ''m''}"])
+  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ prod_decode_m_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: prod_decode_state_upd_def Let_def prod_decode_aux_imp_to_HOL_state_def)[1]
@@ -558,10 +751,10 @@ lemma prod_decode_IMP_Minus_correct_function_1:
 
 lemma prod_decode_IMP_Minus_correct_function_2: 
   "(invoke_subprogram p prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
-     s' (add_prefix p ''snd_ret'') = prod_decode_snd_ret (prod_decode_imp (prod_decode_imp_to_HOL_state p s))"
+     s' (add_prefix p prod_decode_snd_ret_str) = prod_decode_snd_ret (prod_decode_imp (prod_decode_imp_to_HOL_state p s))"
   apply(simp only: prod_decode_IMP_Minus_def prod_decode_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ ''m''}"])
+  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ prod_decode_m_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: prod_decode_state_upd_def Let_def prod_decode_aux_imp_to_HOL_state_def)[1]
@@ -573,7 +766,7 @@ lemma prod_decode_IMP_Minus_correct_time:
      t = (prod_decode_imp_time 0 (prod_decode_imp_to_HOL_state p s))"
   apply(simp only: prod_decode_IMP_Minus_def prod_decode_imp_time.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ ''m''}"])
+  apply(erule prod_decode_aux_IMP_Minus_correct[where vars = "{p @ prod_decode_m_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: prod_decode_state_upd_def Let_def prod_decode_aux_imp_to_HOL_state_def)[1]
@@ -581,15 +774,16 @@ lemma prod_decode_IMP_Minus_correct_time:
   done
 
 lemma prod_decode_IMP_Minus_correct_effects:
-  "(invoke_subprogram (p @ prod_decode_pref) prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set prod_decode_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  "(invoke_subprogram (p @ p2) prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
   using com_add_prefix_valid_subset com_only_vars
   by blast
 
 lemma prod_decode_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) prod_decode_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
      \<lbrakk>t = (prod_decode_imp_time 0 (prod_decode_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''fst_ret'') = prod_decode_fst_ret (prod_decode_imp (prod_decode_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''snd_ret'') = prod_decode_snd_ret (prod_decode_imp (prod_decode_imp_to_HOL_state (p1 @ p2) s));      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+      s' (add_prefix (p1 @ p2) prod_decode_fst_ret_str) = prod_decode_fst_ret (prod_decode_imp (prod_decode_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) prod_decode_snd_ret_str) = prod_decode_snd_ret (prod_decode_imp (prod_decode_imp_to_HOL_state (p1 @ p2) s));      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v);
+      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using prod_decode_IMP_Minus_correct_time prod_decode_IMP_Minus_correct_function_1
         prod_decode_IMP_Minus_correct_function_2
@@ -600,6 +794,10 @@ subsection \<open>Head and tail of lists\<close>
 
 record hd_state = hd_xs::nat hd_ret::nat
 
+abbreviation "hd_prefix \<equiv> ''hd.''"
+abbreviation "hd_xs_str \<equiv> ''xs''"
+abbreviation "hd_ret_str \<equiv> ''hd_ret''"
+
 definition "hd_state_upd s \<equiv>
       let
         prod_decode_m' = hd_xs s - 1;
@@ -657,27 +855,27 @@ lemma hd_imp_time_acc: "(hd_imp_time (Suc t) s) = Suc (hd_imp_time t s)"
 definition hd_IMP_Minus where
 "hd_IMP_Minus \<equiv>
   (     \<comment> \<open>prod_decode_m' = hd_xs s - 1;\<close>
-        (''prod_decode.'' @ ''m'') ::= ((V ''xs'') \<ominus> (N 1));;
+        (prod_decode_prefix @ prod_decode_m_str) ::= ((V hd_xs_str) \<ominus> (N 1));;
         \<comment> \<open>prod_decode_fst_ret' = 0;\<close>
-        (''prod_decode.'' @ ''fst_ret'') ::= (A (N 0));;
+        (prod_decode_prefix @ prod_decode_fst_ret_str) ::= (A (N 0));;
         \<comment> \<open>prod_decode_snd_ret' = 0;\<close>
-        (''prod_decode.'' @ ''snd_ret'') ::= (A (N 0));;
+        (prod_decode_prefix @ prod_decode_snd_ret_str) ::= (A (N 0));;
         \<comment> \<open>prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;\<close>
         \<comment> \<open>prod_decode_ret = prod_decode_imp prod_decode_state;\<close>
-        invoke_subprogram ''prod_decode.'' prod_decode_IMP_Minus;;
+        invoke_subprogram prod_decode_prefix prod_decode_IMP_Minus;;
         \<comment> \<open>hd_ret' = prod_decode_fst_ret prod_decode_ret;\<close>
-        (''hd_ret'') ::= (A (V (''prod_decode.'' @ ''fst_ret'')))
+        (hd_ret_str) ::= (A (V (prod_decode_prefix @ prod_decode_fst_ret_str)))
   )"
 
 definition "hd_imp_to_HOL_state p s =
-  \<lparr>hd_xs = (s (add_prefix p ''xs'')), hd_ret = (s (add_prefix p ''hd_ret''))\<rparr>"
+  \<lparr>hd_xs = (s (add_prefix p hd_xs_str)), hd_ret = (s (add_prefix p hd_ret_str))\<rparr>"
 
 lemma hd_IMP_Minus_correct_function: 
   "(invoke_subprogram p hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
-     s' (add_prefix p ''hd_ret'') = hd_ret (hd_imp (hd_imp_to_HOL_state p s))"
+     s' (add_prefix p hd_ret_str) = hd_ret (hd_imp (hd_imp_to_HOL_state p s))"
   apply(simp only: hd_IMP_Minus_def hd_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ hd_xs_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: hd_state_upd_def Let_def hd_imp_to_HOL_state_def)[1]
@@ -689,7 +887,7 @@ lemma hd_IMP_Minus_correct_time:
      t = hd_imp_time 0 (hd_imp_to_HOL_state p s)"
   apply(simp only: hd_IMP_Minus_def hd_imp_time.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ hd_xs_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: hd_state_upd_def Let_def hd_imp_to_HOL_state_def)[1]
@@ -697,14 +895,16 @@ lemma hd_IMP_Minus_correct_time:
   done
 
 lemma hd_IMP_Minus_correct_effects:
-  "(invoke_subprogram (p @ hd_pref) hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set hd_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  "(invoke_subprogram (p @ hd_pref) hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> v \<in> vars \<Longrightarrow> \<not> (set hd_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
   using com_add_prefix_valid_subset com_only_vars
   by blast
 
 lemma hd_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) hd_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+    (\<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v));
      \<lbrakk>t = (hd_imp_time 0 (hd_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''hd_ret'') = hd_ret (hd_imp (hd_imp_to_HOL_state (p1 @ p2) s))\<rbrakk>
+      s' (add_prefix (p1 @ p2) hd_ret_str) = hd_ret (hd_imp (hd_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using hd_IMP_Minus_correct_time hd_IMP_Minus_correct_function
         hd_IMP_Minus_correct_effects 
@@ -712,6 +912,10 @@ lemma hd_IMP_Minus_correct:
 
 record tl_state = tl_xs::nat tl_ret::nat
 
+abbreviation "tl_prefix \<equiv> ''tl.''"
+abbreviation "tl_xs_str \<equiv> ''xs''"
+abbreviation "tl_ret_str \<equiv> ''tl_ret''"
+
 definition "tl_state_upd s \<equiv>
       let
         prod_decode_m' = tl_xs s - 1;
@@ -769,27 +973,27 @@ lemma tl_imp_time_acc: "(tl_imp_time (Suc t) s) = Suc (tl_imp_time t s)"
 definition tl_IMP_Minus where
 "tl_IMP_Minus \<equiv>
   (     \<comment> \<open>prod_decode_m' = tl_xs s - 1;\<close>
-        (''prod_decode.'' @ ''m'') ::= ((V ''xs'') \<ominus> (N 1));;
+        (prod_decode_prefix @ prod_decode_m_str) ::= ((V tl_xs_str) \<ominus> (N 1));;
         \<comment> \<open>prod_decode_snd_ret' = 0;\<close>
-        (''prod_decode.'' @ ''fst_ret'') ::= (A (N 0));;
+        (prod_decode_prefix @ prod_decode_fst_ret_str) ::= (A (N 0));;
         \<comment> \<open>prod_decode_snd_ret' = 0;\<close>
-        (''prod_decode.'' @ ''snd_ret'') ::= (A (N 0));;
+        (prod_decode_prefix @ prod_decode_snd_ret_str) ::= (A (N 0));;
         \<comment> \<open>prod_decode_state = \<lparr>prod_decode_m = prod_decode_m', prod_decode_snd_ret = prod_decode_snd_ret', prod_decode_snd_ret = prod_decode_snd_ret'\<rparr>;\<close>
         \<comment> \<open>prod_decode_ret = prod_decode_imp prod_decode_state;\<close>
-        invoke_subprogram ''prod_decode.'' prod_decode_IMP_Minus;;
+        invoke_subprogram prod_decode_prefix prod_decode_IMP_Minus;;
         \<comment> \<open>tl_ret' = prod_decode_snd_ret prod_decode_ret;\<close>
-        (''tl_ret'') ::= (A (V (''prod_decode.'' @ ''snd_ret'')))
+        (tl_ret_str) ::= (A (V (prod_decode_prefix @ prod_decode_snd_ret_str)))
   )"
 
 definition "tl_imp_to_HOL_state p s =
-  \<lparr>tl_xs = (s (add_prefix p ''xs'')), tl_ret = (s (add_prefix p ''tl_ret''))\<rparr>"
+  \<lparr>tl_xs = (s (add_prefix p tl_xs_str)), tl_ret = (s (add_prefix p tl_ret_str))\<rparr>"
 
 lemma tl_IMP_Minus_correct_function: 
   "(invoke_subprogram p tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
-     s' (add_prefix p ''tl_ret'') = tl_ret (tl_imp (tl_imp_to_HOL_state p s))"
+     s' (add_prefix p tl_ret_str) = tl_ret (tl_imp (tl_imp_to_HOL_state p s))"
   apply(simp only: tl_IMP_Minus_def tl_imp.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ tl_xs_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: tl_state_upd_def Let_def tl_imp_to_HOL_state_def)[1]
@@ -801,7 +1005,7 @@ lemma tl_IMP_Minus_correct_time:
      t = tl_imp_time 0 (tl_imp_to_HOL_state p s)"
   apply(simp only: tl_IMP_Minus_def tl_imp_time.simps com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
   apply(erule Seq_tE)+
-  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ ''xs''}"])
+  apply(erule prod_decode_IMP_Minus_correct[where vars = "{p @ tl_xs_str}"])
    apply(drule AssignD)+
   apply(elim conjE impE)
   apply(auto simp: tl_state_upd_def Let_def tl_imp_to_HOL_state_def)[1]
@@ -809,111 +1013,572 @@ lemma tl_IMP_Minus_correct_time:
   done
 
 lemma tl_IMP_Minus_correct_effects:
-  "(invoke_subprogram (p @ tl_pref) tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set tl_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  "(invoke_subprogram (p @ tl_pref) tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> v \<in> vars \<Longrightarrow> \<not> (set tl_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
   using com_add_prefix_valid_subset com_only_vars
   by blast
 
 lemma tl_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) tl_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+    (\<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v));
      \<lbrakk>t = (tl_imp_time 0 (tl_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''tl_ret'') = tl_ret (tl_imp (tl_imp_to_HOL_state (p1 @ p2) s))\<rbrakk>
+      s' (add_prefix (p1 @ p2) tl_ret_str) = tl_ret (tl_imp (tl_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using tl_IMP_Minus_correct_time tl_IMP_Minus_correct_function
         tl_IMP_Minus_correct_effects 
   by auto
 
-subsection \<open>Nth Natural number\<close>
-
-term nth_nat
-
-fun nth_nat_imp :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
-"nth_nat 0 x = hd_nat x "|
-"nth_nat (Suc n) x = nth_nat n (tl_nat x)"
-
-
-
-(*
-definition nth_nat_iteration where "nth_nat_iteration \<equiv>
-  [''a''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
-  invoke_subprogram ''a'' snd_nat_IMP_Minus ;;
-  ''a'' ::= [''a''] (A (V ''snd_nat'')) ;;
-  [''a''] ''snd_nat'' ::= (A (N 0)) ;;
-  ''nth_nat'' ::= ((V ''nth_nat'') \<ominus> (N 1))"
-
-fun nth_nat_loop_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_nat_loop_time 0 x = 2" |
-"nth_nat_loop_time (Suc n) x = 9 + snd_nat_IMP_Minus_time (x - 1) 
-  + nth_nat_loop_time n (tl_nat x)"
-
-fun drop_n_nat :: "nat \<Rightarrow> nat\<Rightarrow> nat" where 
-"drop_n_nat 0 x = x "|
-"drop_n_nat (Suc n) x = drop_n_nat n (tl_nat x)"
-
-lemma nth_nat_is_hd_of_drop_n_nat:
-  "nth_nat n x = fst_nat (drop_n_nat n x - Suc 0)"
-  by (induction n arbitrary: x)
-    (auto simp: hd_nat_def)
-
-abbreviation nth_nat_loop_state_transformer where "nth_nat_loop_state_transformer p k x \<equiv>
-  (if k = 0 then (\<lambda>s. s)
-   else 
-        state_transformer p [
-        (''a'', drop_n_nat k x),
-        (''nth_nat'',  0)]
-        \<circ> state_transformer (''a'' @ p) [
-          (''snd_nat'', 0)]
-        \<circ> snd_nat_IMP_Minus_state_transformer (''a'' @ p) 0)"
-
-lemma nth_nat_loop_correct:
-  "s (add_prefix p ''nth_nat'') = k
-  \<Longrightarrow> ((WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration) p, s) 
-      \<Rightarrow>\<^bsup>nth_nat_loop_time k (s (add_prefix p ''a''))\<^esup>
-      nth_nat_loop_state_transformer p k (s (add_prefix p ''a'')) s "
-proof(induction k arbitrary: s)
-  case 0
+subsection \<open>List length\<close>
+
+record length_state = length_xs::nat length_ret::nat
+
+abbreviation "length_prefix \<equiv> ''length.''"
+abbreviation "length_xs_str \<equiv> ''xs''"
+abbreviation "length_ret_str \<equiv> ''length_ret''"
+
+definition "length_state_upd s \<equiv>
+      let
+        tl_xs' = (length_xs s);
+        tl_ret' = 0;
+        tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;
+        tl_state_ret = tl_imp tl_state;
+        length_xs' = tl_ret tl_state_ret;
+        length_ret' = length_ret s + 1;
+        ret = \<lparr>length_xs = length_xs', length_ret = length_ret'\<rparr>
+      in
+        ret
+"
+
+function length_imp:: "length_state \<Rightarrow> length_state" where
+"length_imp s = 
+  (if length_xs s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>
+    (
+      let
+        next_iteration = length_imp (length_state_upd s)
+      in
+        next_iteration
+    )
+  else
+    (
+      let
+        ret = s
+      in
+        ret
+    )
+  )"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>s. length_xs s)")
+      (auto simp: tl_imp_correct length_state_upd_def Let_def split: if_splits)
+
+declare length_imp.simps [simp del]
+
+lemma length_imp_correct:
+   "length_ret (length_imp s) - length_ret s = length_nat (length_xs s)"
+proof (induction s rule: length_imp.induct)
+  case (1 s)
   then show ?case
-    by(auto simp: numeral_eq_Suc fun_eq_iff 
-        intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse])
-next
-  case (Suc k)
-  show ?case
-    apply(rule terminates_in_time_state_intro[OF Big_StepT.WhileTrue[OF _ _ Suc.IH]])
-    using \<open>s (add_prefix p ''nth_nat'') = Suc k\<close>
-    unfolding nth_nat_iteration_def
-    by (fastforce simp: tl_nat_def)+
-qed
-
-
-definition nth_nat_IMP_Minus where "nth_nat_IMP_Minus \<equiv>
-  ''nth_nat'' ::= (A (V ''a'')) ;;
-  ''a'' ::= (A (V ''b'')) ;;
-  WHILE ''nth_nat'' \<noteq>0 DO nth_nat_iteration ;;
-  [''b''] ''a'' ::= ((V ''a'') \<ominus> (N 1)) ;;
-  invoke_subprogram ''b'' fst_nat_IMP_Minus ;;
-  ''nth_nat'' ::= [''b''] (A (V ''fst_nat'')) ;;
-  [''b''] ''fst_nat'' ::= (A (N 0)) ;;
-  zero_variables [''a'', ''b'']"
-
-definition nth_nat_IMP_Minus_time where "nth_nat_IMP_Minus_time n x \<equiv>
-  10 + nth_nat_loop_time n x + fst_nat_IMP_Minus_time ((drop_n_nat n x) - 1)
-  + zero_variables_time [''a'', ''b'']"
-
-abbreviation nth_nat_IMP_Minus_state_transformer where "nth_nat_IMP_Minus_state_transformer p k x
-  \<equiv> state_transformer p [(''nth_nat'', nth_nat k x), (''a'', 0), (''b'', 0)]
-     \<circ> state_transformer (''b'' @ p) [(''fst_nat'', 0)]
-     \<circ> fst_nat_IMP_Minus_state_transformer (''b'' @ p) 0
-     \<circ> nth_nat_loop_state_transformer p k x"
-
-lemma nth_nat_IMP_Minus_correct:
-  "(nth_nat_IMP_Minus p, s) 
-    \<Rightarrow>\<^bsup>nth_nat_IMP_Minus_time (s (add_prefix p ''a'')) (s (add_prefix p ''b''))\<^esup>
-    nth_nat_IMP_Minus_state_transformer p (s (add_prefix p ''a'')) (s (add_prefix p ''b'')) s"
-  unfolding nth_nat_IMP_Minus_def nth_nat_IMP_Minus_time_def tl_nat_def 
-  by (cases "s (add_prefix p ''a'') = 0") (fastforce 
-      simp: hd_nat_def nth_nat_is_hd_of_drop_n_nat
-      intro!: terminates_in_time_state_intro[OF Seq']
-      intro: nth_nat_loop_correct)+
-*)
+    apply(subst length_imp.simps)
+    apply (auto simp: length_state_upd_def Let_def split: if_splits)
+    by (metis Suc_diff_Suc diff_is_0_eq le_imp_less_Suc le_less length_imp.elims
+              length_nat.elims length_state.select_convs(1) length_state.select_convs(2)
+              neq0_conv tl_imp_correct tl_state.select_convs(1) zero_less_diff)
+qed 
+
+function length_imp_time:: "nat \<Rightarrow> length_state\<Rightarrow> nat" where
+  "length_imp_time t s = 
+  (if length_xs s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>
+    (
+      let
+        t = t + 1;
+        tl_xs' = (length_xs s);
+        t = t+2;
+        tl_ret' = 0;
+        t = t+2;
+        tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;
+        tl_state_ret = tl_imp tl_state;
+        t = t + tl_imp_time 0 tl_state;
+        length_xs' = tl_ret tl_state_ret;
+        t = t + 2;
+        length_ret' = length_ret s + 1;
+        t = t + 2;
+        next_iteration = length_imp_time t (length_state_upd s)
+      in
+        next_iteration
+    )
+  else
+    (
+      let
+        t = t + 2;
+        ret = t
+      in
+        ret
+    )
+  )
+"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>(t,s). length_xs s)")
+      (auto simp: tl_imp_correct length_state_upd_def Let_def split: if_splits)
+
+lemmas [simp del] = length_imp_time.simps
+
+lemma length_imp_time_acc: "(length_imp_time (Suc t) s) = Suc (length_imp_time t s)"
+  apply (induction t s arbitrary:  rule: length_imp_time.induct)
+  apply(subst length_imp_time.simps)
+  apply(subst (2) length_imp_time.simps)
+  apply (auto simp add: length_state_upd_def Let_def eval_nat_numeral split: if_splits)
+  done
+
+lemma length_imp_time_acc_2: "(length_imp_time x s) = x + (length_imp_time 0 s)"
+  by (induction x arbitrary: s)
+     (auto simp add: length_imp_time_acc length_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition length_IMP_Minus where
+"length_IMP_Minus \<equiv>
+  (
+  \<comment> \<open>if length_xs s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>\<close>
+  WHILE length_xs_str \<noteq>0 DO (
+        \<comment> \<open>tl_xs' = (length_xs s);\<close>
+     (tl_prefix @ tl_xs_str) ::= (A (V length_xs_str));;
+        \<comment> \<open>tl_ret' = 0;\<close>
+     (tl_prefix @ tl_ret_str) ::= (A (N 0));;
+        \<comment> \<open>tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;\<close>
+        \<comment> \<open>tl_state_ret = tl_imp tl_state;\<close>
+     invoke_subprogram tl_prefix tl_IMP_Minus;;
+        \<comment> \<open>length_xs' = tl_ret tl_state_ret;\<close>
+     length_xs_str ::= (A (V (tl_prefix @ tl_ret_str)));;
+        \<comment> \<open>length_ret' = length_ret s + 1;\<close>
+     length_ret_str ::= ((V (length_ret_str) \<oplus> N 1))
+     )
+  )"
+
+definition "length_imp_to_HOL_state p s =
+  \<lparr>length_xs = (s (add_prefix p length_xs_str)), length_ret = (s (add_prefix p length_ret_str))\<rparr>"
+
+lemma length_IMP_Minus_correct_function: 
+  "(invoke_subprogram p length_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p length_ret_str) = length_ret (length_imp (length_imp_to_HOL_state p s))"
+  apply(induction "length_imp_to_HOL_state p s" arbitrary: s s' t rule: length_imp.induct)
+  apply(subst length_imp.simps)
+  apply(simp only: length_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule While_tE)
+   apply(subst length_imp.simps)
+   apply(auto simp: length_imp_time_acc length_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule tl_IMP_Minus_correct[where vars = "{length_ret_str}"])
+  apply auto [1]
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(auto simp: length_state_upd_def length_imp_to_HOL_state_def)[1]
+  apply(auto simp: tl_imp_to_HOL_state_def )[1]
+  done
+
+lemma length_IMP_Minus_correct_time: 
+  "(invoke_subprogram p length_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = length_imp_time 0 (length_imp_to_HOL_state p s)"                      
+  apply(induction "length_imp_to_HOL_state p s" arbitrary: s s' t rule: length_imp.induct)
+  apply(subst length_imp_time.simps)
+  apply(simp only: length_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps
+                    atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule While_tE)
+   apply(auto simp: length_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule tl_IMP_Minus_correct[where vars = "{length_ret_str}"])
+  apply auto [1]
+
+   apply(drule AssignD)+
+  apply(elim conjE)
+  apply(auto simp: length_state_upd_def length_imp_to_HOL_state_def length_imp_time_acc)[1]
+  apply(subst length_imp_time_acc_2)
+  apply(auto simp: tl_imp_to_HOL_state_def)[1]
+  done
+
+lemma length_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ p2) length_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma length_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) length_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+     \<lbrakk>t = (length_imp_time 0 (length_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) length_ret_str) = length_ret (length_imp (length_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using length_IMP_Minus_correct_time length_IMP_Minus_correct_function
+        length_IMP_Minus_correct_effects 
+  by auto
+
+subsection \<open>List cons\<close>
+
+record cons_state = cons_h::nat cons_t::nat cons_ret::nat
+
+abbreviation "cons_prefix \<equiv> ''cons.''"
+abbreviation "cons_h_str \<equiv> ''h''"
+abbreviation "cons_t_str \<equiv> ''t''"
+abbreviation "cons_ret_str \<equiv> ''cons_ret''"
+
+
+definition "cons_state_upd s \<equiv>
+      let
+        prod_encode_a' = (cons_h s);
+        prod_encode_b' = (cons_t s);
+        prod_encode_ret' = 0;
+        prod_encode_state = \<lparr>prod_encode_a = prod_encode_a', prod_encode_b = prod_encode_b', prod_encode_ret = prod_encode_ret'\<rparr>;
+        prod_encode_state_ret = prod_encode_imp prod_encode_state;
+        cons_ret' = (prod_encode_ret prod_encode_state_ret) + 1;
+        ret = \<lparr>cons_h = cons_h s, cons_t = cons_t s, cons_ret = cons_ret'\<rparr>
+      in
+        ret
+"
+
+fun cons_imp:: "cons_state \<Rightarrow> cons_state" where
+"cons_imp s = 
+      (let
+        ret = cons_state_upd s
+      in
+        ret)
+"
+
+declare cons_imp.simps [simp del]
+
+lemma cons_imp_correct:
+   "cons_ret (cons_imp s) = cons (cons_h s) (cons_t s)"
+  by (auto simp: cons_imp.simps prod_encode_imp_correct cons_state_upd_def Let_def cons_def split: if_splits)
+
+fun cons_imp_time:: "nat \<Rightarrow> cons_state\<Rightarrow> nat" where
+  "cons_imp_time t s = 
+    (
+      let
+        prod_encode_a' = (cons_h s);
+        t = t + 2;
+        prod_encode_b' = (cons_t s);
+        t = t + 2;
+        prod_encode_ret' = 0;
+        t = t + 2;
+        prod_encode_state = \<lparr>prod_encode_a = prod_encode_a', prod_encode_b = prod_encode_b', prod_encode_ret = prod_encode_ret'\<rparr>;
+        prod_encode_state_ret = prod_encode_imp prod_encode_state;
+        t = t + prod_encode_imp_time 0 prod_encode_state;
+        cons_ret' = (prod_encode_ret prod_encode_state_ret) + 1;
+        t = t + 2;
+        ret = t
+      in
+        ret
+    )
+"
+
+lemmas [simp del] = cons_imp_time.simps
+
+lemma cons_imp_time_acc: "(cons_imp_time (Suc t) s) = Suc (cons_imp_time t s)"
+  by (auto simp add: cons_imp_time.simps cons_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+lemma cons_imp_time_acc_2: "(cons_imp_time x s) = x + (cons_imp_time 0 s)"
+  by (induction x arbitrary: s)
+     (auto simp add: cons_imp_time_acc cons_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+definition cons_IMP_Minus where
+"cons_IMP_Minus \<equiv>
+  (
+        \<comment> \<open>prod_encode_a' = (cons_h s);\<close>
+        (prod_encode_prefix @ prod_encode_a_str) ::= (A (V cons_h_str));;
+        \<comment> \<open>prod_encode_b' = (cons_t s);\<close>
+        (prod_encode_prefix @ prod_encode_b_str) ::= (A (V cons_t_str));;
+        \<comment> \<open>prod_encode_ret' = 0;\<close>
+        (prod_encode_prefix @ prod_encode_ret_str) ::= (A (N 0));;
+        \<comment> \<open>prod_encode_state = \<lparr>prod_encode_a = prod_encode_a', prod_encode_b = prod_encode_b', prod_encode_ret = prod_encode_ret'\<rparr>;\<close>
+        \<comment> \<open>prod_encode_state_ret = prod_encode_imp prod_encode_state;\<close>
+        invoke_subprogram prod_encode_prefix prod_encode_IMP_Minus;;
+        \<comment> \<open>cons_ret' = (prod_encode_ret prod_encode_state_ret) + 1;\<close>
+        (cons_ret_str) ::= (V (prod_encode_prefix @ prod_encode_ret_str) \<oplus> (N 1))
+ )"
+
+definition "cons_imp_to_HOL_state p s =
+  \<lparr>cons_h = (s (add_prefix p cons_h_str)), cons_t = (s (add_prefix p cons_t_str)), cons_ret = (s (add_prefix p cons_ret_str))\<rparr>"
+
+lemma cons_IMP_Minus_correct_function: 
+  "(invoke_subprogram p cons_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p cons_ret_str) = cons_ret (cons_imp (cons_imp_to_HOL_state p s))"
+  apply(subst cons_imp.simps)
+  apply(simp only: cons_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_encode_IMP_Minus_correct[where vars = "{cons_ret_str}"])
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(auto simp: cons_state_upd_def cons_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_encode_imp_to_HOL_state_def )[1]
+  done
+
+lemma cons_IMP_Minus_correct_time: 
+  "(invoke_subprogram p cons_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = cons_imp_time 0 (cons_imp_to_HOL_state p s)"
+  apply(subst cons_imp_time.simps)
+  apply(simp only: cons_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule Seq_tE)+
+  apply(erule prod_encode_IMP_Minus_correct[where vars = "{cons_ret_str}"])
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(auto simp: cons_state_upd_def cons_imp_to_HOL_state_def)[1]
+  apply(auto simp: prod_encode_imp_to_HOL_state_def )[1]
+  done
+
+
+lemma cons_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ cons_pref) cons_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> v \<in> vars \<Longrightarrow> \<not> (set cons_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma cons_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) cons_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+    (\<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v));
+     \<lbrakk>t = (cons_imp_time 0 (cons_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) cons_ret_str) = cons_ret (cons_imp (cons_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using cons_IMP_Minus_correct_time cons_IMP_Minus_correct_function
+        cons_IMP_Minus_correct_effects 
+  by auto
+
+subsection \<open>List append\<close>
+
+record append_state = append_acc::nat append_xs::nat
+
+abbreviation "append_prefix \<equiv> ''append.''"
+abbreviation "append_acc_str \<equiv> ''acc''"
+abbreviation "append_xs_str \<equiv> ''xs''"
+
+definition "append_state_upd s \<equiv>
+      let
+        hd_xs' = append_xs s;
+        hd_ret' = 0;
+        hd_state = \<lparr>hd_xs = hd_xs', hd_ret = hd_ret'\<rparr>;
+        hd_state_ret = hd_imp (hd_state);
+        cons_h' = hd_ret hd_state_ret;
+        cons_t' = append_acc s;
+        cons_ret' = 0;
+        cons_state = \<lparr>cons_h = cons_h', cons_t = cons_t', cons_ret = cons_ret'\<rparr>;
+        cons_ret_state = cons_imp cons_state;
+        append_acc' = cons_ret cons_ret_state;
+        tl_xs' = append_xs s;
+        tl_ret' = 0;
+        tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;
+        tl_state_ret = tl_imp tl_state;
+        append_xs' = tl_ret tl_state_ret;
+        ret = \<lparr>append_acc = append_acc', append_xs = append_xs'\<rparr>
+      in
+        ret
+"
+
+function append_imp:: "append_state \<Rightarrow> append_state" where
+"append_imp s = 
+  (if append_xs s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>
+    (
+      let
+        next_iteration = append_imp (append_state_upd s)
+      in
+        next_iteration
+    )
+  else
+    (
+      let
+        ret = s
+      in
+        ret
+    )
+  )"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>s. append_xs s)")
+      (auto simp: tl_imp_correct append_state_upd_def Let_def split: if_splits)
+
+declare append_imp.simps [simp del]
+
+lemma append_imp_correct:
+   "append_acc (append_imp s) = Primitives.append_acc (append_acc s) (append_xs s)"
+proof (induction s rule: append_imp.induct)
+  case (1 s)
+  then show ?case
+    apply(subst append_imp.simps)
+    apply (auto simp: append_state_upd_def Let_def split: if_splits)
+    by (metis Suc_pred' append_acc.simps(2) cons_imp_correct cons_state.select_convs(2)
+              cons_state.simps(1) hd_imp_correct hd_state.simps(1) tl_imp_correct
+              tl_state.select_convs(1))
+qed 
+
+function append_imp_time:: "nat \<Rightarrow> append_state\<Rightarrow> nat" where
+  "append_imp_time t s = 
+  (if append_xs s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>
+    (
+      let
+        t = t + 1;
+        hd_xs' = append_xs s;
+        t = t + 2;
+        hd_ret' = 0;
+        t = t + 2;
+        hd_state = \<lparr>hd_xs = hd_xs', hd_ret = hd_ret'\<rparr>;
+        hd_state_ret = hd_imp (hd_state);
+        t = t + hd_imp_time 0 hd_state;
+        cons_h' = hd_ret hd_state_ret;
+        t = t + 2;
+        cons_t' = append_state.append_acc s;
+        t = t + 2;
+        cons_ret' = 0;
+        t = t + 2;
+        cons_state = \<lparr>cons_h = cons_h', cons_t = cons_t', cons_ret = cons_ret'\<rparr>;
+        cons_ret_state = cons_imp cons_state;
+        t = t + cons_imp_time 0 cons_state;
+        append_acc' = cons_ret cons_ret_state;
+        t = t + 2;
+        tl_xs' = append_xs s;
+        t = t + 2;
+        tl_ret' = 0;
+        t = t + 2;
+        tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;
+        tl_state_ret = tl_imp tl_state;
+        t = t + tl_imp_time 0 tl_state;
+        append_xs' = tl_ret tl_state_ret;
+        t = t + 2;
+        next_iteration = append_imp_time t (append_state_upd s)
+      in
+        next_iteration
+    )
+  else
+    (
+      let
+        t = t + 2;
+        ret = t
+      in
+        ret
+    )
+  )
+"
+  by pat_completeness auto
+termination
+  by  (relation "measure (\<lambda>(t,s). append_xs s)")
+      (auto simp: tl_imp_correct append_state_upd_def Let_def split: if_splits)
+
+lemmas [simp del] = append_imp_time.simps
+
+lemma append_imp_time_acc: "(append_imp_time (Suc t) s) = Suc (append_imp_time t s)"
+  apply (induction t s arbitrary:  rule: append_imp_time.induct)
+  apply(subst append_imp_time.simps)
+  apply(subst (2) append_imp_time.simps)
+  apply (auto simp add: append_state_upd_def Let_def eval_nat_numeral split: if_splits)
+  done
+
+lemma append_imp_time_acc_2: "(append_imp_time x s) = x + (append_imp_time 0 s)"
+  by (induction x arbitrary: s)
+     (auto simp add: append_imp_time_acc append_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+
+abbreviation "append_IMP_Minus_1 \<equiv>
+        \<comment> \<open>hd_xs' = append_xs s;\<close>
+        ((hd_prefix @ hd_xs_str) ::= (A (V append_xs_str)));;
+        \<comment> \<open>hd_ret' = 0;\<close>
+        ((hd_prefix @ hd_ret_str) ::= (A (N 0)));;
+        \<comment> \<open>hd_state = \<lparr>hd_xs = hd_xs', hd_ret = hd_ret'\<rparr>;\<close>
+        \<comment> \<open>hd_state_ret = hd_imp (hd_state);\<close>
+        (invoke_subprogram hd_prefix hd_IMP_Minus);;
+        \<comment> \<open>cons_h' = hd_ret hd_state_ret;\<close>
+        ((cons_prefix @ cons_h_str) ::= (A (V (hd_prefix @ hd_ret_str))));;
+        \<comment> \<open>cons_t' = append_acc s;\<close>
+        ((cons_prefix @ cons_t_str) ::= (A (V append_acc_str)));;
+        \<comment> \<open>cons_ret' = 0;\<close>
+        ((cons_prefix @ cons_ret_str) ::= (A (N 0)));;
+        \<comment> \<open>cons_state = \<lparr>cons_h = cons_h', cons_t = cons_t', cons_ret = cons_ret'\<rparr>;\<close>
+        \<comment> \<open>cons_ret_state = cons_imp cons_state;\<close>
+        (invoke_subprogram cons_prefix cons_IMP_Minus)
+"
+
+definition append_IMP_Minus where
+"append_IMP_Minus \<equiv>
+  (
+  \<comment> \<open>if append_xs s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>\<close>
+  WHILE append_xs_str \<noteq>0 DO (
+        append_IMP_Minus_1;;
+        \<comment> \<open>append_acc' = cons_ret cons_ret_state;\<close>
+        ((append_acc_str) ::= (A (V (cons_prefix @ cons_ret_str))));;
+        \<comment> \<open>tl_xs' = append_xs s;\<close>
+        ((tl_prefix @ tl_xs_str) ::= (A (V (append_xs_str))));;
+        \<comment> \<open>tl_ret' = 0;\<close>
+        ((tl_prefix @ tl_ret_str) ::= (A (N 0)));;
+        \<comment> \<open>tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;\<close>
+        \<comment> \<open>tl_state_ret = tl_imp tl_state;\<close>
+        (invoke_subprogram tl_prefix tl_IMP_Minus);;
+        \<comment> \<open>append_xs' = tl_ret tl_state_ret;\<close>
+        ((append_xs_str) ::= (A (V (tl_prefix @ tl_ret_str))))
+      )
+     
+  )"
+
+definition "append_imp_to_HOL_state p s =
+  \<lparr>append_acc = (s (add_prefix p append_acc_str)), append_xs = (s (add_prefix p append_xs_str))\<rparr>"
+
+lemma append_IMP_Minus_correct_function: 
+  "(invoke_subprogram p append_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p append_acc_str) = append_state.append_acc (append_imp (append_imp_to_HOL_state p s))"
+  apply(induction "append_imp_to_HOL_state p s" arbitrary: s s' t rule: append_imp.induct)
+  apply(subst append_imp.simps)
+  apply(simp only: append_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule While_tE)
+   apply(auto simp: append_imp_time_acc append_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule tl_IMP_Minus_correct[where vars = "{append_xs_str, append_acc_str}"])
+  apply fastforce [1]
+  apply(erule hd_IMP_Minus_correct[where vars = "{append_xs_str, append_acc_str}"])
+   apply fastforce [1]
+  apply(erule cons_IMP_Minus_correct[where vars = "{append_xs_str, append_acc_str}"])
+   apply fastforce [1]
+   apply(drule AssignD)+
+  apply(elim conjE)
+  apply(simp add: append_state_upd_def append_imp_to_HOL_state_def append_imp_time_acc 
+                        cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+                        Let_def)
+  apply fastforce [1]
+  done
+
+lemma append_IMP_Minus_correct_time: 
+  "(invoke_subprogram p append_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = append_imp_time 0 (append_imp_to_HOL_state p s)"
+  apply(induction "append_imp_to_HOL_state p s" arbitrary: s s' t rule: append_imp.induct)
+  apply(subst append_imp_time.simps)
+  apply(simp only: append_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule While_tE)
+   apply(auto simp: append_imp_time_acc append_imp_to_HOL_state_def)[1]
+  apply(dest_com')
+  apply(erule Seq_tE)+
+  apply(erule tl_IMP_Minus_correct[where vars = "{append_xs_str, append_acc_str}"])
+  apply fastforce [1]
+  apply(erule hd_IMP_Minus_correct[where vars = "{append_xs_str, append_acc_str}"])
+   apply fastforce [1]
+  apply(erule cons_IMP_Minus_correct[where vars = "{append_xs_str, append_acc_str}"])
+   apply fastforce [1]
+   apply(drule AssignD)+
+  apply(elim conjE)
+  apply(subst append_imp_time_acc_2)
+  apply(simp add: append_state_upd_def append_imp_to_HOL_state_def append_imp_time_acc 
+                        cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+                        Let_def)
+  apply fastforce [1]
+  done
+
+lemma append_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ append_pref) append_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>  v \<in> vars \<Longrightarrow> \<not> (set append_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma append_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) append_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+    \<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v);
+     \<lbrakk>t = (append_imp_time 0 (append_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) append_acc_str) = append_state.append_acc (append_imp (append_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using append_IMP_Minus_correct_time append_IMP_Minus_correct_function
+        append_IMP_Minus_correct_effects 
+  by auto
 
 
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
index d13caa7c..3669d22e 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy
@@ -1,6 +1,6 @@
 theory IMP_Minus_Max_Constant_Nat
   imports "HOL-Library.Nat_Bijection"
-  "IMP-_To_IMP--/Primitives"  IMP_Minus.Max_Constant 
+  Primitives  IMP_Minus.Max_Constant 
 begin
 
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
index 40ae9a14..55b5d437 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy
@@ -3,9 +3,9 @@
 section "IMP- to SAS+"
 
 theory IMP_Minus_To_SAS_Plus
-  imports "IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus" 
-    "IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness"
-    "SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus"
+  imports IMP_Minus_To_IMP_Minus_Minus
+    IMP_Minus_Minus_To_SAS_Plus_Plus_Correctness
+    SAS_Plus_Plus_To_SAS_Plus
 begin
 
 text \<open> We combine our reduction steps from IMP- to IMP--, then from IMP-- to SAS++ and finally 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
index 9a0723a2..a8f39c00 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy
@@ -1,6 +1,7 @@
-theory IMP_Minus_To_SAS_Plus_Nat imports  "IMP-_To_IMP--/Primitives" IMP_Minus_To_SAS_Plus IMP_Minus_Max_Constant_Nat
-"IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat" "SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat" 
-    "IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat"
+theory IMP_Minus_To_SAS_Plus_Nat imports
+  Primitives IMP_Minus_To_SAS_Plus IMP_Minus_Max_Constant_Nat
+  IMP_Minus_To_IMP_Minus_Minus_nat SAS_Plus_Plus_To_SAS_Plus_Nat
+  IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat
 
 begin
 
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
index b41ea94c..e7a97937 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy
@@ -268,10 +268,10 @@ lemma main_lemma_synth :
 
 subsubsection \<open>Instantiating the Cook_Levin locale\<close>
 
-interpretation Cook_Levin_assumes_Main_lemma encode_sat decode_sat
+(*interpretation Cook_Levin_assumes_Main_lemma encode_sat decode_sat
   apply standard
   by (fact main_lemma_synth) 
    
-term strict_sorted
+term strict_sorted*)
 
 end
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
index 73b57011..08b403f5 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy
@@ -1,6 +1,6 @@
 theory IMP_Minus_To_SAT_Nat 
   imports IMP_Minus_To_SAS_Plus_Nat IMP_Minus_To_SAT SAT_Plan_Base_Nat SAS_Plus_Strips_Nat
- "IMP-_To_IMP--/Primitives"  
+          Primitives
 begin
 
 fun poly_of :: "nat*nat \<Rightarrow> nat \<Rightarrow> nat" where 
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy
index 35711d73..1402daf4 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus.thy
@@ -2,7 +2,8 @@
 
 section "SAS++ to SAS+"
 
-theory SAS_Plus_Plus_To_SAS_Plus imports "../SAS_Plus_Plus"
+theory SAS_Plus_Plus_To_SAS_Plus
+  imports SAS_Plus_Plus
 begin 
 
 text \<open> We give a reduction from SAS++ to SAS+. The challenge here is to replace the semantics of 
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
index a8fcaca7..7c3c779c 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy
@@ -1,5 +1,5 @@
 theory SAS_Plus_Plus_To_SAS_Plus_Nat
-  imports   "../IMP-_To_IMP--/Primitives" SAS_Plus_Plus_To_SAS_Plus
+  imports   Primitives SAS_Plus_Plus_To_SAS_Plus
 begin
 
 definition SAS_Plus_Plus_State_To_SAS_Plus_list:: 
diff --git a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
index 03218e4f..c0ba9146 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy
@@ -1,5 +1,5 @@
 theory SAS_Plus_Strips_Nat 
-  imports "Verified_SAT_Based_AI_Planning.SAS_Plus_STRIPS" "IMP-_To_IMP--/Primitives"
+  imports "Verified_SAT_Based_AI_Planning.SAS_Plus_STRIPS" Primitives
 begin
 
 definition possible_assignments_for_list
diff --git a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
index 8229ccf3..0a0bfe59 100644
--- a/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy
@@ -1,5 +1,5 @@
 theory SAT_Plan_Base_Nat 
-  imports "Verified_SAT_Based_AI_Planning.SAT_Plan_Base" "IMP-_To_IMP--/Primitives"
+  imports "Verified_SAT_Based_AI_Planning.SAT_Plan_Base" Primitives
 begin
 
 definition  encode_state_variable_nat
diff --git a/Cook_Levin/ROOT b/Cook_Levin/ROOT
index 56af6ad1..66608a04 100644
--- a/Cook_Levin/ROOT
+++ b/Cook_Levin/ROOT
@@ -1,7 +1,8 @@
 chapter Poly_Reductions
 
-session Cook_Levin = "HOL-Analysis" + 
-  sessions
+session Cook_Levin = "HOL-Analysis" +
+  options [quick_and_dirty]
+  sessions    
     "Poly_Reductions_Lib"
     "IMP_Minus"
     "HOL-Real_Asymp"
@@ -15,4 +16,4 @@ session Cook_Levin = "HOL-Analysis" +
     "IMP-_To_SAS+/SAS++_To_SAS+"
   theories
     "Complexity_classes/Cook_Levin"
-    "IMP-_To_SAS+/IMP_Minus_To_SAS_Plus"
+    "IMP-_To_SAS+/IMP_Minus_To_SAT_Nat"
diff --git a/IMP-/Call_By_Prefixes.thy b/IMP-/Call_By_Prefixes.thy
index 24e79bc6..386c2b2d 100644
--- a/IMP-/Call_By_Prefixes.thy
+++ b/IMP-/Call_By_Prefixes.thy
@@ -1,7 +1,7 @@
 (*Authors: Mohammad Abdulaziz*)
 
 theory Call_By_Prefixes
-  imports Com Big_StepT
+  imports IMP_Minus.Com Big_StepT
 begin
 
 abbreviation add_prefix :: "string \<Rightarrow> vname \<Rightarrow> vname" where
diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy
index d7073386..8dbc9553 100644
--- a/IMP-/Multiplication.thy
+++ b/IMP-/Multiplication.thy
@@ -5,215 +5,4 @@ theory Multiplication
     Canonical_State_Transformers "../Lib/Polynomial_Growth_Functions"
 begin
 
-
-(*unbundle no_com_syntax*)
-
-(*definition max_a_min_b_IMP_Minus where "max_a_min_b_IMP_Minus =
-  ''c'' ::= ((V ''a'') \<ominus> (V ''b'')) ;;
-  IF ''c''\<noteq>0 
-  THEN
-    (SKIP ;; SKIP ;;
-     SKIP ;; SKIP ;;
-     SKIP ;; SKIP ;;
-     ''c'' ::= A (N 0))
-  ELSE
-    (''c'' ::= A (V ''a'') ;;
-    ''a'' ::= A (V ''b'') ;;
-    ''b'' ::= A (V ''c'') ;;
-    ''c'' ::= A (N 0))"
-
-definition max_a_min_b_IMP_Minus_time where "max_a_min_b_IMP_Minus_time \<equiv> 11"
-
-abbreviation max_a_min_b_IMP_Minus_state_transformer
-  where "max_a_min_b_IMP_Minus_state_transformer p a b
-    \<equiv> state_transformer p 
-        [(''a'', max a b),
-         (''b'', min a b),
-         (''c'', 0)]"
-
-lemma max_a_min_b_IMP_Minus_correct[intro]: 
-  "(max_a_min_b_IMP_Minus p, s) \<Rightarrow>\<^bsup>max_a_min_b_IMP_Minus_time\<^esup> 
-      max_a_min_b_IMP_Minus_state_transformer p (s (add_prefix p ''a''))
-        (s (add_prefix p ''b'')) s" 
-proof(cases "s (add_prefix p ''a'') \<le> s (add_prefix p ''b'')")
-  case True
-  then show ?thesis
-    by(fastforce 
-        simp: max_a_min_b_IMP_Minus_def numeral_eq_Suc
-        max_a_min_b_IMP_Minus_time_def
-        assign_t_simp
-        intro!: terminates_in_time_state_intro[OF Seq[OF Big_StepT.Assign Big_StepT.IfFalse]])
-next
-  case False
-  show ?thesis 
-    unfolding max_a_min_b_IMP_Minus_def max_a_min_b_IMP_Minus_time_def
-    using False
-    by (fastforce intro!: terminates_in_time_state_intro[OF Seq'])+
-qed*)
-
-record mul_state = mul_a::nat mul_b::nat mul_c::nat
-
-definition "mul_state_upd s \<equiv>
-      let
-        d = (mul_b s) mod 2;
-        mul_c = (if d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
-        mul_a = mul_a s + mul_a s;
-        mul_b = (mul_b s) div 2;
-        ret = \<lparr>mul_a = mul_a, mul_b = mul_b, mul_c = mul_c\<rparr>
-      in
-        ret
-"
-
-function mul_imp:: "mul_state \<Rightarrow> mul_state" where
-"mul_imp s = 
-  (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
-    (
-      let
-        next_iteration = mul_imp (mul_state_upd s)
-      in
-        next_iteration
-    )
-  else
-    (
-      let
-        ret = s
-      in
-        ret
-    )
-  )"
-  by pat_completeness auto
-termination
-  by  (relation "measure (\<lambda>s. mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
-
-lemmas [simp del] = mul_imp.simps
-
-lemma mul_imp_correct: "mul_c (mul_imp s) = mul_c s + mul_a s * mul_b s"
-proof (induction s rule: mul_imp.induct)
-  case (1 s)
-  then show ?case
-    apply(subst mul_imp.simps)
-    apply (auto simp: mul_state_upd_def Let_def split: if_splits)
-    by (metis (no_types, lifting) One_nat_def add.commute add_mult_distrib2 distrib_right mult.right_neutral mult_2 mult_div_mod_eq)
-qed 
-
-function mul_imp_time:: "nat \<Rightarrow> mul_state\<Rightarrow> nat" where
-"mul_imp_time t s = 
-(
-    (if mul_b s \<noteq> 0 then \<comment> \<open>While b \<noteq> 0\<close>
-      (
-        let
-          t = t + 1; \<comment> \<open>To account for while loop condition checking\<close>
-          mul_d = (mul_b s) mod 2::nat;
-          t = t + 2;
-          mul_c = (if mul_d \<noteq> 0 then mul_c s + mul_a s else mul_c s);
-          t = t + 1 + (if mul_d \<noteq> 0 then 2 else 2);
-          mul_a = mul_a s + mul_a s;
-          t = t + 2;
-          mul_b = mul_b s div 2;
-          t = t + 2;
-          next_iteration = mul_imp_time t (mul_state_upd s)
-        in
-          next_iteration
-      )
-    else
-      (
-         \<comment> \<open>To account for the two steps of checking the condition and skipping the loop\<close>
-        let
-          t = t + 2;
-          ret = t
-        in
-          ret
-      )
-    )
-)"
-  by pat_completeness auto
-termination
-  by  (relation "measure (\<lambda>(t, s). mul_b s)") (auto simp: mul_state_upd_def Let_def split: if_splits)
-
-lemmas [simp del] = mul_imp_time.simps
-
-lemma mul_imp_time_acc: "(mul_imp_time (Suc t) s) = Suc (mul_imp_time t s)"
-  by (induction t s arbitrary:  rule: mul_imp_time.induct)
-     (auto simp add: mul_imp_time.simps mul_state_upd_def Let_def eval_nat_numeral split: if_splits)
-
-definition mul_IMP_minus where
-"mul_IMP_minus \<equiv>
-  (\<comment> \<open>if b \<noteq> 0 then\<close>
-   WHILE ''b''\<noteq>0 DO
-        \<comment> \<open>d = b mod 2;\<close>
-        (''d'' ::= ((V ''b'') \<doteq>1);;
-        \<comment> \<open>c = (if d \<noteq> 0 then c + a else c);\<close>
-        IF ''d''\<noteq>0 THEN ''c'' ::= ((V ''c'') \<oplus> (V ''a'')) ELSE ''c'' ::= A (V ''c'');;
-        \<comment> \<open>a = a + a;\<close>
-        ''a'' ::= ((V ''a'') \<oplus> (V ''a''));;
-        \<comment> \<open>b = b div 2;\<close>
-        ''b'' ::= ((V ''b'') \<then>))
-  )"
-
-(*definition mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p s \<equiv>
-  state_transformer p  
-    [(''a'', mul_a s),(''b'',  mul_b s),(''c'',  mul_c s),(''d'', mul_d s)]"*)
-
-definition "mul_imp_to_HOL_state p s =
-  \<lparr>mul_a = s (add_prefix p ''a''), mul_b = (s (add_prefix p ''b'')),
-   mul_c = (s (add_prefix p ''c''))\<rparr>"
-
-lemma mul_imp_to_HOL_state_add_prefix: 
-  "mul_imp_to_HOL_state (add_prefix p1 p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix p1))"
-  by (auto simp: mul_imp_to_HOL_state_def)
-
-lemma mul_imp_to_HOL_state_add_prefix':
-  "mul_imp_to_HOL_state (x # p2) s = mul_imp_to_HOL_state p2 (s o (add_prefix [x]))"
-  by (auto simp: mul_imp_to_HOL_state_def)
-
-lemma mul_IMP_minus_correct_time:
-  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> t = (mul_imp_time 0 (mul_imp_to_HOL_state p s))"
-  apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
-  apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
-  apply(erule While_tE)
-   apply(subst mul_imp_time.simps)
-   apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def)[1]
-  apply(dest_com')
-  apply(erule Seq_tE)+
-  apply(erule If_tE)
-   apply(drule AssignD)+
-   apply(elim conjE)
-   apply(subst mul_imp_time.simps)
-   apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def mul_state_upd_def)[1]
-  apply(subst mul_imp_time.simps)
-  apply(auto simp: mul_imp_time_acc mul_imp_to_HOL_state_def mul_state_upd_def)[1]
-  done
-
-lemma mul_IMP_minus_correct_function:
-  "(invoke_subprogram p mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> s' (add_prefix p ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state p s))"
-  apply(induction "mul_imp_to_HOL_state p s" arbitrary: s s' t rule: mul_imp.induct)
-  apply(simp only: mul_IMP_minus_def com_add_prefix.simps)
-  apply(erule While_tE)
-   apply(subst mul_imp.simps)
-   apply(auto simp: mul_imp_to_HOL_state_def)[1]
-  apply(dest_com')
-  apply(erule Seq_tE)+
-  apply(erule If_tE)
-   apply(drule AssignD)+
-   apply(elim conjE)
-   apply(subst mul_imp.simps mul_imp_time.simps)
-   apply(auto simp: mul_imp_to_HOL_state_def mul_state_upd_def)[1]
-  apply(subst mul_imp.simps mul_imp_time.simps)
-  apply(auto simp: mul_imp_to_HOL_state_def mul_state_upd_def)[1]
-  done
-
-lemma mul_IMP_minus_correct_effects:
-  "(invoke_subprogram (p @ mul_pref) mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow> p @ v \<in> vars \<Longrightarrow> \<not> (set mul_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
-  using com_add_prefix_valid_subset com_only_vars
-  by blast
-
-lemma mul_IMP_minus_correct:
-  "\<lbrakk>(invoke_subprogram (p1 @ p2) mul_IMP_minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
-     \<lbrakk>t = (mul_imp_time 0 (mul_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) ''c'') = mul_c (mul_imp (mul_imp_to_HOL_state (p1 @ p2) s));
-      \<And>v. p1 @ v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v) \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
-     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
-  using mul_IMP_minus_correct_time mul_IMP_minus_correct_function mul_IMP_minus_correct_effects
-  by auto
-
 end
\ No newline at end of file
diff --git a/IMP-/ROOT b/IMP-/ROOT
index 0c9f5bd3..d7166a3c 100644
--- a/IMP-/ROOT
+++ b/IMP-/ROOT
@@ -1,6 +1,6 @@
 chapter Poly_Reductions
 
-session IMP_Minus = HOL + 
+session IMP_Minus = "HOL-Eisbach" + 
   theories
     Com
     Big_StepT

From 1485c7b8cc75a0692ba94bb64444c9d708c0baeb Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Fri, 24 Dec 2021 19:58:39 +0100
Subject: [PATCH 102/103] Added some comment

---
 Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
index 45989287..72df4cb5 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
@@ -1472,6 +1472,9 @@ lemma append_imp_time_acc_2: "(append_imp_time x s) = x + (append_imp_time 0 s)"
      (auto simp add: append_imp_time_acc append_state_upd_def Let_def eval_nat_numeral split: if_splits)
 
 
+\<comment> \<open>The following separation is due to parsing time, whic grows exponentially in the length of IMP-
+    programs.\<close>
+
 abbreviation "append_IMP_Minus_1 \<equiv>
         \<comment> \<open>hd_xs' = append_xs s;\<close>
         ((hd_prefix @ hd_xs_str) ::= (A (V append_xs_str)));;

From 3a7e65b11364cd9b4be99f295271b92ab98f744d Mon Sep 17 00:00:00 2001
From: "mohammad.abdulaziz" <mohammad.abdulaziz8@gmail.com>
Date: Sun, 26 Dec 2021 09:46:57 +0100
Subject: [PATCH 103/103] N-th bit + slightly better infrastructure

---
 .../IMP-_To_IMP--/Binary_Arithmetic_IMP.thy   | 886 ++++++++++--------
 .../IMP-_To_IMP--/Binary_Arithmetic_Nat.thy   |  16 +-
 .../IMP-_To_IMP--/Primitives_IMP_Minus.thy    | 339 ++++++-
 IMP-/Big_StepT.thy                            |  48 +-
 IMP-/Call_By_Prefixes.thy                     |   3 +
 5 files changed, 917 insertions(+), 375 deletions(-)

diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
index 677c63ea..62e66af1 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy
@@ -1,386 +1,540 @@
 theory Binary_Arithmetic_IMP 
-  imports "../../../IMP-/IMP_Minus_Nat_Bijection"  Binary_Arithmetic_Nat
+  imports Primitives_IMP_Minus  Binary_Arithmetic_Nat IMP_Minus.Com
 begin
 
-unbundle IMP_Minus_Minus_Com.no_com_syntax
-unbundle Com.no_com_syntax
-
-
-fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_bit_of_num_nat x n  = 
-  (if x = 0 then
-    (if n = 0 then
-       1
-     else
-       0)
-   else
-     if n = 0 then
-       (if hd_nat x = 0 then
-          0
-        else
-          1)
-     else
-        nth_bit_of_num_nat (tl_nat x) (n-1)
-   )"
-
-fun nth_bit_of_num_nat_imp :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_bit_of_num_nat_imp x n  = 
-(
-  let
-    next_iteration = (0::nat)
-  in
-    (if x \<noteq> 0 then
-       if n \<noteq> 0 then
-         (let
-            x = tl_nat x;
-            n = n - 1;
-            next_iteration = nth_bit_of_num_nat x n
-          in 
-            next_iteration
-         )
-       else
-         let
-           hd_x = hd_nat x
-         in
-           (if hd_x \<noteq> 0 then
-             (let
-                ret = 1
-              in 
-                ret
-             )
-            else
-             (let
-                ret = 0
-              in 
-                ret
-             )
-           )
-     else
-       if n \<noteq> 0 then
-         (let
-            ret = 0
-          in 
-            ret
-         )
-       else
-         (let
-            ret = 1
-          in 
-            ret
-         )
-     )
-)"
-
-lemma nth_bit_of_num_nat_imp_correct:
-  "nth_bit_of_num_nat x n = nth_bit_of_num_nat_imp x n"
-  by (auto simp: Let_def)
-
-
-(* [''tl''] ''xs'' ::=  (A ( V ''x'')) ;;
-   invoke_subprogram ''tl'' tl_IMP;;
-   ''x'' ::= [''tl''] (A (V ''ans''));;
-   [''tl''] ''ans'' ::= A (N 0);;
-   ''n'' ::= (V ''n'' \<ominus> N 1 );; 
-   IF ''x''\<noteq>0 THEN 
-        (IF ''n''\<noteq>0 THEN ''b''::= A (N 1) ELSE ''b''::= A (N 0)) 
-        ELSE ''b''::= A (N 0) 
-   
-*)
-
-term invoke_subprogram
-
-abbreviation "invoke_program_1 pfx prog input1 output \<equiv>
-          [pfx] ''input1'' ::=  (A ( V input1)) ;;
-          invoke_subprogram pfx tl_IMP;;
-          output ::= [pfx] (A (V ''ans''));;
-          [pfx] ''ans'' ::= A (N 0)
+subsection \<open>N-th bit of Natural Number\<close>
+
+fun nth_bit_of_num_nat' :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
+  "nth_bit_of_num_nat' x n  = (if x \<noteq> 0 then 
+                              (if n \<noteq> 0 then
+                                nth_bit_of_num_nat' (tl_nat x) (n-1)
+                               else
+                                (if hd_nat x \<noteq> 0 then
+                                   1 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>
+                                 else
+                                   0 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>))
+                            else
+                              (if n \<noteq> 0 then
+                                 0 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>
+                               else
+                                 1 \<comment> \<open>x = 0 \<and> n = 0\<close>)
+                              )"
+
+lemma nth_bit_of_num_nat'_correct:
+  "(nth_bit_of_num_nat' x n) = (nth_bit_of_num_nat x n)"
+proof (induction x n rule: nth_bit_of_num_nat.induct)
+  case (1 s)
+  then show ?case
+    apply(subst nth_bit_of_num_nat.simps)
+    apply(subst nth_bit_of_num_nat'.simps)
+    by (auto simp: Let_def split: if_splits)
+qed 
+
+record nth_bit_of_num_state = nth_bit_of_num_x::nat nth_bit_of_num_n::nat nth_bit_of_num_ret::nat
+
+abbreviation "nth_bit_of_num_prefix \<equiv> ''nth_bit_of_num.''"
+abbreviation "nth_bit_of_num_x_str \<equiv> ''x''"
+abbreviation "nth_bit_of_num_n_str \<equiv> ''n''"
+abbreviation "nth_bit_of_num_ret_str \<equiv> ''ret''"
+
+definition "nth_bit_of_num_state_upd s \<equiv>
+      let
+        tl_xs' = nth_bit_of_num_x s;
+        tl_ret' = 0;
+        tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;
+        tl_ret_state = tl_imp tl_state;
+        nth_bit_of_num_x' = tl_ret tl_ret_state;
+        nth_bit_of_num_n' = nth_bit_of_num_n s - 1;
+        ret = \<lparr>nth_bit_of_num_x = nth_bit_of_num_x', nth_bit_of_num_n = nth_bit_of_num_n', nth_bit_of_num_ret = nth_bit_of_num_ret s\<rparr>
+      in
+        ret
 "
 
-
-definition nth_bit_of_num_iteration::pcom  where "nth_bit_of_num_iteration \<equiv>
-     ''next_iteration'' ::= A (N 0);;
-     IF ''x''\<noteq>0 THEN
-       IF ''n''\<noteq>0 THEN
-            invoke_program_1 ''tl'' tl_IMP ''x'' ''x'';;
-            ''n'' ::= (V ''n'' \<ominus> N 1 );;
-            ''next_iteration'' ::= A(N 1)
-       ELSE
-            invoke_program_1 ''hd'' hd_IMP ''x'' ''hd_x'';;
-            IF ''hd_x''\<noteq>0 THEN
-                ''ret'' ::= A (N 1)
-            ELSE
-                ''ret'' ::= A (N 0)
-     ELSE
-       IF ''n''\<noteq>0 THEN
-            ''ret'' ::= A (N 0)
-       ELSE
-            ''ret'' ::= A (N 1)
+definition 
+  "nth_bit_of_num_imp_compute_loop_condition s \<equiv>
+  (let
+     AND_neq_zero_a' = nth_bit_of_num_x s;
+     AND_neq_zero_b' = nth_bit_of_num_n s;
+     AND_neq_zero_ret' = 0;
+     AND_neq_zero_state = \<lparr>AND_neq_zero_a = AND_neq_zero_a', AND_neq_zero_b = AND_neq_zero_b', AND_neq_zero_ret = AND_neq_zero_ret'\<rparr>;
+     AND_neq_zero_state_ret = AND_neq_zero_imp AND_neq_zero_state;
+     condition = AND_neq_zero_ret (AND_neq_zero_state_ret)
+  in
+     condition)"
+
+definition 
+  "nth_bit_of_num_imp_after_loop s \<equiv>
+       (let
+          hd_xs' = nth_bit_of_num_x s;
+          hd_ret' = 0;
+          hd_state = \<lparr>hd_xs = hd_xs', hd_ret = hd_ret'\<rparr>;
+          hd_state_ret = hd_imp hd_state;
+          hd_x = hd_ret hd_state_ret;
+          nth_bit_of_num_ret' = 
+                           (if nth_bit_of_num_x s \<noteq> 0 then 
+                              ((if hd_x \<noteq> 0 then
+                                   1 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>
+                                 else
+                                   0 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>))
+                            else
+                              (if nth_bit_of_num_n s \<noteq> 0 then
+                                 0 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>
+                               else
+                                 1 \<comment> \<open>x = 0 \<and> n = 0\<close>)
+                              );
+          ret = \<lparr>nth_bit_of_num_x = nth_bit_of_num_x s, nth_bit_of_num_n = nth_bit_of_num_n s,
+                 nth_bit_of_num_ret = nth_bit_of_num_ret'\<rparr>
+        in
+          ret)"
+
+
+function nth_bit_of_num_imp:: "nth_bit_of_num_state \<Rightarrow> nth_bit_of_num_state" where
+  "nth_bit_of_num_imp s = 
+  (
+    (if nth_bit_of_num_imp_compute_loop_condition s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>
+      (
+        let
+          next_iteration = nth_bit_of_num_imp (nth_bit_of_num_state_upd s)
+        in
+          next_iteration
+      )
+    else
+      (
+        let
+          ret = nth_bit_of_num_imp_after_loop s
+        in
+          ret
+      )
+    )
+)"
+  by pat_completeness auto
+termination
+  by (relation "measure (\<lambda>s. nth_bit_of_num_n s)")
+    (auto simp: nth_bit_of_num_imp_compute_loop_condition_def AND_neq_zero_imp_correct tl_imp_correct nth_bit_of_num_state_upd_def Let_def split: if_splits)
+
+lemmas nth_bit_of_num_imp_subprogram_simps = 
+  nth_bit_of_num_imp_after_loop_def nth_bit_of_num_state_upd_def
+  nth_bit_of_num_imp_compute_loop_condition_def 
+
+declare nth_bit_of_num_imp.simps [simp del]
+
+lemma nth_bit_of_num_imp_correct:
+  "nth_bit_of_num_ret (nth_bit_of_num_imp s) = nth_bit_of_num_nat (nth_bit_of_num_x s) (nth_bit_of_num_n s)"
+proof (induction s rule: nth_bit_of_num_imp.induct)
+  case (1 s)
+  then show ?case
+    apply(subst nth_bit_of_num_imp.simps)
+    apply(subst nth_bit_of_num_nat.simps)
+    by (auto simp del: nth_bit_of_num_nat.simps
+        simp add: nth_bit_of_num_imp_after_loop_def 
+        nth_bit_of_num_imp_compute_loop_condition_def
+        tl_imp_correct hd_imp_correct AND_neq_zero_imp_correct
+        nth_bit_of_num_state_upd_def Let_def
+        split: if_splits)
+qed 
+
+
+definition "nth_bit_of_num_state_upd_time t s \<equiv>
+      let
+        tl_xs' = nth_bit_of_num_x s;
+        t = t + 2;
+        tl_ret' = 0;
+        t = t + 2;
+        tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;
+        tl_ret_state = tl_imp tl_state;
+        t = t + tl_imp_time 0 tl_state;
+        nth_bit_of_num_x' = tl_ret tl_ret_state;
+        t = t + 2;
+        nth_bit_of_num_n' = nth_bit_of_num_n s - 1;
+        t = t + 2;
+        ret = t
+      in
+        ret
 "
 
-definition nth_bit_of_num_loop :: "pcom" where 
-"nth_bit_of_num_loop \<equiv> WHILE ''b''\<noteq>0 DO nth_bit_of_num_iteration"
-
-lemma tl_nat_le: "tl_nat x \<le> x"
-  sorry
-
-function (sequential) nth_bit_of_num_loop_t':: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_bit_of_num_loop_t' 0 _ _  = 2 "|
-"nth_bit_of_num_loop_t' (Suc b) x n  = (let
-  x' = tl_nat x; n' = n - 1; b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
-in
-  b' + (nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t' b' x' n')) "
-  by pat_completeness simp_all
-termination (* Proof proceeds by noticing that the sum of the three arguments is always decreasing, rest is hammering *)
-  by(relation "measure (\<lambda>(b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le)
-
-
-function (sequential) nth_bit_of_num_loop_state_transformer' ::
-    "char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where
-  "nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
-  "nth_bit_of_num_loop_state_transformer' p b x n = (let
-    x' = tl_nat x; n' = n-1;
-    b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
+definition 
+  "nth_bit_of_num_imp_compute_loop_condition_time t s \<equiv>
+  (let
+     AND_neq_zero_a' = nth_bit_of_num_x s;
+     t = t + 2;
+     AND_neq_zero_b' = nth_bit_of_num_n s;
+     t = t + 2;
+     AND_neq_zero_ret' = 0;
+     t = t + 2;
+     AND_neq_zero_state = \<lparr>AND_neq_zero_a = AND_neq_zero_a', AND_neq_zero_b = AND_neq_zero_b', AND_neq_zero_ret = AND_neq_zero_ret'\<rparr>;
+     AND_neq_zero_state_ret = AND_neq_zero_imp AND_neq_zero_state;
+     t = t + AND_neq_zero_imp_time 0 AND_neq_zero_state;
+     condition = AND_neq_zero_ret AND_neq_zero_state_ret;
+     t = t + 2;
+     ret = t
   in
-    nth_bit_of_num_iteration_state_transformer p x n o nth_bit_of_num_loop_state_transformer' p b' x' n')"
- by pat_completeness simp_all
-termination (* Proof proceeds by noticing that the sum of the last three arguments is always decreasing, rest is hammering *)
-  by (relation "measure (\<lambda>(p, b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le) 
-
+     t)"
+
+definition 
+  "nth_bit_of_num_imp_after_loop_time t s \<equiv>
+       (let
+          hd_xs' = nth_bit_of_num_x s;
+          t = t + 2;
+          hd_ret' = 0;
+          t = t + 2;
+          hd_state = \<lparr>hd_xs = hd_xs', hd_ret = hd_ret'\<rparr>;
+          hd_state_ret = hd_imp hd_state;
+          t = t + hd_imp_time 0 hd_state;
+          hd_x = hd_ret hd_state_ret;
+          t = t + 2;
+          nth_bit_of_num_ret'::nat = 
+                           (if nth_bit_of_num_x s \<noteq> 0 then 
+                              ((if hd_x \<noteq> 0 then
+                                   1 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>
+                                 else
+                                   0 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>))
+                            else
+                              (if nth_bit_of_num_n s \<noteq> 0 then
+                                 0 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>
+                               else
+                                 1 \<comment> \<open>x = 0 \<and> n = 0\<close>)
+                              );
+          t = t + 1 +
+                           (if nth_bit_of_num_x s \<noteq> 0 then 
+                              (1 +
+                               (if hd_x \<noteq> 0 then
+                                  2 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>
+                                else
+                                  2 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>))
+                            else
+                              1 + 
+                              (if nth_bit_of_num_n s \<noteq> 0 then
+                                 2 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>
+                               else
+                                 2 \<comment> \<open>x = 0 \<and> n = 0\<close>)
+                              );
+          ret = t
+        in
+          ret
+)"
 
-definition nth_bit_of_num_if ::pcom where "nth_bit_of_num_if \<equiv>
- IF ''x''\<noteq>0 THEN 
-        (IF ''n''\<noteq>0 THEN ''b''::= A (N 1) ELSE ''b''::= A (N 0)) 
-        ELSE ''b''::= A (N 0) 
-"
 
-abbreviation nth_bit_of_num_if_state_transformer 
-  where "nth_bit_of_num_if_state_transformer p x n \<equiv>
-    state_transformer p [(''b'',if x >0 \<and> n>0 then 1 else 0)]
+function nth_bit_of_num_imp_time:: "nat \<Rightarrow> nth_bit_of_num_state \<Rightarrow> nat" where
+  "nth_bit_of_num_imp_time t s = 
+  nth_bit_of_num_imp_compute_loop_condition_time 0 s+
+   (
+    (if nth_bit_of_num_imp_compute_loop_condition s \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>
+      (
+        let
+          t = t + 1; \<comment> \<open>While condition true\<close>
+          next_iteration = 
+           nth_bit_of_num_imp_time (t + 
+                                    nth_bit_of_num_state_upd_time 0 s) (nth_bit_of_num_state_upd s)
+        in
+          next_iteration
+      )
+    else
+      (
+        let
+          t = t + 2; \<comment> \<open>skipping while loop as it is false\<close>
+          ret = t + nth_bit_of_num_imp_after_loop_time 0 s
+        in
+          ret
+      )
+    )
+)"
+  by pat_completeness auto
+termination
+  by (relation "measure (\<lambda>(t, s). nth_bit_of_num_n s)")
+    (auto simp: nth_bit_of_num_imp_compute_loop_condition_def
+      AND_neq_zero_imp_correct tl_imp_correct
+      nth_bit_of_num_state_upd_def Let_def
+      split: if_splits)
+
+
+lemmas nth_bit_of_num_imp_subprogram_time_simps = nth_bit_of_num_imp_subprogram_simps
+  nth_bit_of_num_imp_after_loop_time_def nth_bit_of_num_state_upd_time_def
+  nth_bit_of_num_imp_compute_loop_condition_time_def 
+
+
+lemmas [simp del] = nth_bit_of_num_imp_time.simps
+
+lemma nth_bit_of_num_imp_time_acc: "(nth_bit_of_num_imp_time (Suc t) s) = Suc (nth_bit_of_num_imp_time t s)"
+  apply (induction t s arbitrary:  rule: nth_bit_of_num_imp_time.induct)
+  apply(subst nth_bit_of_num_imp_time.simps)
+  apply(subst (2) nth_bit_of_num_imp_time.simps)
+  apply (auto simp add: nth_bit_of_num_imp_compute_loop_condition_time_def
+      nth_bit_of_num_imp_after_loop_time_def
+      nth_bit_of_num_state_upd_time_def
+      nth_bit_of_num_state_upd_def Let_def eval_nat_numeral 
+      split: if_splits)
+  done
+
+lemma nth_bit_of_num_imp_time_acc_2: "(nth_bit_of_num_imp_time x s) = x + (nth_bit_of_num_imp_time 0 s)"
+  by (induction x arbitrary: s)
+    (auto simp add: nth_bit_of_num_imp_time_acc nth_bit_of_num_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+lemma nth_bit_of_num_imp_time_acc_2_simp: 
+  "(nth_bit_of_num_imp_time (nth_bit_of_num_state_upd_time 0 s) s') =
+   (nth_bit_of_num_state_upd_time 0 s) + (nth_bit_of_num_imp_time 0 s')"
+  by (rule nth_bit_of_num_imp_time_acc_2)
+
+\<comment> \<open>The following separation is due to parsing time, whic grows exponentially in the length of IMP-
+    programs.\<close>
+
+abbreviation "nth_bit_of_num_while_cond \<equiv> ''condition''"
+
+definition "nth_bit_of_num_IMP_init_while_cond \<equiv>
+     \<comment> \<open>AND_neq_zero_a' = nth_bit_of_num_x s;\<close>
+     (AND_neq_zero_prefix @ AND_neq_zero_a_str) ::= (A (V nth_bit_of_num_x_str));;
+     \<comment> \<open>AND_neq_zero_b' = nth_bit_of_num_n s;\<close>
+     (AND_neq_zero_prefix @ AND_neq_zero_b_str) ::= (A (V nth_bit_of_num_n_str));;
+     \<comment> \<open>AND_neq_zero_ret' = 0;\<close>
+     (AND_neq_zero_prefix @ AND_neq_zero_ret_str) ::= (A (N 0));;
+     \<comment> \<open>AND_neq_zero_state = \<lparr>AND_neq_zero_a = AND_neq_zero_a', AND_neq_zero_b = AND_neq_zero_b', AND_neq_zero_ret = AND_neq_zero_ret'\<rparr>;\<close>
+     \<comment> \<open>AND_neq_zero_state_ret = AND_neq_zero_imp AND_neq_zero_state;\<close>
+     invoke_subprogram AND_neq_zero_prefix AND_neq_zero_IMP_Minus;;
+     \<comment> \<open>condition = AND_neq_zero_ret (AND_neq_zero_state_ret)\<close>
+     (nth_bit_of_num_while_cond) ::= (A (V (AND_neq_zero_prefix @ AND_neq_zero_ret_str)))
 "
 
-fun nth_bit_of_num_if_time :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"nth_bit_of_num_if_time 0 _ = 3"|
-"nth_bit_of_num_if_time _ _ = 4"
-
-lemma nth_bit_of_num_if_correct[intro]:
-"\<lbrakk> s (add_prefix p ''x'')= x ; s (add_prefix p ''n'') = n  \<rbrakk> \<Longrightarrow>
-(nth_bit_of_num_if p, s) \<Rightarrow>\<^bsup>nth_bit_of_num_if_time x n \<^esup>
-nth_bit_of_num_if_state_transformer p x n s "
-  unfolding nth_bit_of_num_if_def 
-  apply (cases x;cases n)
-     apply (rule Big_StepT.IfFalse)
-       apply simp
-      apply (rule terminates_in_time_state_intro)
-        apply blast
-       apply simp
-      apply simp
-     apply simp
- apply (rule Big_StepT.IfFalse)
-       apply simp
-      apply (rule terminates_in_time_state_intro)
-        apply blast
-       apply simp
-      apply simp
-    apply simp
-   apply (rule Big_StepT.IfTrue)
-     apply simp
-    apply (rule Big_StepT.IfFalse)
-      apply simp
-        apply (rule terminates_in_time_state_intro)
-       apply fast
-      apply fast
-     apply force
-    apply simp
-   apply simp
-      apply (rule Big_StepT.IfTrue)
-    apply simp
-            apply (rule Big_StepT.IfTrue)
-     apply simp
-              apply (rule terminates_in_time_state_intro)
-  apply blast
-     apply simp
-    apply simp
-  apply simp
-  by simp
-  
-definition nth_bit_of_num_iteration::pcom  where "nth_bit_of_num_iteration \<equiv>
-  [''tl''] ''xs'' ::=  (A ( V ''x'')) ;;
-   invoke_subprogram ''tl'' tl_IMP;;
-   ''x'' ::= [''tl''] (A (V ''ans''));;
-   [''tl''] ''ans'' ::= A (N 0);;
-   ''n'' ::= (V ''n'' \<ominus> N 1 );; 
-    nth_bit_of_num_if
+definition "nth_bit_of_num_IMP_loop_body \<equiv>
+      \<comment> \<open>(\<close>
+        \<comment> \<open>let\<close>
+          \<comment> \<open>tl_xs' = nth_bit_of_num_x s;\<close>
+          (tl_prefix @ tl_xs_str) ::= (A (V nth_bit_of_num_x_str));;
+          \<comment> \<open>tl_ret' = 0;\<close>
+          (tl_prefix @ tl_ret_str) ::= (A (N 0));;
+          \<comment> \<open>tl_state = \<lparr>tl_xs = tl_xs', tl_ret = tl_ret'\<rparr>;\<close>
+          \<comment> \<open>tl_ret_state = tl_imp tl_state;\<close>
+          invoke_subprogram tl_prefix tl_IMP_Minus;;
+          \<comment> \<open>nth_bit_of_num_x' = tl_ret tl_ret_state;\<close>
+          (nth_bit_of_num_x_str ::= (A (V (tl_prefix @ tl_ret_str))));;
+          \<comment> \<open>nth_bit_of_num_n' = nth_bit_of_num_n s - 1;\<close>
+          (nth_bit_of_num_n_str ::= ((V nth_bit_of_num_n_str \<ominus> (N 1))))
+          \<comment> \<open>next_iteration = nth_bit_of_num_imp (nth_bit_of_num_state_upd s)\<close>
+        \<comment> \<open>in\<close>
+          \<comment> \<open>next_iteration\<close>
+      \<comment> \<open>)\<close>
 "
 
-definition nth_bit_of_num_iteration_t :: "nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"nth_bit_of_num_iteration_t x n = 8 + tl_time x + nth_bit_of_num_if_time (tl_nat x) (n-1)"
-
-abbreviation nth_bit_of_num_iteration_state_transformer 
-  where "nth_bit_of_num_iteration_state_transformer p x n \<equiv>
-     nth_bit_of_num_if_state_transformer p (tl_nat x) (n-1) o  state_transformer (''tl'' @ p) [( ''ans'', 0)] o
- tl_state_transformer (''tl'' @ p) x o  state_transformer p [(''x'', tl_nat x),(''n'',n-1)] 
+abbreviation "hd_x \<equiv> ''hd_x''"
+
+definition "nth_bit_of_num_IMP_after_loop \<equiv>
+          \<comment> \<open>hd_xs' = nth_bit_of_num_x s;\<close>
+          (hd_prefix @ hd_xs_str) ::= (A (V nth_bit_of_num_x_str));;
+          \<comment> \<open>hd_ret' = 0;\<close>
+          (hd_prefix @ hd_ret_str) ::= (A (N 0));;
+          \<comment> \<open>hd_state = \<lparr>hd_xs = hd_xs', hd_ret = hd_ret'\<rparr>;\<close>
+          \<comment> \<open>hd_state_ret = hd_imp hd_state;\<close>
+          \<comment> \<open>hd_x = hd_ret hd_state_ret;\<close>
+          invoke_subprogram hd_prefix hd_IMP_Minus;;
+          (hd_x) ::= (A (V (hd_prefix @ hd_ret_str)));;
+          \<comment> \<open>nth_bit_of_num_ret' = \<close>
+                           \<comment> \<open>(if nth_bit_of_num_x s \<noteq> 0 then \<close>
+                           IF nth_bit_of_num_x_str \<noteq>0 THEN
+                              \<comment> \<open>((if hd_ret hd_state_ret \<noteq> 0 then\<close>
+                              IF hd_x \<noteq>0 THEN
+                                   \<comment> \<open>1 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>\<close>
+                                   nth_bit_of_num_ret_str ::= (A (N 1))
+                                 \<comment> \<open>else\<close>
+                                 ELSE
+                                   \<comment> \<open>0 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>))\<close>
+                                   nth_bit_of_num_ret_str ::= (A (N 0))
+                            \<comment> \<open>else\<close>
+                            ELSE
+                              \<comment> \<open>(if nth_bit_of_num_n s \<noteq> 0 then\<close>
+                              IF nth_bit_of_num_n_str \<noteq>0 THEN
+                                 \<comment> \<open>0 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>\<close>
+                                 nth_bit_of_num_ret_str ::= (A (N 0))
+                               \<comment> \<open>else\<close>
+                               ELSE
+                                 \<comment> \<open>1 \<comment> \<open>x = 0 \<and> n = 0\<close>)\<close>
+                                 nth_bit_of_num_ret_str ::= (A (N 1))
+                              \<comment> \<open>);\<close>
 "
-value "nth_bit_of_num_iteration_state_transformer"
-lemma nth_bit_of_num_iteration_correct[intro]:
- " s (add_prefix p ''x'') = x \<Longrightarrow> s (add_prefix p ''n'') = n \<Longrightarrow>
-(nth_bit_of_num_iteration p,s)  \<Rightarrow>\<^bsup>nth_bit_of_num_iteration_t x n \<^esup> 
-nth_bit_of_num_iteration_state_transformer p x n s"
-  unfolding nth_bit_of_num_iteration_def nth_bit_of_num_iteration_t_def
-  apply (rule terminates_in_time_state_intro)
-    apply (rule Big_StepT.Seq)+
-              apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
- apply fastforce
-   apply fastforce
-by fastforce
-  
-  
-
-
-
-
-definition nth_bit_of_num_loop :: "pcom" where 
-"nth_bit_of_num_loop \<equiv> WHILE ''b''\<noteq>0 DO nth_bit_of_num_iteration"
 
-lemma tl_nat_le: "tl_nat x \<le> x"
-  sorry
-
-function (sequential) nth_bit_of_num_loop_t':: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_bit_of_num_loop_t' 0 _ _  = 2 "|
-"nth_bit_of_num_loop_t' (Suc b) x n  = (let
-  x' = tl_nat x; n' = n - 1; b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
-in
-  b' + (nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t' b' x' n')) "
-  by pat_completeness simp_all
-termination (* Proof proceeds by noticing that the sum of the three arguments is always decreasing, rest is hammering *)
-  by(relation "measure (\<lambda>(b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le)
-
-
-function (sequential) nth_bit_of_num_loop_state_transformer' ::
-    "char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where
-  "nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
-  "nth_bit_of_num_loop_state_transformer' p b x n = (let
-    x' = tl_nat x; n' = n-1;
-    b' = (if x'>0 \<and> n'>0 then Suc 0 else 0)
-  in
-    nth_bit_of_num_iteration_state_transformer p x n o nth_bit_of_num_loop_state_transformer' p b' x' n')"
- by pat_completeness simp_all
-termination (* Proof proceeds by noticing that the sum of the last three arguments is always decreasing, rest is hammering *)
-  by (relation "measure (\<lambda>(p, b, x, n) . b+x+n)") (auto simp add: add.commute add_increasing le_imp_less_Suc tl_nat_le) 
-
-fun nth_bit_of_num_loop_t:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where 
-"nth_bit_of_num_loop_t 0 _ _  = 2 "|
-"nth_bit_of_num_loop_t (Suc b) x n  = (let x' = tl_nat x; 
-n' = n - 1 
-in ( if x'>0 \<and> n'>0 then 1 + nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t (Suc 0) x' n'
-else 1 + nth_bit_of_num_iteration_t x n + nth_bit_of_num_loop_t 0 x' n'
-) ) "
-
-fun nth_bit_of_num_loop_state_transformer ::
-"char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where 
-"nth_bit_of_num_loop_state_transformer p 0 x n = id "|
-"nth_bit_of_num_loop_state_transformer p (Suc b) x n = (let x' = tl_nat x; n' = n-1;
-iteration = nth_bit_of_num_iteration_state_transformer p x n  in 
-(if x'>0 \<and> n'>0 then nth_bit_of_num_loop_state_transformer p (Suc 0) x' n' o iteration else
-nth_bit_of_num_loop_state_transformer p 0 x' n' o iteration
- ))"
-
-lemma "
-(nth_bit_of_num_iteration_state_transformer p (tl_nat x) (n-1) o
-     nth_bit_of_num_iteration_state_transformer p x n) s = nth_bit_of_num_iteration_state_transformer p (tl_nat x) (n-1) s 
+definition nth_bit_of_num_IMP_Minus where
+  "nth_bit_of_num_IMP_Minus \<equiv>
+  nth_bit_of_num_IMP_init_while_cond;;
+  \<comment> \<open>in\<close>
+    \<comment> \<open>(if condition \<noteq> 0 then \<comment> \<open>While xs \<noteq> 0\<close>\<close>
+      WHILE nth_bit_of_num_while_cond \<noteq>0 DO(
+        nth_bit_of_num_IMP_loop_body;;
+        nth_bit_of_num_IMP_init_while_cond
+      );;
+    \<comment> \<open>else\<close>
+      \<comment> \<open>(\<close>
+        \<comment> \<open>let\<close>
+        nth_bit_of_num_IMP_after_loop
+          \<comment> \<open>ret = \<lparr>nth_bit_of_num_x = nth_bit_of_num_x s, nth_bit_of_num_n = nth_bit_of_num_n s,\<close>
+                 \<comment> \<open>nth_bit_of_num_ret = nth_bit_of_num_ret'\<rparr>\<close>
+        \<comment> \<open>in\<close>
+          \<comment> \<open>ret\<close>
+      \<comment> \<open>)\<close>
+    \<comment> \<open>)\<close>
 "
-  sledgehammer
-lemma " x' = tl_nat x \<Longrightarrow> n' = n-1 \<Longrightarrow> x>0 \<Longrightarrow> n> 0 \<Longrightarrow>
-             (nth_bit_of_num_loop_state_transformer p (Suc 0) x' n'
-o nth_bit_of_num_iteration_state_transformer p x n ) s = 
-      (nth_bit_of_num_loop_state_transformer p (Suc 0) x' n') s"
-  apply (induction  x' n' arbitrary: x n s rule:nth_bit_of_num_nat.induct)
-  apply auto
-  apply fastforce
-fun nth_bit_of_num_loop_state_transformer' ::
-"char list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> (char list \<Rightarrow> nat) \<Rightarrow> char list \<Rightarrow> nat" where 
-"nth_bit_of_num_loop_state_transformer' p 0 x n = id "|
-"nth_bit_of_num_loop_state_transformer' p b x n = (let x' = tl_nat x; n' = n-1;
-b' = (if x'>0 \<and> n'>0 then Suc 0 else 0); iteration = nth_bit_of_num_iteration_state_transformer p x n
- in 
- iteration o nth_bit_of_num_loop_state_transformer' p b' x' n')"
-
-
-thm Big_StepT.WhileTrue
 
+abbreviation 
+  "nth_bit_of_num_IMP_vars \<equiv>
+  {nth_bit_of_num_x_str, nth_bit_of_num_n_str, nth_bit_of_num_ret_str}"
+
+lemmas nth_bit_of_num_IMP_subprogram_simps = 
+  nth_bit_of_num_IMP_init_while_cond_def nth_bit_of_num_IMP_loop_body_def nth_bit_of_num_IMP_after_loop_def
+
+definition "nth_bit_of_num_imp_to_HOL_state p s =
+  \<lparr>nth_bit_of_num_x = (s (add_prefix p nth_bit_of_num_x_str)), 
+   nth_bit_of_num_n = (s (add_prefix p nth_bit_of_num_n_str)),
+   nth_bit_of_num_ret = (s (add_prefix p nth_bit_of_num_ret_str))\<rparr>"
+
+lemmas nth_bit_of_num_state_translators = tl_imp_to_HOL_state_def hd_imp_to_HOL_state_def
+  AND_neq_zero_imp_to_HOL_state_def
+  nth_bit_of_num_imp_to_HOL_state_def
+
+lemmas nth_bit_of_num_complete_simps =
+  nth_bit_of_num_IMP_subprogram_simps nth_bit_of_num_imp_subprogram_simps
+  nth_bit_of_num_state_translators
+
+lemma nth_bit_of_num_IMP_Minus_correct_function: 
+  "(invoke_subprogram p nth_bit_of_num_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p nth_bit_of_num_ret_str) = nth_bit_of_num_ret (nth_bit_of_num_imp (nth_bit_of_num_imp_to_HOL_state p s))"
+  apply(induction "nth_bit_of_num_imp_to_HOL_state p s" arbitrary: s s' t rule: nth_bit_of_num_imp.induct)
+  apply(subst nth_bit_of_num_imp.simps)
+  apply(simp only: nth_bit_of_num_IMP_Minus_def prefix_simps)
+  apply(erule Seq_tE)+
+  apply(erule While_tE)
+   apply(simp only: nth_bit_of_num_IMP_subprogram_simps prefix_simps)
+   apply(erule Seq_tE)+
+   apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply auto [1]
+   apply(erule If_tE)
+    apply(erule If_tE)
+     apply(drule AssignD)+
+     apply(elim conjE)
+     apply(erule hd_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+      apply auto [1]
+     apply(simp add: nth_bit_of_num_imp_subprogram_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def,
+      force)
+    apply(erule hd_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+     apply auto [1]
+    apply(simp add: nth_bit_of_num_imp_subprogram_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def,
+      force)
+   apply(erule hd_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply auto [1]
+   apply(simp add: nth_bit_of_num_imp_subprogram_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def,
+      force)
+
+  apply(erule Seq_tE)+
+  apply(dest_com_gen)
+    apply(simp only: nth_bit_of_num_IMP_init_while_cond_def prefix_simps)
+    apply(erule Seq_tE)+
+    apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+     apply auto [1]
+    apply(simp add: nth_bit_of_num_complete_simps Let_def, force)
+
+   apply(simp only: nth_bit_of_num_IMP_init_while_cond_def nth_bit_of_num_IMP_loop_body_def prefix_simps)
+   apply(erule Seq_tE)+
+   apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply auto [1]
+   apply(erule tl_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply force [1]
+   apply(simp add: nth_bit_of_num_complete_simps Let_def, force)
+
+  apply(simp only: nth_bit_of_num_IMP_init_while_cond_def nth_bit_of_num_IMP_loop_body_def prefix_simps)
+  apply(erule Seq_tE)+
+  apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+   apply auto [1]
+  apply(erule tl_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+   apply force [1]
+  apply(simp add: nth_bit_of_num_complete_simps Let_def, force)
+  done
+
+text \<open>Debugging lemma\<close>
+
+lemma nth_bit_of_num_IMP_Minus_correct_time_loop_condition:
+  "(invoke_subprogram p nth_bit_of_num_IMP_init_while_cond, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = nth_bit_of_num_imp_compute_loop_condition_time 0 (nth_bit_of_num_imp_to_HOL_state p s)"
+  apply(subst nth_bit_of_num_imp_compute_loop_condition_time_def)
+  apply(simp only: nth_bit_of_num_IMP_init_while_cond_def prefix_simps)
+  apply(erule Seq_tE)+
+  apply(drule AssignD)+
+  apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+   apply auto [1]
+  apply(elim conjE)
+  apply(simp add: nth_bit_of_num_imp_subprogram_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def)
+  done
+
+lemmas nth_bit_of_num_complete_time_simps =
+  nth_bit_of_num_imp_subprogram_time_simps
+  nth_bit_of_num_imp_time_acc
+  nth_bit_of_num_imp_time_acc_2_simp
+
+lemma nth_bit_of_num_IMP_Minus_correct_time:
+  "(invoke_subprogram p nth_bit_of_num_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = nth_bit_of_num_imp_time 0 (nth_bit_of_num_imp_to_HOL_state p s)"
+  apply(induction "nth_bit_of_num_imp_to_HOL_state p s" arbitrary: s s' t rule: nth_bit_of_num_imp.induct)
+  apply(subst nth_bit_of_num_imp_time.simps)
+  apply(simp only: nth_bit_of_num_IMP_Minus_def prefix_simps)
+  apply(erule Seq_tE)+
+  apply(erule While_tE_time)
+   apply(simp only: nth_bit_of_num_IMP_subprogram_simps prefix_simps)
+   apply(erule Seq_tE)+
+   apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply auto [1]
+   apply(erule If_tE)
+    apply(erule If_tE)
+
+     apply(drule AssignD)+
+     apply(elim conjE)
+     apply(erule hd_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+      apply auto [1]
+     apply(subst nth_bit_of_num_imp_time_acc_2)
+     apply(simp add: nth_bit_of_num_imp_subprogram_time_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def, force)
+
+    apply(drule AssignD)+
+    apply(elim conjE)
+    apply(erule hd_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+     apply auto [1]
+    apply(subst nth_bit_of_num_imp_time_acc_2)
+    apply(simp add: nth_bit_of_num_imp_subprogram_time_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def, force)
+
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(erule hd_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply auto [1]
+   apply(subst nth_bit_of_num_imp_time_acc_2)
+   apply(simp add: nth_bit_of_num_imp_subprogram_time_simps nth_bit_of_num_imp_time_acc
+      nth_bit_of_num_state_translators Let_def, force)
+
+
+  apply(erule Seq_tE)+
+  apply(simp add: add.assoc)
+  apply(dest_com_gen_time)
+
+    apply(simp only: nth_bit_of_num_IMP_init_while_cond_def prefix_simps)
+    apply(erule Seq_tE)+
+    apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+     apply auto [1]
+    apply(simp add: nth_bit_of_num_complete_simps Let_def, force)
+
+   apply(simp only: nth_bit_of_num_IMP_init_while_cond_def nth_bit_of_num_IMP_loop_body_def prefix_simps)
+   apply(erule Seq_tE)+
+   apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply auto [1]
+   apply(erule tl_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+    apply force [1]
+   apply(simp add: nth_bit_of_num_complete_simps Let_def, force)
+
+  apply(simp only: nth_bit_of_num_IMP_init_while_cond_def nth_bit_of_num_IMP_loop_body_def prefix_simps)
+  apply(erule Seq_tE)+
+  apply(erule AND_neq_zero_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+  apply auto [1]
+  apply(erule tl_IMP_Minus_correct[where vars = "nth_bit_of_num_IMP_vars"])
+  apply force [1]
+  apply(simp add: nth_bit_of_num_imp_time_acc_2[where x = "tl_imp_time t s" for t s]
+      nth_bit_of_num_complete_time_simps nth_bit_of_num_complete_simps Let_def,
+      force)
+  done
   
-  
-
-lemma 
-"\<lbrakk>s (add_prefix p ''x'') = x ; s (add_prefix p ''n'') = n ; s (add_prefix p ''b'') = b \<rbrakk>
-\<Longrightarrow> (nth_bit_of_num_loop p,s) \<Rightarrow>\<^bsup>nth_bit_of_num_loop_t b x n \<^esup>
-      nth_bit_of_num_loop_state_transformer p b x n s"
-  unfolding nth_bit_of_num_loop_def 
-  apply(induction b x n arbitrary:s rule: nth_bit_of_num_loop_t.induct)
-  apply(rule terminates_in_time_state_intro)
-     apply (rule Big_StepT.WhileFalse)
-     apply simp
-  apply simp
-   apply simp
-      apply(rule terminates_in_time_state_intro)
-    apply (rule Big_StepT.WhileTrue)
-       apply linarith
-      apply auto[1]
-     apply (split if_splits) apply (auto simp only:)
-  oops 
-
-lemma
-"(nth_bit_of_num_loop p,s) \<Rightarrow>\<^bsup>nth_bit_of_num_loop_t (s (add_prefix p ''b''))
- (s (add_prefix p ''x''))
- (s (add_prefix p ''n'')) \<^esup>
-      nth_bit_of_num_loop_state_transformer p (s (add_prefix p ''b'')) (s (add_prefix p ''x''))
-  (s (add_prefix p ''n'')) s"
-  unfolding nth_bit_of_num_loop_def 
-proof(induction "(s (add_prefix p ''b''))" "s (add_prefix p ''x'')" "s (add_prefix p ''n'')" arbitrary:s rule: nth_bit_of_num_loop_t.induct)
-case (1)
-  show ?case 
-  apply(rule terminates_in_time_state_intro)
- apply (rule Big_StepT.WhileFalse)
-   using 1  by auto
-next
-  case (2 v)
-  obtain s' where s'_def: "s' = (state_transformer p
-       [(''b'',
-         if 0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then 1
-         else 0)] \<circ>
-      state_transformer (''tl'' @ p) [(''ans'', 0)] \<circ>
-      tl_state_transformer (''tl'' @ p) (s (add_prefix p ''x'')) \<circ>
-      state_transformer p
-       [(''x'', tl_nat (s (add_prefix p ''x''))), (''n'', s (add_prefix p ''n'') - 1)])
-      s" by simp
-    show ?case 
-      apply(rule terminates_in_time_state_intro [where s'= "if  0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then s1 else s2"  
-     for s1 s2] )
-        apply (rule Big_StepT.WhileTrue[where 
- y= "if  0 < tl_nat (s (add_prefix p ''x'')) \<and> 0 < s (add_prefix p ''n'') - 1 then t1 else t2"  
-     for t1 t2])
-       using 2(3) apply linarith
-           apply rule
-            apply simp
-           apply simp
-       apply(rule terminates_split_if)
-       using 2(1)[of s'] s'_def apply fastforce
-       using 2(2)[of s'] s'_def apply fastforce
-         apply fastforce
-       using 2(3)[symmetric] apply auto[1]
-       apply (smt (z3) One_nat_def less_diff_conv plus_1_eq_Suc) 
-       using 2(3)[symmetric] apply auto
-       apply (auto simp only:Let_def comp_apply)
-       
-qed
-
-thm If_tE
 end 
\ No newline at end of file
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
index 26f25fa2..fe81c2f8 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy
@@ -4,9 +4,19 @@ begin
 
 
 fun nth_bit_of_num_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
-"nth_bit_of_num_nat x n  = (if x = 0 then (if n = 0 then 1 else 0) else
-                            if n = 0 then (if hd_nat x = 0 then 0 else 1) else
-                            nth_bit_of_num_nat (tl_nat x) (n-1)) "
+"nth_bit_of_num_nat x n  = (if x = 0 then 
+                              (if n = 0 then
+                                 1 \<comment> \<open>x = 0 \<and> n = 0\<close>
+                               else
+                                 0 \<comment> \<open>x = 0 \<and> n \<noteq> 0\<close>)
+                            else
+                              if n = 0 then
+                                (if hd_nat x = 0 then
+                                   0 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x = 0\<close>
+                                 else
+                                   1 \<comment> \<open>x \<noteq> 0 \<and> n = 0 \<and> hd_nat x \<noteq> 0\<close>)
+                              else
+                                nth_bit_of_num_nat (tl_nat x) (n-1))"
 
 definition nth_bit_of_num_tail ::"nat \<Rightarrow> nat \<Rightarrow> nat" where 
 "nth_bit_of_num_tail x n =  nth_bit_of_num_nat x n"
diff --git a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
index 72df4cb5..470ba169 100644
--- a/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
+++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy
@@ -1576,12 +1576,349 @@ lemma append_IMP_Minus_correct:
   "\<lbrakk>(invoke_subprogram (p1 @ p2) append_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
     \<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v);
      \<lbrakk>t = (append_imp_time 0 (append_imp_to_HOL_state (p1 @ p2) s));
-      s' (add_prefix (p1 @ p2) append_acc_str) = append_state.append_acc (append_imp (append_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) append_acc_str) = 
+        append_state.append_acc (append_imp (append_imp_to_HOL_state (p1 @ p2) s));
       \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
      \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
   using append_IMP_Minus_correct_time append_IMP_Minus_correct_function
         append_IMP_Minus_correct_effects 
   by auto
 
+subsection \<open>Logical And\<close>
+
+record AND_neq_zero_state = AND_neq_zero_a::nat AND_neq_zero_b::nat AND_neq_zero_ret::nat
+
+abbreviation "AND_neq_zero_prefix \<equiv> ''AND_neq_zero.''"
+abbreviation "AND_neq_zero_a_str \<equiv> ''AND_a''"
+abbreviation "AND_neq_zero_b_str \<equiv> ''AND_b''"
+abbreviation "AND_neq_zero_ret_str \<equiv> ''AND_ret''"
+
+definition "AND_neq_zero_state_upd s \<equiv>
+      let
+        AND_neq_zero_ret' = 
+          (if AND_neq_zero_a s \<noteq> 0 then
+            (if AND_neq_zero_b s \<noteq> 0 then
+               1
+             else
+               0)
+           else
+             0);
+        ret = \<lparr>AND_neq_zero_a = AND_neq_zero_a s, AND_neq_zero_b = AND_neq_zero_b s, AND_neq_zero_ret = AND_neq_zero_ret'\<rparr>
+      in
+        ret
+"
+
+fun AND_neq_zero_imp:: "AND_neq_zero_state \<Rightarrow> AND_neq_zero_state" where
+"AND_neq_zero_imp s = 
+      (let
+        ret = AND_neq_zero_state_upd s
+      in
+        ret
+      )"
+
+declare AND_neq_zero_imp.simps [simp del]
+
+lemma AND_neq_zero_imp_correct:
+   "AND_neq_zero_ret (AND_neq_zero_imp s) = (if (AND_neq_zero_a s) \<noteq> 0 \<and> (AND_neq_zero_b s) \<noteq> 0 then 1 else 0)"
+  by (subst AND_neq_zero_imp.simps) (auto simp: AND_neq_zero_state_upd_def Let_def split: if_splits)
+
+fun AND_neq_zero_imp_time:: "nat \<Rightarrow> AND_neq_zero_state\<Rightarrow> nat" where
+  "AND_neq_zero_imp_time t s = 
+    (
+      let
+        AND_neq_zero_ret' = 
+          (if AND_neq_zero_a s \<noteq> 0 then
+            (if AND_neq_zero_b s \<noteq> 0 then
+               (1::nat)
+             else
+               0)
+           else
+             0);
+        t = t + 1 + (if AND_neq_zero_a s \<noteq> 0 then
+            1 +
+            (if AND_neq_zero_b s \<noteq> 0 then
+               2
+             else
+               2)
+           else
+             2);
+        ret = t
+      in
+        ret
+    )
+"
+
+lemmas [simp del] = AND_neq_zero_imp_time.simps
+
+lemma AND_neq_zero_imp_time_acc: "(AND_neq_zero_imp_time (Suc t) s) = Suc (AND_neq_zero_imp_time t s)"
+  apply(subst AND_neq_zero_imp_time.simps)
+  apply(subst AND_neq_zero_imp_time.simps)
+  apply (auto simp add: AND_neq_zero_state_upd_def Let_def eval_nat_numeral split: if_splits)
+  done
+
+lemma AND_neq_zero_imp_time_acc_2: "(AND_neq_zero_imp_time x s) = x + (AND_neq_zero_imp_time 0 s)"
+  by (induction x arbitrary: s)
+     (auto simp add: AND_neq_zero_imp_time_acc AND_neq_zero_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+
+\<comment> \<open>The following separation is due to parsing time, whic grows exponentially in the length of IMP-
+    programs.\<close>
+
+definition AND_neq_zero_IMP_Minus where
+"AND_neq_zero_IMP_Minus \<equiv>
+  (
+          \<comment> \<open>(if AND_neq_zero_a s \<noteq> 0 then\<close>
+          IF AND_neq_zero_a_str \<noteq>0 THEN
+            \<comment> \<open>(if AND_neq_zero_b s \<noteq> 0 then\<close>
+            IF AND_neq_zero_b_str \<noteq>0 THEN
+               \<comment> \<open>1\<close>
+               AND_neq_zero_ret_str ::= (A (N 1))
+            \<comment> \<open>else\<close>
+            ELSE
+               \<comment> \<open>0)\<close>
+               AND_neq_zero_ret_str ::= (A (N 0))
+           \<comment> \<open>else\<close>
+           ELSE
+             \<comment> \<open>0);\<close>
+             AND_neq_zero_ret_str ::= (A (N 0))
+  )"
+
+definition "AND_neq_zero_imp_to_HOL_state p s =
+  \<lparr>AND_neq_zero_a = (s (add_prefix p AND_neq_zero_a_str)), AND_neq_zero_b = (s (add_prefix p AND_neq_zero_b_str)), AND_neq_zero_ret = (s (add_prefix p AND_neq_zero_ret_str))\<rparr>"
+
+lemma AND_neq_zero_IMP_Minus_correct_function: 
+  "(invoke_subprogram p AND_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p AND_neq_zero_ret_str) = AND_neq_zero_ret (AND_neq_zero_imp (AND_neq_zero_imp_to_HOL_state p s))"
+  apply(subst AND_neq_zero_imp.simps)
+  apply(simp only: AND_neq_zero_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule If_tE)
+   apply(erule If_tE)
+    apply(drule AssignD)+
+    apply(elim conjE)
+    apply(simp add: AND_neq_zero_state_upd_def AND_neq_zero_imp_to_HOL_state_def AND_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(simp add: AND_neq_zero_state_upd_def AND_neq_zero_imp_to_HOL_state_def AND_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  apply(drule AssignD)+
+  apply(elim conjE)
+  apply(simp add: AND_neq_zero_state_upd_def AND_neq_zero_imp_to_HOL_state_def AND_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  done
+
+lemma AND_neq_zero_IMP_Minus_correct_time: 
+  "(invoke_subprogram p AND_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = AND_neq_zero_imp_time 0 (AND_neq_zero_imp_to_HOL_state p s)"
+  apply(subst AND_neq_zero_imp_time.simps)
+  apply(simp only: AND_neq_zero_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule If_tE)
+   apply(erule If_tE)
+    apply(drule AssignD)+
+    apply(elim conjE)
+    apply(simp add: AND_neq_zero_state_upd_def AND_neq_zero_imp_to_HOL_state_def AND_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(simp add: AND_neq_zero_state_upd_def AND_neq_zero_imp_to_HOL_state_def AND_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  apply(drule AssignD)+
+  apply(elim conjE)
+  apply(simp add: AND_neq_zero_state_upd_def AND_neq_zero_imp_to_HOL_state_def AND_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  done
+
+lemma AND_neq_zero_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ AND_neq_zero_pref) AND_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>  v \<in> vars \<Longrightarrow> \<not> (set AND_neq_zero_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma AND_neq_zero_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) AND_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+    \<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v);
+     \<lbrakk>t = (AND_neq_zero_imp_time 0 (AND_neq_zero_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) AND_neq_zero_ret_str) = 
+        AND_neq_zero_ret (AND_neq_zero_imp (AND_neq_zero_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using AND_neq_zero_IMP_Minus_correct_time AND_neq_zero_IMP_Minus_correct_function
+        AND_neq_zero_IMP_Minus_correct_effects 
+  by auto
+
+
+subsection \<open>Logical Or\<close>
+
+record OR_neq_zero_state = OR_neq_zero_a::nat OR_neq_zero_b::nat OR_neq_zero_ret::nat
+
+abbreviation "OR_neq_zero_prefix \<equiv> ''OR_neq_zero.''"
+abbreviation "OR_neq_zero_a_str \<equiv> ''OR_a''"
+abbreviation "OR_neq_zero_b_str \<equiv> ''OR_b''"
+abbreviation "OR_neq_zero_ret_str \<equiv> ''OR_ret''"
+
+definition "OR_neq_zero_state_upd s \<equiv>
+      let
+        OR_neq_zero_ret' = 
+          (if OR_neq_zero_a s \<noteq> 0 then
+            1
+           else
+             (if OR_neq_zero_b s \<noteq> 0 then
+               1
+             else
+               0));
+        ret = \<lparr>OR_neq_zero_a = OR_neq_zero_a s, OR_neq_zero_b = OR_neq_zero_b s, OR_neq_zero_ret = OR_neq_zero_ret'\<rparr>
+      in
+        ret
+"
+
+fun OR_neq_zero_imp:: "OR_neq_zero_state \<Rightarrow> OR_neq_zero_state" where
+"OR_neq_zero_imp s = 
+      (let
+        ret = OR_neq_zero_state_upd s
+      in
+        ret
+      )"
+
+declare OR_neq_zero_imp.simps [simp del]
+
+lemma OR_neq_zero_imp_correct:
+   "OR_neq_zero_ret (OR_neq_zero_imp s) = (if (OR_neq_zero_a s) \<noteq> 0 \<or> (OR_neq_zero_b s) \<noteq> 0 then 1 else 0)"
+  by (subst OR_neq_zero_imp.simps) (auto simp: OR_neq_zero_state_upd_def Let_def split: if_splits)
+
+fun OR_neq_zero_imp_time:: "nat \<Rightarrow> OR_neq_zero_state\<Rightarrow> nat" where
+  "OR_neq_zero_imp_time t s = 
+    (
+      let
+        OR_neq_zero_ret' = 
+          (if OR_neq_zero_a s \<noteq> 0 then
+             1::nat
+           else
+             (if OR_neq_zero_b s \<noteq> 0 then
+               (1::nat)
+             else
+               0));
+        t = t + 1 + (if OR_neq_zero_a s \<noteq> 0 then
+            2
+           else
+             1 +
+            (if OR_neq_zero_b s \<noteq> 0 then
+               2
+             else
+               2));
+        ret = t
+      in
+        ret
+    )
+"
+
+lemmas [simp del] = OR_neq_zero_imp_time.simps
+
+lemma OR_neq_zero_imp_time_acc: "(OR_neq_zero_imp_time (Suc t) s) = Suc (OR_neq_zero_imp_time t s)"
+  apply(subst OR_neq_zero_imp_time.simps)
+  apply(subst OR_neq_zero_imp_time.simps)
+  apply (auto simp add: OR_neq_zero_state_upd_def Let_def eval_nat_numeral split: if_splits)
+  done
+
+lemma OR_neq_zero_imp_time_acc_2: "(OR_neq_zero_imp_time x s) = x + (OR_neq_zero_imp_time 0 s)"
+  by (induction x arbitrary: s)
+     (auto simp add: OR_neq_zero_imp_time_acc OR_neq_zero_state_upd_def Let_def eval_nat_numeral split: if_splits)
+
+
+\<comment> \<open>The following separation is due to parsing time, whic grows exponentially in the length of IMP-
+    programs.\<close>
+
+definition OR_neq_zero_IMP_Minus where
+"OR_neq_zero_IMP_Minus \<equiv>
+  (
+          \<comment> \<open>(if OR_neq_zero_a s \<noteq> 0 then\<close>
+          IF OR_neq_zero_a_str \<noteq>0 THEN
+             \<comment> \<open>1);\<close>
+            OR_neq_zero_ret_str ::= (A (N 1))
+           \<comment> \<open>else\<close>
+           ELSE
+            \<comment> \<open>(if OR_neq_zero_b s \<noteq> 0 then\<close>
+            IF OR_neq_zero_b_str \<noteq>0 THEN
+               \<comment> \<open>1\<close>
+               OR_neq_zero_ret_str ::= (A (N 1))
+            \<comment> \<open>else\<close>
+            ELSE
+               \<comment> \<open>0)\<close>
+               OR_neq_zero_ret_str ::= (A (N 0))
+             
+  )"
+
+definition "OR_neq_zero_imp_to_HOL_state p s =
+  \<lparr>OR_neq_zero_a = (s (add_prefix p OR_neq_zero_a_str)), OR_neq_zero_b = (s (add_prefix p OR_neq_zero_b_str)), OR_neq_zero_ret = (s (add_prefix p OR_neq_zero_ret_str))\<rparr>"
+
+lemma OR_neq_zero_IMP_Minus_correct_function: 
+  "(invoke_subprogram p OR_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     s' (add_prefix p OR_neq_zero_ret_str) = OR_neq_zero_ret (OR_neq_zero_imp (OR_neq_zero_imp_to_HOL_state p s))"
+  apply(subst OR_neq_zero_imp.simps)
+  apply(simp only: OR_neq_zero_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule If_tE)
+    apply(drule AssignD)+
+    apply(elim conjE)
+    apply(simp add: OR_neq_zero_state_upd_def OR_neq_zero_imp_to_HOL_state_def OR_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+   apply(erule If_tE)
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(simp add: OR_neq_zero_state_upd_def OR_neq_zero_imp_to_HOL_state_def OR_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  apply(drule AssignD)+
+  apply(elim conjE)
+  apply(simp add: OR_neq_zero_state_upd_def OR_neq_zero_imp_to_HOL_state_def OR_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  done
+
+lemma OR_neq_zero_IMP_Minus_correct_time: 
+  "(invoke_subprogram p OR_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>
+     t = OR_neq_zero_imp_time 0 (OR_neq_zero_imp_to_HOL_state p s)"
+  apply(subst OR_neq_zero_imp_time.simps)
+  apply(simp only: OR_neq_zero_IMP_Minus_def com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps invoke_subprogram_append)
+  apply(erule If_tE)
+    apply(drule AssignD)+
+    apply(elim conjE)
+    apply(simp add: OR_neq_zero_state_upd_def OR_neq_zero_imp_to_HOL_state_def OR_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+   apply(erule If_tE)
+   apply(drule AssignD)+
+   apply(elim conjE)
+   apply(simp add: OR_neq_zero_state_upd_def OR_neq_zero_imp_to_HOL_state_def OR_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  apply(drule AssignD)+
+  apply(elim conjE)
+  apply(simp add: OR_neq_zero_state_upd_def OR_neq_zero_imp_to_HOL_state_def OR_neq_zero_imp_time_acc 
+      cons_imp_to_HOL_state_def hd_imp_to_HOL_state_def tl_imp_to_HOL_state_def
+      Let_def)[1]
+  done
+
+lemma OR_neq_zero_IMP_Minus_correct_effects:
+  "(invoke_subprogram (p @ OR_neq_zero_pref) OR_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s' \<Longrightarrow>  v \<in> vars \<Longrightarrow> \<not> (set OR_neq_zero_pref \<subseteq> set v) \<Longrightarrow> s (add_prefix p v) = s' (add_prefix p v)"
+  using com_add_prefix_valid_subset com_only_vars
+  by blast
+
+lemma OR_neq_zero_IMP_Minus_correct:
+  "\<lbrakk>(invoke_subprogram (p1 @ p2) OR_neq_zero_IMP_Minus, s) \<Rightarrow>\<^bsup>t\<^esup> s';
+    \<And>v. v \<in> vars \<Longrightarrow> \<not> (set p2 \<subseteq> set v);
+     \<lbrakk>t = (OR_neq_zero_imp_time 0 (OR_neq_zero_imp_to_HOL_state (p1 @ p2) s));
+      s' (add_prefix (p1 @ p2) OR_neq_zero_ret_str) = 
+        OR_neq_zero_ret (OR_neq_zero_imp (OR_neq_zero_imp_to_HOL_state (p1 @ p2) s));
+      \<And>v. v \<in> vars \<Longrightarrow> s (add_prefix p1 v) = s' (add_prefix p1 v)\<rbrakk>
+     \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
+  using OR_neq_zero_IMP_Minus_correct_time OR_neq_zero_IMP_Minus_correct_function
+        OR_neq_zero_IMP_Minus_correct_effects 
+  by auto
+
 
 end
\ No newline at end of file
diff --git a/IMP-/Big_StepT.thy b/IMP-/Big_StepT.thy
index 659a58f0..9c4fe421 100644
--- a/IMP-/Big_StepT.thy
+++ b/IMP-/Big_StepT.thy
@@ -231,8 +231,6 @@ method dest_com_init_while =
    \<open>match premises in b[thin]: "(v ::= a;; WHILE v \<noteq>0 DO _, s2) \<Rightarrow>\<^bsup>t2\<^esup> s2'"
       for s2 s2' t2 \<Rightarrow> \<open>insert a\<close>\<close>)*)
 
-
-
 lemma terminates_split_if : "(P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t1\<^esup> s1 ) \<Longrightarrow> 
 (\<not> P s \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup>t2\<^esup> s2 ) \<Longrightarrow> (c,s) \<Rightarrow>\<^bsup>if P s then t1 else t2\<^esup>  if P s then s1 else s2"
   by auto
@@ -298,17 +296,57 @@ lemma AssignI'':
 "\<lbrakk>s' = s (x:= aval a s)\<rbrakk>
         \<Longrightarrow> (x ::= a, s) \<Rightarrow>\<^bsup> 2 \<^esup> s' \<and> s' = s'" 
   by (auto simp add: Assign eval_nat_numeral)
-thm Assign_tE
 
 lemma AssignD: "(x ::= a, s) \<Rightarrow>\<^bsup> t \<^esup> s' \<Longrightarrow> t = 2 \<and> s' = s(x := aval a s)"
   by auto
 
-thm Seq_tE
+lemma compose_programs_1:
+  "(c2, s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<Longrightarrow> (c1, s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<Longrightarrow> 
+    ((c1;; c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3 \<Longrightarrow> P)
+   \<Longrightarrow> P"
+  by auto
 
-lemma Seq_tE_While_init: 
+lemma compose_programs_2:
+  "(c1, s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<Longrightarrow> (c2, s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<Longrightarrow> 
+    ((c1;; c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3 \<Longrightarrow> P)
+   \<Longrightarrow> P"
+  by auto
+
+lemma While_tE_time:
+"(WHILE b\<noteq>0 DO c, s) \<Rightarrow>\<^bsup> x \<^esup> t \<Longrightarrow>
+  (x = Suc (Suc 0) \<Longrightarrow> t = s \<Longrightarrow> s b = 0 \<Longrightarrow> P) \<Longrightarrow>
+  (\<And>x' s2 y. 0 < s b \<Longrightarrow> (c, s) \<Rightarrow>\<^bsup> x' \<^esup> s2 \<Longrightarrow> (WHILE b\<noteq>0 DO c, s2) \<Rightarrow>\<^bsup> y \<^esup> t \<Longrightarrow> x = Suc (x' + y) \<Longrightarrow> P) \<Longrightarrow> P"
+  by auto
+
+lemma Seq_tE_While_init:
   "(WHILE v \<noteq>0 DO c2, s2) \<Rightarrow>\<^bsup> y \<^esup> s3 \<Longrightarrow> (c1, s1) \<Rightarrow>\<^bsup> x \<^esup> s2 \<Longrightarrow> 
     ((c1;; WHILE v \<noteq>0 DO c2, s1) \<Rightarrow>\<^bsup> x + y \<^esup> s3 \<Longrightarrow> P)
    \<Longrightarrow> P"
   by auto
 
+method dest_com_gen = 
+  (erule compose_programs_1[where ?c2.0 = "(Com.While _ _)"], assumption,
+    erule compose_programs_2[where ?c1.0 = "(_;; Com.While _ _)"], assumption,
+    (match premises
+      in a[thin]: 
+      "(init_while_cond;; 
+                WHILE _ \<noteq>0 DO (loop_body;; init_while_cond);;
+                after_loop, _) \<Rightarrow>\<^bsup>_\<^esup> _"
+    for init_while_cond loop_body after_loop  \<Rightarrow> 
+      \<open>match premises in b[thin]: "\<lbrakk>loop_cond; state_upd; _\<rbrakk> \<Longrightarrow> P"
+       for loop_cond state_upd P \<Rightarrow> \<open>subst b[OF _ _ a]\<close>\<close>))
+
+
+method dest_com_gen_time = 
+  (erule compose_programs_1[where ?c2.0 = "(Com.While _ _)"], assumption,
+    erule compose_programs_2[where ?c1.0 = "(_;; Com.While _ _)"], assumption,
+    (match premises
+      in a[thin]: 
+      "(init_while_cond;; 
+                WHILE _ \<noteq>0 DO (loop_body;; init_while_cond);;
+                after_loop, _) \<Rightarrow>\<^bsup>_\<^esup> _"
+    for init_while_cond loop_body after_loop  \<Rightarrow> 
+      \<open>match premises in b[thin]: "\<lbrakk>loop_cond; state_upd; _\<rbrakk> \<Longrightarrow> P"
+       for loop_cond state_upd P \<Rightarrow> \<open>subst b[OF _ _ a, simplified add.assoc]\<close>\<close>))
+
 end
\ No newline at end of file
diff --git a/IMP-/Call_By_Prefixes.thy b/IMP-/Call_By_Prefixes.thy
index 386c2b2d..adfa18a6 100644
--- a/IMP-/Call_By_Prefixes.thy
+++ b/IMP-/Call_By_Prefixes.thy
@@ -121,4 +121,7 @@ lemma aexp_add_prefix_append: "aexp_add_prefix p1 (aexp_add_prefix p2 aexp) = (a
 lemma invoke_subprogram_append: "invoke_subprogram p1 (invoke_subprogram p2 c) = (invoke_subprogram (p1 @ p2) c)"
   by (induction "(p1 @ p2)" c arbitrary: p1 p2 rule: com_add_prefix.induct) (auto simp: aexp_add_prefix_append)
 
+lemmas prefix_simps = com_add_prefix.simps aexp_add_prefix.simps atomExp_add_prefix.simps
+                      invoke_subprogram_append
+
 end
\ No newline at end of file