diff -r 48ce16d61e03 -r 61eff2abb0b6 thys2/ClosedForms.thy --- a/thys2/ClosedForms.thy Sat Apr 16 09:52:57 2022 +0100 +++ b/thys2/ClosedForms.thy Tue Apr 19 09:08:01 2022 +0100 @@ -25,62 +25,62 @@ inductive - hrewrite:: "rrexp \ rrexp \ bool" ("_ \ _" [99, 99] 99) + hrewrite:: "rrexp \ rrexp \ bool" ("_ h\ _" [99, 99] 99) where - "RSEQ RZERO r2 \ RZERO" -| "RSEQ r1 RZERO \ RZERO" -| "RSEQ RONE r \ r" -| "r1 \ r2 \ RSEQ r1 r3 \ RSEQ r2 r3" -| "r3 \ r4 \ RSEQ r1 r3 \ RSEQ r1 r4" -| "r \ r' \ (RALTS (rs1 @ [r] @ rs2)) \ (RALTS (rs1 @ [r'] @ rs2))" + "RSEQ RZERO r2 h\ RZERO" +| "RSEQ r1 RZERO h\ RZERO" +| "RSEQ RONE r h\ r" +| "r1 h\ r2 \ RSEQ r1 r3 h\ RSEQ r2 r3" +| "r3 h\ r4 \ RSEQ r1 r3 h\ RSEQ r1 r4" +| "r h\ r' \ (RALTS (rs1 @ [r] @ rs2)) h\ (RALTS (rs1 @ [r'] @ rs2))" (*context rule for eliminating 0, alts--corresponds to the recursive call flts r::rs = r::(flts rs)*) -| "RALTS (rsa @ [RZERO] @ rsb) \ RALTS (rsa @ rsb)" -| "RALTS (rsa @ [RALTS rs1] @ rsb) \ RALTS (rsa @ rs1 @ rsb)" -| "RALTS [] \ RZERO" -| "RALTS [r] \ r" -| "a1 = a2 \ RALTS (rsa@[a1]@rsb@[a2]@rsc) \ RALTS (rsa @ [a1] @ rsb @ rsc)" +| "RALTS (rsa @ [RZERO] @ rsb) h\ RALTS (rsa @ rsb)" +| "RALTS (rsa @ [RALTS rs1] @ rsb) h\ RALTS (rsa @ rs1 @ rsb)" +| "RALTS [] h\ RZERO" +| "RALTS [r] h\ r" +| "a1 = a2 \ RALTS (rsa@[a1]@rsb@[a2]@rsc) h\ RALTS (rsa @ [a1] @ rsb @ rsc)" inductive - hrewrites:: "rrexp \ rrexp \ bool" ("_ \* _" [100, 100] 100) + hrewrites:: "rrexp \ rrexp \ bool" ("_ h\* _" [100, 100] 100) where - rs1[intro, simp]:"r \* r" -| rs2[intro]: "\r1 \* r2; r2 \ r3\ \ r1 \* r3" - - -lemma hr_in_rstar : "r1 \ r2 \ r1 \* r2" + rs1[intro, simp]:"r h\* r" +| rs2[intro]: "\r1 h\* r2; r2 h\ r3\ \ r1 h\* r3" + + +lemma hr_in_rstar : "r1 h\ r2 \ r1 h\* r2" using hrewrites.intros(1) hrewrites.intros(2) by blast lemma hreal_trans[trans]: - assumes a1: "r1 \* r2" and a2: "r2 \* r3" - shows "r1 \* r3" + assumes a1: "r1 h\* r2" and a2: "r2 h\* r3" + shows "r1 h\* r3" using a2 a1 apply(induct r2 r3 arbitrary: r1 rule: hrewrites.induct) apply(auto) done -lemma hmany_steps_later: "\r1 \ r2; r2 \* r3 \ \ r1 \* r3" +lemma hmany_steps_later: "\r1 h\ r2; r2 h\* r3 \ \ r1 h\* r3" by (meson hr_in_rstar hreal_trans) lemma hrewrites_seq_context: - shows "r1 \* r2 \ RSEQ r1 r3 \* RSEQ r2 r3" + shows "r1 h\* r2 \ RSEQ r1 r3 h\* RSEQ r2 r3" apply(induct r1 r2 rule: hrewrites.induct) apply simp using hrewrite.intros(4) by blast lemma hrewrites_seq_context2: - shows "r1 \* r2 \ RSEQ r0 r1 \* RSEQ r0 r2" + shows "r1 h\* r2 \ RSEQ r0 r1 h\* RSEQ r0 r2" apply(induct r1 r2 rule: hrewrites.induct) apply simp using hrewrite.intros(5) by blast lemma hrewrites_seq_context0: - shows "r1 \* RZERO \ RSEQ r1 r3 \* RZERO" - apply(subgoal_tac "RSEQ r1 r3 \* RSEQ RZERO r3") + shows "r1 h\* RZERO \ RSEQ r1 r3 h\* RZERO" + apply(subgoal_tac "RSEQ r1 r3 h\* RSEQ RZERO r3") using hrewrite.intros(1) apply blast by (simp add: hrewrites_seq_context) lemma hrewrites_seq_contexts: - shows "\r1 \* r2; r3 \* r4\ \ RSEQ r1 r3 \* RSEQ r2 r4" + shows "\r1 h\* r2; r3 h\* r4\ \ RSEQ r1 r3 h\* RSEQ r2 r4" by (meson hreal_trans hrewrites_seq_context hrewrites_seq_context2) @@ -1215,7 +1215,7 @@ -(*a more refined notion of \* is needed, +(*a more refined notion of h\* is needed, this lemma fails when rs1 contains some RALTS rs where elements of rs appear in later parts of rs1, which will be picked up by rs2 and deduplicated*) @@ -1546,11 +1546,11 @@ lemma grewrite_ralts: - shows "rs \g rs' \ RALTS rs \* RALTS rs'" + shows "rs \g rs' \ RALTS rs h\* RALTS rs'" by (smt (verit) grewrite_cases_middle hr_in_rstar hrewrite.intros(11) hrewrite.intros(7) hrewrite.intros(8)) lemma grewrites_ralts: - shows "rs \g* rs' \ RALTS rs \* RALTS rs'" + shows "rs \g* rs' \ RALTS rs h\* RALTS rs'" apply(induct rule: grewrites.induct) apply simp using grewrite_ralts hreal_trans by blast @@ -1558,8 +1558,8 @@ lemma distinct_grewrites_subgoal1: shows " - \rs1 \g* [a]; RALTS rs1 \* a; [a] \g rs3\ \ RALTS rs1 \* rsimp_ALTs rs3" - apply(subgoal_tac "RALTS rs1 \* RALTS rs3") + \rs1 \g* [a]; RALTS rs1 h\* a; [a] \g rs3\ \ RALTS rs1 h\* rsimp_ALTs rs3" + apply(subgoal_tac "RALTS rs1 h\* RALTS rs3") apply (metis hrewrite.intros(10) hrewrite.intros(9) rs2 rsimp_ALTs.cases rsimp_ALTs.simps(1) rsimp_ALTs.simps(2) rsimp_ALTs.simps(3)) apply(subgoal_tac "rs1 \g* rs3") using grewrites_ralts apply blast @@ -1571,7 +1571,7 @@ lemma grewrites_ralts_rsimpalts: - shows "rs \g* rs' \ RALTS rs \* rsimp_ALTs rs' " + shows "rs \g* rs' \ RALTS rs h\* rsimp_ALTs rs' " apply(induct rs rs' rule: grewrites.induct) apply(case_tac rs) using hrewrite.intros(9) apply force @@ -1592,7 +1592,7 @@ by (metis (no_types, opaque_lifting) grewrite_ralts hr_in_rstar hreal_trans hrewrite.intros(10) neq_Nil_conv rsimp_ALTs.simps(2) rsimp_ALTs.simps(3)) lemma hrewrites_alts: - shows " r \* r' \ (RALTS (rs1 @ [r] @ rs2)) \* (RALTS (rs1 @ [r'] @ rs2))" + shows " r h\* r' \ (RALTS (rs1 @ [r] @ rs2)) h\* (RALTS (rs1 @ [r'] @ rs2))" apply(induct r r' rule: hrewrites.induct) apply simp using hrewrite.intros(6) by blast @@ -1601,17 +1601,17 @@ srewritescf:: "rrexp list \ rrexp list \ bool" (" _ scf\* _" [100, 100] 100) where ss1: "[] scf\* []" -| ss2: "\r \* r'; rs scf\* rs'\ \ (r#rs) scf\* (r'#rs')" +| ss2: "\r h\* r'; rs scf\* rs'\ \ (r#rs) scf\* (r'#rs')" lemma hrewrites_alts_cons: - shows " RALTS rs \* RALTS rs' \ RALTS (r # rs) \* RALTS (r # rs')" + shows " RALTS rs h\* RALTS rs' \ RALTS (r # rs) h\* RALTS (r # rs')" oops -lemma srewritescf_alt: "rs1 scf\* rs2 \ (RALTS (rs@rs1)) \* (RALTS (rs@rs2))" +lemma srewritescf_alt: "rs1 scf\* rs2 \ (RALTS (rs@rs1)) h\* (RALTS (rs@rs2))" apply(induct rs1 rs2 arbitrary: rs rule: srewritescf.induct) apply(rule rs1) @@ -1626,7 +1626,7 @@ corollary srewritescf_alt1: assumes "rs1 scf\* rs2" - shows "RALTS rs1 \* RALTS rs2" + shows "RALTS rs1 h\* RALTS rs2" using assms by (metis append_Nil srewritescf_alt) @@ -1634,7 +1634,7 @@ lemma trivialrsimp_srewrites: - "\\x. x \ set rs \ x \* f x \ \ rs scf\* (map f rs)" + "\\x. x \ set rs \ x h\* f x \ \ rs scf\* (map f rs)" apply(induction rs) apply simp @@ -1643,15 +1643,15 @@ lemma hrewrites_list: shows -" (\xa. xa \ set x \ xa \* rsimp xa) \ RALTS x \* RALTS (map rsimp x)" +" (\xa. xa \ set x \ xa h\* rsimp xa) \ RALTS x h\* RALTS (map rsimp x)" apply(induct x) apply(simp)+ by (simp add: srewritescf_alt1 ss2 trivialrsimp_srewrites) -(* apply(subgoal_tac "RALTS x \* RALTS (map rsimp x)")*) +(* apply(subgoal_tac "RALTS x h\* RALTS (map rsimp x)")*) lemma hrewrite_simpeq: - shows "r1 \ r2 \ rsimp r1 = rsimp r2" + shows "r1 h\ r2 \ rsimp r1 = rsimp r2" apply(induct rule: hrewrite.induct) apply simp+ apply (simp add: basic_rsimp_SEQ_property3) @@ -1668,7 +1668,7 @@ using grewrite.intros(4) grewrite_equal_rsimp by presburger lemma hrewrites_simpeq: - shows "r1 \* r2 \ rsimp r1 = rsimp r2" + shows "r1 h\* r2 \ rsimp r1 = rsimp r2" apply(induct rule: hrewrites.induct) apply simp apply(subgoal_tac "rsimp r2 = rsimp r3") @@ -1678,13 +1678,13 @@ lemma simp_hrewrites: - shows "r1 \* rsimp r1" + shows "r1 h\* rsimp r1" apply(induct r1) apply simp+ apply(case_tac "rsimp r11 = RONE") apply simp apply(subst basic_rsimp_SEQ_property1) - apply(subgoal_tac "RSEQ r11 r12 \* RSEQ RONE r12") + apply(subgoal_tac "RSEQ r11 r12 h\* RSEQ RONE r12") using hreal_trans hrewrite.intros(3) apply blast using hrewrites_seq_context apply presburger apply(case_tac "rsimp r11 = RZERO") @@ -1698,8 +1698,8 @@ apply simp+ using hrewrites_seq_contexts apply presburger apply simp - apply(subgoal_tac "RALTS x \* RALTS (map rsimp x)") - apply(subgoal_tac "RALTS (map rsimp x) \* rsimp_ALTs (rdistinct (rflts (map rsimp x)) {}) ") + apply(subgoal_tac "RALTS x h\* RALTS (map rsimp x)") + apply(subgoal_tac "RALTS (map rsimp x) h\* rsimp_ALTs (rdistinct (rflts (map rsimp x)) {}) ") using hreal_trans apply blast apply (meson flts_gstar greal_trans grewrites_ralts_rsimpalts gstar_rdistinct) @@ -1707,9 +1707,9 @@ by simp lemma interleave_aux1: - shows " RALT (RSEQ RZERO r1) r \* r" - apply(subgoal_tac "RSEQ RZERO r1 \* RZERO") - apply(subgoal_tac "RALT (RSEQ RZERO r1) r \* RALT RZERO r") + shows " RALT (RSEQ RZERO r1) r h\* r" + apply(subgoal_tac "RSEQ RZERO r1 h\* RZERO") + apply(subgoal_tac "RALT (RSEQ RZERO r1) r h\* RALT RZERO r") apply (meson grewrite.intros(1) grewrite_ralts hreal_trans hrewrite.intros(10) hrewrites.simps) using rs1 srewritescf_alt1 ss1 ss2 apply presburger by (simp add: hr_in_rstar hrewrite.intros(1)) @@ -1717,7 +1717,7 @@ lemma rnullable_hrewrite: - shows "r1 \ r2 \ rnullable r1 = rnullable r2" + shows "r1 h\ r2 \ rnullable r1 = rnullable r2" apply(induct rule: hrewrite.induct) apply simp+ apply blast @@ -1726,7 +1726,7 @@ lemma interleave1: - shows "r \ r' \ rder c r \* rder c r'" + shows "r h\ r' \ rder c r h\* rder c r'" apply(induct r r' rule: hrewrite.induct) apply (simp add: hr_in_rstar hrewrite.intros(1)) apply (metis (no_types, lifting) basic_rsimp_SEQ_property3 list.simps(8) list.simps(9) rder.simps(1) rder.simps(5) rdistinct.simps(1) rflts.simps(1) rflts.simps(2) rsimp.simps(1) rsimp.simps(2) rsimp.simps(3) rsimp_ALTs.simps(1) simp_hrewrites) @@ -1758,7 +1758,7 @@ using hrewrite.intros(11) by auto lemma interleave_star1: - shows "r \* r' \ rder c r \* rder c r'" + shows "r h\* r' \ rder c r h\* rder c r'" apply(induct rule : hrewrites.induct) apply simp by (meson hreal_trans interleave1) @@ -1775,7 +1775,7 @@ using inside_simp_seq_nullable apply blast apply simp apply (smt (verit, del_insts) basic_rsimp_SEQ_property2 basic_rsimp_SEQ_property3 der_simp_nullability rder.simps(1) rder.simps(5) rnullable.simps(2) rsimp.simps(1) rsimp_SEQ.simps(1) rsimp_idem) - apply(subgoal_tac "rder x (RALTS xa) \* rder x (rsimp (RALTS xa))") + apply(subgoal_tac "rder x (RALTS xa) h\* rder x (rsimp (RALTS xa))") using hrewrites_simpeq apply presburger using interleave_star1 simp_hrewrites apply presburger by simp