Single valued relations (as defined by single_valued in the Relation theory) allow to deduce equalities from membership relations. I was wondering if there was a way to take advantage of this to rewrite terms in the goal (and then merge these membership relations).
As an example, here is a goal that cannot be solved by auto or force without auxiliary theorems:
lemma
assumes "single_valued A"
assumes "(a,b) ∈ A" and "(a,b') ∈ A"
shows "b = b'"
using assms
by (metis single_valued_def)
Here the equality is directly in the goal, but it would be great to also rewrite in the assumptions.
Also, I talk here about sets of pairs but I have a more complex application with another kind of relation with a similar property, where such kind of assumptions are common, and I am then looking for a way to simplify them.
It seems to me that automatic methods could greatly benefit from such a feature.
I have already written some simprocs before and it seems to me we could use them here if we could access the set of assumptions once the simproc has been triggered on, which I don't know if this is possible. For example, once "(a,b) ∈ A" has triggered the simproc, could we check if any assumption contains "(a,_) ∈ A" ? But it would perhaps be too costly...
Any idea ?
Here is a simproc that does what you want:
lemma single_valuedD_eq:
"⟦ single_valued A; (x, a) ∈ A ⟧ ⟹ (x, b) ∈ A ⟷ b = a"
by(auto dest: single_valuedD)
simproc_setup single_valued ("(x, y) ∈ A") = {*
(fn phi => fn ctxt => fn redex => case term_of redex of
Const (#{const_name "Set.member"},
Type (#{type_name fun},
[Txy as Type (#{type_name prod}, [Tx, Ty]),
Type (#{type_name fun}, [TA, _])])) $
(Const (#{const_name "Pair"}, _) $ tx $ ty) $
tA =>
let
val thy = Proof_Context.theory_of ctxt;
val prems = Simplifier.prems_of ctxt;
fun mk_stmt t = t |> HOLogic.mk_Trueprop |> Thm.cterm_of thy |> Goal.init
fun mk_thm tac t =
case SINGLE (tac 1) (mk_stmt t) of
SOME thm => SOME (Goal.finish (Syntax.init_pretty_global (Thm.theory_of_thm thm)) thm)
| NONE => NONE;
val svA = Const (#{const_name single_valued}, TA --> #{typ bool}) $ tA
val [z] = Name.invent (Variable.names_of ctxt) "z" 1
val xzA =
Const (#{const_name Set.member}, Txy --> TA --> #{typ bool})
$ (Const (#{const_name Pair}, Tx --> Ty --> Txy)
$ tx $ Var ((z, 0), Ty))
$ tA
in
case mk_thm (resolve_tac prems) svA of NONE => NONE
| SOME thm_svA => case mk_thm (resolve_tac prems) xzA of NONE => NONE
| SOME thm_xzA =>
SOME (#{thm single_valuedD_eq[THEN eq_reflection]} OF [thm_svA, thm_xzA])
end
| _ => NONE)
*}
When it triggers on a term of the pattern (_, _) ∈ _, say (x, y) ∈ A, it checks whether there are assumptions single_valued A and (x, ?z) ∈ A in the current goal. If so, it instantiates the theorem single_valuedD_eq with them and rewrites (x, y) ∈ A to y = ?z with ?z being appropriate instantiated.
Here is an example:
lemma
"⟦ single_valued A; (x, b) ∈ A; (x, c) ∈ A ⟧
⟹ map (λy. (x, y) ∈ A) xs = foo"
apply simp
NEW GOAL:
1. ⟦single_valued A; b = c; (x, c) ∈ A⟧ ⟹ map (λy. y = c) xs = foo
Note that single_valued A has to be an assumption of the goal. It does not suffice to have single_valued A as a [simp] rule somewhere. This is because the assumptions are looked up with resolve_tac prems rather than a full simplifier invocation.
Related
I'm trying to use rule dec_induct to do an induction proof with a base case that is not 0, but I don't understand how the rule is being applied by Isabelle. If I state the following lemma:
lemma test:
shows "P a"
proof (rule dec_induct)
Isabelle transforms it into three subgoals, which I assume are supposed to be the premises of dec_induct unified with my goal. dec_induct is
⟦?i ≤ ?j; ?P ?i; ⋀n. ⟦?i ≤ n; n < ?j; ?P n⟧ ⟹ ?P (Suc n)⟧ ⟹ ?P ?j
, so I would think that the ?j in its conclusion would unify with the "a" of my goal. That is, I would expect the following three subgoals:
?i ≤ a
?P ?i
⋀n. ⟦?i ≤ n; n < a; ?P n⟧ ⟹ ?P (Suc n)
But the subgoals Isabelle actually transforms it to are
?i ≤ ?j
P a
⋀n. ⟦?i ≤ n; n < ?j; P a⟧ ⟹ P a
How is Isabelle getting that, and how can I get it to perform the induction as I expect? I realize I should be using the induct method, but I'm just trying to understand how rule works.
Higher order unification can produce very unintuitive results, especially when you have patterns like ?f ?x, i.e. a schematic variable of function type, applied to another schematic variable. I don't know much about higher order unification, but it seems that if you unify ?f ?x with something like f x, you tend to get the unifier [?f ↦ λy. f x] instead of [?f ↦ f, ?x ↦ x], which is probably what you wanted.
You can experiment with it like this to see precisely what the possible inferred unifiers are:
context
fixes P :: "int ⇒ bool" and j :: int
begin
ML ‹
local
val ctxt = Context.Proof #{context}
val env = Envir.init
val ctxt' = #{context} |> Proof_Context.set_mode Proof_Context.mode_schematic
val s1 = "?P ?j"
val s2 = "P j"
val (t1, t2) = apply2 (Syntax.read_term ctxt') (s1, s2)
val prt = Syntax.pretty_term #{context}
fun pretty_schem s = prt (Var ((s, 0), \<^typ>‹unit›))
fun pretty_unifier (Envir.Envir {tenv, ...}, _) =
tenv
|> Vartab.dest
|> map (fn ((s,_),(_,t)) => Pretty.block
(Pretty.breaks [pretty_schem s, Pretty.str "↦", prt t]))
|> (fn x => Pretty.block (Pretty.str "[" :: Pretty.commas x # [Pretty.str "]"]))
in
val _ =
Pretty.breaks [Pretty.str "Unifiers for", prt t1, Pretty.str "and", prt t2, Pretty.str ":"]
|> Pretty.block
|> Pretty.writeln
val _ =
Unify.unifiers (ctxt, env, [(t1, t2)])
|> Seq.list_of
|> map pretty_unifier
|> map (fn x => Pretty.block [Pretty.str "∙ ", x])
|> map (Pretty.indent 2)
|> Pretty.fbreaks
|> Pretty.block
|> Pretty.writeln
end
›
Output:
Unifiers for ?P ?j and P j :
∙ [?P ↦ λa. P j]
(Disclaimer: This is only experimental code to illustrate what is going on, this is not clean Isabelle/ML coding style.)
To summarise: don't rely on higher-order unification to figure out instantiations of function variables, especially when you have patterns like ?f ?x.
I need to generate a code calculating all values greater or equal to some value:
datatype ty = A | B | C
instantiation ty :: order
begin
fun less_ty where
"A < x = (x = C)"
| "B < x = (x = C)"
| "C < x = False"
definition "(x :: ty) ≤ y ≡ x = y ∨ x < y"
instance
apply intro_classes
apply (metis less_eq_ty_def less_ty.elims(2) ty.distinct(3) ty.distinct(5))
apply (simp add: less_eq_ty_def)
apply (metis less_eq_ty_def less_ty.elims(2))
using less_eq_ty_def less_ty.elims(2) by fastforce
end
instantiation ty :: enum
begin
definition [simp]: "enum_ty ≡ [A, B, C]"
definition [simp]: "enum_all_ty P ≡ P A ∧ P B ∧ P C"
definition [simp]: "enum_ex_ty P ≡ P A ∨ P B ∨ P C"
instance
apply intro_classes
apply auto
by (case_tac x, auto)+
end
lemma less_eq_code_predI [code_pred_intro]:
"Predicate_Compile.contains {z. x ≤ z} y ⟹ x ≤ y"
(* "Predicate_Compile.contains {z. z ≤ y} x ⟹ x ≤ y"*)
by (simp_all add: Predicate_Compile.contains_def)
code_pred [show_modes] less_eq
by (simp add: Predicate_Compile.containsI)
values "{x. A ≤ x}"
(* values "{x. x ≤ C}" *)
It works fine. But the theory looks over-complicated. Also I can't calculate values less or equal to some value. If one will uncoment the 2nd part of less_eq_code_predI lemma, then less_eq will have only one mode i => i => boolpos.
Is there a simpler and more generic approach?
Can less_eq support i => o => boolpos and o => i => boolpos at the same time?
Is it possible not to declare ty as an instance of enum class? I can declare a function returning a set of elements greater or equal to some element:
fun ge_values where
"ge_values A = {A, C}"
| "ge_values B = {B, C}"
| "ge_values C = {C}"
lemma ge_values_eq_less_eq_ty:
"{y. x ≤ y} = ge_values x"
by (cases x; auto simp add: dual_order.order_iff_strict)
This would allow me to remove enum and code_pred stuff. But in this case I will not be able to use this function in the definition of other predicates. How to replace (≤) by ge_values in the following definition?
inductive pred1 where
"x ≤ y ⟹ pred1 x y"
code_pred [show_modes] pred1 .
I need pred1 to have at least i => o => boolpos mode.
The predicate compiler has an option inductify that tries to convert functional definitions into inductive ones. It is somewhat experimental and does not work in every case, so use it with care. In the above example, the type classes make the whole situation a bit more complicated. Here's what I managed to get working:
case_of_simps less_ty_alt: less_ty.simps
definition less_ty' :: "ty ⇒ ty ⇒ bool" where "less_ty' = (<)"
declare less_ty_alt [folded less_ty'_def, code_pred_def]
code_pred [inductify, show_modes] "less_ty'" .
values "{x. less_ty' A x}"
The first line convertes the pattern-matching equations into one with a case expression on the right. It uses the command case_of_simps from HOL-Library.Simps_Case_Conv.
Unfortunately, the predicate compiler seems to have trouble with compiling type class operations. At least I could not get it to work.
So the second line introduces a new constant for (<) on ty.
The attribute code_pred_def tells the predicate compiler to use the given theorem (namely less_ty_alt with less_ty' instead of (<)) as the "defining equation".
code_pred with the inductify option looks at the equation for less_ty' declared by code_pred_def and derives an inductive definition out of that. inductify usually works well with case expressions, constructors and quantifiers. Everything beyond that is at your own risk.
Alternatively, you could also manually implement the enumeration similar to ge_values and register the connection between (<) and ge_values with the predicate compiler. See the setup block at the end of the Predicate_Compile theory in the distribution for an example with Predicate.contains. Note however that the predicate compiler works best with predicates and not with sets. So you'd have to write ge_values in the predicate monad Predicate.pred.
I’d like to define the following function using Program Fixpoint or Function in Coq:
Require Import Coq.Lists.List.
Import ListNotations.
Require Import Coq.Program.Wf.
Require Import Recdef.
Inductive Tree := Node : nat -> list Tree -> Tree.
Fixpoint height (t : Tree) : nat :=
match t with
| Node x ts => S (fold_right Nat.max 0 (map height ts))
end.
Program Fixpoint mapTree (f : nat -> nat) (t : Tree) {measure (height t)} : Tree :=
match t with
Node x ts => Node (f x) (map (fun t => mapTree f t) ts)
end.
Next Obligation.
Unfortunately, at this point I have a proof obligation height t < height (Node x ts) without knowing that t is a member of ts.
Similarly with Function instead of Program Fixpoint, only that Function detects the problem and aborts the definition:
Error:
the term fun t : Tree => mapTree f t can not contain a recursive call to mapTree
I would expect to get a proof obligation of In t ts → height t < height (Node x ts).
Is there a way of getting that that does not involve restructuring the function definition? (I know work-arounds that require inlining the definition of map here, for example – I’d like to avoid these.)
Isabelle
To justify that expectation, let me show what happens when I do the same in Isabelle, using the function command, which is (AFAIK) related to Coq’s Function command:
theory Tree imports Main begin
datatype Tree = Node nat "Tree list"
fun height where
"height (Node _ ts) = Suc (foldr max (map height ts) 0)"
function mapTree where
"mapTree f (Node x ts) = Node (f x) (map (λ t. mapTree f t) ts)"
by pat_completeness auto
termination
proof (relation "measure (λ(f,t). height t)")
show "wf (measure (λ(f, t). height t))" by auto
next
fix f :: "nat ⇒ nat" and x :: nat and ts :: "Tree list" and t
assume "t ∈ set ts"
thus "((f, t), (f, Node x ts)) ∈ measure (λ(f, t). height t)"
by (induction ts) auto
qed
In the termination proof, I get the assumption t ∈ set ts.
Note that Isabelle does not require a manual termination proof here, and the following definition works just fine:
fun mapTree where
"mapTree f (Node x ts) = Node (f x) (map (λ t. mapTree f t) ts)"
This works because the map function has a “congruence lemma” of the form
xs = ys ⟹ (⋀x. x ∈ set ys ⟹ f x = g x) ⟹ map f xs = map g ys
that the function command uses to find out that the termination proof only needs to consider t ∈ set ts..
If such a lemma is not available, e.g. because I define
definition "map' = map"
and use that in mapTree, I get the same unprovable proof obligation as in Coq. I can make it work again by declaring a congruence lemma for map', e.g. using
declare map_cong[folded map'_def,fundef_cong]
In this case, you actually do not need well-founded recursion in its full generality:
Require Import Coq.Lists.List.
Set Implicit Arguments.
Inductive tree := Node : nat -> list tree -> tree.
Fixpoint map_tree (f : nat -> nat) (t : tree) : tree :=
match t with
| Node x ts => Node (f x) (map (fun t => map_tree f t) ts)
end.
Coq is able to figure out by itself that recursive calls to map_tree are performed on strict subterms. However, proving anything about this function is difficult, as the induction principle generated for tree is not useful:
tree_ind :
forall P : tree -> Prop,
(forall (n : nat) (l : list tree), P (Node n l)) ->
forall t : tree, P t
This is essentially the same problem you described earlier. Luckily, we can fix the issue by proving our own induction principle with a proof term.
Require Import Coq.Lists.List.
Import ListNotations.
Unset Elimination Schemes.
Inductive tree := Node : nat -> list tree -> tree.
Set Elimination Schemes.
Fixpoint tree_ind
(P : tree -> Prop)
(IH : forall (n : nat) (ts : list tree),
fold_right (fun t => and (P t)) True ts ->
P (Node n ts))
(t : tree) : P t :=
match t with
| Node n ts =>
let fix loop ts :=
match ts return fold_right (fun t' => and (P t')) True ts with
| [] => I
| t' :: ts' => conj (tree_ind P IH t') (loop ts')
end in
IH n ts (loop ts)
end.
Fixpoint map_tree (f : nat -> nat) (t : tree) : tree :=
match t with
| Node x ts => Node (f x) (map (fun t => map_tree f t) ts)
end.
The Unset Elimination Schemes command prevents Coq from generating its default (and not useful) induction principle for tree. The occurrence of fold_right on the induction hypothesis simply expresses that the predicate P holds of every tree t' appearing in ts.
Here is a statement that you can prove using this induction principle:
Lemma map_tree_comp f g t :
map_tree f (map_tree g t) = map_tree (fun n => f (g n)) t.
Proof.
induction t as [n ts IH]; simpl; f_equal.
induction ts as [|t' ts' IHts]; try easy.
simpl in *.
destruct IH as [IHt' IHts'].
specialize (IHts IHts').
now rewrite IHt', <- IHts.
Qed.
You can now do this with Equations and get the right elimination principle automatically, using either structural nested recursion or well-founded recursion
In general, it might be advisable to avoid this problem. But if one really wants to obtain the proof obligation that Isabelle gives you, here is a way:
In Isabelle, we can give an external lemma that stats that map applies its arguments only to members of the given list. In Coq, we cannot do this in an external lemma, but we can do it in the type. So instead of the normal type of map
forall A B, (A -> B) -> list A -> list B
we want the type to say “f is only ever applied to elements of the list:
forall A B (xs : list A), (forall x : A, In x xs -> B) -> list B
(It requires reordering the argument so that the type of f can mention xs).
Writing this function is not trivial, and I found it easier to use a proof script:
Definition map {A B} (xs : list A) (f : forall (x:A), In x xs -> B) : list B.
Proof.
induction xs.
* exact [].
* refine (f a _ :: IHxs _).
- left. reflexivity.
- intros. eapply f. right. eassumption.
Defined.
But you can also write it “by hand”:
Fixpoint map {A B} (xs : list A) : forall (f : forall (x:A), In x xs -> B), list B :=
match xs with
| [] => fun _ => []
| x :: xs => fun f => f x (or_introl eq_refl) :: map xs (fun y h => f y (or_intror h))
end.
In either case, the result is nice: I can use this function in mapTree, i.e.
Program Fixpoint mapTree (f : nat -> nat) (t : Tree) {measure (height t)} : Tree :=
match t with
Node x ts => Node (f x) (map ts (fun t _ => mapTree f t))
end.
Next Obligation.
and I don’t have to do anything with the new argument to f, but it shows up in the the termination proof obligation, as In t ts → height t < height (Node x ts) as desired. So I can prove that and define mapTree:
simpl.
apply Lt.le_lt_n_Sm.
induction ts; inversion_clear H.
- subst. apply PeanoNat.Nat.le_max_l.
- rewrite IHts by assumption.
apply PeanoNat.Nat.le_max_r.
Qed.
It only works with Program Fixpoint, not with Function, unfortunately.
I want to make a new datatype shaped like an old one, but (unlike using type_synonym) it should be recognized as distinct in other theories.
My motivating example: I'm making a stack datatype out of lists. I don't want my other theories to see my stacks as lists so I can enforce my own simplification rules on it, but the only solution I've found is the following:
datatype 'a stk = S "'a list"
...
primrec index_of' :: "'a list => 'a => nat option"
where "index_of' [] b = None"
| "index_of' (a # as) b = (
if b = a then Some 0
else case index_of' as b of Some n => Some (Suc n) | None => None)"
primrec index_of :: "'a stk => 'a => nat option"
where "index_of (S as) x = index_of' as x"
...
lemma [simp]: "index_of' del v = Some m ==> m <= n ==>
index_of' (insert_at' del n v) v = Some m"
<proof>
lemma [simp]: "index_of del v = Some m ==> m <= n ==>
index_of (insert_at del n v) v = Some m"
by (induction del, simp)
It works, but it means my stack theory is bloated and filled with way too much redundancy: every function has a second version stripping the constructor off, and every theorem has a second version (for which the proof is always by (induction del, simp), which strikes me as a sign I'm doing too much work somewhere).
Is there anything that would help here?
You want to use typedef.
The declaration
typedef 'a stack = "{xs :: 'a list. True}"
morphisms list_of_stack as_stack
by auto
introduces a new type, containing all lists, as well as functions between 'a stack and 'a list and a bunch of theorems. Here is selection of them (you can view all using show_theorems after the typedef command):
theorems:
as_stack_cases: (⋀y. ?x = as_stack y ⟹ y ∈ {xs. True} ⟹ ?P) ⟹ ?P
as_stack_inject: ?x ∈ {xs. True} ⟹ ?y ∈ {xs. True} ⟹ (as_stack ?x = as_stack ?y) = (?x = ?y)
as_stack_inverse: ?y ∈ {xs. True} ⟹ list_of_stack (as_stack ?y) = ?y
list_of_stack: list_of_stack ?x ∈ {xs. True}
list_of_stack_inject: (list_of_stack ?x = list_of_stack ?y) = (?x = ?y)
list_of_stack_inverse: as_stack (list_of_stack ?x) = ?x
type_definition_stack: type_definition list_of_stack as_stack {xs. True}
The ?x ∈ {xs. True} assumptions are quite boring here, but you can specify a subset of all lists there, e.g. if your stacks are never empty, and ensure on the type level that the property holds for all types.
The type_definition_stack theorem is useful in conjunction with the lifting package. After the declaration
setup_lifting type_definition_stack
you can define functions on stacks by giving their definition in terms of lists, and also prove theorems involving stacks by proving their equivalent proposition in terms of lists; much easier than manually juggling with the conversion functions.
Up until several days ago, I always defined a type, and then proved theorems directly about the type. Now I'm trying to use type classes.
Problem
The problem is that I can't instantiate cNAT for my type myD below, and it appears it's because simp has no effect on the abstract function cNAT, which I've made concrete with my primrec function cNAT_myD. I can only guess what's happening because of the automation that happens after instance proof.
Questions
Q1: Below, at the statement instantiation myD :: (type) cNAT, can you tell me how to finish the proof, and why I can prove the following theorem, but not the type class proof, which requires injective?
theorem dNAT_1_to_1: "(dNAT n = dNAT m) ==> n = m"
assumes injective: "(cNAT n = cNAT m) ==> n = m"
Q2: This is not as important, but at the bottom is this statement:
instantiation myD :: (type) cNAT2
It involves another way I was trying to instantiate cNAT. Can you tell me why I get Failed to refine any pending goal at shows? I put some comments in the source to explain some of what I did to set it up. I used this slightly modified formula for the requirement injective:
assumes injective: "!!n m. (cNAT2 n = cNAT2 m) --> n = m"
Specifics
My contrived datatype is this, which may be useful to me someday: (Update: Well, for another example maybe. A good mental exercise is for me to try and figure out how I can actually get something inside a 'a myD list, other than []. With BNF, something like datatype_new 'a myD = myS "'a myD fset" gives me the warning that there's an unused type variable on the right-hand side)
datatype 'a myD = myL "'a myD list"
The type class is this, which requires an injective function from nat to 'a:
class cNAT =
fixes cNAT :: "nat => 'a"
assumes injective: "(cNAT n = cNAT m) ==> n = m"
dNAT: this non-type class version of cNAT works
fun get_myL :: "'a myD => 'a myD list" where
"get_myL (myL L) = L"
primrec dNAT :: "nat => 'a myD" where
"dNAT 0 = myL []"
|"dNAT (Suc n) = myL (myL [] # get_myL(dNAT n))"
fun myD2nat :: "'a myD => nat" where
"myD2nat (myL []) = 0"
|"myD2nat (myL (x # xs)) = Suc(myD2nat (myL xs))"
theorem left_inverse_1 [simp]:
"myD2nat(dNAT n) = n"
apply(induct n, auto)
by(metis get_myL.cases get_myL.simps)
theorem dNAT_1_to_1:
"(dNAT n = dNAT m) ==> n = m"
apply(induct n)
apply(simp) (*
The simp method expanded dNAT.*)
apply(metis left_inverse_1 myD2nat.simps(1))
by (metis left_inverse_1)
cNAT: type class version that I can't instantiate
instantiation myD :: (type) cNAT
begin
primrec cNAT_myD :: "nat => 'a myD" where
"cNAT_myD 0 = myL []"
|"cNAT_myD (Suc n) = myL (myL [] # get_myL(cNAT_myD n))"
instance
proof
fix n m :: nat
show "cNAT n = cNAT m ==> n = m"
apply(induct n)
apply(simp) (*
The simp method won't expand cNAT to cNAT_myD's definition.*)
by(metis injective)+ (*
Metis proved it without unfolding cNAT_myD. It's useless. Goals always remain,
and the type variables in the output panel are all weird.*)
oops
end
cNAT2: Failed to refine any pending goal at show
(*I define a variation of `injective` in which the `assumes` definition, the
goal, and the `show` statement are exactly the same, and that strange `fails
to refine any pending goal shows up.*)
class cNAT2 =
fixes cNAT2 :: "nat => 'a"
assumes injective: "!!n m. (cNAT2 n = cNAT2 m) --> n = m"
instantiation myD :: (type) cNAT2
begin
primrec cNAT2_myD :: "nat => 'a myD" where
"cNAT2_myD 0 = myL []"
|"cNAT2_myD (Suc n) = myL (myL [] # get_myL(cNAT2_myD n))"
instance
proof (*
goal: !!n m. cNAT2 n = cNAT2 m --> n = m.*)
show
"!!n m. cNAT2 n = cNAT2 m --> n = m"
(*Failed to refine any pending goal
Local statement fails to refine any pending goal
Failed attempt to solve goal by exported rule:
cNAT2 (n::nat) = cNAT2 (m::nat) --> n = m *)
Your function cNAT is polymorphic in its result type, but the type variable does not appear among the parameters. This often causes type inference to compute a type which is more general than you want. In your case for cNAT, Isabelle infers for the two occurrences of cNAT in the show statement the type nat => 'b for some 'b of sort cNAT, but their type in the goal is nat => 'a myD. You can see this in jEdit by Ctrl-hovering over the cNAT occurrences to inspect the types. In ProofGeneral, you can enable printing of types with using [[show_consts]].
Therefore, you have to explicitly constrain types in the show statement as follows:
fix n m
assume "(cNAT n :: 'a myD) = cNAT m"
then show "n = m"
Note that it is usually not a good idea to use Isabelle's meta-connectives !! and ==> inside a show statement, you better rephrase them using fix/assume/show.