
diff -r 72edbac05c59 -r f5b96a532c85 thys2/ClosedForms.thy
--- a/thys2/ClosedForms.thy	Tue Apr 12 15:51:35 2022 +0100
+++ b/thys2/ClosedForms.thy	Wed Apr 13 09:18:29 2022 +0100
@@ -1602,16 +1602,6 @@
 "s \<noteq> [] \<Longrightarrow> rders_simp (RALTS rs) s = 
 rsimp (RALTS (map (\<lambda>r. rders_simp r s) rs))"
   by (metis alts_closed_form comp_apply rders_simp_nonempty_simped)
-  
-
-
-
-lemma star_closed_form:
-  shows "rders_simp (RSTAR r0) (c#s) = 
-rsimp ( RALTS ( (map (\<lambda>s1. RSEQ (rders_simp r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) ))"
-  apply(induct s)
-   apply simp
-  sorry
 
 thm vsuf.simps
 
@@ -1623,17 +1613,6 @@
 
 
 
-lemma vsuf_der_stepwise:
-  shows "rsimp (RALTS (RSEQ (rders_simp r1 (xs @ [x])) r2 # map (rders_simp r2) (vsuf (xs @ [x]) r1))) = 
-rsimp (rder x (rsimp (RALTS (RSEQ (rders_simp r1 xs) r2 # map (rders_simp r2) (vsuf xs r1)))))"
-  apply simp
-  apply(subst rders_simp_append)
-
-  oops
-
-inductive softrewrite :: "rrexp \<Rightarrow> rrexp list \<Rightarrow> bool" ("_ \<leadsto>o _" [100, 100] 100) where
-  "RALTS rs  \<leadsto>o rs"
-| "r1 \<leadsto>o rs1 \<Longrightarrow> (RALT r1 r2) \<leadsto>o (rs1 @ [r2])"
 
 
 fun sflat_aux :: "rrexp  \<Rightarrow> rrexp list " where
@@ -1808,14 +1787,7 @@
 
 
 
-lemma seq_sflat0:
-  shows "sflat (rders (RSEQ r1 r2) s) = sflat (RALTS ( (RSEQ (rders r1 s) r2) #
-                                       (map (rders r2) (vsuf s r1))) )"
-  apply(induct s rule: rev_induct)
-   apply simp
-  apply(subst rders_append)+
 
-  sorry
 
 lemma vsuf_prop1:
   shows "vsuf (xs @ [x]) r = (if (rnullable (rders r xs)) 
@@ -1887,18 +1859,11 @@
 
 
 lemma sflat_rsimpeq:
-  shows "sflat_aux r1 = sflat_aux r2 \<Longrightarrow> rsimp r1 = rsimp r2"
-  apply(cases r1 )
-       apply(cases r2)
-            apply simp+
-        apply(case_tac x5)
-  apply simp
-        apply(case_tac list)
-         apply simp
-
-
-
-  sorry
+  shows "created_by_seq r1 \<Longrightarrow> sflat_aux r1 =  rs \<Longrightarrow> rsimp r1 = rsimp (RALTS rs)"
+  apply(induct r1 arbitrary: rs rule:  created_by_seq.induct)
+   apply simp
+  using rsimp_seq_equal1 apply force
+  by (metis head_one_more_simp rsimp.simps(2) sflat_aux.simps(1) simp_flatten)
 
 
 
@@ -1906,13 +1871,16 @@
   shows "rsimp (rders (RSEQ r1 r2) s) = 
 rsimp ( (RALTS ( (RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1))))))"
   apply(case_tac "s \<noteq> []")
-  apply(subgoal_tac "sflat_aux (rders (RSEQ r1 r2) s) = sflat_aux (RALTS ( (RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1)))))")
+  apply(subgoal_tac "created_by_seq (rders (RSEQ r1 r2) s)")
+  apply(subgoal_tac "sflat_aux (rders (RSEQ r1 r2) s) = RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1))")
   using sflat_rsimpeq apply blast
-  using seq_sfau0 apply blast
+    apply (simp add: seq_sfau0)
+  using recursively_derseq1 apply blast
   apply simp
   by (metis idem_after_simp1 rsimp.simps(1))
   
 
+
 lemma seq_closed_form_aux1:
   shows "rsimp ( (RALTS ( (RSEQ (rders r1 s) r2 # (map (rders r2) (vsuf s r1)))))) =
 rsimp ( (RALTS ( (RSEQ (rders_simp r1 s) r2 # (map (rders r2) (vsuf s r1))))))"
@@ -1986,6 +1954,149 @@
    apply force
   by presburger
 
+
+lemma star_closed_form_seq1:
+  shows "sflat_aux (rders (RSTAR r0) (c # s)) = 
+   RSEQ (rders (rder c r0) s) (RSTAR r0) #
+                                       map (rders (RSTAR r0)) (vsuf s (rder c r0))"
+  apply simp
+  using seq_sfau0 by blast
+
+fun hflat_aux :: "rrexp \<Rightarrow> rrexp list" where
+  "hflat_aux (RALT r1 r2) = hflat_aux r1 @ hflat_aux r2"
+| "hflat_aux r = [r]"
+
+
+fun hflat :: "rrexp \<Rightarrow> rrexp" where
+  "hflat (RALT r1 r2) = RALTS ((hflat_aux r1) @ (hflat_aux r2))"
+| "hflat r = r"
+
+inductive created_by_star :: "rrexp \<Rightarrow> bool" where
+  "created_by_star (RSEQ ra (RSTAR rb))"
+| "\<lbrakk>created_by_star r1; created_by_star r2\<rbrakk> \<Longrightarrow> created_by_star (RALT r1 r2)"
+
+fun hElem :: "rrexp  \<Rightarrow> rrexp list" where
+  "hElem (RALT r1 r2) = (hElem r1 ) @ (hElem r2)"
+| "hElem r = [r]"
+
+
+
+
+lemma cbs_ders_cbs:
+  shows "created_by_star r \<Longrightarrow> created_by_star (rder c r)"
+  apply(induct r rule: created_by_star.induct)
+   apply simp
+  using created_by_star.intros(1) created_by_star.intros(2) apply auto[1]
+  by (metis (mono_tags, lifting) created_by_star.simps list.simps(8) list.simps(9) rder.simps(4))
+
+lemma star_ders_cbs:
+  shows "created_by_star (rders (RSEQ r1 (RSTAR r2)) s)"
+  apply(induct s rule: rev_induct)
+   apply simp
+   apply (simp add: created_by_star.intros(1))
+  apply(subst rders_append)
+  apply simp
+  using cbs_ders_cbs by auto
+
+lemma created_by_star_cases:
+  shows "created_by_star r \<Longrightarrow> \<exists>ra rb. (r = RALT ra rb \<and> created_by_star ra \<and> created_by_star rb) \<or> r = RSEQ ra rb "
+  by (meson created_by_star.cases)
+
+
+
+lemma hfau_pushin: 
+  shows "created_by_star r \<Longrightarrow> hflat_aux (rder c r) = concat (map hElem (map (rder c) (hflat_aux r)))"
+  apply(induct r rule: created_by_star.induct)
+   apply simp
+  apply(subgoal_tac "created_by_star (rder c r1)")
+  prefer 2
+  apply(subgoal_tac "created_by_star (rder c r2)")
+  using cbs_ders_cbs apply blast
+  using cbs_ders_cbs apply auto[1]
+  apply simp
+  done
+
+lemma stupdate_induct1:
+  shows " concat (map (hElem \<circ> (rder x \<circ> (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)))) Ss) =
+          map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_update x r0 Ss)"
+  apply(induct Ss)
+   apply simp+
+  by (simp add: rders_append)
+  
+
+
+lemma stupdates_join_general:
+  shows  "concat (map hElem (map (rder x) (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates xs r0 Ss)))) =
+           map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates (xs @ [x]) r0 Ss)"
+  apply(induct xs arbitrary: Ss)
+   apply (simp)
+  prefer 2
+   apply auto[1]
+  using stupdate_induct1 by blast
+
+
+
+ 
+lemma stupdates_join:
+  shows "concat (map hElem (map (rder x) (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates xs r0 [[c]])))) =
+           map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates (xs @ [x]) r0 [[c]])"
+  using stupdates_join_general by auto
+  
+
+
+lemma star_hfau_induct:
+  shows "hflat_aux (rders (RSEQ (rder c r0) (RSTAR r0)) s) =   
+      map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates s r0 [[c]])"
+  apply(induct s rule: rev_induct)
+   apply simp
+  apply(subst rders_append)+
+  apply simp
+  apply(subst stupdates_append)
+  apply(subgoal_tac "created_by_star (rders (RSEQ (rder c r0) (RSTAR r0)) xs)")
+  prefer 2
+  apply (simp add: star_ders_cbs)
+  apply(subst hfau_pushin)
+   apply simp
+  apply(subgoal_tac "concat (map hElem (map (rder x) (hflat_aux (rders (RSEQ (rder c r0) (RSTAR r0)) xs)))) =
+                     concat (map hElem (map (rder x) ( map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates xs r0 [[c]])))) ")
+   apply(simp only:)
+  prefer 2
+   apply presburger
+  apply(subst stupdates_append[symmetric])
+  using stupdates_join_general by blast
+
+
+
+lemma star_closed_form_seq2:
+  shows "RSEQ (rders (rder c r0) s) (RSTAR r0) # map (rders (RSTAR r0)) (vsuf s (rder c r0)) =
+         map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0)) (star_updates s r0 [[c]])"
+  apply(induct s rule: rev_induct)
+   apply simp
+  apply(subst rders_append)+
+  apply(case_tac "rnullable (rder c r0)")
+   apply simp
+  
+  sorry
+
+
+lemma star_closed_form1:
+  shows "rders (RSTAR r0) (c#s) = 
+ ( RALTS ( (map (\<lambda>s1. RSEQ (rders r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) ))"
+  
+
+  sorry
+
+lemma star_closed_form:
+  shows "rders_simp (RSTAR r0) (c#s) = 
+rsimp ( RALTS ( (map (\<lambda>s1. RSEQ (rders_simp r0 s1) (RSTAR r0) ) (star_updates s r0 [[c]]) ) ))"
+  apply(induct s)
+   apply simp
+   apply (metis idem_after_simp1 rsimp.simps(1) rsimp.simps(6) rsimp_idem)
+  
+
+  sorry
+
+
 lemma simp_helps_der_pierce:
   shows " rsimp
             (rder x




