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_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--_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 \IMP-- Subprograms\ -theory IMP_Minus_Minus_Subprograms imports "../IMP_Minus_Minus_Small_StepT" +theory IMP_Minus_Minus_Subprograms + imports IMP_Minus_Minus_Small_StepT begin text \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 new file mode 100644 index 00000000..eec15906 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_Subprograms_Nat.thy @@ -0,0 +1,372 @@ +theory IMP_Minus_Minus_Subprograms_Nat + imports Primitives IMP_Minus_Minus_Subprograms +begin + + + + +fun map_all_subprograms:: "nat \ nat \ 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) )" + + +lemma submap_all_subprograms: +"map_all_subprograms c n = map_nat (\x. 2## x ## c ## 0) n" + apply (induct c n rule: map_all_subprograms.induct) + apply auto + done + +fun map_all_subprograms_acc:: "nat \ nat \ nat \ 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 (\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 \ nat \ 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 \ 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 \ all_sub list \ 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 \ nat \ 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 \ []" + apply(cases c) + apply auto + done + + + +fun add_res :: "com list \ all_sub list \ 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 \ []" + apply(cases s) + apply auto + subgoal for a xs + apply (cases a) + apply auto + done + done + +fun add_res_nat :: "nat \ nat \ 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 + +function all_subprograms_stack :: "all_sub list \ 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 (\ 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 (\ x. x ;; (While v c)) c')) s)" + sorry +termination sorry + +function all_subprograms_stack_nat :: "nat \ 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 \ [] \ 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 "\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 "\x. (com.Seq x (com.While _ _))" ] + map_map map_append list.map ) + apply (metis list.exhaust) + done + done + +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 \ com list" where +"all_subprograms_t c = all_subprograms_stack (push_stack c [] )" + +definition all_subprograms_nat :: "nat \ 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) + +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))" + by (simp add: sub_all_subprograms_t subtailnat_all_subprograms) + +definition all_subprograms_tail :: "nat \ 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 \nat" where +"enumerate_subprograms_nat c = remdups_nat (all_subprograms_nat c)" + +definition enumerate_subprograms_tail :: "nat \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 + 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 \nat" where +"all_variables_nat n = (if n=0 \ hd_nat n =0 \ 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 )" + +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 + vname_list_encode_def cons0 sub_cons sub_nth nth.simps) + apply auto + done + +fun map_all_variables:: "nat \ 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 \ nat \ 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 \ 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 \ nat" where +"enumerate_variables_nat c = + remdups_nat (concat_nat (map_all_variables (enumerate_subprograms_nat c)))" + +definition enumerate_variables_tail :: "nat \ 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 + (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_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 \ We show correctness for the IMP-- to SAS++ reduction. \ 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 \ domain_element) list \ com" where -"pc_to_com l = (case l ! 0 of (_, PCV x) \ x)" +"pc_to_com l = (if l = [] then SKIP else (case l ! 0 of (_, PCV x) \ x | t \ SKIP))" + +lemma pc_to_com_def2 :"l \ [] \ pc_to_com l = (case l ! 0 of (_, PCV x) \ x | t \ SKIP)" + apply (auto simp add: pc_to_com_def) + done fun com_to_operators :: "com \ operator list" where "com_to_operators (SKIP) = []" | @@ -144,16 +148,18 @@ lemma map_of_precondition_of_op_PC[simp]: "op \ set (com_to_operators c) lemma pc_to_com_precondition_of_op_PC [simp]: "op \ set (com_to_operators c) \ 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 \ set (com_to_operators c) \ (PC, y) \ set (effect_of op) \ 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 \ set (com_to_operators c) \ 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_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..71f9d047 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_Reduction_Nat.thy @@ -0,0 +1,1064 @@ +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)]" + +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 + +definition pc_to_com_nat :: "nat\ 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 \ 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) + 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 \ nat \ nat \ 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) +)" + +fun map_com_to_operators_acc:: " nat \ nat \ nat \ nat \ 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(\ 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 (\ 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 + +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 \ 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 (\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 \ nat \ 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 (\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 \ nat \ nat \ 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 \ nat \ nat \ nat \ 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 (\ 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 +lemma map_com_to_operators3_induct: +"map_com_to_operators3_acc i c1 acc n = map_acc (\ 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 \ nat \ 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 \ nat \ nat \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 (\ 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 map_com_to_operators4_acc :: "nat \ nat \ nat \ nat \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(\ 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 \ nat \ 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 + + +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 \ 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 \ com_op" where +"com_op_decode n = (case list_decode n of + [0] \ SKIP | + [Suc 0,v,b] \ Assign (vname_decode v) (bit_decode b)| + [Suc (Suc 0), c1, c2] \ Seq_0 (comm_decode c1) (comm_decode c2)| + [Suc (Suc (Suc 0)),v ,c1 ,c2] \ If (vname_list_decode v) (comm_decode c1) (comm_decode c2)| + [Suc (Suc (Suc (Suc 0))), v, c] \ While (vname_list_decode v) (comm_decode c)| + [Suc (Suc (Suc (Suc (Suc 0)))),c1,c2,op] \ Seq_f (comm_decode c1) (comm_decode c2) (map operator_decode (list_decode op))| + [Suc (Suc (Suc (Suc (Suc (Suc 0))))),op] \ 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 \ com_op list \ 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" + +definition push_to_stack_op_nat :: "nat \ nat \ 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: push_to_stack_op_nat_def +sub_cons simp del:list_encode.simps) + done + +fun add_res_to_stack_op :: "operator list \ com_op list \ 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" + +definition add_res_to_stack_op_nat :: "nat \ nat \ 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 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 ) + 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 + +fun size_e :: "com \ 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 \ 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 \ nat" where +"stack_size s = stack_size_rev (rev s)" + +lemma +stack_size_mono :" x \ [] \y \ [] \ stack_size_rev y < stack_size_rev x + \ 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) = (\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: +"\x. s \ [Bot x] \ a \ Bot x \ 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 \ 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 + [\ precondition_of = [(PC, PCV (com.Assign v b))], + effect_of = [(PC, PCV com.SKIP), (VN v, EV b)]\] s )" | +"com_to_operators_stack (Seq_0 c1 c2 #s) = +(if c1 = com.SKIP then com_to_operators_stack ( add_res_to_stack_op [\ precondition_of = [(PC, PCV (c1 ;; c2))], + effect_of = [(PC, PCV c2)]\] 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 (\ op. + (let c1' = pc_to_com (effect_of op) in + \ precondition_of = + list_update (precondition_of op) 0 (PC, PCV (com.Seq c1 c2)), + effect_of = + list_update (effect_of op) 0 (PC, PCV (com.Seq c1' c2))\)) 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\0 THEN c1 ELSE c2) + in \ precondition_of = (PC, i) # map (\v. (VN v, EV Zero)) (remdups vs), + effect_of = [(PC, PCV c2)]\ + # map (\ v. + \ precondition_of = [(PC, i), (VN v, EV One)], + effect_of = [(PC, PCV c1)]\) 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 + \ precondition_of = (PC, i) # map (\v. (VN v, EV Zero)) (remdups vs), + effect_of = [(PC, k)]\ + # map (\ v. + \ precondition_of = [(PC, i), (VN v, EV One)], + effect_of = [(PC, j)]\) 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 ( +com_to_operators c) s)" + apply(induct c arbitrary:s rule: com_to_operators.induct) + apply auto + done + +definition com_to_operators_t :: "com \ operator list" where +"com_to_operators_t c = com_to_operators_stack (push_to_stack_op c [])" + +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 (domintros) com_to_operators_stack_nat :: "nat \ 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) + ## + ( + (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) 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 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 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_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 +)) +" by pat_completeness auto + + + + + +lemma push_stack_not_Nil : +"push_to_stack_op c s \ []" + apply (cases c) + apply auto + done + +lemma add_res_not_Nil : +"add_res_to_stack_op c s \ []" + 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 \ + precondition_of = x, effect_of = y +\" + 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 + + +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 simp_op_id:"\sas_plus_operator.precondition_of = + sas_plus_operator.precondition_of a, + effect_of = effect_of a\ = 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 +"\x. \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);; _))]\" + + ] ) + 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 "\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 "\x. \sas_plus_operator.precondition_of = + [(PC, PCV (IF _\0 THEN _ ELSE _)), (VN x, EV One)], + effect_of = [(PC, PCV _)]\" ]) + 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 "\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 "\x.\sas_plus_operator.precondition_of = + [(PC, PCV (WHILE _\0 DO _ )), (VN x, EV One)], + effect_of = [(PC, PCV (_;; WHILE _\0 DO _))]\" ]) + 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: +" com_to_operators_stack_nat (list_encode (map com_op_encode s)) += list_encode (map operator_encode(com_to_operators_stack s))" +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 +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 +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 + 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 + 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 + 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 list_encode_0 comm_inj_simps simp flip: com_op_encode.simps(3) comm_encode.simps(1) list.map(2) split: if_splits) + done +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 + 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 +"\x. \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);; _))]\" + + ] ) + 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 ) + 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 (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) + apply(simp only: bit_encode.simps(1) cons0 sub_cons sub_map flip: domain_element_encode.simps comp_def[of sas_assignment_encode "\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 "\x. \sas_plus_operator.precondition_of = + [(PC, PCV (IF _\0 THEN _ ELSE _)), (VN x, EV One)], + effect_of = [(PC, PCV _)]\" ]) + apply simp +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 ) + 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 (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: bit_encode.simps(1) cons0 sub_cons sub_map flip: domain_element_encode.simps comp_def[of sas_assignment_encode "\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 "\x.\sas_plus_operator.precondition_of = + [(PC, PCV (WHILE _\0 DO _ )), (VN x, EV One)], + effect_of = [(PC, PCV (_;; WHILE _\0 DO _))]\" ]) + 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 \ 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 \ 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 \ 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 \ nat \ 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 \ 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 \ nat" where +"coms_to_operators_nat cs = concat_nat (map_coms_to_operators cs)" + +definition coms_to_operators_tail :: "nat \ 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))"] + map_map) + apply (auto simp add: comp_def) + done + + + +definition imp_minus_minus_to_sas_plus_list:: +"com \ (vname,bit) assignment list \ (vname,bit) assignment list \ + (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 (\ i. PCV i) cs in + \ 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 (com.SKIP, goal_vs), + range_ofl = (PC, pc_d)#(map (\ v. (VN v, domain)) (enumerate_variables c))\)" + +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 \ 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 (\ i. prod_encode(1, i)) n " + apply (induct n rule: map_PCV.induct) + apply (auto) + done + +fun map_PCV_acc :: "nat \ nat \ 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 (\ i. prod_encode(1, i)) acc n" + apply(induct acc n rule:map_PCV_acc.induct) + apply auto done + +definition map_PCV_tail :: "nat \ 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 \ 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 \ nat \ 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 \ 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\ 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 \ nat\ 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 (\ 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 (\ 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 \ 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 \ nat \ nat \ 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 )" + +definition imp_minus_minus_to_sas_plus_tail:: "nat \ nat \ nat \ 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) = + 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.thy b/Cook_Levin/IMP-_To_SAS+/IMP--_To_SAS++/IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations.thy index dae24314..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 \ We define a translation between IMP-- states and SAS++ states. For this purpose, it is useful @@ -24,6 +24,7 @@ definition imp_minus_state_to_sas_plus :: "(com \ imp_state) \\<^sub>m (\x. (case x of VN v \ Some v))) (PC \ PCV (fst ci))" + definition sas_plus_state_to_imp_minus:: "sas_state \ (com \ imp_state)" where "sas_plus_state_to_imp_minus ss = ((case (the (ss PC)) of (PCV c) \ c), (\x. (case x of EV y \ Some y | _ \ None)) \\<^sub>m ss \\<^sub>m (\x. Some (VN x)))" 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..cbb10f00 --- /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,112 @@ +theory IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations_Nat + imports IMP_Minus_Minus_To_SAS_Plus_Plus_State_Translations + Primitives +begin + + +definition imp_minus_state_to_sas_plus_list:: + "(com * (vname*bit) list) \ (variable*domain_element) list" where +"imp_minus_state_to_sas_plus_list ci =(PC,PCV (fst ci))# + map (\(x,y). (x, EV y)) (map (\(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 "\y. (x,y) \ set b" + using weak_map_of_SomeI by force + hence "\y. (VN x, y) \ set (map (\(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 \ 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 \ nat \ 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 (\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 \ 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 (\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 \ 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 \ 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)) " + 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_IMP--/Binary_Arithmetic.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic.thy index 3883990f..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 @@ -14,6 +14,15 @@ fun nth_bit_nat:: "nat \ nat \ 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 \ nat \ 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_IMP.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy new file mode 100644 index 00000000..62e66af1 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_IMP.thy @@ -0,0 +1,540 @@ +theory Binary_Arithmetic_IMP + imports Primitives_IMP_Minus Binary_Arithmetic_Nat IMP_Minus.Com +begin + +subsection \N-th bit of Natural Number\ + +fun nth_bit_of_num_nat' :: "nat \ nat \ nat" where + "nth_bit_of_num_nat' x n = (if x \ 0 then + (if n \ 0 then + nth_bit_of_num_nat' (tl_nat x) (n-1) + else + (if hd_nat x \ 0 then + 1 \ \x \ 0 \ n = 0 \ hd_nat x \ 0\ + else + 0 \ \x \ 0 \ n = 0 \ hd_nat x = 0\)) + else + (if n \ 0 then + 0 \ \x = 0 \ n \ 0\ + else + 1 \ \x = 0 \ n = 0\) + )" + +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 \ ''nth_bit_of_num.''" +abbreviation "nth_bit_of_num_x_str \ ''x''" +abbreviation "nth_bit_of_num_n_str \ ''n''" +abbreviation "nth_bit_of_num_ret_str \ ''ret''" + +definition "nth_bit_of_num_state_upd s \ + let + tl_xs' = nth_bit_of_num_x s; + tl_ret' = 0; + tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\; + 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 = \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\ + in + ret +" + +definition + "nth_bit_of_num_imp_compute_loop_condition s \ + (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 = \AND_neq_zero_a = AND_neq_zero_a', AND_neq_zero_b = AND_neq_zero_b', AND_neq_zero_ret = AND_neq_zero_ret'\; + 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 \ + (let + hd_xs' = nth_bit_of_num_x s; + hd_ret' = 0; + hd_state = \hd_xs = hd_xs', hd_ret = hd_ret'\; + 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 \ 0 then + ((if hd_x \ 0 then + 1 \ \x \ 0 \ n = 0 \ hd_nat x \ 0\ + else + 0 \ \x \ 0 \ n = 0 \ hd_nat x = 0\)) + else + (if nth_bit_of_num_n s \ 0 then + 0 \ \x = 0 \ n \ 0\ + else + 1 \ \x = 0 \ n = 0\) + ); + ret = \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'\ + in + ret)" + + +function nth_bit_of_num_imp:: "nth_bit_of_num_state \ nth_bit_of_num_state" where + "nth_bit_of_num_imp s = + ( + (if nth_bit_of_num_imp_compute_loop_condition s \ 0 then \ \While xs \ 0\ + ( + 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 (\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 \ + let + tl_xs' = nth_bit_of_num_x s; + t = t + 2; + tl_ret' = 0; + t = t + 2; + tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\; + 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_imp_compute_loop_condition_time t s \ + (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 = \AND_neq_zero_a = AND_neq_zero_a', AND_neq_zero_b = AND_neq_zero_b', AND_neq_zero_ret = AND_neq_zero_ret'\; + 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 + t)" + +definition + "nth_bit_of_num_imp_after_loop_time t s \ + (let + hd_xs' = nth_bit_of_num_x s; + t = t + 2; + hd_ret' = 0; + t = t + 2; + hd_state = \hd_xs = hd_xs', hd_ret = hd_ret'\; + 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 \ 0 then + ((if hd_x \ 0 then + 1 \ \x \ 0 \ n = 0 \ hd_nat x \ 0\ + else + 0 \ \x \ 0 \ n = 0 \ hd_nat x = 0\)) + else + (if nth_bit_of_num_n s \ 0 then + 0 \ \x = 0 \ n \ 0\ + else + 1 \ \x = 0 \ n = 0\) + ); + t = t + 1 + + (if nth_bit_of_num_x s \ 0 then + (1 + + (if hd_x \ 0 then + 2 \ \x \ 0 \ n = 0 \ hd_nat x \ 0\ + else + 2 \ \x \ 0 \ n = 0 \ hd_nat x = 0\)) + else + 1 + + (if nth_bit_of_num_n s \ 0 then + 2 \ \x = 0 \ n \ 0\ + else + 2 \ \x = 0 \ n = 0\) + ); + ret = t + in + ret +)" + + +function nth_bit_of_num_imp_time:: "nat \ nth_bit_of_num_state \ 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 \ 0 then \ \While xs \ 0\ + ( + let + t = t + 1; \ \While condition true\ + 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; \ \skipping while loop as it is false\ + ret = t + nth_bit_of_num_imp_after_loop_time 0 s + in + ret + ) + ) +)" + by pat_completeness auto +termination + by (relation "measure (\(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) + +\ \The following separation is due to parsing time, whic grows exponentially in the length of IMP- + programs.\ + +abbreviation "nth_bit_of_num_while_cond \ ''condition''" + +definition "nth_bit_of_num_IMP_init_while_cond \ + \ \AND_neq_zero_a' = nth_bit_of_num_x s;\ + (AND_neq_zero_prefix @ AND_neq_zero_a_str) ::= (A (V nth_bit_of_num_x_str));; + \ \AND_neq_zero_b' = nth_bit_of_num_n s;\ + (AND_neq_zero_prefix @ AND_neq_zero_b_str) ::= (A (V nth_bit_of_num_n_str));; + \ \AND_neq_zero_ret' = 0;\ + (AND_neq_zero_prefix @ AND_neq_zero_ret_str) ::= (A (N 0));; + \ \AND_neq_zero_state = \AND_neq_zero_a = AND_neq_zero_a', AND_neq_zero_b = AND_neq_zero_b', AND_neq_zero_ret = AND_neq_zero_ret'\;\ + \ \AND_neq_zero_state_ret = AND_neq_zero_imp AND_neq_zero_state;\ + invoke_subprogram AND_neq_zero_prefix AND_neq_zero_IMP_Minus;; + \ \condition = AND_neq_zero_ret (AND_neq_zero_state_ret)\ + (nth_bit_of_num_while_cond) ::= (A (V (AND_neq_zero_prefix @ AND_neq_zero_ret_str))) +" + +definition "nth_bit_of_num_IMP_loop_body \ + \ \(\ + \ \let\ + \ \tl_xs' = nth_bit_of_num_x s;\ + (tl_prefix @ tl_xs_str) ::= (A (V nth_bit_of_num_x_str));; + \ \tl_ret' = 0;\ + (tl_prefix @ tl_ret_str) ::= (A (N 0));; + \ \tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\;\ + \ \tl_ret_state = tl_imp tl_state;\ + invoke_subprogram tl_prefix tl_IMP_Minus;; + \ \nth_bit_of_num_x' = tl_ret tl_ret_state;\ + (nth_bit_of_num_x_str ::= (A (V (tl_prefix @ tl_ret_str))));; + \ \nth_bit_of_num_n' = nth_bit_of_num_n s - 1;\ + (nth_bit_of_num_n_str ::= ((V nth_bit_of_num_n_str \ (N 1)))) + \ \next_iteration = nth_bit_of_num_imp (nth_bit_of_num_state_upd s)\ + \ \in\ + \ \next_iteration\ + \ \)\ +" + +abbreviation "hd_x \ ''hd_x''" + +definition "nth_bit_of_num_IMP_after_loop \ + \ \hd_xs' = nth_bit_of_num_x s;\ + (hd_prefix @ hd_xs_str) ::= (A (V nth_bit_of_num_x_str));; + \ \hd_ret' = 0;\ + (hd_prefix @ hd_ret_str) ::= (A (N 0));; + \ \hd_state = \hd_xs = hd_xs', hd_ret = hd_ret'\;\ + \ \hd_state_ret = hd_imp hd_state;\ + \ \hd_x = hd_ret hd_state_ret;\ + invoke_subprogram hd_prefix hd_IMP_Minus;; + (hd_x) ::= (A (V (hd_prefix @ hd_ret_str)));; + \ \nth_bit_of_num_ret' = \ + \ \(if nth_bit_of_num_x s \ 0 then \ + IF nth_bit_of_num_x_str \0 THEN + \ \((if hd_ret hd_state_ret \ 0 then\ + IF hd_x \0 THEN + \ \1 \ \x \ 0 \ n = 0 \ hd_nat x \ 0\\ + nth_bit_of_num_ret_str ::= (A (N 1)) + \ \else\ + ELSE + \ \0 \ \x \ 0 \ n = 0 \ hd_nat x = 0\))\ + nth_bit_of_num_ret_str ::= (A (N 0)) + \ \else\ + ELSE + \ \(if nth_bit_of_num_n s \ 0 then\ + IF nth_bit_of_num_n_str \0 THEN + \ \0 \ \x = 0 \ n \ 0\\ + nth_bit_of_num_ret_str ::= (A (N 0)) + \ \else\ + ELSE + \ \1 \ \x = 0 \ n = 0\)\ + nth_bit_of_num_ret_str ::= (A (N 1)) + \ \);\ +" + +definition nth_bit_of_num_IMP_Minus where + "nth_bit_of_num_IMP_Minus \ + nth_bit_of_num_IMP_init_while_cond;; + \ \in\ + \ \(if condition \ 0 then \ \While xs \ 0\\ + WHILE nth_bit_of_num_while_cond \0 DO( + nth_bit_of_num_IMP_loop_body;; + nth_bit_of_num_IMP_init_while_cond + );; + \ \else\ + \ \(\ + \ \let\ + nth_bit_of_num_IMP_after_loop + \ \ret = \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'\\ + \ \in\ + \ \ret\ + \ \)\ + \ \)\ +" + +abbreviation + "nth_bit_of_num_IMP_vars \ + {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 = + \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))\" + +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) \\<^bsup>t\<^esup> s' \ + 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 \Debugging lemma\ + +lemma nth_bit_of_num_IMP_Minus_correct_time_loop_condition: + "(invoke_subprogram p nth_bit_of_num_IMP_init_while_cond, s) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ + 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 + +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..fe81c2f8 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Arithmetic_Nat.thy @@ -0,0 +1,209 @@ +theory Binary_Arithmetic_Nat + imports Binary_Arithmetic Primitives +begin + + +fun nth_bit_of_num_nat :: "nat \ nat \ nat" where +"nth_bit_of_num_nat x n = (if x = 0 then + (if n = 0 then + 1 \ \x = 0 \ n = 0\ + else + 0 \ \x = 0 \ n \ 0\) + else + if n = 0 then + (if hd_nat x = 0 then + 0 \ \x \ 0 \ n = 0 \ hd_nat x = 0\ + else + 1 \ \x \ 0 \ n = 0 \ hd_nat x \ 0\) + else + nth_bit_of_num_nat (tl_nat x) (n-1))" + +definition nth_bit_of_num_tail ::"nat \ nat \ 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) + 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 \ 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 \ nat \ nat \ nat" where +"nth_carry_nat n a b = (if n = 0 then (if (nth_bit_nat a 0 = 1 \ nth_bit_nat b 0 = 1) then 1 else 0) + else (if (nth_bit_nat a n = 1 \ nth_bit_nat b n = 1) + \ ((nth_bit_nat a n = 1 \ nth_bit_nat b n = 1) \ nth_carry_nat (n-1) a b = 1) + then 1 else 0) )" + +fun nth_carry_acc :: "nat \ nat \ nat \ nat \ nat \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 \ 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 \ nth_bit_tail b (n-diff+1) = 1) + \ ((nth_bit_tail a (n-diff+1) = 1 \ nth_bit_tail b (n-diff+1) = 1) \ (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 \ 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 \n \ 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 \ nth_bit_nat b 0 = 1) + then 1 else 0)" + apply auto + done + +definition nth_carry_tail :: "nat \ nat \ nat \ 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) + done + + + +fun nth_carry_sub_nat :: "nat \ nat \ nat \ nat" where +"nth_carry_sub_nat n a b = (if n =0 + then (if (nth_bit_nat a 0 = 0 \ nth_bit_nat b 0 = 1) + then 1 else 0) + else (if (nth_bit_nat a n = 0 \ ( nth_bit_nat b n = 1 \ nth_carry_sub_nat (n-1) a b = 1)) + \ (nth_bit_nat a n = 1 \ (nth_bit_nat b n) = 1 \ nth_carry_sub_nat (n-1) a b = 1) + then 1 + else 0))" + +fun nth_carry_sub_acc :: "nat \ nat \ nat \ nat \ nat \ 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 \ 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 \ ( nth_bit_tail b (n-diff+1) = 1 \ acc = 1)) + \ (nth_bit_tail a (n-diff+1) = 1 \ (nth_bit_tail b (n-diff+1) ) = 1 \ 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 \ 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 \n \ 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 \ nth_bit_nat b 0 = 1) + then 1 else 0)" + apply auto + done + +definition nth_carry_sub_tail :: "nat \ nat \ nat \ 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 \ 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 +fun bit_list_to_nat_acc:: "nat \ nat \ 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))" + + + +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 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 \ 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.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 \ 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 new file mode 100644 index 00000000..bc88066a --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Binary_Operations_Nat.thy @@ -0,0 +1,786 @@ +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 \ nat" where +"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 \ nat \ 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 \ 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_tail ys" + using com_list_to_seq_rev[of ys 0] append_nat_0 com_list_to_seq_tail_def + by(auto) + + +definition comm_list_encode :: "IMP_Minus_Minus_com list \ nat" where +"comm_list_encode xs = list_encode (map comm_encode xs) " + +definition comm_list_decode :: "nat \ 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 \ nat \ nat \ 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) ) )" + +fun binary_assign_constant_acc:: " nat \ nat \ nat \ nat \ nat \ 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 \n \ + 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 \ nat \ nat \ 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) + 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 \ nat \ nat \ 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)) +" +fun copy_var_to_operand_acc ::"nat \ nat \ nat \ nat \ nat \ 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 \ i \ 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) + 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 \ nat \ nat \ 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 +)" + +fun copy_const_to_operand_acc :: "nat \ nat \ nat \ nat \ nat \ 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\i \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 \ nat \ nat \ 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) + 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 \ nat \ nat \ 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))" + +definition copy_atom_to_operand_tail:: "nat \ nat \ nat \ 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 + 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 \ nat \ nat \ nat \ nat \ 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 \ a + b + c = 3 then 1 else 0) ## 0 ) ## (1##(vname_encode ''carry'')## (if a + b + c \ 2 then 1 else 0) ## 0) ## 0 " + +definition assign_var_carry_tail :: "nat \ nat \ nat \ nat \ nat \ 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 \ a + b + c = 3 then 1 else 0) ## 0 ) ## (1##(vname_encode ''carry'')## (if a + b + c \ 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 + 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 \ nat \ 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 + )" + +definition full_adder_tail :: "nat \ nat \ 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 + Let_def simp flip: char_nat_encode.simps) + apply auto + done + +fun map_adder :: "nat \ nat \ 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 \ nat \ nat \ 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 (\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 \ nat \ 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" + +definition adder_tail:: "nat \ nat \ 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)" + 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 \ nat \nat\ nat \ 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" + +definition binary_adder_tail:: "nat \ nat \nat\ nat \ 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)" + 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 \ nat \ nat \ nat \ nat \ 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 \ b + c = 2 then (if a = 1 then 1 else 0) + else (if b + c = 1 \ 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 \ nat \ nat \ nat \ nat \ 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 \ b + c = 2 then (if a = 1 then 1 else 0) + else (if b + c = 1 \ 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 + 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 \ nat \ 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 + )" + +definition full_subtractor_tail:: "nat \ nat \ 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 + 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 \ nat \ 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" + +definition underflow_handler_tail:: "nat \ nat \ 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 + bit_encode.simps comm_encode.simps vname_list_encode_def sub_binary_assign_constant ) + apply auto + done + +fun map_full_subtractor :: "nat \ nat \ 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 (\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 \ nat \ nat \ 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 \ nat \ 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 \ nat \ 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 +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 \ nat \ nat \ nat \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" + +definition binary_subtractor_tail:: "nat \ nat \ nat \ nat \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)" + 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 \ nat \ nat \ nat" where +"binary_parity_nat n v a = (if fst_nat a \ 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 )" + +definition binary_parity_tail:: "nat \ nat \ nat \ nat" where +"binary_parity_tail n v a = (if fst_nat a \ 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) + 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 \ nat \ 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 +)" + +fun assign_shifted_bits_acc:: "nat \ nat \ nat \ nat \ 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 \ i \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 \ nat \ 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) + 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 \ nat \ 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" + +definition assign_shifted_bits_and_zero_most_significant_tail:: + "nat \ nat \ 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)" + 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 \ nat \ nat \ 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" + +definition binary_right_shift_tail:: "nat \ nat \ nat \ 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 + 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 \ nat \nat \ 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) +)" + +definition assignment_to_binary_tail:: "nat \ nat \nat \ 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)" + 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+/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..18ceda4f --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_State_Translations_nat.thy @@ -0,0 +1,665 @@ +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 \ 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 (\i. i = encode_char (CHR ''#'')) v" + apply (induct v rule:dropWhile_char.induct) + apply (auto) + done + +fun takeWhile_char:: "nat \ 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 (\i. i = encode_char (CHR ''#'')) v" + apply (induct v rule:takeWhile_char.induct) + apply (auto) + apply metis + done + +fun takeWhile_char_acc :: "nat \ nat \ 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 \ + 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 \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 takeWhile_char_induct: " takeWhile_char xs = xs \ +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 \ 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 \ 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 \ hd_nat t = encode_char(CHR ''$'') then some_nat (prod_encode(tl_nat t, l)) + else 0)) + else 0) + else 0)" + +definition var_to_var_bit_tail :: "nat \ 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 \ 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 \ nat" where +"vname_nat_encode (v,n) = prod_encode (vname_encode v, n)" + +fun vname_nat_decode :: "nat \ 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 "\p. \cs n. (cs, n) = p \ prod_encode (vname_encode cs, n) = vname_nat_encode p" + by simp + then show "(case prod_decode (vname_nat_encode x) of (n, x) \ (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 \ 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 \ (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: "(\i. i = encode_char x) \ encode_char = (\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 \ 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 +fun n_hashes_acc :: "nat \ nat \ nat" where +"n_hashes_acc acc 0 = acc" | +"n_hashes_acc acc (Suc n) = n_hashes_acc ((encode_char (CHR ''#'')) ## acc) n" + +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 \ 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 \ nat" where +"var_bit_to_var_nat vk = append_nat (append_nat (n_hashes_nat (snd_nat vk + 1)) + (vname_encode ''$'')) (fst_nat vk)" + +definition var_bit_to_var_tail:: "nat \ nat" where +"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:subtail_append 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) + 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 \ 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 \prod_decode p = (x, y)\ + 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 \ 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 \ nat \ 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 \ 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 \ nat " where +"char_nat_encode (x,n) = prod_encode (encode_char x,n) " + +fun char_nat_decode ::" nat \ (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 \ nat" where +"var_to_operand_bit_nat v = (if v \ 0 \ 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)" + +definition var_to_operand_bit_tail:: "nat \ nat" where +"var_to_operand_bit_tail v = (if v \ 0 \ 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 \ 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 \ (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 \ 0 \ 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 \ nat \ nat \ nat \ vname \ 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) \ if k < n then Some (nth_bit (fun_list_find s v') k) else None | + None \ (case var_to_operand_bit v of + Some (CHR ''a'', k) \ if k < n then Some (nth_bit a k) else None | + Some (CHR ''b'', k) \ if k < n then Some (nth_bit b k) else None | + _ \ (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 \ nat \ nat \ nat \nat \ 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 \ 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 \ 0 \ 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 \ 0 \ 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)))" + +definition IMP_Minus_State_To_IMP_Minus_Minus_with_operands_a_b_tail:: + "nat \ nat \ nat \ nat \nat \ 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 \ 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 \ 0 \ 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 \ 0 \ 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 (\(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 \ nat \ nat \ vname \ 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) \ if k \ n then None else + (if k < r then map_list_find (map (\(x,y). (x,nth_bit y k)) s) v' else Some Zero) | + None \ (case var_to_operand_bit v of + Some (CHR ''a'', k) \ if k < n then Some Zero else None | + Some (CHR ''b'', k) \ if k < n then Some Zero else None | + _ \ (if v = ''carry'' then Some Zero else None)))" + +lemma sub_lambda_partial: "((\x. Some (nth_bit x k)) \\<^sub>m map_of s) v' = + map_list_find (map (\(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 \ nat \ 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 \ nat \ nat \ 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 (\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 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 \ nat \ 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 \ nat \ nat \ nat \ 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 \ 0 then if k \ 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 \ 0 \ vo = encode_char CHR ''a'' then if ko < n then Suc 0 else 0 else if +po \ 0 \ 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 \ nat \ nat \ nat \ 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 \ 0 then if k \ 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 \ 0 \ vo = encode_char CHR ''a'' then if ko < n then Suc 0 else 0 else if +po \ 0 \ 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 +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 "\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 \ nat \ vname \ 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 \ nat \ nat \ 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" + +definition IMP_Minus_State_To_IMP_Minus_Minus_tail:: "nat \ nat \ nat \ 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)" + 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..9068641c --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/IMP_Minus_To_IMP_Minus_Minus_nat.thy @@ -0,0 +1,666 @@ +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 \ nat \ 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 \ nat \ nat \ 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 (\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 \ nat \ 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 \ nat \ nat" where +"var_bit_list_nat n v = map_var_bit_to_var v (list_less_nat n)" + +definition var_bit_list_tail :: "nat \ nat \ 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 + flip: vname_nat_encode.simps ) + apply auto + by (metis comp_apply) + + +declare nth_nat.simps[simp del] +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 \ 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 \ IMPm_IMPmm" where +"IMPm_IMPmm_decode n = (case list_decode n of + [0,x] \ Bot (comm_decode x)| + [Suc 0,n] \ SKIP n| + [Suc (Suc 0) , v , a, n] \ Assign (vname_decode v) (aexp_decode a) n| + [Suc (Suc (Suc 0)), c1, c2,n] \ Seq_0 (com_decode c1) (com_decode c2) n| + [Suc (Suc (Suc (Suc 0))), c1, c2 ,n, c3] \ Seq_m (com_decode c1) (com_decode c2) n (comm_decode c3)| + [Suc (Suc (Suc (Suc (Suc 0)))), c1, c2, n, c3,c4] \ 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] \ 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] \ 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] \ 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] \ While_0 (vname_decode v) (com_decode c) n| + [Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc 0))))))))), v, c, n, c'] \ 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 \ nat" where +"IMPm_IMPmm_list_encode xs = list_encode (map IMPm_IMPmm_encode xs)" + +definition IMPm_IMPmm_list_decode :: "nat \ 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 size_e :: "Com.com \ 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 \ 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 \ nat" where +"size_stack s = size_stack_rev (rev s)" + +lemma +size_stack_mono :" x \ [] \y \ [] \ size_stack_rev y < size_stack_rev x + \ 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) = (\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 \ nat \ IMPm_IMPmm list \ 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 " + +definition push_on_stack_nat :: "nat \ nat \ nat \ 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_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 + + + + + +fun add_result_to_stack :: "IMP_Minus_Minus_com \ IMPm_IMPmm list \ IMPm_IMPmm list" where +"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" + +definition add_result_to_stack_nat :: "nat \ nat \ 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_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) + 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 + +lemma add_res_less: +"\x. s \ [Bot x] \ a \ Bot x \ 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 \ 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"| +"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 (domintros) IMP_Minus_to_IMP_Minus_Minus_stack_nat :: "nat \ 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) +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 = 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(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 (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 ) + +else nth_nat (Suc 0) h + +)" + by pat_completeness auto + +lemma push_non_empty : "push_on_stack c n s \ []" + apply(cases c) + apply auto + done +lemma add_result_non_empty: "add_result_to_stack c s \ []" + apply(cases s) + apply auto + subgoal for a xs + apply(cases a) + apply auto + 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: +" IMP_Minus_to_IMP_Minus_Minus_stack_nat (IMPm_IMPmm_list_encode s) += comm_encode (IMP_Minus_to_IMP_Minus_Minus_stack s) " +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 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 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 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 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 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 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 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 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 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 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 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) += 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_t:: "IMP_Minus_com \ nat \ 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 \ nat \ 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_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_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 \ nat \ 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) + + + + + + +end \ No newline at end of file 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..08e03115 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives.thy @@ -0,0 +1,2284 @@ +theory Primitives + 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_Plus_Plus_To_SAS_Plus +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 \ bit" + +lemma extract_lambda: "(\i. f(g i v)) = f o (\i .g i v)" + by auto + +lemma extract_lambda2: "(\i .g i v) o f = (\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 \ nat" where +"encode_char = of_char " + +definition decode_char :: "nat \ 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 \ x = y" + by (simp add: encode_char_def) + +definition fst_nat :: "nat \ nat" where +"fst_nat \ fst o prod_decode" +definition snd_nat::"nat \ nat" where +"snd_nat \ 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 \ 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 \ nat" where +"hd_nat xs = fst_nat (xs-1)" +definition tl_nat :: "nat \ nat" where +"tl_nat xs = snd_nat (xs-1)" + +fun head :: "nat list \ nat" where +"head [] = 0"| +"head (x#xs) = x" + +fun tail :: "nat list \ nat list" where +"tail [] = []"| +"tail (x#xs) = xs" + +lemma "xs = [] \ 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 \ [] \head xs = hd xs" + apply (cases xs) + apply (auto simp add: hd_nat_def) + done + +lemma sub_tail :" xs \ [] \ 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 \ 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) \ 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 \ 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 \ nat \ 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 \ 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 \ bool) \ nat \ 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 \ bool) \ nat \ 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 \ nat option" where +"option_decode 0 = None"| +"option_decode (Suc x) = Some x" + +fun option_encode :: "nat option \ 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 \ 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 \ nat" where +"vname_encode v = list_encode (map encode_char v)" + +definition vname_decode :: "nat \ 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 \ nat" where +"vname_list_encode l = list_encode (map vname_encode l)" + +definition vname_list_decode :: "nat \ 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 \ nat \ 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 append_acc :: "nat \ nat \ 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 \nat \ 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 \ 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) \ 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 \ 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 \ nat \ 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 \ nat \ 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) \ 0 = (e \ 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 \ set l)" + using sub_elem_of by blast + +fun remdups_nat :: "nat \ nat" where +"remdups_nat n = (if n=0 then 0 else if elemof (hd_nat n) (tl_nat n) \ 0 then remdups_nat (tl_nat n) + else cons (hd_nat n) (remdups_nat (tl_nat n)))" + +fun remdups_acc :: "nat \ nat => nat" where +"remdups_acc acc n =(if n=0 then acc else if elemof (hd_nat n) (tl_nat n) \ 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) + 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 non_empty_not_zero:"list_encode (a#xs) \ 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 \ 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 \(x,y) = prod_decode p \ 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 \ x+y \ 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 \(x,y) = prod_decode p \ y < p" + using prod_sum_less + by (metis add.commute add_lessD1) + + +lemma prod_snd_less2:"(x,y) = prod_decode p \ y \ p" + using prod_sum_less + by (metis le_prod_encode_2 prod_decode_inverse) + + +lemma prod_fst_less2:"(x,y) = prod_decode p \ x \ p" + using prod_sum_less + by (metis le_prod_encode_1 prod_decode_inverse) + + +fun atomExp_encode :: "atomExp \ nat" where +"atomExp_encode (V var) = prod_encode (0, vname_encode var)" | +"atomExp_encode (N n) = prod_encode (1,n) " + +definition atomExp_decode :: "nat \ atomExp" where +"atomExp_decode n = (case prod_decode n of (0,v) \ V (vname_decode v) | (Suc 0,n) \ 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 \ 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 \ aexp" where +"aexp_decode n = (case list_decode n of + [0,a] \ A (atomExp_decode a)| + [Suc 0,a,b] \ Plus (atomExp_decode a) (atomExp_decode b)| + [Suc (Suc 0),a,b] \ Sub (atomExp_decode a) (atomExp_decode b)| + [Suc (Suc (Suc 0)),a] \ Parity (atomExp_decode a)| + [Suc (Suc (Suc (Suc 0))),a] \ 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 \set xs \ 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 \set (list_decode n) \ x < n" +proof - + assume assms:"x \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 \ 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 \ Com.com" where +"com_decode n = (case list_decode n of + [0] \ Com.com.SKIP | + [Suc 0,v,a] \ Com.com.Assign (vname_decode v) (aexp_decode a)| + [Suc (Suc 0),c1,c2] \ Com.com.Seq (com_decode c1) (com_decode c2) | + [Suc(Suc (Suc 0)),v,c1,c2] \ Com.com.If (vname_decode v) (com_decode c1) (com_decode c2)| + [Suc (Suc (Suc (Suc 0))),v,c] \ Com.com.While (vname_decode v) (com_decode c) +)" + +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 ) + done + +fun bit_encode :: "bit \ nat" where +"bit_encode Zero = 0"| +"bit_encode One = 1" + +fun bit_decode :: "nat \ 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 \ 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 \ com" where +"comm_decode n = (case list_decode n of + [0] \ SKIP | + [Suc 0,v,a] \ Assign (vname_decode v) (bit_decode a)| + [Suc (Suc 0),c1,c2] \ Seq (comm_decode c1) (comm_decode c2) | + [Suc(Suc (Suc 0)),v,c1,c2] \ If (vname_list_decode v) (comm_decode c1) (comm_decode c2)| + [Suc (Suc (Suc (Suc 0))),v,c] \ 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 \ nat list \ nat" where +"nth n [] = 0"| +"nth 0 (x#xs) = x"| +"nth (Suc n) (x#xs) = nth n xs" + +fun nth_nat :: "nat \ nat\ 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 \ 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 \ 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 \ 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 + + +fun map_nat :: "(nat\ nat) \ nat \ 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 \ 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 \ 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 \ nat" where +"num_encode x = list_encode (num_to_list x) " + +definition num_decode :: "nat \ 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 \ [] \ 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 \ nat \ 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 \ nat \ nat \ 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.. nat \ 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 \ nat" where +"list_less_nat n = list_from_nat 0 n" + +definition list_less_tail :: "nat \ 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.. remdups (map f xs) = map f (remdups xs)" + apply (induct xs) + apply (auto simp add:inj_def) + done + +fun concat_nat :: "nat \ 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 \ nat \ 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 + apply (subst concat_nat.simps) + 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 \ 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) + + + +fun domain_element_encode ::"domain_element \ 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 \ domain_element" where +"domain_element_decode n = (case prod_decode n of + (0,b) \ EV (bit_decode b)| + (Suc 0 , com) \ 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 \ nat" where +"variable_encode PC = 0"| +"variable_encode (VN vn) = Suc (vname_encode vn)" + +fun variable_decode :: "nat \ 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 \ nat" where +"sas_assignment_encode (v,d) = prod_encode (variable_encode v, domain_element_encode d)" + +fun sas_assignment_decode:: "nat \ (variable * domain_element) " where +"sas_assignment_decode n = (case prod_decode n of (v,d) \ (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 \ 'a" where +"someOf (Some x) = x" + + +definition map_to_list :: "('a,'b) map \ ('a*'b) list" where +"map_to_list s \ (SOME l. map_of l = s)" + +lemma has_map: + fixes s + assumes "finite (dom s)" + shows "\l. map_of l = s " +proof - + obtain n where n_def:"n = card (dom s)" by blast + then show "\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 \ {}" using card_gt_0_iff + by force + then obtain x where x_def: "x \ 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) \ 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 \ nat" where +"sas_state_encode xs = list_encode (map sas_assignment_encode (map_to_list xs)) " + +definition sas_state_decode :: "nat \ sas_state" where +"sas_state_decode n = map_of (map sas_assignment_decode (list_decode n)) " + + +lemma sas_state_id : "finite (dom x) \ 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 \ nat" where +"imp_assignment_encode (v,d) = prod_encode (vname_encode v, bit_encode d)" + +fun imp_assignment_decode:: "nat \ (vname * bit)" where +"imp_assignment_decode n = (case prod_decode n of (v,d) \ (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 \ nat" where +"imp_state_encode xs = list_encode (map imp_assignment_encode (map_to_list xs)) " + +definition imp_state_decode :: "nat \ imp_state" where +"imp_state_decode n = map_of (map imp_assignment_decode (list_decode n))" + +lemma imp_state_id : " finite (dom x) \ 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) \ nat" where +"comm_imp_state_encode (c,i) = prod_encode (comm_encode c, imp_state_encode i)" + +fun comm_imp_state_decode :: "nat \ (com*imp_state)" where +"comm_imp_state_decode n = (case prod_decode n of (c,i) \ (comm_decode c, imp_state_decode i))" + +lemma comm_imp_state_id: + "finite (dom (snd x)) \ 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 \ nat" where +"imp_assignment_list_encode xs = list_encode (map imp_assignment_encode xs)" + +definition imp_assignment_list_decode :: "nat \ (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) \ nat" where +"cilist_encode (c,i) = prod_encode (comm_encode c, imp_assignment_list_encode i)" + +fun cilist_decode :: " nat \ (com * (vname*bit) list)" where +"cilist_decode n = (case prod_decode n of (c,i) \ + (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) \ (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 \ nat" where +"sas_assignment_list_encode xs =list_encode (map sas_assignment_encode xs)" + +definition sas_assignment_list_decode :: "nat \ (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 \ 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 \ operator" where +"operator_decode n = ( case list_decode n of [p,e] \ + \precondition_of = sas_assignment_list_decode p, + effect_of = sas_assignment_list_decode e \ ) " + +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 \ nat \ nat \ 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)" + +definition list_update_tail :: "nat \ nat \ nat \ 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) + 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 \ 'vname list \ ('vname,'bit) assignment list" where +"restrict_list [] s = []" | +"restrict_list ((x,y)#xs) s = (if x \ 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>\\<^sub>+)" [1000] 999) + operators_ofl :: "('variable, 'domain) sas_plus_operator list" ("(_\<^sub>\\<^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 \ nat" where +"vdlist_encode (x,y) = prod_encode (variable_encode x,list_encode (map domain_element_encode y))" + +fun vdlist_decode :: "nat \ (variable, domain_element list) assignment" where +"vdlist_decode n = (case prod_decode n of (x,y) \ (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 \('v,'d)sas_plus_problem" + where " list_problem_to_problem x = + \ 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) + \" + +definition list_problem_encode :: + "(variable,domain_element) sas_plus_list_problem \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 \ (variable,domain_element) sas_plus_list_problem" where +"list_problem_decode x = (case list_decode x of +[var,op,i,g,r] \ \ 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) \ )" + +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 \ nat \ 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 \ 0 then + (hd_nat l)## t else t))) " + +fun restrict_acc :: "nat \ nat \ nat \ nat" where +"restrict_acc acc l s = (if l = 0 then acc else(if elemof (fst_nat (hd_nat l)) s \ 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)" + 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 + +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 \ nat \ 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" +fun var_encode :: "var \ nat" where +"var_encode Stage = 0 " | +"var_encode (Var v) = Suc (variable_encode v)" + +fun var_decode :: "nat \ 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 \ 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 \ 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 \ nat" where + "sas_plus_assignment_encode (v,d) = prod_encode(var_encode v, dom_encode d)" + +fun sas_plus_assignment_decode:: " nat \ (var,dom) assignment" where + "sas_plus_assignment_decode n = (case prod_decode n of (v,d) \ + (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 \ nat " + where "sas_plus_assignment_list_encode x = list_encode (map sas_plus_assignment_encode x)" + +definition sas_plus_assignment_list_decode :: "nat \ (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 \ (variable,domain_element) assignment list) \ nat" where +"islist_encode (i,s) = prod_encode (dom_encode i, sas_assignment_list_encode s)" + +fun islist_decode :: "nat \ (dom \ (variable,domain_element) assignment list)" where +"islist_decode n = (case prod_decode n of (i,s) \ + (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 \ (variable,domain_element) assignment list) \ (dom \ sas_state) " where +"islist_to_map (i,s) = (i,map_of s)" + +definition sas_plus_state_decode :: "nat \ 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 \ 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 \ operator_plus" where +"operator_plus_decode n = ( case list_decode n of [p,e] \ + \precondition_of = sas_plus_assignment_list_decode p, + effect_of = sas_plus_assignment_list_decode e \ ) " + +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 \ nat" where + "the_nat x = x-1" + +fun list_option_encode :: " nat list option \ nat" where +"list_option_encode None = 0"| +"list_option_encode (Some x) = Suc (list_encode x)" + +fun list_option_decode :: "nat \ 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 \ 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 \'a \ '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 \ nat \ 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 \ nat \ 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)" + 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 \ nat" where +"vdlist_plus_encode (x,y) = prod_encode (var_encode x,list_encode (map dom_encode y))" + +fun vdlist_plus_decode :: "nat \ (var, dom list) assignment" where +"vdlist_plus_decode n = (case prod_decode n of (x,y) \ (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 \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 \ (var,dom) sas_plus_list_problem" where +"list_problem_plus_decode x = (case list_decode x of +[var,op,i,g,r] \ \ 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) \ )" + +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 \ vname \ nat" where +"fun_of x v = (case (map_of x) v of None \ 0 | Some x \ x)" + +fun fun_list_find :: "('a,nat) assignment list \ 'a \ 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 \ nat \ 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 \ nat \ 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" + 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 \ nat" where +"impm_assignment_encode (v,n) = prod_encode (vname_encode v, n)" + +fun impm_assignment_decode :: " nat \ (vname,nat) assignment" where +"impm_assignment_decode x = (case prod_decode x of (v,n) \ (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 \ nat" where +"impm_assignment_list_encode x = list_encode (map impm_assignment_encode x)" + +definition impm_assignment_list_decode :: "nat \ (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 \ nat" where +"bit_option_encode None = 0"| +"bit_option_encode (Some x) = Suc (bit_encode x)" + +fun bit_option_decode :: "nat \ 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 \ fun_list_find (map (\(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 \ fun_list_find (map (\(x,y). (f x, g y) ) xs) (f x) = +fun_list_find (map (\(x,y). (x , g y)) xs) x +" + apply ( induct xs) + apply (auto simp add:inj_def) + done + +fun max_list :: "nat list \ nat" where +"max_list [] = 0"| +"max_list (x#xs) = max x (max_list xs)" + +fun max_list_nat :: "nat \ 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 \ nat \ 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 + apply (subst max_list_nat.simps) + apply (auto simp only: sub_tl tail.simps sub_hd head.simps) + 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 \ 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 \ [] \ 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 \ 'a \ ('a,'b) assignment list" where +"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(\x. fst x \ a) xs" + apply(induct xs) + apply auto + done + + +fun del_nat :: "nat \ nat \ 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: "\(x,y) \ set (del xs a). x \ a" + apply (induct xs) + apply auto + by (smt case_prod_conv set_ConsD) + +lemma del_correct_corr: " a \ x \ 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 \ ('a,'b) assignment list" where +"nub [] = [] "| +"nub ((x,y)#xs) = (x,y) # nub (del xs x) " + +lemma del_shorter : "length (del xs a) \ length xs" + apply (induct xs) + apply auto + done + +function nub_nat :: "nat \ 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 \ []" 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) \ set xs" + apply (induct xs) + apply (auto split:if_splits) + done + +lemma nub_includes: "set (nub xs) \ 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 \ 'b list" where +"ran_list xs = map snd (nub xs)" + +fun map_snd :: "nat \ 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 \ nat" where +"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 submap_snd + sub_nub sub_map map_map comp_def sub_snd) + done + +lemma sub_ran_list_helper : "distinct (map fst xs) \ +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 \ [] \ ran_list I \ []" + apply (cases I) + apply (auto simp add:ran_list_def ) + done +lemma del_inj: "inj f \del (map (\(a, y). (f a, y)) I) (f a) = map (\(a, y). (f a, y)) ( del I a) " + apply (induct I) + apply (auto simp add:inj_def) + done +lemma nub_inj : "inj f \ nub (map (\(a, y). (f a, y)) I) = map (\(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 \ran_list (map (\(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 (\(x,y). (x, the y)) (filter (\(x,y) . y \ None) (map (\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 (\(x,y). (x, the y)) (filter (\(x,y) . y \ None) (map (\x. (x,f x)) xs))) = (f |` set xs) " + using sub_restrict_apply by fast + +fun filter_nat ::"(nat\ bool) \ nat \ 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 (\n. prod_encode(fst_nat n, the_nat (snd_nat n))) (filter_nat (\n . snd_nat n \ 0) (map_nat (\x. prod_encode(x,option_encode (f x))) (list_encode xs))) + = list_encode (map prod_encode (map (\(x,y). (x, the y)) (filter (\(x,y) . y \ None) (map (\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 \ 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 \ map_list_find (map (\(x,y). (f x, g y)) s) (f x) = +map_list_find (map (\(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 \ map_list_find (map (\(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 (\(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 \ nat" where +"bool_encode False = 0"| +"bool_encode True = 1" + +fun bool_decode :: "nat \ 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 \ nat" where +"strips_assignment_encode (s,b) = prod_encode (sas_plus_assignment_encode s , bool_encode b)" + +fun strips_assignment_decode :: "nat \ ((var,dom) assignment,bool) assignment" where +"strips_assignment_decode n = (case prod_decode n of (s,b) \ +(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 \ nat" where +"strips_assignment_list_encode x = list_encode (map strips_assignment_encode x)" + +definition strips_assignment_list_decode :: "nat \ ((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 (\(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 \ 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 \ (var,dom) assignment strips_operator " where +"strips_operator_decode n = (case list_decode n of [pre,add,delete] \ + \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 \) +" + +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>\)" [1000] 999) + operators_of :: "'variable strips_operator list" ("(_\<^sub>\)" [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 \ ('variable)strips_problem" where +"strips_list_problem_to_problem P = +\ + 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) + \" + +definition strips_operator_list_encode :: " (var,dom) assignment strips_operator list \ nat" where +" strips_operator_list_encode xs = list_encode (map strips_operator_encode xs)" + +definition strips_operator_list_decode :: " nat \ (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 \ 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 \ ((var,dom) assignment) strips_list_problem" where +"strips_list_problem_decode n = (case list_decode n of +[vs,ops,I,gs] \ \ + 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 + \ )" + +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 \ 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 \ sat_plan_variable" where +"sat_variable_decode n = (case list_decode n of [0,x,y] \ State x y | [Suc 0, x ,y] \ 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 \ 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 \ sat_plan_formula" where +"sat_formula_decode n = (case list_decode n of + [0] \ Bot| + [Suc 0,v] \ Atom (sat_variable_decode v)| + [Suc (Suc 0),v] \ Not (sat_formula_decode v)| + [Suc (Suc (Suc 0)),a,b] \ And (sat_formula_decode a) (sat_formula_decode b)| + [Suc (Suc (Suc (Suc 0))),a,b] \ Or (sat_formula_decode a) (sat_formula_decode b)| + [Suc (Suc (Suc (Suc (Suc 0)))),a,b] \ 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 \ nat" where +"bool_option_encode None = 0"| +"bool_option_encode (Some b) = Suc (bool_encode b)" + +fun bool_option_decode :: "nat \ 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 \ nat \ 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 \ 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 \nat" where +"sat_formula_list_encode xs = list_encode (map sat_formula_encode xs)" + +definition sat_formula_list_decode :: "nat \ 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 \ 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 \ nat \ 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) + 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 + +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 \ 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 \ 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 + +fun BigOr_acc:: "nat \ nat \ 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 \ 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 (\(s,b). (sas_plus_assignment_encode s, bool_encode b))" + apply (auto) + done + +fun map_pair :: "nat \ nat \ 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 \ nat \ nat \ 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 (\(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 + +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 \ nat \ 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 (\(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_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 \ (elemof (f e) (list_encode (map f l)) \ 0) = (e \ 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 + +fun map_acc :: "(nat \ nat) \ nat \ nat \ 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 \ bool) \ nat \ nat \ 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 \ 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) + +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 \ nat \ 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 \ nat \ nat \ 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 \ nat \ 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 \ nat \ 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 \ 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 (\x. fst_nat x \ 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 \nat \ nat \ 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 (\x. fst_nat x \ a) acc xs " + apply(induct acc xs a rule:del_acc.induct) + apply auto + done + +definition del_tail :: "nat \ nat \ 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 \ nat \ 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 (\(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 \ []" 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 \ 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 \ 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 + +fun length_acc :: "nat \ nat \ 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 \ 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-_To_IMP--/Primitives_IMP_Minus.thy b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy new file mode 100644 index 00000000..470ba169 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP-_To_IMP--/Primitives_IMP_Minus.thy @@ -0,0 +1,1924 @@ +\<^marker>\creator Mohammad Abdulaziz, Florian Keßler\ + +theory Primitives_IMP_Minus + imports "HOL-Library.Nat_Bijection" Primitives IMP_Minus.Call_By_Prefixes +begin +subsection \Multiplication\ + +record mul_state = mul_a::nat mul_b::nat mul_c::nat + +abbreviation "mul_prefix \ ''mul.''" +abbreviation "mul_a_str \ ''a''" +abbreviation "mul_b_str \ ''b''" +abbreviation "mul_c_str \ ''c''" + + +definition "mul_state_upd s \ + let + d = (mul_b s) mod 2; + mul_c = (if d \ 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 = \mul_a = mul_a, mul_b = mul_b, mul_c = mul_c\ + in + ret +" + +function mul_imp:: "mul_state \ mul_state" where +"mul_imp s = + (if mul_b s \ 0 then \ \While b \ 0\ + ( + 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 (\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 \ mul_state\ nat" where +"mul_imp_time t s = +( + (if mul_b s \ 0 then \ \While b \ 0\ + ( + let + t = t + 1; \ \To account for while loop condition checking\ + mul_d = (mul_b s) mod 2::nat; + t = t + 2; + mul_c = (if mul_d \ 0 then mul_c s + mul_a s else mul_c s); + t = t + 1 + (if mul_d \ 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 + ( + \ \To account for the two steps of checking the condition and skipping the loop\ + let + t = t + 2; + ret = t + in + ret + ) + ) +)" + by pat_completeness auto +termination + by (relation "measure (\(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 \ + (\ \if b \ 0 then\ + WHILE mul_b_str\0 DO + \ \d = b mod 2;\ + (''d'' ::= ((V mul_b_str) \1);; + \ \c = (if d \ 0 then c + a else c);\ + IF ''d''\0 THEN mul_c_str ::= ((V mul_c_str) \ (V mul_a_str)) ELSE mul_c_str ::= A (V mul_c_str);; + \ \a = a + a;\ + mul_a_str ::= ((V mul_a_str) \ (V mul_a_str));; + \ \b = b div 2;\ + mul_b_str ::= ((V mul_b_str) \)) + )" + +(*definition mul_IMP_Minus_state_transformer where "mul_IMP_Minus_state_transformer p s \ + 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 = + \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))\" + +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) \\<^bsup>t\<^esup> s' \ 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) \\<^bsup>t\<^esup> s' \ 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) \\<^bsup>t\<^esup> s' \ p @ v \ vars \ \ (set mul_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) mul_IMP_minus, s) \\<^bsup>t\<^esup> s'; + \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)); + \v. p1 @ v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using mul_IMP_minus_correct_time mul_IMP_minus_correct_function mul_IMP_minus_correct_effects + by auto + +subsection \Encoding and decoding natural numbers\ + +record triangle_state = triangle_a::nat triangle_triangle::nat + +abbreviation "triangle_prefix \ ''triangle.''" +abbreviation "triangle_a_str \ ''a''" +abbreviation "triangle_triangle_str \ ''triangle''" + + +definition "triangle_state_upd (s::triangle_state) \ + let + mul_a' = triangle_a s; + mul_b' = (triangle_a s) + 1; + mul_c' = 0; + (triangle_mul_state::mul_state) = \mul_a = mul_a', mul_b = mul_b', mul_c = mul_c'\; + mul_ret = (mul_imp triangle_mul_state); + triangle_triangle = (mul_c mul_ret) div 2; + ret = \triangle_a = triangle_a s,triangle_triangle = triangle_triangle\ + in + ret +" + +fun triangle_imp:: "triangle_state \ triangle_state" where +"triangle_imp s = + (let + ret = triangle_state_upd s + in + 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_imp.simps triangle_def triangle_state_upd_def Let_def mul_imp_correct split: if_splits) +qed + +fun triangle_imp_time:: "nat \ triangle_state \ nat" where +"triangle_imp_time t s = + (let + mul_a' = triangle_a s; + t = t + 2; + mul_b' = (triangle_a s) + 1; + t = t + 2; + mul_c' = 0; + t = t + 2; + (triangle_mul_state::mul_state) = \mul_a = mul_a', mul_b = mul_b', mul_c = mul_c'\; + mul_ret = (mul_imp triangle_mul_state); + 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; + t = t + 2; + ret = t + in + ret + )" + +lemmas [simp del] = triangle_imp_time.simps + +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 \ + ( + \ \mul_a' = triangle_a s;\ + (mul_prefix @ mul_a_str) ::= (A (V mul_a_str)) ;; + \ \mul_b' = (triangle_a s) + 1;\ + (mul_prefix @ mul_b_str) ::= ((V mul_a_str) \ (N 1));; + \ \mul_c' = 0;\ + (mul_prefix @ mul_c_str) ::= (A (N 0)) ;; + \ \(mul_state::mul_state) = \mul_a = mul_a, mul_b = mul_b, mul_c = 0\;\ + \ \mul_ret = (mul_imp mul_state);\ + invoke_subprogram mul_prefix mul_IMP_minus;; + \ \triangle_triangle = mul_c mul_ret div 2;\ + triangle_triangle_str ::= (V (mul_prefix @ mul_c_str) \);; + triangle_a_str ::= A (V mul_a_str) + )" + + +(*definition triangle_IMP_Minus_state_transformer where "triangle_IMP_Minus_state_transformer p s \ + (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 = + \triangle_a = s (add_prefix p triangle_a_str), triangle_triangle = (s (add_prefix p triangle_triangle_str))\" + +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 rev_add_prefix_all_variables: + "p1 \ [] \ (add_prefix p2 v \ set (all_variables (invoke_subprogram p1 (c::pcom) p2)))" + nitpick + apply(induction p1 arbitrary: c p2) + subgoal by auto + subgoal apply auto + + +lemma rev_add_prefix_all_variables:"(add_prefix p v \ set (all_variables (invoke_subprogram p1 c p2))) + = (rev (add_prefix p v) \ set (map rev (all_variables (invoke_subprogram p1 c p2))))" + by auto +*) + +lemma cons_append: "xs \ [] \ x # xs = [x] @ xs" + by simp + +lemma triangle_IMP_Minus_correct_function: + "(invoke_subprogram p triangle_IMP_Minus, s) + \\<^bsup>t \<^esup> s' + \ 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)+ + \ \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.\ + 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] + apply(auto simp: mul_imp_to_HOL_state_def)[1] + done + +lemma triangle_IMP_Minus_correct_time: + "(invoke_subprogram p triangle_IMP_Minus, s) + \\<^bsup>t\<^esup> s' + \ t = triangle_imp_time 0 (triangle_imp_to_HOL_state p s)" + 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(erule mul_IMP_minus_correct[where vars = "{p @ triangle_triangle_str}"]) + \ \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\ + 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 + +lemma triangle_IMP_Minus_correct_effects: + "(invoke_subprogram (p @ triangle_pref) triangle_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ p @ v \ vars \ \ (set triangle_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) triangle_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \t = (triangle_imp_time 0 (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)); + \v. p1 @ v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using triangle_IMP_Minus_correct_time triangle_IMP_Minus_correct_function + triangle_IMP_Minus_correct_effects + by auto + +record prod_encode_state = prod_encode_a::nat prod_encode_b::nat prod_encode_ret::nat + +abbreviation "prod_encode_prefix \ ''prod_encode.''" +abbreviation "prod_encode_a_str \ ''a''" +abbreviation "prod_encode_b_str \ ''b''" +abbreviation "prod_encode_ret_str \ ''prod_encode_ret''" + +definition "prod_encode_state_upd (s::prod_encode_state) \ + let + triangle_a = prod_encode_a s + prod_encode_b s; + triangle_triangle' = 0; + (triangle_state::triangle_state) = \triangle_a = triangle_a, triangle_triangle = triangle_triangle'\; + triangle_ret = (triangle_imp triangle_state); + prod_encode_ret = triangle_triangle triangle_ret; + prod_encode_ret = prod_encode_ret + prod_encode_a s; + ret = \prod_encode_a = prod_encode_a s,prod_encode_b = prod_encode_b s, prod_encode_ret = prod_encode_ret\ + in + ret +" + +fun prod_encode_imp:: "prod_encode_state \ 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 \ prod_encode_state \ 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) = \triangle_a = triangle_a, triangle_triangle = triangle_triangle'\; + 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) = \triangle_a = triangle_a, triangle_triangle = 0\; + 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 \ + (triangle_prefix @ triangle_a_str) ::= ((V prod_encode_a_str) \ (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) \ (V prod_encode_ret_str))" + +definition "prod_encode_imp_to_HOL_state p s = + \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))\" + +lemma notD: "x \ s \ (x \ s \ False)" + by auto + +lemma prod_encode_IMP_Minus_correct_function: + "(invoke_subprogram p prod_encode_IMP_Minus, s) + \\<^bsup>t \<^esup> s' + \ 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)+ + \ \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.\ + 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] + 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) + \\<^bsup>t\<^esup> s' + \ 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)+ + \ \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.\ + 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) \\<^bsup>t\<^esup> s' \ p @ v \ vars \ \ (set prod_encode_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) prod_encode_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \t = (prod_encode_imp_time 0 (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)); + \v. p1 @ v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using prod_encode_IMP_Minus_correct_time prod_encode_IMP_Minus_correct_function + prod_encode_IMP_Minus_correct_effects + by auto + +record prod_decode_aux_state = prod_decode_aux_k::nat prod_decode_aux_m::nat + +abbreviation "prod_decode_aux_pref \ ''prod_decode_aux.''" +abbreviation "prod_decode_aux_k_str \ ''k''" +abbreviation "prod_decode_aux_m_str \ ''m''" + +definition "prod_decode_aux_state_upd s \ + let + prod_decode_aux_k' = Suc (prod_decode_aux_k s); + prod_decode_aux_m' = (prod_decode_aux_m s) - prod_decode_aux_k'; + ret = \prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\ + in + ret +" + +function prod_decode_aux_imp :: "prod_decode_aux_state \ prod_decode_aux_state" + where "prod_decode_aux_imp s = + (if prod_decode_aux_m s - prod_decode_aux_k s \ 0 \ \while condition\ + 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 (\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_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 \ prod_decode_aux_state\ nat" where +"prod_decode_aux_imp_time t s = +( + (if prod_decode_aux_m s - prod_decode_aux_k s \ 0 then \ \While\ + ( + let + t = t + 3; \ \To account for while loop condition checking and difference computation\ + prod_decode_aux_k' = Suc (prod_decode_aux_k s); + t = t + 2; + 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 + next_iteration + ) + else + ( + \ \To account for the two steps of checking the condition, skipping the loop, and the difference computation\ + let + t = t + 4; + ret = t + in + ret + ) + ) +)" + by pat_completeness auto +termination + by (relation "measure (\(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 + +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 \ + (\ \if prod_decode_aux_m s - prod_decode_aux_k s \ 0 then\ + ''diff'' ::= ((V prod_decode_aux_m_str) \ (V prod_decode_aux_k_str));; + WHILE ''diff''\0 DO ( + \ \prod_decode_aux_k' = Suc (prod_decode_aux_k s);\ + prod_decode_aux_k_str ::= ((V prod_decode_aux_k_str) \ (N 1));; + \ \prod_decode_aux_m' = (prod_decode_aux_m s) - prod_decode_aux_k';\ + prod_decode_aux_m_str ::= ((V prod_decode_aux_m_str) \ (V prod_decode_aux_k_str));; + ''diff'' ::= ((V prod_decode_aux_m_str) \ (V prod_decode_aux_k_str))) + )" + +definition "prod_decode_aux_imp_to_HOL_state p s = + \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))\" + +lemma prod_decode_aux_IMP_Minus_correct_function_1: + "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) + 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_tE_While_init) + 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_IMP_Minus_correct_function_2: + "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) + 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_tE_While_init) + apply assumption + apply(dest_com_init_while) + apply(erule Seq_tE)+ + apply(drule AssignD)+ + apply(elim conjE) + 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 + +lemma prod_decode_aux_IMP_Minus_correct_time: + "(invoke_subprogram p prod_decode_aux_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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_tE_While_init) + apply assumption + apply(dest_com_init_while) + apply(erule Seq_tE)+ + apply(drule AssignD)+ + apply(elim conjE) + 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 @ p2) prod_decode_aux_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ p @ v \ vars \ \ (set p2 \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) prod_decode_aux_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \t = (prod_decode_aux_imp_time 0 (prod_decode_aux_imp_to_HOL_state (p1 @ p2) s)); + 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)); + \v. p1 @ v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ 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 + +abbreviation "prod_decode_prefix \ ''prod_decode.''" +abbreviation "prod_decode_m_str \ ''m''" +abbreviation "prod_decode_fst_ret_str \ ''fst_ret''" +abbreviation "prod_decode_snd_ret_str \ ''snd_ret''" + +definition "prod_decode_state_upd s \ + let + prod_decode_aux_k' = 0; + prod_decode_aux_m' = (prod_decode_m s); + prod_decode_aux_state = \prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\; + 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 = \prod_decode_m = prod_decode_m s, fst_ret = fst_ret', snd_ret = snd_ret'\ + in + ret +" + +fun prod_decode_imp :: "prod_decode_state \ 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 \ prod_decode_state\ 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 = \prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\; + 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 \ + ( \ \prod_decode_aux_k' = 0;\ + (prod_decode_aux_pref @ prod_decode_aux_k_str) ::= (A (N 0));; + \ \prod_decode_aux_m' = (prod_decode_m s);\ + (prod_decode_aux_pref @ prod_decode_aux_m_str) ::= (A (V prod_decode_m_str));; + \ \prod_decode_aux_state = \prod_decode_aux_k = prod_decode_aux_k', prod_decode_aux_m = prod_decode_aux_m'\;\ + \ \prod_decode_aux_ret = prod_decode_aux_imp prod_decode_aux_state;\ + invoke_subprogram prod_decode_aux_pref prod_decode_aux_IMP_Minus;; + \ \fst_ret' = prod_decode_aux_m prod_decode_aux_ret;\ + prod_decode_fst_ret_str ::= (A (V (prod_decode_aux_pref @ prod_decode_aux_m_str)));; + \ \snd_ret' = prod_decode_aux_k prod_decode_aux_ret - prod_decode_aux_m prod_decode_aux_ret;\ + prod_decode_snd_ret_str ::= ((V (prod_decode_aux_pref @ prod_decode_aux_k_str)) \ (V (prod_decode_aux_pref @ prod_decode_aux_m_str))) + )" + +definition "prod_decode_imp_to_HOL_state p s = + \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))\" + +lemma prod_decode_IMP_Minus_correct_function_1: + "(invoke_subprogram p prod_decode_IMP_Minus, s) \\<^bsup>t\<^esup> 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 @ 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] + 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) \\<^bsup>t\<^esup> 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 @ 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] + 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) \\<^bsup>t\<^esup> s' \ + 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 @ 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] + apply(auto simp: prod_decode_imp_to_HOL_state_def)[1] + done + +lemma prod_decode_IMP_Minus_correct_effects: + "(invoke_subprogram (p @ p2) prod_decode_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ p @ v \ vars \ \ (set p2 \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) prod_decode_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \t = (prod_decode_imp_time 0 (prod_decode_imp_to_HOL_state (p1 @ p2) s)); + 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)); \v. p1 @ v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v); + \v. p1 @ v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ 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 + +subsection \Head and tail of lists\ + +record hd_state = hd_xs::nat hd_ret::nat + +abbreviation "hd_prefix \ ''hd.''" +abbreviation "hd_xs_str \ ''xs''" +abbreviation "hd_ret_str \ ''hd_ret''" + +definition "hd_state_upd s \ + let + prod_decode_m' = hd_xs s - 1; + prod_decode_fst_ret' = 0; + prod_decode_snd_ret' = 0; + prod_decode_state = \prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\; + prod_decode_ret = prod_decode_imp prod_decode_state; + hd_ret' = prod_decode_fst_ret prod_decode_ret; + ret = \hd_xs = hd_xs s, hd_ret = hd_ret'\ + in + ret +" + +fun hd_imp :: "hd_state \ 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 \ hd_state\ 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 = \prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\; + 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 \ + ( \ \prod_decode_m' = hd_xs s - 1;\ + (prod_decode_prefix @ prod_decode_m_str) ::= ((V hd_xs_str) \ (N 1));; + \ \prod_decode_fst_ret' = 0;\ + (prod_decode_prefix @ prod_decode_fst_ret_str) ::= (A (N 0));; + \ \prod_decode_snd_ret' = 0;\ + (prod_decode_prefix @ prod_decode_snd_ret_str) ::= (A (N 0));; + \ \prod_decode_state = \prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\;\ + \ \prod_decode_ret = prod_decode_imp prod_decode_state;\ + invoke_subprogram prod_decode_prefix prod_decode_IMP_Minus;; + \ \hd_ret' = prod_decode_fst_ret prod_decode_ret;\ + (hd_ret_str) ::= (A (V (prod_decode_prefix @ prod_decode_fst_ret_str))) + )" + +definition "hd_imp_to_HOL_state p s = + \hd_xs = (s (add_prefix p hd_xs_str)), hd_ret = (s (add_prefix p hd_ret_str))\" + +lemma hd_IMP_Minus_correct_function: + "(invoke_subprogram p hd_IMP_Minus, s) \\<^bsup>t\<^esup> 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 @ 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] + 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) \\<^bsup>t\<^esup> s' \ + 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 @ 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] + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set hd_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) hd_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + (\v. v \ vars \ \ (set p2 \ set v)); + \t = (hd_imp_time 0 (hd_imp_to_HOL_state (p1 @ p2) s)); + s' (add_prefix (p1 @ p2) hd_ret_str) = hd_ret (hd_imp (hd_imp_to_HOL_state (p1 @ p2) s)); + \v. v \ vars \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ 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 + +abbreviation "tl_prefix \ ''tl.''" +abbreviation "tl_xs_str \ ''xs''" +abbreviation "tl_ret_str \ ''tl_ret''" + +definition "tl_state_upd s \ + let + prod_decode_m' = tl_xs s - 1; + prod_decode_fst_ret' = 0; + prod_decode_snd_ret' = 0; + prod_decode_state = \prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\; + prod_decode_ret = prod_decode_imp prod_decode_state; + tl_ret' = prod_decode_snd_ret prod_decode_ret; + ret = \tl_xs = tl_xs s, tl_ret = tl_ret'\ + in + ret +" + +fun tl_imp :: "tl_state \ 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 \ tl_state\ 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 = \prod_decode_m = prod_decode_m', prod_decode_fst_ret = prod_decode_fst_ret', prod_decode_snd_ret = prod_decode_snd_ret'\; + 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 \ + ( \ \prod_decode_m' = tl_xs s - 1;\ + (prod_decode_prefix @ prod_decode_m_str) ::= ((V tl_xs_str) \ (N 1));; + \ \prod_decode_snd_ret' = 0;\ + (prod_decode_prefix @ prod_decode_fst_ret_str) ::= (A (N 0));; + \ \prod_decode_snd_ret' = 0;\ + (prod_decode_prefix @ prod_decode_snd_ret_str) ::= (A (N 0));; + \ \prod_decode_state = \prod_decode_m = prod_decode_m', prod_decode_snd_ret = prod_decode_snd_ret', prod_decode_snd_ret = prod_decode_snd_ret'\;\ + \ \prod_decode_ret = prod_decode_imp prod_decode_state;\ + invoke_subprogram prod_decode_prefix prod_decode_IMP_Minus;; + \ \tl_ret' = prod_decode_snd_ret prod_decode_ret;\ + (tl_ret_str) ::= (A (V (prod_decode_prefix @ prod_decode_snd_ret_str))) + )" + +definition "tl_imp_to_HOL_state p s = + \tl_xs = (s (add_prefix p tl_xs_str)), tl_ret = (s (add_prefix p tl_ret_str))\" + +lemma tl_IMP_Minus_correct_function: + "(invoke_subprogram p tl_IMP_Minus, s) \\<^bsup>t\<^esup> 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 @ 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] + 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) \\<^bsup>t\<^esup> s' \ + 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 @ 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] + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set tl_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) tl_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + (\v. v \ vars \ \ (set p2 \ set v)); + \t = (tl_imp_time 0 (tl_imp_to_HOL_state (p1 @ p2) s)); + s' (add_prefix (p1 @ p2) tl_ret_str) = tl_ret (tl_imp (tl_imp_to_HOL_state (p1 @ p2) s)); + \v. v \ vars \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using tl_IMP_Minus_correct_time tl_IMP_Minus_correct_function + tl_IMP_Minus_correct_effects + by auto + +subsection \List length\ + +record length_state = length_xs::nat length_ret::nat + +abbreviation "length_prefix \ ''length.''" +abbreviation "length_xs_str \ ''xs''" +abbreviation "length_ret_str \ ''length_ret''" + +definition "length_state_upd s \ + let + tl_xs' = (length_xs s); + tl_ret' = 0; + tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\; + tl_state_ret = tl_imp tl_state; + length_xs' = tl_ret tl_state_ret; + length_ret' = length_ret s + 1; + ret = \length_xs = length_xs', length_ret = length_ret'\ + in + ret +" + +function length_imp:: "length_state \ length_state" where +"length_imp s = + (if length_xs s \ 0 then \ \While xs \ 0\ + ( + 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 (\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 + 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 \ length_state\ nat" where + "length_imp_time t s = + (if length_xs s \ 0 then \ \While xs \ 0\ + ( + let + t = t + 1; + tl_xs' = (length_xs s); + t = t+2; + tl_ret' = 0; + t = t+2; + tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\; + 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 (\(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 \ + ( + \ \if length_xs s \ 0 then \ \While xs \ 0\\ + WHILE length_xs_str \0 DO ( + \ \tl_xs' = (length_xs s);\ + (tl_prefix @ tl_xs_str) ::= (A (V length_xs_str));; + \ \tl_ret' = 0;\ + (tl_prefix @ tl_ret_str) ::= (A (N 0));; + \ \tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\;\ + \ \tl_state_ret = tl_imp tl_state;\ + invoke_subprogram tl_prefix tl_IMP_Minus;; + \ \length_xs' = tl_ret tl_state_ret;\ + length_xs_str ::= (A (V (tl_prefix @ tl_ret_str)));; + \ \length_ret' = length_ret s + 1;\ + length_ret_str ::= ((V (length_ret_str) \ N 1)) + ) + )" + +definition "length_imp_to_HOL_state p s = + \length_xs = (s (add_prefix p length_xs_str)), length_ret = (s (add_prefix p length_ret_str))\" + +lemma length_IMP_Minus_correct_function: + "(invoke_subprogram p length_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set p2 \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) length_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \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)); + \v. v \ vars \ \ (set p2 \ set v) \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using length_IMP_Minus_correct_time length_IMP_Minus_correct_function + length_IMP_Minus_correct_effects + by auto + +subsection \List cons\ + +record cons_state = cons_h::nat cons_t::nat cons_ret::nat + +abbreviation "cons_prefix \ ''cons.''" +abbreviation "cons_h_str \ ''h''" +abbreviation "cons_t_str \ ''t''" +abbreviation "cons_ret_str \ ''cons_ret''" + + +definition "cons_state_upd s \ + let + prod_encode_a' = (cons_h s); + prod_encode_b' = (cons_t s); + prod_encode_ret' = 0; + prod_encode_state = \prod_encode_a = prod_encode_a', prod_encode_b = prod_encode_b', prod_encode_ret = prod_encode_ret'\; + prod_encode_state_ret = prod_encode_imp prod_encode_state; + cons_ret' = (prod_encode_ret prod_encode_state_ret) + 1; + ret = \cons_h = cons_h s, cons_t = cons_t s, cons_ret = cons_ret'\ + in + ret +" + +fun cons_imp:: "cons_state \ 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 \ cons_state\ 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 = \prod_encode_a = prod_encode_a', prod_encode_b = prod_encode_b', prod_encode_ret = prod_encode_ret'\; + 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 \ + ( + \ \prod_encode_a' = (cons_h s);\ + (prod_encode_prefix @ prod_encode_a_str) ::= (A (V cons_h_str));; + \ \prod_encode_b' = (cons_t s);\ + (prod_encode_prefix @ prod_encode_b_str) ::= (A (V cons_t_str));; + \ \prod_encode_ret' = 0;\ + (prod_encode_prefix @ prod_encode_ret_str) ::= (A (N 0));; + \ \prod_encode_state = \prod_encode_a = prod_encode_a', prod_encode_b = prod_encode_b', prod_encode_ret = prod_encode_ret'\;\ + \ \prod_encode_state_ret = prod_encode_imp prod_encode_state;\ + invoke_subprogram prod_encode_prefix prod_encode_IMP_Minus;; + \ \cons_ret' = (prod_encode_ret prod_encode_state_ret) + 1;\ + (cons_ret_str) ::= (V (prod_encode_prefix @ prod_encode_ret_str) \ (N 1)) + )" + +definition "cons_imp_to_HOL_state p s = + \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))\" + +lemma cons_IMP_Minus_correct_function: + "(invoke_subprogram p cons_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set cons_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) cons_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + (\v. v \ vars \ \ (set p2 \ set v)); + \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)); + \v. v \ vars \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using cons_IMP_Minus_correct_time cons_IMP_Minus_correct_function + cons_IMP_Minus_correct_effects + by auto + +subsection \List append\ + +record append_state = append_acc::nat append_xs::nat + +abbreviation "append_prefix \ ''append.''" +abbreviation "append_acc_str \ ''acc''" +abbreviation "append_xs_str \ ''xs''" + +definition "append_state_upd s \ + let + hd_xs' = append_xs s; + hd_ret' = 0; + hd_state = \hd_xs = hd_xs', hd_ret = hd_ret'\; + hd_state_ret = hd_imp (hd_state); + cons_h' = hd_ret hd_state_ret; + cons_t' = append_acc s; + cons_ret' = 0; + cons_state = \cons_h = cons_h', cons_t = cons_t', cons_ret = cons_ret'\; + cons_ret_state = cons_imp cons_state; + append_acc' = cons_ret cons_ret_state; + tl_xs' = append_xs s; + tl_ret' = 0; + tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\; + tl_state_ret = tl_imp tl_state; + append_xs' = tl_ret tl_state_ret; + ret = \append_acc = append_acc', append_xs = append_xs'\ + in + ret +" + +function append_imp:: "append_state \ append_state" where +"append_imp s = + (if append_xs s \ 0 then \ \While xs \ 0\ + ( + 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 (\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 \ append_state\ nat" where + "append_imp_time t s = + (if append_xs s \ 0 then \ \While xs \ 0\ + ( + let + t = t + 1; + hd_xs' = append_xs s; + t = t + 2; + hd_ret' = 0; + t = t + 2; + hd_state = \hd_xs = hd_xs', hd_ret = hd_ret'\; + 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 = \cons_h = cons_h', cons_t = cons_t', cons_ret = cons_ret'\; + 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 = \tl_xs = tl_xs', tl_ret = tl_ret'\; + 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 (\(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) + + +\ \The following separation is due to parsing time, whic grows exponentially in the length of IMP- + programs.\ + +abbreviation "append_IMP_Minus_1 \ + \ \hd_xs' = append_xs s;\ + ((hd_prefix @ hd_xs_str) ::= (A (V append_xs_str)));; + \ \hd_ret' = 0;\ + ((hd_prefix @ hd_ret_str) ::= (A (N 0)));; + \ \hd_state = \hd_xs = hd_xs', hd_ret = hd_ret'\;\ + \ \hd_state_ret = hd_imp (hd_state);\ + (invoke_subprogram hd_prefix hd_IMP_Minus);; + \ \cons_h' = hd_ret hd_state_ret;\ + ((cons_prefix @ cons_h_str) ::= (A (V (hd_prefix @ hd_ret_str))));; + \ \cons_t' = append_acc s;\ + ((cons_prefix @ cons_t_str) ::= (A (V append_acc_str)));; + \ \cons_ret' = 0;\ + ((cons_prefix @ cons_ret_str) ::= (A (N 0)));; + \ \cons_state = \cons_h = cons_h', cons_t = cons_t', cons_ret = cons_ret'\;\ + \ \cons_ret_state = cons_imp cons_state;\ + (invoke_subprogram cons_prefix cons_IMP_Minus) +" + +definition append_IMP_Minus where +"append_IMP_Minus \ + ( + \ \if append_xs s \ 0 then \ \While xs \ 0\\ + WHILE append_xs_str \0 DO ( + append_IMP_Minus_1;; + \ \append_acc' = cons_ret cons_ret_state;\ + ((append_acc_str) ::= (A (V (cons_prefix @ cons_ret_str))));; + \ \tl_xs' = append_xs s;\ + ((tl_prefix @ tl_xs_str) ::= (A (V (append_xs_str))));; + \ \tl_ret' = 0;\ + ((tl_prefix @ tl_ret_str) ::= (A (N 0)));; + \ \tl_state = \tl_xs = tl_xs', tl_ret = tl_ret'\;\ + \ \tl_state_ret = tl_imp tl_state;\ + (invoke_subprogram tl_prefix tl_IMP_Minus);; + \ \append_xs' = tl_ret tl_state_ret;\ + ((append_xs_str) ::= (A (V (tl_prefix @ tl_ret_str)))) + ) + + )" + +definition "append_imp_to_HOL_state p s = + \append_acc = (s (add_prefix p append_acc_str)), append_xs = (s (add_prefix p append_xs_str))\" + +lemma append_IMP_Minus_correct_function: + "(invoke_subprogram p append_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set append_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) append_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \v. v \ vars \ \ (set p2 \ set v); + \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)); + \v. v \ vars \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ P" + using append_IMP_Minus_correct_time append_IMP_Minus_correct_function + append_IMP_Minus_correct_effects + by auto + +subsection \Logical And\ + +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 \ ''AND_neq_zero.''" +abbreviation "AND_neq_zero_a_str \ ''AND_a''" +abbreviation "AND_neq_zero_b_str \ ''AND_b''" +abbreviation "AND_neq_zero_ret_str \ ''AND_ret''" + +definition "AND_neq_zero_state_upd s \ + let + AND_neq_zero_ret' = + (if AND_neq_zero_a s \ 0 then + (if AND_neq_zero_b s \ 0 then + 1 + else + 0) + else + 0); + ret = \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'\ + in + ret +" + +fun AND_neq_zero_imp:: "AND_neq_zero_state \ 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) \ 0 \ (AND_neq_zero_b s) \ 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 \ AND_neq_zero_state\ nat" where + "AND_neq_zero_imp_time t s = + ( + let + AND_neq_zero_ret' = + (if AND_neq_zero_a s \ 0 then + (if AND_neq_zero_b s \ 0 then + (1::nat) + else + 0) + else + 0); + t = t + 1 + (if AND_neq_zero_a s \ 0 then + 1 + + (if AND_neq_zero_b s \ 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) + + +\ \The following separation is due to parsing time, whic grows exponentially in the length of IMP- + programs.\ + +definition AND_neq_zero_IMP_Minus where +"AND_neq_zero_IMP_Minus \ + ( + \ \(if AND_neq_zero_a s \ 0 then\ + IF AND_neq_zero_a_str \0 THEN + \ \(if AND_neq_zero_b s \ 0 then\ + IF AND_neq_zero_b_str \0 THEN + \ \1\ + AND_neq_zero_ret_str ::= (A (N 1)) + \ \else\ + ELSE + \ \0)\ + AND_neq_zero_ret_str ::= (A (N 0)) + \ \else\ + ELSE + \ \0);\ + AND_neq_zero_ret_str ::= (A (N 0)) + )" + +definition "AND_neq_zero_imp_to_HOL_state p s = + \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))\" + +lemma AND_neq_zero_IMP_Minus_correct_function: + "(invoke_subprogram p AND_neq_zero_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set AND_neq_zero_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) AND_neq_zero_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \v. v \ vars \ \ (set p2 \ set v); + \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)); + \v. v \ vars \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ 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 \Logical Or\ + +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 \ ''OR_neq_zero.''" +abbreviation "OR_neq_zero_a_str \ ''OR_a''" +abbreviation "OR_neq_zero_b_str \ ''OR_b''" +abbreviation "OR_neq_zero_ret_str \ ''OR_ret''" + +definition "OR_neq_zero_state_upd s \ + let + OR_neq_zero_ret' = + (if OR_neq_zero_a s \ 0 then + 1 + else + (if OR_neq_zero_b s \ 0 then + 1 + else + 0)); + ret = \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'\ + in + ret +" + +fun OR_neq_zero_imp:: "OR_neq_zero_state \ 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) \ 0 \ (OR_neq_zero_b s) \ 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 \ OR_neq_zero_state\ nat" where + "OR_neq_zero_imp_time t s = + ( + let + OR_neq_zero_ret' = + (if OR_neq_zero_a s \ 0 then + 1::nat + else + (if OR_neq_zero_b s \ 0 then + (1::nat) + else + 0)); + t = t + 1 + (if OR_neq_zero_a s \ 0 then + 2 + else + 1 + + (if OR_neq_zero_b s \ 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) + + +\ \The following separation is due to parsing time, whic grows exponentially in the length of IMP- + programs.\ + +definition OR_neq_zero_IMP_Minus where +"OR_neq_zero_IMP_Minus \ + ( + \ \(if OR_neq_zero_a s \ 0 then\ + IF OR_neq_zero_a_str \0 THEN + \ \1);\ + OR_neq_zero_ret_str ::= (A (N 1)) + \ \else\ + ELSE + \ \(if OR_neq_zero_b s \ 0 then\ + IF OR_neq_zero_b_str \0 THEN + \ \1\ + OR_neq_zero_ret_str ::= (A (N 1)) + \ \else\ + ELSE + \ \0)\ + OR_neq_zero_ret_str ::= (A (N 0)) + + )" + +definition "OR_neq_zero_imp_to_HOL_state p s = + \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))\" + +lemma OR_neq_zero_IMP_Minus_correct_function: + "(invoke_subprogram p OR_neq_zero_IMP_Minus, s) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ + 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) \\<^bsup>t\<^esup> s' \ v \ vars \ \ (set OR_neq_zero_pref \ set v) \ 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: + "\(invoke_subprogram (p1 @ p2) OR_neq_zero_IMP_Minus, s) \\<^bsup>t\<^esup> s'; + \v. v \ vars \ \ (set p2 \ set v); + \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)); + \v. v \ vars \ s (add_prefix p1 v) = s' (add_prefix p1 v)\ + \ P\ \ 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/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..b67f4ac9 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Common_Funs_Nat.thy @@ -0,0 +1,409 @@ +theory IMP_Minus_Common_Funs_Nat + imports "../../IMP-/IMP_Minus_Nat_Bijection" +begin + +subsection \append\ + +text\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*.\ + +lemma revapp: "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) +*) + +(* Registers: +e: xs +f: ys +*) +definition append_tail_IMP_Minus where "append_tail_IMP_Minus \ + ''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'']" + +definition append_tail_IMP_Minus_time where + "append_tail_IMP_Minus_time xs ys \ +16 ++ reverse_nat_acc_IMP_Minus_time 0 xs ++ reverse_nat_acc_IMP_Minus_time (reverse_nat_acc 0 xs) ys ++ reverse_nat_acc_IMP_Minus_time 0 (reverse_nat_acc (reverse_nat_acc 0 xs) ys) ++ zero_variables_time [''a'', ''b'', ''c'', ''d'', ''e'', ''f'', ''fst_nat'', ''snd_nat'', ''cons'', + ''triangle'', ''prod_encode'', ''reverse_nat_acc'']" + +lemma append_tail_IMP_Minus_correct: + "(append_tail_IMP_Minus, s) + \\<^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 + 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 \elemof\ + +(* Registers: + e: e + f: list + a: "result" +*) +definition elemof_IMP_Minus_iteration where "elemof_IMP_Minus_iteration \ + ''a'' ::= ((V ''f'') \ (N 1)) ;; + IMP_Minus_fst_nat ;; + ''a'' ::= ((V ''fst_nat'') \ (V ''e'')) ;; + ''b'' ::= ((V ''e'') \ (V ''fst_nat'')) ;; + ''a'' ::= ((V ''a'') \ (V ''b'')) ;; + IF ''a''\0 THEN + ''a'' ::= ((V ''f'') \ (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 +*) + +definition elemof_IMP_Minus_iteration_time where + "elemof_IMP_Minus_iteration_time e l \ + 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'']" + +lemma elemof_IMP_Minus_iteration_correct: + "(elemof_IMP_Minus_iteration, s) + \\<^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 show ?thesis + unfolding elemof_IMP_Minus_iteration_def + elemof_IMP_Minus_iteration_time_def + 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 show ?thesis + unfolding elemof_IMP_Minus_iteration_def + 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 + )+ +qed + + +definition elemof_IMP_Minus_loop where "elemof_IMP_Minus_loop \ + (WHILE ''f'' \0 DO elemof_IMP_Minus_iteration)" + +fun elemof_IMP_Minus_loop_time :: "nat \ nat \ 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))" + + +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) + \\<^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 show ?thesis + unfolding elemof_IMP_Minus_loop_def + by(auto simp: numeral_2_eq_2 1 + intro!: terminates_in_state_intro[OF Big_StepT.WhileFalse]) + next + case (Suc nat) + 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 _ + elemof_IMP_Minus_iteration_correct Big_StepT.WhileFalse ] + by simp + next + case False + show ?thesis unfolding elemof_IMP_Minus_loop_def + 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 + + + +(* Registers: + a: e + b: l +*) +definition elemof_IMP_Minus where "elemof_IMP_Minus \ + ''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'']" + +definition elemof_IMP_Minus_time :: "nat \ nat \ 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''] +" + +lemma elemof_IMP_Minus_correct: + "(elemof_IMP_Minus, s) + \\<^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 + by(fastforce + intro!: ext terminates_in_time_state_intro[OF Seq'] + intro: zero_variables_correct elemof_IMP_Minus_loop_correct + )+ + + +subsection \remdups_tail\ + +subsection \list_from_acc\ + +(* Registers: +acc: d +s: e +n: f +*) +definition list_from_acc_IMP_Minus_iteration where + "list_from_acc_IMP_Minus_iteration \ + cons_IMP_Minus (V ''e'') (V ''d'') ;; + ''d'' ::= (A (V ''cons'')) ;; + ''e'' ::= ((V ''e'') \ (N 1)) ;; + ''f'' ::= ((V ''f'') \ (N 1)) +" + +definition list_from_acc_IMP_Minus_iteration_time where + "list_from_acc_IMP_Minus_iteration_time h t \ + cons_IMP_Minus_time h t + 6 +" + +lemma list_from_acc_IMP_Minus_iteration_correct: + "(list_from_acc_IMP_Minus_iteration, s) + \\<^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)+ + +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" + +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''\0 DO list_from_acc_IMP_Minus_iteration, s) + \\<^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_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 + + +subsection \concat_acc\ + +(* +WHILE n \ 0 + acc := append_tail (reverse_nat (hd_nat n)) acc ; + n = tl_nat n ; + +WHILE n \ 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 \ + ''a'' ::= ((V ''n'') \ (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'') \ (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''] + " + +definition concat_acc_IMP_Minus_iteration_time where + "concat_acc_IMP_Minus_iteration_time acc n \ + 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''] +" + +lemma concat_acc_IMP_Minus_iteration_correct: + "(concat_acc_IMP_Minus_iteration, s) + \\<^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)+ + +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) +" + +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''\0 DO concat_acc_IMP_Minus_iteration, s) + \\<^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 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..10007228 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_IMP_Minus.thy @@ -0,0 +1,1127 @@ +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 \ + ''atomExp_to_constant'' ::= (A (V ''a'')) ;; + IMP_Minus_fst_nat ;; + ''a'' ::= (A (V ''atomExp_to_constant'')) ;; + IMP_Minus_snd_nat ;; + (IF ''fst_nat'' \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 \ + 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) \\<^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 \ + ''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'') \ (N 1)) ;; + IMP_Minus_fst_nat ;; + + ''a'' ::= ((N 3) \ (V ''fst_nat'')) ;; + IF ''a'' \0 + THEN + ( + IF ''fst_nat'' \0 + THEN + ''b'' ::= (A (V ''atomExp_to_constant'')) + ELSE + ''b'' ::= (A (V ''nth_nat'')) + ) + ELSE + ( + IF ''fst_nat'' \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 \ + 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 aexp_max_constant_IMP_Minus_correct: + "(aexp_max_constant_IMP_Minus, s) + \\<^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 + 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 + 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 + + +definition add_res_nat_first_part where "add_res_nat_first_part \ + ''d'' ::= (A (V ''a'')) ;; + ''e'' ::= (A (V ''b'')) ;; + + ''a'' ::= ((V ''e'') \ (N 1)) ;; + IMP_Minus_fst_nat ;; + ''f'' ::= (A (V ''fst_nat'')) ;; + + ''a'' ::= ((V ''e'') \ (N 1)) ;; + IMP_Minus_snd_nat ;; + ''g'' ::= (A (V ''snd_nat'')) ;; + + ''a'' ::= ((V ''f'') \ (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 \ + (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) \\<^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 \ + ''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 \ + (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) + \\<^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)+ + +definition add_res_nat_third_part where "add_res_nat_third_part \ + IF ''e'' \0 + THEN + ( + ''a'' ::= ((V ''h'') \ (N 1)) ;; + IF ''a'' \0 + THEN + ( + ''a'' ::= ((V ''h'') \ (N 3)) ;; + IF ''a'' \0 + THEN + ( + ''a'' ::= ((V ''h'') \ (N 4)) ;; + IF ''a'' \0 + THEN + ( + ''a'' ::= ((V ''h'') \ (N 5)) ;; + IF ''a'' \0 + THEN + ( + ''add_res'' ::= (A (V ''l'')) + ) + ELSE + ( + ''add_res'' ::= (A (V ''cons'')) + ) + ) + ELSE + ( + ''add_res'' ::= (A (V ''l'')) ;; + Com.SKIP ;; Com.SKIP ;; Com.SKIP + ) + ) + ELSE + ( + ''a'' ::= ((V ''h'') \ (N 2)) ;; + IF ''a'' \0 + THEN + ( + ''add_res'' ::= (A (V ''n'')) + ) + ELSE + ( + ''add_res'' ::= (A (V ''m'')) + ) ;; + 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 + ) + ) + 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 + );; + zero_variables [''a'', ''e'', ''h'', ''k'', ''l'', ''m'', ''n'', ''cons'']" + +definition add_res_nat_IMP_Minus where "add_res_nat_IMP_Minus \ + 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 \ + add_res_nat_first_part_time n s + + add_res_nat_second_part_time n s + + 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) + \\<^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 add_res_nat_def + using \s ''b'' = 0\ + by(fastforce intro: zero_variables_correct)+ +next + case (Suc nat) + let ?c = "hd_nat (hd_nat (s ''b''))" + have "?c = 0 \ ?c = 1 \ ?c = 2 \ ?c = 3 \ ?c = 4 \ ?c = 5 \ ?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 add_res_nat_def + using \s ''b'' = Suc nat\ + apply simp + using \s ''b'' = Suc nat\ + by (fastforce + 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 \ + ''e'' ::= (A (V ''a'')) ;; + ''f'' ::= (A (V ''b'')) ;; + + ''a'' ::= ((V ''a'') \ (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 \ + (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) \\<^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 \ + 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 \ + (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) + \\<^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 \ + ''a'' ::= ((V ''g'') \ (N 1)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''g'') \ (N 2)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''g'') \ (N 3)) ;; + IF ''a'' \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'' \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 \ + (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 \ + 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 \ + 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) + \\<^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 \ hd_nat (s ''a'') = 1 \ hd_nat (s ''a'') = 2 + \ hd_nat (s ''a'') = 3 \ hd_nat (s ''a'') > 3" + by auto + thus ?thesis + apply(elim disjE) + 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 + 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 \ + ''e'' ::= (A (V ''a'')) ;; + + ''a'' ::= ((V ''e'') \ (N 1)) ;; + IMP_Minus_fst_nat ;; + ''f'' ::= (A (V ''fst_nat'')) ;; + + ''a'' ::= ((V ''e'') \ (N 1)) ;; + IMP_Minus_snd_nat ;; + ''g'' ::= (A (V ''snd_nat'')) ;; + + ''a'' ::= ((V ''f'') \ (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 \ + (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) + \\<^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 \ + ''max_constant'' ::= (A (N 1)) ;; + IF ''e'' \0 THEN + IF ''h'' \0 THEN + ( + ''a'' ::= ((V ''h'') \ (N 1)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''h'') \ (N 2)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''h'') \ (N 3)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''h'') \ (N 4)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''h'') \ (N 5)) ;; + IF ''a'' \0 THEN + ( + ''a'' ::= ((V ''h'') \ (N 6)) ;; + IF ''a'' \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'')) + ) + ELSE + ( + ''a'' ::= (A (N 0)) ;; + ''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'', + ''prod_encode'', ''add_res'', ''atomExp_to_constant'', ''push_con'']" + +definition max_constant_iteration_second_part_time where + "max_constant_iteration_second_part_time s \ + 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 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) + 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 \ + max_constant_iteration_first_part ;; + max_constant_iteration_second_part" + +definition max_constant_iteration_time where "max_constant_iteration_time s \ + max_constant_iteration_first_part_time s + + max_constant_iteration_second_part_time s" + +lemma max_constant_iteration_correct: +"(max_constant_iteration, s') + \\<^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 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)), + ''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 s \ 0 \ 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 (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 \ ?c = 1 \ ?c = 2 \ ?c = 3 \ ?c = 4 \ ?c = 5 \ ?c = 6 \ ?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) + using Suc + 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 + +function (domintros) max_constant_loop_time :: "nat \ 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 \ 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 \ s' ''a'' = s \ + 0 < s' ''max_constant'' \ +(WHILE ''max_constant''\0 DO max_constant_iteration, s') + \\<^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 \ 0 \ ?c < 7") + case True + + hence "?c = 0 \ ?c = 1 \ ?c = 2 \ ?c = 3 \ ?c = 4 \ ?c = 5 \ ?c = 6" + by auto + + then show ?thesis + apply(elim disjE) + using \0 < s' ''max_constant''\ + \s \ 0 \ hd_nat (hd_nat s) < 7\ \s' ''a'' = s\ + max_constant_loop_time.psimps + max_constant_stack_nat.psimps + max_constant_stack_nat_domain_then_max_constant_loop_time_domain + \max_constant_stack_nat_dom s\ + 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 + \0 < s' ''max_constant''\ + max_constant_loop_time.psimps[OF max_constant_loop_time.domintros] + max_constant_stack_nat.psimps[OF max_constant_stack_nat.domintros] + \s' ''a'' = s\ + 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 \ 0" "?c > 6" + using \\ (s \ 0 \ ?c < 7)\ + by auto + thus ?thesis + using + \0 < s' ''max_constant''\ + max_constant_loop_time.psimps[OF max_constant_loop_time.domintros] + max_constant_stack_nat.psimps[OF max_constant_stack_nat.domintros] + \s' ''a'' = s\ + 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 \ + ''max_constant'' ::= (A (N 1)) ;; + WHILE ''max_constant''\0 DO max_constant_iteration ;; + ''max_constant'' ::= (A (V ''a'')) ;; + ''a'' ::= (A (N 0))" + +definition max_constant_time where "max_constant_time s \ + 6 + max_constant_loop_time s" + +lemma max_constant_IMP_Minus_correct: +"max_constant_stack_nat_dom (s ''a'') \ + 0 < s' ''max_constant'' \ +(max_constant_IMP_Minus, s) + \\<^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 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..3669d22e --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_Max_Constant_Nat.thy @@ -0,0 +1,1142 @@ +theory IMP_Minus_Max_Constant_Nat + imports "HOL-Library.Nat_Bijection" + Primitives IMP_Minus.Max_Constant +begin + + + +definition atomExp_to_constant_nat:: "nat \ nat" where +"atomExp_to_constant_nat n = (if fst_nat n = 0 then 0 else snd_nat n)" + +definition atomExp_to_constant_tail:: "nat \ 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) + done + + +definition aexp_max_constant_nat:: "nat \ nat" where +"aexp_max_constant_nat n = (if hd_nat n \2 \ 1 \ 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))" + +definition aexp_max_constant_tail:: "nat \ nat" where +"aexp_max_constant_tail n = (if hd_nat n \2 \ 1 \ 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_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_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 + done + + +lemma fst_less [simp]: "n >0 \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 \ fst_nat n > 0 \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 \ n" + apply (simp add: fst_nat_def snd_nat_def) + by (simp add: prod_sum_less2) + + +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 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 \ 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 max_con_decode :: "nat \ max_con" where +"max_con_decode n = (case list_decode n of + [0] \ SKIP | + [Suc 0,aexp] \ Assign (aexp_decode aexp)| + [Suc (Suc 0), c1 , c2] \ Seq_0 (com_decode c1) (com_decode c2)| + [Suc (Suc ( Suc 0)), c1 , c2, n] \ Seq_m (com_decode c1) (com_decode c2) n| + [Suc (Suc (Suc (Suc 0))), c1 , c2, n, m] \ Seq_f (com_decode c1) (com_decode c2) n m| + [Suc (Suc (Suc (Suc (Suc 0)))), c] \ While_0 (com_decode c) | + [Suc (Suc (Suc (Suc (Suc (Suc 0))))), c,n] \ While_f (com_decode c) n | + [Suc (Suc (Suc (Suc (Suc (Suc (Suc 0)))))),n] \ Bot n | x \ 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 \ max_con list \ 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 \ []" + apply(cases c) + apply auto + done + +definition push_con_nat :: "nat \ nat \ 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: push_con_nat_def sub_hd sub_cons sub_tl cons0 simp del: list_encode.simps) + done + +fun add_res :: "nat \ max_con list \ 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 = [Bot n]" + +lemma add_res_Nil: +"add_res n s \ []" + apply (cases s) + apply auto + subgoal for a xs + apply(cases a) + apply auto + done + done + + +definition add_res_nat :: "nat \ nat \ 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 (7##n##0) ## 0 ) + +)" + +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 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) + apply( auto simp add: Let_def sub_hd cons0 sub_cons sub_tl simp del: list_encode.simps(2)) + done + done + +fun size_e :: "Com.com \ 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 \ 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) = (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) = (\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 \ nat" where +"size_stack s = size_stack_rev (rev s)" + +lemma size_pos:"size_e c >0" + apply(induct c) + apply auto + done +lemma +size_stack_mono :" x \ [] \y \ [] \ size_stack_rev y < size_stack_rev x + \ 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 add_res_less:"\x. s \ [Bot x] \ a \ Bot x \ 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 + +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 \ 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)"| +"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 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 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 apply (cases c1) + using size_stack_mono by auto +next + case (5 c1 c2 n0 s) + then show ?case apply (cases c2) + using size_stack_mono by auto +next + case (6 uu uv n m s) + 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 apply (cases c) + using size_stack_mono by auto +next + case (8 uw n s) + 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 + +termination using max_const_stack_term by auto + + + + + + + + + +function (domintros) max_constant_stack_nat :: "nat \ nat" where +" 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)" + by pat_completeness auto + + +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: +"max_constant_stack_nat (list_encode (map max_con_encode s)) += max_constant_stack s " +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 + 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 + 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 + 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 + 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 + 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: +"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 \ nat" where +"atomExp_var_nat n = (if fst_nat n = 0 then cons (snd_nat n) 0 else 0)" + +definition atomExp_var_tail :: "nat \ 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) + 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 + + +definition aexp_vars_nat:: "nat \ nat" where +"aexp_vars_nat n = ( if hd_nat n = 1 \ 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))" + +definition aexp_vars_tail:: "nat \ nat" where +"aexp_vars_tail n = ( if hd_nat n = 1 \ 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 + sub_append sub_atomExp_var aexp_vars.simps vname_list_encode_def) + 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 \ 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 \ all_var list \ 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 \ []" + apply(cases c) + apply auto + done + +definition push_var_nat :: "nat \ nat \ 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 push_var_nat_def simp del: list_encode.simps) + done + +fun add_var :: " vname list \ all_var list \ 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 \ []" + apply (cases s) + apply auto + subgoal for a xs + apply(cases a) + apply auto + done + done + + +definition add_var_nat :: "nat \ nat \ 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 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) + apply( auto simp add: Let_def sub_hd cons0 sub_cons sub_tl simp del: list_encode.simps(2)) + done + done + +fun size_stack_rev_var :: "all_var list \ 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 \ nat" where +"size_stack_var s = size_stack_rev_var (rev s)" + +lemma +size_stack_var_mono :" x \ [] \y \ [] \ size_stack_rev_var y < size_stack_rev_var x + \ 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) = (\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: +"\x. s \ [Bot x] \ a \ Bot x \ 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 \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)"| +"all_variables_stack [] = []" + by pat_completeness auto +termination +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 (domintros) all_variables_stack_nat :: "nat \ 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 + 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)" + 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: +"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 sub_all_variables_stack: +"s \ [] \ all_variables_stack_nat (list_encode (map all_var_encode s)) += vname_list_encode (all_variables_stack s) " +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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 + 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 \ vname list" where +" all_variables_t c = all_variables_stack (push_var c [])" + +definition all_variables_nat :: "nat \ 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 \ nat" where +"all_variables_tail c = all_variables_nat c" + +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 \nat" where +" max_constant_t c = max_constant_stack (push_con c [])" + +definition max_constant_nat :: "nat \ 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 \ 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)" + 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 + + + + + +definition num_variables_nat :: "nat \ nat" where +"num_variables_nat n = length_nat (remdups_nat (all_variables_nat n))" + +definition num_variables_tail :: "nat \ 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" + 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 \ 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 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) + 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.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus.thy index 3bfe386a..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 \ We combine our reduction steps from IMP- to IMP--, then from IMP-- to SAS++ and finally @@ -116,6 +116,7 @@ lemma map_le_IMP_Minus_State_To_IMP_Minus_Minus_2: + lemma IMP_Minus_to_SAS_Plus_correctness: assumes "I \\<^sub>m Some \ s1" @@ -429,5 +430,5 @@ proof - show ?thesis using \t'' \ t\ \(c, ?s1') \\<^bsup>t''\<^esup> s2''\ \I \\<^sub>m Some \ ?s1'\ \G \\<^sub>m Some \ s2''\ 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 new file mode 100644 index 00000000..a8f39c00 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAS_Plus_Nat.thy @@ -0,0 +1,387 @@ +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 + + +definition max_input_bits_list :: "IMP_Minus_com \ (vname,nat) assignment list \ nat \ 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 \ nat \ nat\ nat" where +"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 \ nat \ nat\ nat" where +"max_input_bits_tail c I r = +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 (\(a,b). (vname_encode a,b))" + apply auto + done +lemma sublist_max_input_bits: + assumes "I \ []" + 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 \ nat) + \ nat \ nat \ (vname \ bit)" where +"IMP_Minus_initial_to_IMP_Minus_Minus I n guess_range = (\v. + (case var_to_operand_bit v of + Some (CHR ''a'', k) \ if k < n then Some Zero else None | + Some (CHR ''b'', k) \ if k < n then Some Zero else None | + _ \ (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 + \ nat \ nat \ vname \ 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) \ if k < n then Some Zero else None | + Some (CHR ''b'', k) \ if k < n then Some Zero else None | + _ \ (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 + \ nat \ nat \ nat \ 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 \ 0 \ v' = encode_char (CHR ''a'') then + if k < n then Suc 0 else 0 else if p \ 0 \ 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))" + +definition IMP_Minus_initial_to_IMP_Minus_Minus_tail::" nat + \ nat \ nat \ nat \ 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 \ 0 \ v' = encode_char (CHR ''a'') then + if k < n then Suc 0 else 0 else if p \ 0 \ 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) = + +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_list:: "IMP_Minus_com \ (vname, nat) assignment list \ nat \ (vname, nat) assignment list + \ nat \ (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 (\(x,y). (x, the y)) (filter (\(x,y) . y \ None) (map (\x. (x,IMP_Minus_State_To_IMP_Minus_Minus_partial_list I n guess_range x)) (enumerate_variables c'))) +; + + G' = map (\(x,y). (x, the y)) (filter (\(x,y) . y \ None) (map (\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 \ []" + 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 \ nat \ nat \ nat \ nat" where +"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 n guess_range x = map_nat (\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 \ nat \ nat \ nat \ 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 I n guess_range x = map_nat (\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 +fun map_IMP_Minus_State_To_IMP_Minus_Minus_partial_acc :: "nat \ nat \ nat \ nat \ nat \ 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 (\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 \ nat \ nat \ nat \ 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 \ nat" where +"filter_none n = (if n =0 then 0 else if snd_nat (hd_nat n) \ 0 then (hd_nat n) ## (filter_none (tl_nat n)) else filter_none (tl_nat n))" + +fun filter_none_acc :: "nat \ nat \ nat" where +"filter_none_acc acc n = (if n =0 then acc else if snd_nat (hd_nat n) \ 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 (\n . snd_nat n \ 0) n" + apply (induct n rule: filter_none.induct) + apply auto + done +lemma filter_none_induct : +"filter_none_acc acc n = filter_acc (\n . snd_nat n \ 0) acc n" + apply(induct acc n rule:filter_none_acc.induct) + apply auto + done + +definition filter_none_tail :: "nat \ 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 \ 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 (\n. prod_encode(fst_nat n, the_nat (snd_nat n))) n" + apply (induct n rule:map_prod_the.induct) + apply auto + done + +fun map_prod_the_acc :: "nat\ nat \ 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 (\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 \ 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 \ nat \ nat \ nat + \ nat \ 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_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 n (enumerate_variables_nat c'))) + in + 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 \ nat \ nat \ nat + \ nat \ 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 (\x. prod_encode + (vname_encode x, + thefn + (bit_option_to_option + (ff x)))) + (filter + (\x. ff x \ + None) +xs) += +map (\x. prod_encode + (vname_encode x, + bit_encode ( the + (ff x)))) + (filter + (\x. ff x \ + 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 + +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 "\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 "\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 (\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 + (\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 \ + None) + (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))))) + (map (\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 + (\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 \ + 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 (\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 + (\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 \ + None) + (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))))) + (map (\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 + (\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 \ + 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 (\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 + (\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 \ + None) + (enumerate_variables (IMP_Minus_To_IMP_Minus_Minus c (t + max_input_bits_list c I r + 1))))) + (map (\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 + (\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 \ + 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+/IMP_Minus_To_SAT.thy b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy index 41d2b828..e7a97937 100644 --- a/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy +++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT.thy @@ -1,6 +1,6 @@ theory IMP_Minus_To_SAT imports "IMP_Minus_To_SAS_Plus" "Verified_SAT_Based_AI_Planning.SAT_Solve_SAS_Plus" - "../Complexity_classes/Cook_Levin" + "../Complexity_classes/Cook_Levin" "IMP_Minus.Max_Constant" begin section \Translation from IMP- to SAT\ @@ -73,8 +73,8 @@ qed lemma if_there_is_model_then_program_terminates: assumes - "dom I \ set (IMP_Minus_Max_Constant.all_variables c)" - "dom G \ set (IMP_Minus_Max_Constant.all_variables c)" + "dom I \ set (Max_Constant.all_variables c)" + "dom G \ set (Max_Constant.all_variables c)" "Max (ran G) < 2 ^ (t + max_input_bits c I r)" (* Mohammad: The following assumption cannot be true for many verifiers. s1 has to depend on I , otherwise the assumption is vacuous.*) @@ -94,6 +94,19 @@ proof- by(auto intro: SAS_Plus_to_IMP_Minus_correctness) qed +definition t' ::"(nat \ nat) \ (nat\ nat) \ nat \ nat" + where "t' pt p_cer x = (make_mono pt) (bit_length x + (make_mono p_cer) (bit_length x)) + 1" + + definition imp_to_sat :: "Com.com \ (nat \ nat) \ (nat\ nat) \ nat \ sat_plan_formula" where + "imp_to_sat c pt p_cer x = + (let I = (Map.empty)(''input'' \ x); + G = (Map.empty)(''input'' \ 0); + guess_range = x + 1 + 2 * 2 ^ (p_cer (bit_length x)); + max_bits = max_input_bits c I guess_range + in + \\<^sub>\ (\ 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 @@ -119,13 +132,13 @@ lemma main_lemma_hol: "\x s s' t. \in_lang x \ 0; s ''input'' = x; (c, s) \\<^bsup> t \<^esup> s'\ \ s' ''input'' = in_lang x" assumes verifier_has_registers: - "''input'' \ set (IMP_Minus_Max_Constant.all_variables c)" - shows "\imp_to_sat t_red s_red. + "''input'' \ set (Max_Constant.all_variables c)" + shows "\t_red s_red. poly t_red \ poly s_red - \ (\x. \f. bit_length (encode_sat f) \ s_red ( bit_length x ) \ imp_to_sat x = f + \ (\x. \f. bit_length (encode_sat f) \ s_red ( bit_length x ) \ imp_to_sat c pt p_cer x = f \ (Sema.sat {f} \ in_lang x = 0))" -proof- +proof - define t''::"(char list \ nat) \ nat" where "t'' s = (make_mono pt) (bit_length (s ''input''))" for s @@ -136,11 +149,8 @@ proof- text\Upper bound on the time\ - define t'::"nat \ nat" - where "t' x \ (make_mono pt) (bit_length x + (make_mono p_cer) (bit_length x)) + 1" for x - - have t_bound_2: "\s' t. t \ t' x \ (c, s) \\<^bsup> t \<^esup> s'" + have t_bound_2: "\s' t. t \ t' pt p_cer x \ (c, s) \\<^bsup> t \<^esup> s'" if "s ''input'' = x" for s x proof- @@ -149,10 +159,10 @@ proof- "t \ pt (bit_length (s ''input''))" using verifier_tbounded by blast+ - have "t'' s \ t' (s ''input'')" + have "t'' s \ 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 \ t' (s ''input'')" + hence "t \ t' pt p_cer (s ''input'')" using t_bound \(c, s) \\<^bsup> t \<^esup> s'\ by (smt bigstepT_the_cost less_le_trans not_le) thus ?thesis @@ -160,19 +170,7 @@ proof- by auto qed - define f where - "f x \ - let I = (Map.empty)(''input'' \ x); - G = (Map.empty)(''input'' \ 0); - guess_range = x + 1 + 2 * 2 ^ (p_cer (bit_length x)); - max_bits = max_input_bits c I guess_range - in - \\<^sub>\ (\ 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- @@ -185,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)) \ t' x" + moreover hence "t'' (s(''certificate'' := z)) \ t' pt p_cer x" by (auto simp: \s ''input'' = x\ t'_def t''_def bit_length_def le_make_mono order_trans intro!: le_SucI monoD[OF mono_make_mono]) - hence "t \ t' x" + hence "t \ t' pt p_cer x" using t_bound \(c, s(''certificate'' := z)) \\<^bsup> t \<^esup> s'\ by (smt bigstepT_the_cost less_le_trans not_le) moreover have "[''input'' \ x] \\<^sub>m Some \ s(''certificate'' := z)" @@ -199,8 +197,8 @@ proof- using \bit_length z \ p_cer (bit_length x)\ 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 "\\. \ \ f x" - unfolding Sema.sat_def f_def Let_def + ultimately have "\\. \ \ 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 @@ -208,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 \ where "\ \ f x" - using \Sema.sat {f x}\ + obtain \ where "\ \ imp_to_sat c pt p_cer x" + using \Sema.sat {imp_to_sat c pt p_cer x}\ by (auto simp: Sema.sat_def) - hence "\s1 s2 t''. t'' \ t' x \ [''input'' \ x] \\<^sub>m Some \ s1 \ + hence "\s1 s2 t''. t'' \ t' pt p_cer x \ [''input'' \ x] \\<^sub>m Some \ s1 \ [''input'' \ 0] \\<^sub>m Some \ s2 \ (c, s1) \\<^bsup> t'' \<^esup> s2" apply(intro if_there_is_model_then_program_terminates [where \ = \ 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'' \ t' x" "[''input'' \ x] \\<^sub>m Some \ s1" + where "t'' \ t' pt p_cer x" "[''input'' \ x] \\<^sub>m Some \ s1" "[''input'' \ 0] \\<^sub>m Some \ s2" "(c, s1) \\<^bsup> t'' \<^esup> s2" by auto moreover hence "s2 ''input'' = 0" "s1 ''input'' = x" @@ -270,10 +268,10 @@ lemma main_lemma_synth : subsubsection \Instantiating the Cook_Levin locale\ -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 new file mode 100644 index 00000000..08b403f5 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/IMP_Minus_To_SAT_Nat.thy @@ -0,0 +1,686 @@ +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 + Primitives +begin + +fun poly_of :: "nat*nat \ nat \ 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 \ 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 \ 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) \ (nat*nat) \ nat \ 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 \ 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 \ nat \ 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 \ nat \ nat \ 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:) + 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 + + +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:"\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 \ nat \ 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 \ nat \ nat \ 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 \ nat \ nat \ 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) + done + +definition "empty_sasp_action_nat \ (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 "empty_sasp_action_tail \ (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 \ \ + \ variables_ofl = variables_ofl \, + operators_ofl = empty_sasp_action # operators_ofl \, + initial_ofl = initial_ofl \, + goal_ofl = goal_ofl \, + range_ofl = range_ofl \\" + +lemma sublist_prob_with_noop: +"list_problem_to_problem (prob_with_noop_list \) = prob_with_noop (list_problem_to_problem \)" + apply (auto simp add: prob_with_noop_list_def prob_with_noop_def) + done + +definition prob_with_noop_nat :: "nat \ 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 \ 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)" + 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 + \ nat + \ 'variable strips_operator + \ 'variable strips_operator + \ sat_plan_variable formula" + where "encode_interfering_operator_pair_exclusion_list \ k op\<^sub>1 op\<^sub>2 + \ let ops = operators_of \ in + \<^bold>\(Atom (Operator k (index ops op\<^sub>1))) + \<^bold>\ \<^bold>\(Atom (Operator k (index ops op\<^sub>2)))" + +lemma sublist_encode_interfering_operator_pair_exclusion: +"encode_interfering_operator_pair_exclusion_list \ k op\<^sub>1 op\<^sub>2 += encode_interfering_operator_pair_exclusion (strips_list_problem_to_problem \) 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_pair_exclusion_nat + :: "nat + \ nat + \ nat + \ nat + \ nat" + where "encode_interfering_operator_pair_exclusion_nat p k o1 o2 + \ 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 + \ nat + \ nat + \ nat + \ 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 + (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 \ nat \ nat" where +"list_inter xs ys = (if xs = 0 then 0 +else if elemof (hd_nat xs) ys \ 0 then 1 else list_inter (tl_nat xs) ys)" + +definition list_inter_tail :: "nat \ nat \ 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 \ []) " + using list_encode_empty by force + +lemma sub_list_inter: +"inj f \ list_inter (list_encode (map f xs)) (list_encode (map f ys)) \ 0 += list_ex (\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 \ nat \ nat" where +"are_operators_interfering_nat o1 o2 \ +if list_inter (nth_nat (Suc (Suc 0)) o1) (nth_nat 0 o2) \ 0 \ + list_inter (nth_nat 0 o1) (nth_nat (Suc (Suc 0)) o2) \ 0 then 1 else 0 " + +definition are_operators_interfering_tail :: "nat \ nat \ nat" where +"are_operators_interfering_tail o1 o2 \ +if list_inter_tail (nth_nat (Suc (Suc 0)) o1) (nth_nat 0 o2) \ 0 \ + list_inter_tail (nth_nat 0 o1) (nth_nat (Suc (Suc 0)) o2) \ 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)" + 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 \ nat \ sat_plan_variable formula" + where "encode_interfering_operator_exclusion_list \ t \ let + ops = operators_of \ + ; interfering = filter (\(op\<^sub>1, op\<^sub>2). index ops op\<^sub>1 \ index ops op\<^sub>2 + \ are_operators_interfering op\<^sub>1 op\<^sub>2) (List.product ops ops) + in BigAnd (concat (map (\(op\<^sub>1, op\<^sub>2). map (\k. encode_interfering_operator_pair_exclusion_list \ k op\<^sub>1 op\<^sub>2) + [0.. t += encode_interfering_operator_exclusion (strips_list_problem_to_problem \) 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 +fun filter_interfering:: "nat \ nat \ nat" where +"filter_interfering ops xs = (if xs = 0 then 0 else if index_nat ops (fst_nat (hd_nat xs)) \ index_nat ops (snd_nat (hd_nat xs)) + \ are_operators_interfering_nat (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)) \ 0 then (hd_nat xs) ## filter_interfering ops (tl_nat xs) else filter_interfering ops (tl_nat xs))" + +fun filter_interfering_acc:: "nat \ nat \ nat \ nat" where +"filter_interfering_acc acc ops xs = (if xs = 0 then acc else if index_nat ops (fst_nat (hd_nat xs)) \ index_nat ops (snd_nat (hd_nat xs)) + \ are_operators_interfering_tail (fst_nat (hd_nat xs)) (snd_nat (hd_nat xs)) \ 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 (\n. index_nat ops (fst_nat n) \ index_nat ops (snd_nat n) + \ are_operators_interfering_nat (fst_nat n) (snd_nat n) \ 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 (\n. index_nat ops (fst_nat n) \ index_nat ops (snd_nat n) + \ are_operators_interfering_nat (fst_nat n) (snd_nat n) \ 0 ) xs" + apply (induct ops xs rule:filter_interfering.induct) + apply (auto simp del:index_nat.simps) + done + +definition filter_interfering_tail :: "nat \ nat \ 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 \ nat \ nat \ 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 (\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_encode_interfering_acc :: "nat \ nat \ nat \ nat \ 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 +(\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 \nat \ nat \ nat" where +"map_map_encode_interfering \ t xs = (if xs = 0 then 0 else +(map_encode_interfering \ (hd_nat xs) (list_less_nat t)) ## map_map_encode_interfering \ t (tl_nat xs) +) " + +fun map_map_encode_interfering_acc :: "nat \ nat \nat \ nat \ nat" where +"map_map_encode_interfering_acc acc \ t xs = (if xs = 0 then acc else map_map_encode_interfering_acc( +(map_encode_interfering \ (hd_nat xs) (list_less_nat t)) ## acc) \ t (tl_nat xs) +) " + +lemma map_map_encode_interfering_induct: +"map_map_encode_interfering_acc acc \ t xs = map_acc (\n. map_encode_interfering \ n + (list_less_nat t) ) acc xs " + apply(induct acc \ t xs rule: map_map_encode_interfering_acc.induct) + apply auto + done + +lemma submap_map_encode_interfering: +"map_map_encode_interfering \ t xs = map_nat (\n. map_encode_interfering \ n + (list_less_nat t) ) xs " + apply (induct \ t xs rule: map_map_encode_interfering.induct) + apply auto + done + +definition map_map_encode_interfering_tail :: "nat \ nat \ nat \ nat" where +"map_map_encode_interfering_tail \ t xs = reverse_nat (map_map_encode_interfering_acc 0 \ t xs)" + +lemma subtail_map_map_encode_interfering: +"map_map_encode_interfering_tail \ t xs = map_map_encode_interfering \ 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 \ nat \ nat" + where "encode_interfering_operator_exclusion_nat \ t \ let + ops = nth_nat (Suc 0) \ + ; interfering = filter_interfering ops (product_nat ops ops) + in BigAnd_nat (concat_nat (map_map_encode_interfering \ t interfering ))" + +definition encode_interfering_operator_exclusion_tail + :: "nat \ nat \ nat" + where "encode_interfering_operator_exclusion_tail \ t \ let + ops = nth_nat (Suc 0) \ + ; interfering = filter_interfering_tail ops (product_tail ops ops) + in BigAnd_tail (concat_tail (map_map_encode_interfering_tail \ 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)" + using inj_strips_op + 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 + ) + 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 "\x. + (map (\k. sat_formula_encode + (encode_interfering_operator_pair_exclusion_list p k (fst x) (snd x))) + [0..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" +"\x. (map (\k. encode_interfering_operator_pair_exclusion_list p k (fst x) (snd x)) + [0.. nat \ sat_plan_variable formula" + where "encode_problem_with_operator_interference_exclusion_list \ t + \ encode_initial_state_list \ + \<^bold>\ (encode_operators_list \ t + \<^bold>\ (encode_all_frame_axioms_list \ t + \<^bold>\ (encode_interfering_operator_exclusion_list \ t + \<^bold>\ (encode_goal_state_list \ t))))" + +definition encode_problem_with_operator_interference_exclusion_nat + :: "nat\ nat \ nat" + where "encode_problem_with_operator_interference_exclusion_nat \ t + \ 3 ## (encode_initial_state_nat \) + ## (3 ## (encode_operators_nat \ t) + ## (3 ## (encode_all_frame_axioms_nat \ t) + ## (3 ## (encode_interfering_operator_exclusion_nat \ t) + ## (encode_goal_state_nat \ t) ## 0) ## 0 )## 0) ## 0" + +definition encode_problem_with_operator_interference_exclusion_tail + :: "nat\ nat \ nat" + where "encode_problem_with_operator_interference_exclusion_tail \ t + \ 3 ## (encode_initial_state_tail \) + ## (3 ## (encode_operators_tail \ t) + ## (3 ## (encode_all_frame_axioms_tail \ t) + ## (3 ## (encode_interfering_operator_exclusion_tail \ t) + ## (encode_goal_state_tail \ t) ## 0) ## 0 )## 0) ## 0" + +lemma subtail_encode_problem_with_operator_interference_exclusion: +"encode_problem_with_operator_interference_exclusion_tail \ t = + encode_problem_with_operator_interference_exclusion_nat \ 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 \) t = +sat_formula_encode (encode_problem_with_operator_interference_exclusion_list \ 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 \ t += encode_problem_with_operator_interference_exclusion (strips_list_problem_to_problem \) 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 \ (nat*nat) \ (nat*nat) \ nat \ 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_list c I guess_range + in + 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 = (\_.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 = (\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.*) + "\s. \t s'. (c, s) \\<^bsup> t \<^esup> s' \ + t \ poly_of pt (bit_length (s ''input''))" + assumes verifier_terminates: + (*"\x z. \s. s ''input'' = x \ s ''certificate'' = z \ + (\t s'. (c, s) \\<^bsup> t \<^esup> s' \ 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*) + "\x s. \in_lang x = 0 ; s ''input'' = x\ \ + (\z t s'. bit_length z \ poly_of p_cer (bit_length x) \ + (c, s(''certificate'' := z)) \\<^bsup> t \<^esup> s' \ + s' ''input'' = in_lang x)" + "\x s s' t. \in_lang x \ 0; s ''input'' = x; (c, s) \\<^bsup> t \<^esup> s'\ \ + s' ''input'' = in_lang x" + assumes verifier_has_registers: + "''input'' \ set (Max_Constant.all_variables c)" + shows "\t_red s_red. + poly t_red + \ poly s_red + \ (\x. \f. bit_length (encode_sat f) \ s_red ( bit_length x ) \ imp_to_sat_list c pt p_cer x = f + \ (Sema.sat {f} \ 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 \ nat \ nat \ nat \ 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))" + +definition imp_to_sat_tail :: "nat \ nat \ nat \ nat \ 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 + +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 + (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)) + + 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 and pt::"nat*nat" and p_cer::"nat*nat" and in_lang + assumes verifier_tbounded: + "\s. \t s'. (c, s) \\<^bsup> t \<^esup> s' \ + t \ poly_of pt (bit_length (s ''input''))" + assumes verifier_terminates: + "\x s. \in_lang x = 0 ; s ''input'' = x\ \ + (\z t s'. bit_length z \ poly_of p_cer (bit_length x) \ + (c, s(''certificate'' := z)) \\<^bsup> t \<^esup> s' \ + s' ''input'' = in_lang x)" + "\x s s' t. \in_lang x \ 0; s ''input'' = x; (c, s) \\<^bsup> t \<^esup> s'\ \ + s' ''input'' = in_lang x" + assumes verifier_has_registers: + "''input'' \ set (Max_Constant.all_variables c)" + shows "\t_red s_red. + poly t_red + \ poly s_red + \ (\x. \f. bit_length (encode_sat f) \ s_red ( bit_length x ) \ imp_to_sat_nat (com_encode c) (prod_encode pt) (prod_encode p_cer) x = sat_formula_encode f + \ (Sema.sat {f} \ 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: + "\s. \t s'. (c, s) \\<^bsup> t \<^esup> s' \ + t \ poly_of pt (bit_length (s ''input''))" + assumes verifier_terminates: + "\x s. \in_lang x = 0 ; s ''input'' = x\ \ + (\z t s'. bit_length z \ poly_of p_cer (bit_length x) \ + (c, s(''certificate'' := z)) \\<^bsup> t \<^esup> s' \ + s' ''input'' = in_lang x)" + "\x s s' t. \in_lang x \ 0; s ''input'' = x; (c, s) \\<^bsup> t \<^esup> s'\ \ + s' ''input'' = in_lang x" + assumes verifier_has_registers: + "''input'' \ set (Max_Constant.all_variables c)" + shows "\t_red s_red. + poly t_red + \ poly s_red + \ (\x. \f. bit_length (encode_sat f) \ s_red ( bit_length x ) \ imp_to_sat_tail(com_encode c) (prod_encode pt) (prod_encode p_cer) x = sat_formula_encode f + \ (Sema.sat {f} \ 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+/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 \ nat \ nat \ 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 \ nat \ 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 \ 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 \ nat \ 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 \ nat \ nat \ nat" where +"find_triangle_search a b n = (let m = ((a+b) div 2); t = triangle' m in +if b\a then a else if n-t \ m then find_triangle_search a m n else find_triangle_search (m+1) b n +)" + by pat_completeness auto +termination by (relation "measure (\(a,b,n).b-a)") (auto simp add: sub_triangle) + +lemma mean_in_the_interval:"\ b \ a \ ((a::nat) + b ) div 2 \ a \ b \ Suc ((a::nat) + b ) div 2 " + by auto +lemma "\ b \ a \ b = Suc ((a + b) div 2) \ b = a \ b = Suc a \ b = Suc(Suc a)" + apply auto + done + +lemma find_triangle_search_inv:"\ a \ c_sum n ; c_sum n \ b\ \ 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 \ (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 \ (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 \ b = Suc a \ 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) \ 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 \ b = Suc a \ 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) \ 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 \ 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 \ 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 \ 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 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..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 \ We give a reduction from SAS++ to SAS+. The challenge here is to replace the semantics of @@ -124,16 +125,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 \ 'a list" where +"thef None = []"| +"thef (Some x) = x" + + + definition initialization_operators:: "('v, 'd) sas_plus_problem \ ('v, 'd) operator list" where "initialization_operators P = concat (map (\ v. (if v \ dom ((P)\<^sub>I\<^sub>+) then [] else map (\ y. \ precondition_of = [(Stage, Init)], effect_of = [(Var v, DE y)]\) - (the (range_of P v)))) ((P)\<^sub>\\<^sub>+))" + (thef (range_of P v)))) ((P)\<^sub>\\<^sub>+))" lemma in_initialization_operators_iff: "\precondition_of = [(Stage, Init)], effect_of = [(Var x, DE y)]\ \ set (initialization_operators P) - \ (x \ set ((P)\<^sub>\\<^sub>+) \ ((P)\<^sub>I\<^sub>+) x = None \ y \ set (the (range_of P x)))" + \ (x \ set ((P)\<^sub>\\<^sub>+) \ ((P)\<^sub>I\<^sub>+) x = None \ y \ set (thef (range_of P x)))" by(auto simp: initialization_operators_def) lemma Stage_after_initialization_operator[simp]: 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..7c3c779c --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/SAS++_To_SAS+/SAS_Plus_Plus_To_SAS_Plus_Nat.thy @@ -0,0 +1,1027 @@ +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 \ (variable,domain_element) assignment list) \ + (var,dom) assignment list" where +"SAS_Plus_Plus_State_To_SAS_Plus_list is = (Stage, fst is) # + map (\(x,y). (x,DE y)) (map (\(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 "\y. (x,y) \ set b" + using weak_map_of_SomeI by force + hence "\y. (Var x, y) \ set (map (\(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\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 \ nat\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 (\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 (\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 \ 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 \ 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 \ 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)" + 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 \ 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 \ nat \ 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 (\ 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 (\ 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 \ 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 \ 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 \ 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) + 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 \ operator_plus list" where +"initialization_operators_list P = + concat (map (\ v. (if v \ set (map fst (initial_ofl P)) then [] + else map (\ y. \ precondition_of = [(Stage, Init)], effect_of = [(Var v, DE y)]\) + (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 \ nat\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) )" + +fun map_inner_acc :: "nat \ nat \ nat\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 (\ 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 (\ 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 \ nat \ 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\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 \ nat\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 +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 \ 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 + +function map_outer :: "nat \ nat \ 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)) \ 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 (\ v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \ 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) +declare map_list_find_nat.simps elemof.simps [simp del] + +function map_outer_acc :: "nat \ nat \ nat \ 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)) \ 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 (\ v. (if elemof v (map_fst (nth_nat (Suc (Suc 0)) P)) \ 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 \ nat \ 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 \ nat" where +"initialization_operators_nat P = + concat_nat (map_outer P (nth_nat 0 P))" + +definition initialization_operators_tail:: + "nat \ 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 (\(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 (\(x,y). (variable_encode x,domain_element_encode y))" + by force + +lemma map_find_map:"inj f \ map_list_find (map (\(x, y). (f x, g (h y))) l) (f x) = + (case map_list_find l x of None \ None | Some y \ Some (g (h y)))" + apply (induct l arbitrary:x) + apply (auto simp add:inj_def) + done + +lemma map_find_map2:"inj f \ map_list_find (map (\(x, y). (f x, g y)) l) (f x) = + (case map_list_find l x of None \ None | Some y \ Some (g y))" + apply (rule map_find_map) apply auto + done + +lemma inj_map_set: "inj f \ (f x \ set (map f xs)) = ( x \ 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 \ [] | Some x \ 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" "\x.(case x of + (x, y) \ (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 "(\x. case map_list_find (range_ofl P) x of None \ [] + | Some xa \ + if x \ set (map fst (initial_ofl P)) then [] + else map (\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 \ 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 \ nat \ 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 (\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 + +lemma map_init_seq_induct: +"map_init_seq_acc acc n = map_acc (\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 \ 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 \ nat" where + "initialization_sequence_nat vs = map_init_seq vs" + +definition initialization_sequence_tail:: "nat \ 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)) " + 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 \ (var, dom) assignment list" where +"initial_state_list P = SAS_Plus_Plus_State_To_SAS_Plus_list (Init, + map (\v. (v, case (map_list_find (initial_ofl P) v) of Some val \ val | + None \ (the (map_list_find (range_ofl P) v)) ! 0 ) ) (variables_ofl P) +)" + +lemma sublist_initial_state_helper_apply: +" (\v. if v \ set ((P)\<^sub>\\<^sub>+) + then Some + (case map_of ((P)\<^sub>I\<^sub>+) v of None \ the (map_of (range_ofl P) v) ! 0 + | Some val \ val) + else None) k = + map_of + (map (\v. (v, case map_of ((P)\<^sub>I\<^sub>+) v of + None \ the (map_of (range_ofl P) v) ! 0 | Some val \ val)) + ((P)\<^sub>\\<^sub>+)) k +" + apply (auto) + subgoal +proof - + assume a1: "k \ set ((P)\<^sub>\\<^sub>+)" + then have "set ((P)\<^sub>\\<^sub>+) \ {}" + by force + then show "Some (case map_of ((P)\<^sub>I\<^sub>+) k of None \ the (map_of (range_ofl P) k) ! 0 | Some a \ a) = map_of (map (\b. (b, case map_of ((P)\<^sub>I\<^sub>+) b of None \ the (map_of (range_ofl P) b) ! 0 | Some a \ a)) ((P)\<^sub>\\<^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: +"(\v. if v \ set ((P)\<^sub>\\<^sub>+) + then Some + (case map_of ((P)\<^sub>I\<^sub>+) v of None \ the (map_of (range_ofl P) v) ! 0 + | Some val \ val) + else None) += map_of + (map (\v. (v, case map_of ((P)\<^sub>I\<^sub>+) v of + None \ the (map_of (range_ofl P) v) ! 0 | Some val \ val)) + ((P)\<^sub>\\<^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 \ map f x = f a # map f xs" + apply auto + done +declare map_list_find_nat.simps [simp del] +fun map_initial_state :: "nat \ nat \ 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 \ val | + 0 \ 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))" + +fun map_initial_state_acc :: "nat \ nat \ nat \ 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 \ val | + 0 \ 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 (\v. prod_encode(v, case (map_list_find_nat (nth_nat (Suc (Suc 0)) P) v) of Suc val \ val | + 0 \ 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 + +lemma map_initial_state_induct: +"map_initial_state_acc P acc n = map_acc (\v. prod_encode(v, case (map_list_find_nat (nth_nat (Suc (Suc 0)) P) v) of Suc val \ val | + 0 \ 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 \ nat \ 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 \ 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 \ 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 \ t | Suc y \ f y) = + (case x of None \ t | Some y \ f y) " + apply (cases x) + apply auto + done + +lemma some_case_unfold: "f a = Some y \ (case f a of None \ None | Some t \ Some (g t)) = Some (g y)" + apply auto + done + + +lemma lambda_case_simplifier: +assumes "\x \ set (variables_ofl P). \t. map_list_find (range_ofl P) x = Some t \ t\[]" +shows +" map (\x. case map_list_find ((P)\<^sub>I\<^sub>+) x of + None \ + prod_encode + (variable_encode x, + hd_nat + (the_nat + (option_encode + (case map_list_find (range_ofl P) x of None \ None + | Some y \ + Some + (list_encode (map domain_element_encode y)))))) + | Some xa \ + prod_encode (variable_encode x, domain_element_encode xa)) + ((P)\<^sub>\\<^sub>+) = + map (\x. case map_list_find ((P)\<^sub>I\<^sub>+) x of + None \ + 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 \ + prod_encode (variable_encode x, domain_element_encode xa)) + ((P)\<^sub>\\<^sub>+) +" + using assms + apply (induct "((P)\<^sub>\\<^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 "\x \ set (variables_ofl P). \t. map_list_find (range_ofl P) x = Some t \ t\[]" +shows +"map (\x. case map_list_find ((P)\<^sub>I\<^sub>+) x of + None \ + prod_encode + (variable_encode x, + head + (map domain_element_encode + (the (map_list_find (range_ofl P) x)))) + | Some xa \ + prod_encode (variable_encode x, domain_element_encode xa)) + ((P)\<^sub>\\<^sub>+) += +map (\x. case map_list_find ((P)\<^sub>I\<^sub>+) x of + None \ + prod_encode + (variable_encode x, + domain_element_encode (hd ( + (the (map_list_find (range_ofl P) x))))) + | Some xa \ + prod_encode (variable_encode x, domain_element_encode xa)) + ((P)\<^sub>\\<^sub>+) + +" + using assms + apply (induct "((P)\<^sub>\\<^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 "\x \ set (variables_ofl P). \t. map_list_find (range_ofl P) x = Some t \ t\[]" +shows +"map (\x. case map_list_find ((P)\<^sub>I\<^sub>+) x of + None \ + prod_encode + (variable_encode x, + domain_element_encode (hd ( + (the (map_list_find (range_ofl P) x))))) + | Some xa \ + prod_encode (variable_encode x, domain_element_encode xa)) + ((P)\<^sub>\\<^sub>+) + += + +map (\x. case map_list_find ((P)\<^sub>I\<^sub>+) x of + None \ + prod_encode + (variable_encode x, + domain_element_encode ( + (the (map_list_find (range_ofl P) x))!0)) + | Some xa \ + prod_encode (variable_encode x, domain_element_encode xa)) + ((P)\<^sub>\\<^sub>+) + +" + using assms + apply (induct "((P)\<^sub>\\<^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 "\x \ set (variables_ofl P). \t. map_list_find (range_ofl P) x = Some t \ t\[]" + 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 "\x \ set (variables_ofl P). \t. map_list_find (range_ofl P) x = Some t \ t\[]" +proof - + obtain P' where def: "P' = list_problem_to_problem 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 "\x \ set (sas_plus_problem.variables_of P'). \t. (range_of P') x = Some t \ t \ []" + 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 \ (var,dom)sas_plus_list_problem" where +"SAS_Plus_Plus_To_SAS_Plus_list P = \ variables_ofl = Stage # (map Var ((P)\<^sub>\\<^sub>+)), + operators_ofl = \ precondition_of = [(Stage, Init)], effect_of = [(Stage, NonInit)]\ + # (initialization_operators_list P) + @ (map SAS_Plus_Plus_Operator_To_SAS_Plus_Operator ((P)\<^sub>\\<^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 (\(x,y). (x, map DE y)) (map (\(x,y). (Var x, y)) (range_ofl P))\" + +lemma sublist_SAS_Plus_Plus_To_SAS_Plus_helper_apply: +"map_of ((Stage, [Init,NonInit])# + map (\(x,y). (x, map DE y)) (map (\(x,y). (Var x, y)) (range_ofl P))) k += + (((\x. Some (map DE x)) \\<^sub>m (map_of (range_ofl P)) + \\<^sub>m (\x. (case x of Var x \ Some x | Stage \ None)))(Stage \ [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 "\y. (x1,y) \ set (range_ofl P)" + using weak_map_of_SomeI by force + then have "\y. (Var x1,y) \ set (map (\(x, y). (Var x, y)) (range_ofl P)) " + by auto + thus " map_of (map (\(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 (\(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 (\(x,y). (x, map DE y)) (map (\(x,y). (Var x, y)) (range_ofl P))) += + (((\x. Some (map DE x)) \\<^sub>m (map_of (range_ofl P)) + \\<^sub>m (\x. (case x of Var x \ Some x | Stage \ None)))(Stage \ [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 \ 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 \ nat \ 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 \ 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 \ 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 \ nat \ 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 (\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 (\n. Suc (Suc n)) acc n " + apply(induct acc n rule:map_DE_acc.induct) + apply auto + done + +definition map_DE_tail :: "nat \ 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 \ 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 \ nat \ 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 (\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 (\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 \ 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 \ 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 \ nat \ 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 ( \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 ( \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 \ 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\ 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 \ nat\ 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\ 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 \ 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 )" + +definition SAS_Plus_Plus_To_SAS_Plus_tail:: " nat \ 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: " (\x. case x of + (x1, x2) \ + prod_encode + ((case x of (x1, x2) \ Pair (Suc (variable_encode x1))) + (list_encode + (map (\x. Suc (Suc (domain_element_encode x))) x2)))) += + (\x. case x of + (x1, x2) \ + prod_encode + (Suc (variable_encode x1), + list_encode + (map (\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 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..c0ba9146 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/SAS_Plus_Strips_Nat.thy @@ -0,0 +1,714 @@ +theory SAS_Plus_Strips_Nat + imports "Verified_SAT_Based_AI_Planning.SAS_Plus_STRIPS" Primitives +begin + +definition possible_assignments_for_list + :: "('variable, 'domain) sas_plus_list_problem \ 'variable \ ('variable \ 'domain) list" + where "possible_assignments_for_list \ v \ [(v, a). a \ the (map_list_find (range_ofl \) 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 + +fun map_prodWith :: " nat \ nat \ 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 \ nat \ nat \ 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 (\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 (\a. prod_encode (v,a)) n" + apply (induct v n rule:map_prodWith.induct) + apply auto + done + +definition map_prodWith_tail :: "nat \ nat \ 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 \ nat \ nat" + where "possible_assignments_for_nat P v \ map_prodWith v (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))" + +definition possible_assignments_for_tail + :: "nat \ nat \ nat" + where "possible_assignments_for_tail P v \ 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 (\(v,d). (var_encode v, list_encode (map dom_encode d)))" + apply auto + done + +lemma subnat_possible_assignments_for_pre: + assumes "v \ set (variables_ofl P)" + assumes " v \ set (variables_ofl P ) \ map_list_find (range_ofl P) v \ 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 +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 + 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 \ set (variables_ofl P)" + shows "map_list_find (range_ofl P) v \ None" +proof - + have "v \ set (sas_plus_problem.variables_of (list_problem_to_problem P))" + using assms by auto + hence "range_of (list_problem_to_problem P) v \ 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 \ 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 \ ('variable \ 'domain) list" + where "all_possible_assignments_for_list \ + \ concat [possible_assignments_for_list \ v. v \ variables_ofl \]" + +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 + +fun map_possible_assignments_for :: "nat \ nat \ 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 \ nat \ nat \ 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 \ nat \ 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 \ nat" + where "all_possible_assignments_for_nat \ + \ concat_nat (map_possible_assignments_for \ (nth_nat 0 \))" + +definition all_possible_assignments_for_tail:: + "nat \ nat" + where "all_possible_assignments_for_tail \ + \ concat_tail (map_possible_assignments_for_tail \ (nth_nat 0 \))" + +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)" + shows " map (\x. possible_assignments_for_nat (list_problem_plus_encode P) (var_encode x)) + (variables_ofl P) = + map sas_plus_assignment_list_encode (map (\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 + 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 + 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 _ "\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 + \ ('variable, 'domain) assignment list + \ (('variable, 'domain) assignment ,bool) assignment list" + where "state_to_strips_state_list \ s + \ let defined = filter (\v. map_list_find s v \ None) (variables_ofl \) in + map (\(v, a). ((v, a), the (map_list_find s v) = a)) + (concat [possible_assignments_for_list \ v. v \ 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 + +declare map_list_find_nat.simps [simp del] +fun map_find_eq:: "nat \ nat \ 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 \ nat \ nat \ 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 (\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 \ nat \ 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 (\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 + +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 \ nat \ nat" where +"filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \ 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))" + +fun filter_defined_acc :: "nat \ nat \ nat \ nat" where +"filter_defined_acc s acc n = (if n = 0 then acc else if map_list_find_nat s (hd_nat n) \ 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 (\v. map_list_find_nat s v \ 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 (\v. map_list_find_nat s v \ 0) acc n" + apply( induct s acc n rule:filter_defined_acc.induct) + apply auto + done + +definition filter_defined_tail :: "nat \ nat \ 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 + :: "nat \nat \nat" + where "state_to_strips_state_nat \ s + \ let defined = filter_defined s (nth_nat 0 \) in + map_find_eq s (concat_nat (map_possible_assignments_for \ defined))" + +definition state_to_strips_state_tail + :: "nat \nat \nat" + where "state_to_strips_state_tail \ s + \ let defined = filter_defined_tail s (nth_nat 0 \) in + map_find_eq_tail s (concat_tail (map_possible_assignments_for_tail \ defined))" + +lemma subtail_state_to_strips_state: +"state_to_strips_state_tail \ s = state_to_strips_state_nat \ 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)" +shows +"map (\x. possible_assignments_for_nat (list_problem_plus_encode P) (var_encode x)) + (filter (\x. map_list_find s x \ None) (variables_ofl P)) += map sas_plus_assignment_list_encode ( map (possible_assignments_for_list P) + (filter (\x. map_list_find s x \ None) (variables_ofl P)) )" + using assms apply (auto simp add: subnat_possible_assignments_for) + done + +lemma possible_assignments_fst: "(x, b) \ set (possible_assignments_for_list P y) \ 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 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 + 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 (\(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 (\(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 + \ ('variable, 'domain) sas_plus_operator + \ ('variable, 'domain) assignment strips_operator" + ("\\<^sub>O _ _" 99) + where "sasp_op_to_strips_list \ op \ let + pre = precondition_of op + ; add = effect_of op + ; delete = concat (map (\(v,a). map (\a'. (v, a')) (filter ((\) a) (the (map_list_find (range_ofl \ )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 \ nat \ nat \ nat" where +"operator_for_nat pre add delete = pre ## add ## delete ##0 " + +definition operator_for_tail :: "nat \ nat \ nat \ 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) + done + + +fun filter_diff_snd :: "nat \ nat \ nat" where +"filter_diff_snd n xs = (if xs = 0 then 0 else if (hd_nat xs) \ 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 \ nat \ nat \ nat" where +"filter_diff_snd_acc n acc xs = (if xs = 0 then acc else if (hd_nat xs) \ 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 ((\) (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 \ nat \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 ((\) (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 \ nat \ 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 \ nat \ nat \ 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 (\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 (\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 \ nat \ 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 \ nat \ 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 \ nat \ nat \ 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 (\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 (\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 \ nat \ 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 \nat \ nat " + where "sasp_op_to_strips_nat \ op \ let + pre = nth_nat 0 op + ; add = nth_nat (Suc 0) op + ; delete = concat_nat (map_sasp_op_to_strips \ (nth_nat (Suc 0) op)) + in operator_for_nat pre add delete" + +definition sasp_op_to_strips_tail + :: "nat \nat \ nat " + where "sasp_op_to_strips_tail \ op \ let + pre = nth_nat 0 op + ; add = nth_nat (Suc 0) op + ; delete = concat_tail (map_sasp_op_to_strips_tail \ (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 + + + +lemma subnat_sasp_op_to_strips_map: + assumes "\(v,d)\ set (effect_of op). map_list_find (range_ofl P) v \ None" + shows +"map (\x. map_nat (\a'. prod_encode (var_encode (fst x), a')) + (filter_nat ((\) (dom_encode (snd x))) + (the_nat + (option_encode + (map_list_find + (map (\(v, d). + (var_encode v, list_encode (map dom_encode d))) + (range_ofl P)) + (var_encode (fst x))))))) + (effect_of op) = +map (\(v,d). map_nat (\a'. prod_encode (var_encode v, a')) + (filter_nat ((\) (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: + "(\(v, d). + list_encode + (map (\a'. prod_encode (var_encode v, a')) + (filter ((\) (dom_encode d)) + (map dom_encode (the (map_list_find (range_ofl P) v)))))) += list_encode o (\(v,d). map (\a'. prod_encode (var_encode v, a')) + (filter ((\) (dom_encode d)) + (map dom_encode (the (map_list_find (range_ofl P) v)))))" + apply (auto) + done +lemma subnat_sasp_op_to_strips_map3: +"(\(v, d). + map sas_plus_assignment_encode + (map (Pair v) (filter ((\) d) (the (map_list_find (range_ofl P) v))))) += map sas_plus_assignment_encode o (\(v,d). map (Pair v) (filter ((\) 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 \ set (operators_ofl P)" + shows "\(v,d)\ set (effect_of op). map_list_find (range_ofl P) v \ 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 "\(v,d)\ set (effect_of op). map_list_find (range_ofl P) v \ 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 +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 ) + 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 \ 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 + \ 'variable strips_operator list + \ ('variable,bool) assignment list + \ ('variable,bool) assignment list + \ ('variable) strips_list_problem" + where "problem_for_list vs ops I gs \ \ + variables_of = vs + , operators_of = ops + , initial_of = I + , goal_of = gs \" + +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 \ ('variable, 'domain) assignment strips_list_problem" + ("\ _ " 99) + where "sas_plus_problem_to_strips_problem_list \ \ let + vs = concat (map (possible_assignments_for_list \)(variables_ofl \)) + ; ops = map (sasp_op_to_strips_list \) (operators_ofl \) + ; I = state_to_strips_state_list \ (initial_ofl \) + ; G = state_to_strips_state_list \ (goal_ofl \) + 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 + \ nat + \ nat + \ nat + \ nat" + where "problem_for_nat vs ops I gs \ vs ## ops ## I ## gs ## 0 " + +definition problem_for_tail:: "nat + \ nat + \ nat + \ nat + \ 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) += + 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 + +fun maps_sasp_op_to_strips :: "nat \ nat \ 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 \ nat \ nat \ 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 \ nat \ 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\nat" + where "sas_plus_problem_to_strips_problem_nat \ \ let + vs = concat_nat (map_possible_assignments_for \(nth_nat 0 \)) + ; ops = maps_sasp_op_to_strips \ (nth_nat (Suc 0) \) + ; I = state_to_strips_state_nat \ (nth_nat (Suc (Suc 0)) \) + ; G = state_to_strips_state_nat \ (nth_nat (Suc (Suc (Suc 0))) \) + in problem_for_nat vs ops I G" + +definition sas_plus_problem_to_strips_problem_tail + :: "nat\nat" + ("\ _ " 99) + where "sas_plus_problem_to_strips_problem_tail \ \ let + vs = concat_tail (map_possible_assignments_for_tail \(nth_nat 0 \)) + ; ops = maps_sasp_op_to_strips_tail \ (nth_nat (Suc 0) \) + ; I = state_to_strips_state_tail \ (nth_nat (Suc (Suc 0)) \) + ; G = state_to_strips_state_tail \ (nth_nat (Suc (Suc (Suc 0))) \) + 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)" + shows "map (\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 (\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 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 + 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..0a0bfe59 --- /dev/null +++ b/Cook_Levin/IMP-_To_SAS+/SAT_Plan_Base_Nat.thy @@ -0,0 +1,1171 @@ +theory SAT_Plan_Base_Nat + imports "Verified_SAT_Based_AI_Planning.SAT_Plan_Base" Primitives +begin + +definition encode_state_variable_nat + :: "nat \ nat \ nat\ 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 \ nat \ nat\ 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 \ 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 \ sat_plan_variable formula" + where "encode_initial_state_list \ + \ let I = initial_of \ + ; vs = variables_of \ + in \<^bold>\(map (\v. encode_state_variable 0 (index vs v) (map_list_find I v) \<^bold>\ \) + (filter (\v. map_list_find I v \ 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 \ nat \ nat \ nat \ 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 \ nat \ nat \ nat \ nat \ 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 (\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 \ nat \ nat \ nat \ 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 (\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 \ nat \ nat" where +"filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \ 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))" + +fun filter_defined_acc :: "nat \ nat \ nat \ nat" where +"filter_defined_acc s acc n = (if n = 0 then acc else if map_list_find_nat s (hd_nat n) \ 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 (\v. map_list_find_nat s v \ 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 (\v. map_list_find_nat s v \ 0) acc n" + apply( induct s acc n rule:filter_defined_acc.induct) + apply auto + done + +definition filter_defined_tail :: "nat \ nat \ 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\ nat" + where "encode_initial_state_nat \ + \ let I = nth_nat (Suc (Suc 0)) \ + ; vs = nth_nat 0 \ + in BigAnd_nat ( map_encode_initial_state 0 I vs + (filter_defined I vs))" + +definition encode_initial_state_tail + :: "nat\ nat" + where "encode_initial_state_tail \ + \ let I = nth_nat (Suc (Suc 0)) \ + ; vs = nth_nat 0 \ + 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 \ = encode_initial_state_nat \" + 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) + +lemma subnat_encode_initial_state_map: +"map (\x. list_encode + [4, encode_state_variable_nat 0 (index (P\<^sub>\) x) + (option_encode + (map_list_find (map (\(s, b). (s, bool_encode b)) (P\<^sub>I)) x)), + sat_formula_encode \]) + (filter (\x. map_list_find (P\<^sub>I) x \ None) (P\<^sub>\)) += +map (\x. list_encode + [4, sat_formula_encode (encode_state_variable 0 (index (P\<^sub>\) x) + (map_list_find (P\<^sub>I) x)), + sat_formula_encode \]) + (filter (\x. map_list_find (P\<^sub>I) x \ None) (P\<^sub>\)) +" + apply (induct "(P\<^sub>\)") + 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 "\x. encode_state_variable 0 (index ((P)\<^sub>\) x) (map_list_find ((P)\<^sub>I) x) \<^bold>\ \"]) + done + +definition encode_goal_state_list + :: "'variable strips_list_problem \ nat \ sat_plan_variable formula" ("\\<^sub>G _" 99) + where "encode_goal_state_list \ t + \ let + vs = variables_of \ + ; G = goal_of \ + in \<^bold>\(map (\v. encode_state_variable t (index vs v) (map_list_find G v) \<^bold>\ \) + (filter (\v. map_list_find G v \ 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\ nat \ nat" + where "encode_goal_state_nat \ t + \ let G = nth_nat (Suc (Suc (Suc 0))) \ + ; vs = nth_nat 0 \ + in BigAnd_nat (map_encode_initial_state t G vs + (filter_defined G vs))" + +definition encode_goal_state_tail + :: "nat\ nat \ nat" + where "encode_goal_state_tail \ t + \ let G = nth_nat (Suc (Suc (Suc 0))) \ + ; vs = nth_nat 0 \ + 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 (\x. list_encode + [4, encode_state_variable_nat t (index (P\<^sub>G) x) + (option_encode + (map_list_find (map (\(s, b). (s, bool_encode b)) (P\<^sub>I)) x)), + sat_formula_encode \]) + (filter (\x. map_list_find (P\<^sub>I) x \ None) (P\<^sub>G)) += +map (\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 \]) + (filter (\x. map_list_find (P\<^sub>I) x \ 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 "\x. encode_state_variable t (index ((P)\<^sub>\) x) (map_list_find (((P)\<^sub>G)) x) \<^bold>\ \"]) + done + +definition encode_operator_precondition_list + :: "'variable strips_list_problem + \ nat + \ 'variable strips_operator + \ sat_plan_variable formula" + where "encode_operator_precondition_list \ t op \ let + vs = variables_of \ + ; ops = strips_list_problem.operators_of \ + in \<^bold>\(map (\v. + \<^bold>\ (Atom (Operator t (index ops op))) \<^bold>\ Atom (State t (index vs v))) + (strips_operator.precondition_of op))" + +lemma sublist_encode_operator_precondition: +"encode_operator_precondition_list \ t op = + encode_operator_precondition (strips_list_problem_to_problem \) t op" + apply (auto simp add: encode_operator_precondition_list_def encode_operator_precondition_def) + done +fun map_encode_operator_precondition :: "nat \ nat \ nat \ nat \ nat \ 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) +)" + +fun map_encode_operator_precondition_acc :: "nat \ nat \ nat \ nat \ nat \ nat \ nat" where +"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) +## 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 (\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 = +map_nat (\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 map_encode_operator_precondition_tail :: "nat \ nat \ nat \ nat \ nat \ 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 + \ nat + \ nat + \ nat" + where "encode_operator_precondition_nat \ t op \ let + vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + in BigAnd_nat (map_encode_operator_precondition t ops op vs + (nth_nat 0 op))" + +definition encode_operator_precondition_tail + :: "nat + \ nat + \ nat + \ nat" + where "encode_operator_precondition_tail \ t op \ let + vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + 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) +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 +"\x.\<^bold>\ (Atom (Operator t (index ((P)\<^sub>\) op))) \<^bold>\ Atom (State t (index ((P)\<^sub>\) x))"]) + done + +lemma sub_foldr: "foldr (\<^bold>\) xs (\<^bold>\\) = BigAnd xs " + apply (induct xs) + apply auto + done +definition encode_all_operator_preconditions_list + :: "'variable strips_list_problem + \ 'variable strips_operator list + \ nat + \ sat_plan_variable formula" + where "encode_all_operator_preconditions_list \ ops t \ let + l = List.product [0..(t, op). encode_operator_precondition_list \ t op) l)" + +lemma sublist_encode_all_operator_preconditions: +"encode_all_operator_preconditions_list \ ops t = +encode_all_operator_preconditions (strips_list_problem_to_problem \) 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) \ (case x of (x1,x2) \ f x1 x2) (g x1 x2)) += (case x of (x1,x2) \ f x1 x2 (g x1 x2))" + by (simp add: prod.case_eq_if) + +fun maps_encode_operator_precondition :: "nat \ nat \ 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 (\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 + +fun maps_encode_operator_precondition_acc :: "nat \ nat \ nat \ 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 (\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 \ nat \ 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 + \ nat + \ nat + \ nat" + where "encode_all_operator_preconditions_nat \ ops t \ let + l = product_nat (list_less_nat t) ops + in BigAnd_nat (maps_encode_operator_precondition \ l)" + +definition encode_all_operator_preconditions_tail + :: "nat + \ nat + \ nat + \ nat" + where "encode_all_operator_preconditions_tail \ ops t \ let + l = product_tail (list_less_tail t) ops + in BigAnd_tail (maps_encode_operator_precondition_tail \ l)" + +lemma subtail_encode_all_operator_preconditions: +"encode_all_operator_preconditions_tail \ ops t = encode_all_operator_preconditions_nat \ 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:"(\x. case x of (a,b) \ f a b) = (\(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..x. encode_operator_precondition_list P (fst x) (snd x) "]) + done + +definition encode_operator_effect_list + :: "'variable strips_list_problem + \ nat + \ 'variable strips_operator + \ sat_plan_variable formula" + where "encode_operator_effect_list \ t op + \ let + vs = variables_of \ + ; ops = operators_of \ + in \<^bold>\(map (\v. + \<^bold>\(Atom (Operator t (index ops op))) + \<^bold>\ Atom (State (Suc t) (index vs v))) + (add_effects_of op) + @ map (\v. + \<^bold>\(Atom (Operator t (index ops op))) + \<^bold>\ \<^bold>\ (Atom (State (Suc t) (index vs v)))) + (delete_effects_of op))" + +lemma sublist_encode_operator_effect: +"encode_operator_effect_list \ t op = +encode_operator_effect (strips_list_problem_to_problem \) t op" + apply (auto simp add: encode_operator_effect_list_def encode_operator_effect_def) + done + +fun map_encode_operator_effect::"nat \ nat \ nat \ nat \ nat \ 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) +)" + +fun map_encode_operator_effect_acc::"nat \ nat \ nat \ nat \ nat \ nat \ 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 (\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 (\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 + +definition map_encode_operator_effect_tail ::"nat \ nat \ nat \ nat \ nat \ 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 \ nat \ nat \ nat \ nat \ 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 (\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 + + +fun map_encode_operator_effect2_acc :: "nat \ nat \ nat \ nat \ nat \ nat \ 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 (\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 \ nat \ nat \ nat \ nat \ 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 + \ nat + \ nat + \ nat" + where "encode_operator_effect_nat \ t op + \ let + vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + 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)))" + +definition encode_operator_effect_tail + :: "nat + \ nat + \ nat + \ nat" + where "encode_operator_effect_tail \ t op + \ let + vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + 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)" + 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 "\x. Not (Atom (Operator t (index ((P)\<^sub>\) op))) \<^bold>\ + Atom (State (Suc t) (index ((P)\<^sub>\) x))" ] comp_def [of sat_formula_encode "\x. Not (Atom (Operator t (index ((P)\<^sub>\) op))) \<^bold>\ + Not ( Atom (State (Suc t) (index ((P)\<^sub>\) 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 + \ 'variable strips_operator list + \ nat + \ sat_plan_variable formula" + where "encode_all_operator_effects_list \ ops t + \ let l = List.product [0..(t, op). encode_operator_effect_list \ t op) l)" + +lemma sublist_encode_all_operator_effects: +"encode_all_operator_effects_list \ ops t = +encode_all_operator_effects (strips_list_problem_to_problem \) 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 \ nat \ 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) + )" + +fun map_encode_all_operator_effects_acc :: "nat \ nat \ nat \ 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 + (\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 (\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 + +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 + \ nat + \ nat + \ nat" + where "encode_all_operator_effects_nat P ops t + \ 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 + \ nat + \ nat + \ nat" + where "encode_all_operator_effects_tail P ops t + \ 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 += +sat_formula_encode (encode_all_operator_effects_list P ops t)" +using list.map_id [of "[0..x. encode_operator_effect_list P (fst x) (snd x) "]) + done + + +definition encode_operators_list + :: "'variable strips_list_problem \ nat \ sat_plan_variable formula" + where "encode_operators_list \ t + \ let ops = operators_of \ + in encode_all_operator_preconditions_list \ ops t \<^bold>\ encode_all_operator_effects_list \ 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 \ nat \ nat" + where "encode_operators_nat \ t + \ let ops = nth_nat (Suc 0) \ + in 3 ## (encode_all_operator_preconditions_nat \ ops t) ## (encode_all_operator_effects_nat \ ops t) ## 0" + +definition encode_operators_tail + :: "nat \ nat \ nat" + where "encode_operators_tail \ t + \ let ops = nth_nat (Suc 0) \ + in 3 ## (encode_all_operator_preconditions_tail \ ops t) ## + (encode_all_operator_effects_tail \ ops t) ## 0" + +lemma subtail_encode_operators: +"encode_operators_tail \ t = encode_operators_nat \ 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)" + 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 + \ nat + \ 'variable + \ sat_plan_variable formula" + where "encode_negative_transition_frame_axiom_list \ t v + \ let vs = variables_of \ + ; ops = operators_of \ + ; deleting_operators = filter (\op. ListMem v (delete_effects_of op)) ops + in \<^bold>\(Atom (State t (index vs v))) + \<^bold>\ (Atom (State (Suc t) (index vs v)) + \<^bold>\ \<^bold>\ (map (\op. Atom (Operator t (index ops op))) deleting_operators))" + +lemma sublist_encode_negative_transition_frame_axiom: +"encode_negative_transition_frame_axiom_list \ t v = +encode_negative_transition_frame_axiom (strips_list_problem_to_problem \) 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 \ nat \ nat" where +"filter_del_effects v ops = (if ops = 0 then 0 else if +elemof v (nth_nat (Suc (Suc 0)) (hd_nat ops)) \ 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 (\op. elemof v (nth_nat (Suc (Suc 0)) op) \ 0) ops " + apply(induct v ops rule:filter_del_effects.induct) + apply auto + done + +fun filter_del_effects_acc :: "nat \ nat \ nat \ 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)) \ 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 +(\op. elemof v (nth_nat (Suc (Suc 0)) op) \ 0) acc ops " + apply(induct acc v ops rule:filter_del_effects_acc.induct) + apply auto + done + +definition filter_del_effects_tail :: "nat \ nat \ 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 \ nat \ nat \ 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 \ nat \ nat \ nat \ 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 +(\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 (\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 \ nat \ nat \ 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 + \ nat + \nat + \ nat" + where "encode_negative_transition_frame_axiom_nat \ t v + \ let vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + ; 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" + +definition encode_negative_transition_frame_axiom_tail + :: "nat + \ nat + \nat + \ nat" + where "encode_negative_transition_frame_axiom_tail \ t v + \ let vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + ; 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)" + 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 "\x. Atom (Operator t (index ((P)\<^sub>\) 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 + \ nat + \ 'variable + \ sat_plan_variable formula" + where "encode_positive_transition_frame_axiom_list \ t v + \ let vs = variables_of \ + ; ops = operators_of \ + ; adding_operators = filter (\op. ListMem v (add_effects_of op)) ops + in (Atom (State t (index vs v)) + \<^bold>\ (\<^bold>\(Atom (State (Suc t) (index vs v))) + \<^bold>\ \<^bold>\(map (\op. Atom (Operator t (index ops op))) adding_operators)))" + +lemma sublist_encode_positive_transition_frame_axiom: +"encode_positive_transition_frame_axiom_list \ t v = +encode_positive_transition_frame_axiom (strips_list_problem_to_problem \) 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 \ nat \ nat" where +"filter_add_effects v ops = (if ops = 0 then 0 else if +elemof v (nth_nat (Suc 0) (hd_nat ops)) \ 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 \ nat \ nat \ 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)) \ 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 (\op. elemof v (nth_nat (Suc 0) op) \ 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 (\op. elemof v (nth_nat (Suc 0) op) \ 0) ops " + apply(induct v ops rule:filter_add_effects.induct) + apply auto + done + +definition filter_add_effects_tail :: "nat \ nat \ 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 + \ nat + \ nat + \ nat" + where "encode_positive_transition_frame_axiom_nat \ t v + \ let vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + ; 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" + +definition encode_positive_transition_frame_axiom_tail + :: "nat + \ nat + \ nat + \ nat" + where "encode_positive_transition_frame_axiom_tail \ t v + \ let vs = nth_nat 0 \ + ; ops = nth_nat (Suc 0) \ + ; 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)" + 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 "\x. Atom (Operator t (index ((P)\<^sub>\) 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 \ nat \ sat_plan_variable formula" + where "encode_all_frame_axioms_list \ t + \ let l = List.product [0..) + in \<^bold>\(map (\(k, v). encode_negative_transition_frame_axiom_list \ k v) l + @ map (\(k, v). encode_positive_transition_frame_axiom_list \ k v) l)" + +lemma sublist_encode_all_frame_axioms: +" encode_all_frame_axioms_list \ t = +encode_all_frame_axioms (strips_list_problem_to_problem \) 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 \ nat \ 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 (\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_negative_acc ::"nat \ nat \ nat \ 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 (\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 \ nat \ 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 \ nat \ 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 (\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 + +fun map_encode_positive_acc ::"nat \ nat \ nat \ 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 (\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 \ nat \ 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 + :: "nat \ nat \ nat" + where "encode_all_frame_axioms_nat \ t + \ let l = product_nat (list_less_nat t) (nth_nat 0 \) + in BigAnd_nat ( append_nat (map_encode_negative \ l) + (map_encode_positive \ l))" + +definition encode_all_frame_axioms_tail + :: "nat \ nat \ nat" + where "encode_all_frame_axioms_tail \ t + \ let l = product_tail (list_less_tail t) (nth_nat 0 \) + in BigAnd_tail ( append_tail (map_encode_negative_tail \ l) + (map_encode_positive_tail \ l))" + +lemma subtail_encode_all_frame_axioms: +"encode_all_frame_axioms_tail \ t = encode_all_frame_axioms_nat \ 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 = +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..\" ] + 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 "\x. encode_negative_transition_frame_axiom_list P (fst x) (snd x)"] + comp_def[of sat_formula_encode "\x. encode_positive_transition_frame_axiom_list P (fst x) (snd x)"] +) + done + +definition encode_problem_list:: "'variable strips_list_problem \ nat \ sat_plan_formula" + where "encode_problem_list \ t + \ encode_initial_state_list \ + \<^bold>\ (encode_operators_list \ t + \<^bold>\ (encode_all_frame_axioms_list \ t + \<^bold>\ (encode_goal_state_list \ t)))" + +lemma sublist_encode_problem : +"encode_problem_list \ t = encode_problem (strips_list_problem_to_problem \) 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 \ nat \ nat" + where "encode_problem_nat \ t + \ 3 ## (encode_initial_state_nat \) ## + ( 3 ## (encode_operators_nat \ t) + ## (3 ##(encode_all_frame_axioms_nat \ t) + ## (encode_goal_state_nat \ t) ## 0) ## 0) ## 0" + +definition encode_problem_tail:: "nat \ nat \ nat" + where "encode_problem_tail \ t + \ 3 ## (encode_initial_state_tail \) ## + ( 3 ## (encode_operators_tail \ t) + ## (3 ##(encode_all_frame_axioms_tail \ t) + ## (encode_goal_state_tail \ t) ## 0) ## 0) ## 0" + +lemma subtail_encode_problem: +"encode_problem_tail \ t = encode_problem_nat \ 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)" + 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 diff --git a/Cook_Levin/ROOT b/Cook_Levin/ROOT index ee08c029..66608a04 100644 --- a/Cook_Levin/ROOT +++ b/Cook_Levin/ROOT @@ -1,10 +1,11 @@ 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" + "HOL-Real_Asymp" "Landau_Symbols" "Verified_SAT_Based_AI_Planning" directories @@ -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" \ No newline at end of file + "IMP-_To_SAS+/IMP_Minus_To_SAT_Nat" 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 index 1468835d..9c4fe421 100644 --- a/IMP-/Big_StepT.thy +++ b/IMP-/Big_StepT.thy @@ -1,6 +1,6 @@ -\<^marker>\creator Bilel Ghorbel, Florian Kessler\ +\<^marker>\creator Mohammad Abdulaziz, Bilel Ghorbel, Florian Kessler\ section "Big step semantics of IMP-" -theory Big_StepT imports Main Com begin +theory Big_StepT imports Main Max_Constant Com "HOL-Eisbach.Eisbach_Tools" begin paragraph "Summary" text\We define big step semantics with time for IMP-. @@ -22,7 +22,7 @@ WhileFalse: "\ s b = 0 \ \ (WHILE b \0 DO WhileTrue: "\ s1 b \ 0; (c,s1) \\<^bsup> x \<^esup> s2; (WHILE b \0 DO c, s2) \\<^bsup> y \<^esup> s3; 1+x+y=z \ \ (WHILE b \0 DO c, s1) \\<^bsup> z \<^esup> s3" -bundle big_step_syntax +bundle big_step_syntax begin notation big_step_t ("_ \\<^bsup> _ \<^esup> _" 55) end @@ -72,6 +72,8 @@ inductive_cases Assign_tE[elim!]: "(x ::= a,s) \\<^bsup> p \<^esup> inductive_cases Seq_tE[elim!]: "(c1;;c2,s1) \\<^bsup> p \<^esup> s3" inductive_cases If_tE[elim!]: "(IF b \0 THEN c1 ELSE c2,s) \\<^bsup> x \<^esup> t" inductive_cases While_tE[elim]: "(WHILE b \0 DO c,s) \\<^bsup> x \<^esup> t" +lemma Seq': "\ (c1,s1) \\<^bsup> x \<^esup> s2; (c2,s2) \\<^bsup> y \<^esup> s3 \ \ (c1;;c2, s1) \\<^bsup> x + y \<^esup> s3" + by auto text "Rule inversion use examples:" lemma "(IF b \0 THEN SKIP ELSE SKIP, s) \\<^bsup> x \<^esup> t \ t = s" @@ -107,6 +109,29 @@ done lemma bigstep_det: "(c1, s) \\<^bsup> p1 \<^esup> t1 \ (c1, s) \\<^bsup> p \<^esup> t \ p1=p \ t1=t" using big_step_t_determ2 by simp +lemma seq_assign_t_simp: + "((c ;; x ::= a, s) \\<^bsup> Suc(Suc t) \<^esup> s') + \ (\s''. (c, s) \\<^bsup> t \<^esup> s'' \ s' = s''(x := aval a s''))" +proof + assume "(c;; x ::= a, s) \\<^bsup> Suc (Suc t) \<^esup> s'" + then obtain s'' where "(c, s) \\<^bsup> t \<^esup> s''" by auto + have "s' = s''(x := aval a s'')" using \(c;; x ::= a, s) \\<^bsup> Suc (Suc t) \<^esup> s'\ + using bigstep_det \(c, s) \\<^bsup> t \<^esup> s''\ + by blast + thus "\s''. (c, s) \\<^bsup> t \<^esup> s'' \ s' = s''(x := aval a s'')" + using \(c, s) \\<^bsup> t \<^esup> s''\ + by blast +qed auto + +lemma seq_assign_t_intro: "(c, s) \\<^bsup> t \<^esup> s'' \ s' = s''(x := aval a s'') + \(c ;; x ::= a, s) \\<^bsup> Suc(Suc t) \<^esup> s'" + using seq_assign_t_simp + by auto + +lemma seq_is_noop[simp]: "(SKIP, s) \\<^bsup>t\<^esup> s' \ (t = Suc 0 \ s = s')" by auto + +lemma seq_skip[simp]: "(c ;; SKIP, s) \\<^bsup>Suc t\<^esup> s' \ (c, s) \\<^bsup>t\<^esup> s'" by auto + subsection "Progress property" text "every command costs time" lemma bigstep_progress: "(c, s) \\<^bsup> p \<^esup> t \ p > 0" @@ -170,6 +195,158 @@ proof - moreover from b bigstepT_the_cost have "(THE n. \a. (IF b \0 THEN c1 ELSE c2, s) \\<^bsup> n \<^esup> a) = p+1" by simp ultimately show ?thesis by simp qed - + + +lemma terminates_in_state_intro: "(c, s) \\<^bsup>t\<^esup> s' \ s' = s'' \ (c, s) \\<^bsup>t\<^esup> s''" + by simp + +lemma terminates_in_time_state_intro: "(c, s) \\<^bsup>t\<^esup> s' \ t = t' \ s' = s'' + \ (c, s) \\<^bsup>t'\<^esup> s''" + by simp + +lemma terminates_in_time_state_intro': "(c', s) \\<^bsup>t\<^esup> s' \ t = t' \ s' = s'' \ c' = c + \ (c, s) \\<^bsup>t'\<^esup> s''" + by simp + +method dest_com = + (match premises in a: "\loop_cond; state_upd\ \ (_, s) \\<^bsup>t\<^esup> s'" + for s s' t loop_cond state_upd \ \rule terminates_in_time_state_intro'[OF a]\) + +method dest_com' = + (match premises in a[thin]: "\loop_cond; state_upd; (_, s) \\<^bsup>t\<^esup> s'\ \ P" + for s s' t loop_cond state_upd P \ + \match premises in b[thin]: "(While _ _, s2) \\<^bsup>t2\<^esup> s2'" + for s2 s2' t2 \ \insert a[OF _ _ b]\\) + + +method dest_com_init_while = + (match premises in a[thin]: "\loop_cond; state_upd; ((_ ;; While _ _), s) \\<^bsup>t\<^esup> s'\ \ P" + for s s' t loop_cond state_upd P \ + \match premises in b[thin]: "((_ ;; While _ _), s2) \\<^bsup>t2\<^esup> s2'" + for s2 s2' t2 \ \insert a[OF _ _ b]\\) + +(*method dest_com_init_while = + (match premises in a[thin]: "\loop_cond; state_upd; (v ::= a;; WHILE v \0 DO _, s) \\<^bsup>t\<^esup> s'\ \ P" + for v a s s' t loop_cond state_upd P \ + \match premises in b[thin]: "(v ::= a;; WHILE v \0 DO _, s2) \\<^bsup>t2\<^esup> s2'" + for s2 s2' t2 \ \insert a\\)*) + +lemma terminates_split_if : "(P s \ (c, s) \\<^bsup>t1\<^esup> s1 ) \ +(\ P s \ (c, s) \\<^bsup>t2\<^esup> s2 ) \ (c,s) \\<^bsup>if P s then t1 else t2\<^esup> if P s then s1 else s2" + by auto + +lemma AssignD': +"(x ::= a, s) \\<^bsup> 2 \<^esup> s' \ s' = s (x:= aval a s)" + by (auto simp add: eval_nat_numeral) + +lemma com_only_vars: "\(c, s) \\<^bsup> t \<^esup> s'; x \ set (Max_Constant.all_variables c)\ \ s x = s' x" + by (induction arbitrary: t rule: big_step_t_induct) auto + +lemma Seq'': "\ (c1,s1) \\<^bsup> x \<^esup> s2 \ P s2; P s2 \ (c2,s2) \\<^bsup> y \<^esup> s3 \ Q s3; Q s3 \ R s3 \ + \ (c1;;c2, s1) \\<^bsup> x + y \<^esup> s3 \ R s3" + by auto + +lemma WhileI: +"\(s1 b \ 0 \ (c,s1) \\<^bsup> x \<^esup> s2 \ (WHILE b \0 DO c, s2) \\<^bsup> y \<^esup> s3); + (s1 b = 0 \ s1 = s3); + z = (if s1 b \ 0 then 1+x+y else 2)\ + \ (WHILE b \0 DO c, s1) \\<^bsup> z \<^esup> s3" + by (auto simp add: WhileTrue WhileFalse numeral_2_eq_2) + +lemma IfI: +"\s b \ 0 \ (c1,s) \\<^bsup> x1 \<^esup> t1; + s b = 0 \ (c2,s) \\<^bsup> x2 \<^esup> t2; + y = (if s b \ 0 then x1 else x2) + 1; + t = (if s b \ 0 then t1 else t2)\ + \ (IF b \0 THEN c1 ELSE c2, s) \\<^bsup> y \<^esup> t" + by (auto simp add: IfTrue IfFalse) + +lemma IfE: +"(IF b \0 THEN c1 ELSE c2, s) \\<^bsup> (if s b \ 0 then x1 else x2) + 1 \<^esup> (if s b \ 0 then s1 else s2) \ + \\s b \ 0; (if s b \ 0 then x1 else x2) + 1 = x1 + 1; + (if s b \ 0 then s1 else s2) = s1; (c1,s) \\<^bsup> x1 \<^esup> s1\ \ P; + \s b = 0; (if s b \ 0 then x1 else x2) + 1 = x2 + 1; + (if s b \ 0 then s1 else s2) = s2; (c2,s) \\<^bsup> x2 \<^esup> s2\ \ P\ + \ P" + by (auto simp add: IfTrue IfFalse) + +thm Seq_tE + +lemma IfD: +"(IF b \0 THEN c1 ELSE c2, s) \\<^bsup> (if s b \ 0 then x1 else x2) + 1 \<^esup> (if s b \ 0 then t1 else t2) \ + \\s b \ 0; (c1,s) \\<^bsup> x1 \<^esup> t1\ \ P; + \s b = 0; (c2,s) \\<^bsup> x2 \<^esup> t2\ \ P\ + \ P" + by (auto simp add: IfTrue IfFalse) + + + + +lemma AssignI: +"\s' = s (x:= aval a s)\ + \ (x ::= a, s) \\<^bsup> Suc (Suc 0) \<^esup> s'" + by (auto simp add: Assign) + +lemma AssignI': +"\s' = s (x:= aval a s)\ + \ (x ::= a, s) \\<^bsup> 2 \<^esup> s'" + by (auto simp add: Assign eval_nat_numeral) + +lemma AssignI'': +"\s' = s (x:= aval a s)\ + \ (x ::= a, s) \\<^bsup> 2 \<^esup> s' \ s' = s'" + by (auto simp add: Assign eval_nat_numeral) + +lemma AssignD: "(x ::= a, s) \\<^bsup> t \<^esup> s' \ t = 2 \ s' = s(x := aval a s)" + by auto + +lemma compose_programs_1: + "(c2, s2) \\<^bsup> y \<^esup> s3 \ (c1, s1) \\<^bsup> x \<^esup> s2 \ + ((c1;; c2, s1) \\<^bsup> x + y \<^esup> s3 \ P) + \ P" + by auto + +lemma compose_programs_2: + "(c1, s1) \\<^bsup> x \<^esup> s2 \ (c2, s2) \\<^bsup> y \<^esup> s3 \ + ((c1;; c2, s1) \\<^bsup> x + y \<^esup> s3 \ P) + \ P" + by auto + +lemma While_tE_time: +"(WHILE b\0 DO c, s) \\<^bsup> x \<^esup> t \ + (x = Suc (Suc 0) \ t = s \ s b = 0 \ P) \ + (\x' s2 y. 0 < s b \ (c, s) \\<^bsup> x' \<^esup> s2 \ (WHILE b\0 DO c, s2) \\<^bsup> y \<^esup> t \ x = Suc (x' + y) \ P) \ P" + by auto + +lemma Seq_tE_While_init: + "(WHILE v \0 DO c2, s2) \\<^bsup> y \<^esup> s3 \ (c1, s1) \\<^bsup> x \<^esup> s2 \ + ((c1;; WHILE v \0 DO c2, s1) \\<^bsup> x + y \<^esup> s3 \ P) + \ 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 _ \0 DO (loop_body;; init_while_cond);; + after_loop, _) \\<^bsup>_\<^esup> _" + for init_while_cond loop_body after_loop \ + \match premises in b[thin]: "\loop_cond; state_upd; _\ \ P" + for loop_cond state_upd P \ \subst b[OF _ _ a]\\)) + + +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 _ \0 DO (loop_body;; init_while_cond);; + after_loop, _) \\<^bsup>_\<^esup> _" + for init_while_cond loop_body after_loop \ + \match premises in b[thin]: "\loop_cond; state_upd; _\ \ P" + for loop_cond state_upd P \ \subst b[OF _ _ a, simplified add.assoc]\\)) end \ No newline at end of file diff --git a/IMP-/Call_By_Prefixes.thy b/IMP-/Call_By_Prefixes.thy new file mode 100644 index 00000000..adfa18a6 --- /dev/null +++ b/IMP-/Call_By_Prefixes.thy @@ -0,0 +1,127 @@ +(*Authors: Mohammad Abdulaziz*) + +theory Call_By_Prefixes + imports IMP_Minus.Com Big_StepT +begin + +abbreviation add_prefix :: "string \ vname \ vname" where +"add_prefix p s \ p @ s" + +(*type_synonym pcom = "string \ 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 \ SKIP" + +abbreviation pcom_Assign where "pcom_Assign v aexp p \ + Assign (add_prefix p v) (aexp_add_prefix p aexp)" + +abbreviation pcom_Seq where "pcom_Seq a b p \ (a p) ;; (b p)" + +abbreviation pcom_If where "pcom_If v a b p \ + If (add_prefix p v) (a p) (b p)" + +abbreviation pcom_While where "pcom_While v a p \ While (add_prefix p v) (a p)" + +abbreviation write_subprogram_param where "write_subprogram_param p' a b \ + (\p. Assign (add_prefix (p' @ p) a) (aexp_add_prefix p b))" + +abbreviation read_subprogram_param where "read_subprogram_param a p' b \ + (\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 \ + (\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 _/\0 THEN _/ ELSE _)" [0, 0, 61] 61) and + pcom_While ("(WHILE _/\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 _/\0 THEN _/ ELSE _)" [0, 0, 61] 61) and + pcom_While ("(WHILE _/\0 DO _)" [0, 61] 61) +end + +unbundle pcom_syntax*) + +lemma atomExp_add_prefix_valid: "(\v. v \ set (atomExp_var x1) \ s1 v = s1' (add_prefix p v)) \ + atomVal x1 s1 = atomVal (atomExp_add_prefix p x1) s1'" + by (cases x1) auto + +lemma aexp_add_prefix_valid: "(\v. v \ set (aexp_vars aexp) \ s1 v = s1' (add_prefix p v)) \ + 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 \ set (atomExp_var (atomExp_add_prefix p x1)) \ \v'. v = p @ v'" + by (cases x1) (auto simp:) + +lemma aexp_add_prefix_valid':"v \ set (aexp_vars (aexp_add_prefix p aexp)) \ \v'. v = p @ v'" + by (cases aexp) (auto simp: atomExp_add_prefix_valid') + +lemma com_add_prefix_valid': "v \ set (all_variables (com_add_prefix p c)) \ \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 \ set (atomExp_var (atomExp_add_prefix (p1 @ p2) x1)) \ \v'. v = p2 @ v'" + by (cases x1) (auto simp:) + +lemma aexp_add_prefix_valid'':"add_prefix p1 v \ set (aexp_vars (aexp_add_prefix (p1 @ p2) aexp)) \ \v'. v = p2 @ v'" + by (cases aexp) (auto simp: atomExp_add_prefix_valid'') + + +lemma com_add_prefix_valid'': "add_prefix p1 v \ set (all_variables (com_add_prefix (p1 @ p2) c)) \ \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 \ set (all_variables (com_add_prefix (p1 @ p2) c)) \ set p2 \ set v" + using com_add_prefix_valid'' + by (metis set_append sup_ge1) + +abbreviation invoke_subprogram + where "invoke_subprogram \ 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) + +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 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 \finite (range s)\ 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 \finite (range s)\ 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 \ We show that there always is a linear bound for the memory consumpt lemma linear_bound: "(c1, s1) \\<^bsup>t\<^esup> s2 \ finite (range s1) \ 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) \\<^bsup>t\<^esup> s2" "finite (range s1)" - fix t' - show "\c' s'. - (c1, s1) \\<^bsup>t'\<^esup> (c', s') \ - state_memory c' s' \ ?b" - proof - fix c' - show "\s'. (c1, s1) \\<^bsup>t'\<^esup> (c', s') \ - state_memory c' s' \ ?b" - proof - fix s' - show "(c1, s1) \\<^bsup>t'\<^esup> (c', s') \ - state_memory c' s' \ ?b" - proof - assume "(c1, s1) \\<^bsup>t'\<^esup> (c', s')" - - hence "finite (range s')" - using \finite (range s1)\ finite_range_stays_finite - by auto - - have "Max (range s') \ (2 ^ t') * (max (Max (range s1)) (max_constant c1))" - using Max_increase \(c1, s1) \\<^bsup>t'\<^esup> (c', s')\ \finite (range s1)\ - by auto - also have "... \ (2 ^ t) * (max (Max (range s1)) (max_constant c1))" - using small_step_cant_run_longer_than_big_step - \(c1, s1) \\<^bsup>t\<^esup> s2\ \(c1, s1) \\<^bsup>t'\<^esup> (c', s')\ - by simp - - finally have "state_memory c' s' \ num_variables c' + + have "(c1, s1) \\<^bsup>t'\<^esup> (c', s') \ state_memory c' s' \ ?b" for t' c' s' + proof - + assume "(c1, s1) \\<^bsup>t'\<^esup> (c', s')" + + hence "finite (range s')" + using \finite (range s1)\ finite_range_stays_finite + by auto + + have "Max (range s') \ (2 ^ t') * (max (Max (range s1)) (max_constant c1))" + using Max_increase \(c1, s1) \\<^bsup>t'\<^esup> (c', s')\ \finite (range s1)\ + by auto + also have "... \ (2 ^ t) * (max (Max (range s1)) (max_constant c1))" + using small_step_cant_run_longer_than_big_step + \(c1, s1) \\<^bsup>t\<^esup> s2\ \(c1, s1) \\<^bsup>t'\<^esup> (c', s')\ + by simp + + finally have "state_memory c' s' \ num_variables c' * bit_length ((2 ^ t) * (max (Max (range s1)) (max_constant c1)))" - using Max_register_bounds_state_memory[OF \finite (range s')\] - by (meson bit_length_monotonic dual_order.trans mult_le_cancel1) - also have "... \ num_variables c' + using Max_register_bounds_state_memory[OF \finite (range s')\] + by (meson bit_length_monotonic dual_order.trans mult_le_cancel1) + also have "... \ 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' \ ?b" - using num_variables_not_increasing[OF \(c1, s1) \\<^bsup>t'\<^esup> (c', s')\] order_trans - by(fastforce simp: bit_length_of_power_of_two) - qed - qed + finally show "state_memory c' s' \ ?b" + using num_variables_not_increasing[OF \(c1, s1) \\<^bsup>t'\<^esup> (c', s')\] order_trans + by(fastforce simp: bit_length_of_power_of_two) qed + + thus ?thesis by(auto simp: is_memory_bound_def) qed end diff --git a/IMP-/Multiplication.thy b/IMP-/Multiplication.thy new file mode 100644 index 00000000..8dbc9553 --- /dev/null +++ b/IMP-/Multiplication.thy @@ -0,0 +1,8 @@ +\<^marker>\creator Florian Kessler, Mohammad Abdulaziz\ + +theory Multiplication + imports Big_Step_Small_Step_Equivalence "HOL-Library.Discrete" + Canonical_State_Transformers "../Lib/Polynomial_Growth_Functions" +begin + +end \ No newline at end of file diff --git a/IMP-/ROOT b/IMP-/ROOT index d8a6c45d..d7166a3c 100644 --- a/IMP-/ROOT +++ b/IMP-/ROOT @@ -1,9 +1,8 @@ chapter Poly_Reductions -session IMP_Minus = HOL + +session IMP_Minus = "HOL-Eisbach" + theories 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 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 new file mode 100644 index 00000000..4007d863 --- /dev/null +++ b/ROOT @@ -0,0 +1,3 @@ +session Poly_Reductions_Base = HOL + sessions NREST "HOL-Real_Asymp" Landau_Symbols + + 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 +