173 lines
5.4 KiB
Plaintext
173 lines
5.4 KiB
Plaintext
(*
|
|
* Copyright 2014, NICTA
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_BSD2.txt" for details.
|
|
*
|
|
* @TAG(NICTA_BSD)
|
|
*)
|
|
|
|
theory StringOrd
|
|
imports "~~/src/HOL/Main"
|
|
begin
|
|
|
|
datatype anotherBL =
|
|
BLNon
|
|
| BLZer anotherBL
|
|
| BLOne anotherBL
|
|
| BLTwo anotherBL
|
|
| BLThr anotherBL
|
|
|
|
lemma twice_bound_meta_all:
|
|
"(\<And>a b. x = a \<and> y = b \<Longrightarrow> PROP Q a b) \<equiv> (PROP Q x y)"
|
|
apply (rule equal_intr_rule)
|
|
apply (erule meta_allE, erule meta_allE, erule meta_mp)
|
|
apply simp
|
|
apply clarsimp
|
|
done
|
|
|
|
function(sequential) anotherBL_ord :: "anotherBL \<Rightarrow> anotherBL \<Rightarrow> bool"
|
|
where
|
|
"anotherBL_ord BLNon x = True"
|
|
| "anotherBL_ord x BLNon = False"
|
|
| "anotherBL_ord (BLZer x) (BLZer y) = anotherBL_ord x y"
|
|
| "anotherBL_ord (BLZer x) y = True"
|
|
| "anotherBL_ord x (BLZer y) = False"
|
|
| "anotherBL_ord (BLOne x) (BLOne y) = anotherBL_ord x y"
|
|
| "anotherBL_ord (BLOne x) y = True"
|
|
| "anotherBL_ord x (BLOne y) = False"
|
|
| "anotherBL_ord (BLTwo x) (BLTwo y) = anotherBL_ord x y"
|
|
| "anotherBL_ord (BLTwo x) y = True"
|
|
| "anotherBL_ord x (BLTwo y) = False"
|
|
| "anotherBL_ord (BLThr x) (BLThr y) = anotherBL_ord x y"
|
|
apply simp_all
|
|
apply (case_tac x, simp_all)
|
|
apply (case_tac a, simp_all)
|
|
apply (case_tac b, simp_all add: twice_bound_meta_all)[1]
|
|
apply (case_tac b, simp_all add: twice_bound_meta_all)[1]
|
|
apply (case_tac b, simp_all add: twice_bound_meta_all)[1]
|
|
apply (case_tac b, simp_all add: twice_bound_meta_all)[1]
|
|
done
|
|
|
|
termination anotherBL_ord
|
|
apply (rule anotherBL_ord.termination)
|
|
apply (rule wf_measure[where f="size_prod size size"])
|
|
apply simp+
|
|
done
|
|
|
|
instantiation
|
|
anotherBL :: ord
|
|
begin
|
|
definition le_anotherBL: "a \<le> b \<equiv> anotherBL_ord a b"
|
|
definition less_anotherBL: "a < b \<equiv> (anotherBL_ord a b \<and> a \<noteq> b)"
|
|
|
|
instance ..
|
|
end
|
|
|
|
lemma anotherBL_to_less_simps:
|
|
"(anotherBL_ord a b = v) \<Longrightarrow> (a < b = (v \<and> a \<noteq> b))"
|
|
by (simp add: less_anotherBL)
|
|
|
|
lemmas anotherBL_ords[simp] =
|
|
anotherBL_ord.simps[folded le_anotherBL, simplified]
|
|
anotherBL_ord.simps [THEN anotherBL_to_less_simps,
|
|
simplified, folded less_anotherBL]
|
|
|
|
lemma anotherBL_trans:
|
|
"\<lbrakk> x \<le> (y :: anotherBL); y \<le> z \<rbrakk> \<Longrightarrow> x \<le> z"
|
|
apply (rule ccontr)
|
|
apply (erule rev_mp)+
|
|
apply (induct y arbitrary: x z)
|
|
apply (case_tac x, simp_all)[1]
|
|
apply (case_tac x, simp_all(no_asm_simp))[1]
|
|
apply (case_tac z, simp_all)[1]
|
|
apply (case_tac x, simp_all(no_asm_simp))[1]
|
|
apply (case_tac z, simp_all)[1]
|
|
apply (case_tac z, simp_all)[1]
|
|
apply (case_tac z, simp_all(no_asm_simp))[1]
|
|
apply (case_tac x, simp_all)[1]
|
|
apply (case_tac x, simp_all)[1]
|
|
apply (case_tac z, simp_all(no_asm_simp))[1]
|
|
apply (case_tac x, simp_all)[1]
|
|
done
|
|
|
|
lemma anotherBL_antisym:
|
|
"\<lbrakk> x \<le> y; (y :: anotherBL) \<le> x \<rbrakk> \<Longrightarrow> x = y"
|
|
apply (erule rev_mp)+
|
|
apply (induct x arbitrary: y)
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
done
|
|
|
|
lemma anotherBL_total_ord:
|
|
"x \<le> y \<or> y \<le> (x :: anotherBL)"
|
|
apply (induct x arbitrary: y)
|
|
apply simp
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
apply (case_tac y, simp_all)[1]
|
|
done
|
|
|
|
lemma less_eq_conj_anotherBL:
|
|
"x < (y :: anotherBL) = (x \<le> y \<and> x \<noteq> y)"
|
|
by (simp add: less_anotherBL le_anotherBL)
|
|
|
|
instantiation anotherBL :: linorder
|
|
begin
|
|
|
|
instance
|
|
apply intro_classes
|
|
apply (simp add: less_eq_conj_anotherBL)
|
|
apply safe[1]
|
|
apply (drule(1) anotherBL_antisym)
|
|
apply simp
|
|
apply (induct_tac x, simp_all)[1]
|
|
apply (erule(1) anotherBL_trans)
|
|
apply (erule(1) anotherBL_antisym)
|
|
apply (rule anotherBL_total_ord)
|
|
done
|
|
|
|
end
|
|
|
|
primrec
|
|
nibble_to_anbl :: "nibble \<Rightarrow> anotherBL \<Rightarrow> anotherBL"
|
|
where
|
|
"nibble_to_anbl Nibble0 anbl = BLZer (BLZer anbl)"
|
|
| "nibble_to_anbl Nibble1 anbl = BLZer (BLOne anbl)"
|
|
| "nibble_to_anbl Nibble2 anbl = BLZer (BLTwo anbl)"
|
|
| "nibble_to_anbl Nibble3 anbl = BLZer (BLThr anbl)"
|
|
| "nibble_to_anbl Nibble4 anbl = BLOne (BLZer anbl)"
|
|
| "nibble_to_anbl Nibble5 anbl = BLOne (BLOne anbl)"
|
|
| "nibble_to_anbl Nibble6 anbl = BLOne (BLTwo anbl)"
|
|
| "nibble_to_anbl Nibble7 anbl = BLOne (BLThr anbl)"
|
|
| "nibble_to_anbl Nibble8 anbl = BLTwo (BLZer anbl)"
|
|
| "nibble_to_anbl Nibble9 anbl = BLTwo (BLOne anbl)"
|
|
| "nibble_to_anbl NibbleA anbl = BLTwo (BLTwo anbl)"
|
|
| "nibble_to_anbl NibbleB anbl = BLTwo (BLThr anbl)"
|
|
| "nibble_to_anbl NibbleC anbl = BLThr (BLZer anbl)"
|
|
| "nibble_to_anbl NibbleD anbl = BLThr (BLOne anbl)"
|
|
| "nibble_to_anbl NibbleE anbl = BLThr (BLTwo anbl)"
|
|
| "nibble_to_anbl NibbleF anbl = BLThr (BLThr anbl)"
|
|
|
|
primrec
|
|
char_to_anbl :: "char \<Rightarrow> anotherBL \<Rightarrow> anotherBL"
|
|
where
|
|
"char_to_anbl (Char nib nob) anbl = nibble_to_anbl nib (nibble_to_anbl nob anbl)"
|
|
|
|
primrec
|
|
string_to_anbl :: "string \<Rightarrow> anotherBL"
|
|
where
|
|
"string_to_anbl [] = BLNon"
|
|
| "string_to_anbl (chr # str) = char_to_anbl chr (string_to_anbl str)"
|
|
|
|
lemmas string_ord_simps
|
|
= string_to_anbl.simps char_to_anbl.simps nibble_to_anbl.simps
|
|
anotherBL_ords anotherBL.simps
|
|
|
|
end
|