src/HOL/Datatype_Examples/Misc_N2M.thy
author haftmann
Fri Oct 10 19:55:32 2014 +0200 (2014-10-10)
changeset 58646 cd63a4b12a33
parent 58396 7b60e4e74430
child 58889 5b7a9633cfa8
permissions -rw-r--r--
specialized specification: avoid trivial instances
traytel@58385
     1
(*  Title:      HOL/Datatype_Examples/Misc_N2M.thy
traytel@58385
     2
    Author:     Dmitriy Traytel, TU Muenchen
traytel@58385
     3
    Copyright   2014
traytel@58385
     4
blanchet@58396
     5
Miscellaneous tests for the nested-to-mutual reduction.
traytel@58385
     6
*)
traytel@58385
     7
traytel@58385
     8
header \<open>Miscellaneous Tests for the Nested-to-Mutual Reduction\<close>
traytel@58385
     9
traytel@58385
    10
theory Misc_N2M
traytel@58385
    11
imports "~~/src/HOL/Library/BNF_Axiomatization"
traytel@58385
    12
begin
traytel@58385
    13
traytel@58385
    14
locale misc
traytel@58385
    15
begin
traytel@58385
    16
traytel@58385
    17
datatype 'a li = Ni | Co 'a "'a li"
traytel@58385
    18
datatype 'a tr = Tr "'a \<Rightarrow> 'a tr li"
traytel@58385
    19
traytel@58385
    20
primrec (nonexhaustive)
traytel@58385
    21
  f_tl :: "'a \<Rightarrow> 'a tr li \<Rightarrow> nat" and
traytel@58385
    22
  f_t :: "'a \<Rightarrow> 'a tr \<Rightarrow> nat"
traytel@58385
    23
where
traytel@58385
    24
  "f_tl _ Ni = 0" |
traytel@58385
    25
  "f_t a (Tr ts) = 1 + f_tl a (ts a)"
traytel@58385
    26
traytel@58385
    27
datatype ('a, 'b) l = N | C 'a 'b "('a, 'b) l"
traytel@58385
    28
datatype ('a, 'b) t = T "(('a, 'b) t, 'a) l" "(('a, 'b) t, 'b) l"
traytel@58385
    29
traytel@58385
    30
primrec (nonexhaustive)
traytel@58385
    31
  f_tl2 :: "(('a, 'a) t, 'a) l \<Rightarrow> nat" and
traytel@58385
    32
  f_t2 :: "('a, 'a) t \<Rightarrow> nat"
traytel@58385
    33
where
traytel@58385
    34
  "f_tl2 N = 0" |
traytel@58385
    35
  "f_t2 (T ts us) = f_tl2 ts + f_tl2 us"
traytel@58385
    36
traytel@58385
    37
primrec  (nonexhaustive)
traytel@58385
    38
  g_tla :: "(('a, 'b) t, 'a) l \<Rightarrow> nat" and
traytel@58385
    39
  g_tlb :: "(('a, 'b) t, 'b) l \<Rightarrow> nat" and
traytel@58385
    40
  g_t :: "('a, 'b) t \<Rightarrow> nat"
traytel@58385
    41
where
traytel@58385
    42
  "g_tla N = 0" |
traytel@58385
    43
  "g_tlb N = 1" |
traytel@58385
    44
  "g_t (T ts us) = g_tla ts + g_tlb us"
traytel@58385
    45
traytel@58385
    46
traytel@58385
    47
datatype
traytel@58385
    48
  'a l1 = N1 | C1 'a "'a l1"
traytel@58385
    49
traytel@58385
    50
datatype
traytel@58385
    51
  ('a, 'b) t1 = T1 'a 'b "('a, 'b) t1 l1" "(nat \<times> ('a, 'b) t1) l1" and
traytel@58385
    52
  ('a, 'b) t2 = T2 "('a, 'b) t1"
traytel@58385
    53
traytel@58385
    54
primrec
traytel@58385
    55
  h1_tl1 :: "(nat, 'a) t1 l1 \<Rightarrow> nat" and
traytel@58385
    56
  h1_natl1 :: "(nat \<times> (nat, 'a) t1) l1 \<Rightarrow> nat" and
traytel@58385
    57
  h1_t1 :: "(nat, 'a) t1 \<Rightarrow> nat"
traytel@58385
    58
where
traytel@58385
    59
  "h1_tl1 N1 = 0" |
traytel@58385
    60
  "h1_tl1 (C1 t ts) = h1_t1 t + h1_tl1 ts" |
traytel@58385
    61
  "h1_natl1 N1 = Suc 0" |
traytel@58385
    62
  "h1_natl1 (C1 n ts) = fst n + h1_natl1 ts" |
traytel@58385
    63
  "h1_t1 (T1 n _ ts _) = n + h1_tl1 ts"
traytel@58385
    64
traytel@58385
    65
end
traytel@58385
    66
traytel@58385
    67
traytel@58385
    68
bnf_axiomatization ('a, 'b) M0 [wits: "('a, 'b) M0"]
traytel@58385
    69
bnf_axiomatization ('a, 'b) N0 [wits: "('a, 'b) N0"]
traytel@58385
    70
bnf_axiomatization ('a, 'b) K0 [wits: "('a, 'b) K0"]
traytel@58385
    71
bnf_axiomatization ('a, 'b) L0 [wits: "('a, 'b) L0"]
traytel@58385
    72
bnf_axiomatization ('a, 'b, 'c) G0 [wits: "('a, 'b, 'c) G0"]
traytel@58385
    73
traytel@58385
    74
locale (*co*)mplicated
traytel@58385
    75
begin
traytel@58385
    76
traytel@58385
    77
datatype 'a M = CM "('a, 'a M) M0"
traytel@58385
    78
datatype 'a N = CN "('a N, 'a) N0"
traytel@58385
    79
datatype ('a, 'b) K = CK "('a, ('a, 'b) L) K0"
traytel@58385
    80
         and ('a, 'b) L = CL "('b, ('a, 'b) K) L0"
traytel@58385
    81
datatype 'a G = CG "('a, ('a G, 'a G N) K, ('a G M, 'a G) L) G0"
traytel@58385
    82
traytel@58385
    83
primrec
traytel@58385
    84
    fG :: "'a G \<Rightarrow> 'a G"
traytel@58385
    85
and fK :: "('a G, 'a G N) K \<Rightarrow> ('a G, 'a G N) K"
traytel@58385
    86
and fL :: "('a G, 'a G N) L \<Rightarrow> ('a G, 'a G N) L"
traytel@58385
    87
and fM :: "'a G M \<Rightarrow> 'a G M" where
traytel@58385
    88
  "fG (CG x) = CG (map_G0 id fK (map_L fM fG) x)"
traytel@58385
    89
| "fK (CK y) = CK (map_K0 fG fL y)"
traytel@58385
    90
| "fL (CL z) = CL (map_L0 (map_N fG) fK z)"
traytel@58385
    91
| "fM (CM w) = CM (map_M0 fG fM w)"
traytel@58385
    92
thm fG_def fK_def fL_def fM_def fG.simps fK.simps fL.simps fM.simps
traytel@58385
    93
traytel@58385
    94
end
traytel@58385
    95
traytel@58385
    96
locale complicated
traytel@58385
    97
begin
traytel@58385
    98
traytel@58385
    99
codatatype 'a M = CM "('a, 'a M) M0"
traytel@58385
   100
codatatype 'a N = CN "('a N, 'a) N0"
traytel@58385
   101
codatatype ('a, 'b) K = CK "('a, ('a, 'b) L) K0"
traytel@58385
   102
         and ('a, 'b) L = CL "('b, ('a, 'b) K) L0"
traytel@58385
   103
codatatype 'a G = CG "('a, ('a G, 'a G N) K, ('a G M, 'a G) L) G0"
traytel@58385
   104
traytel@58385
   105
primcorec
traytel@58385
   106
    fG :: "'a G \<Rightarrow> 'a G"
traytel@58385
   107
and fK :: "('a G, 'a G N) K \<Rightarrow> ('a G, 'a G N) K"
traytel@58385
   108
and fL :: "('a G, 'a G N) L \<Rightarrow> ('a G, 'a G N) L"
traytel@58385
   109
and fM :: "'a G M \<Rightarrow> 'a G M" where
traytel@58385
   110
  "fG x = CG (map_G0 id fK (map_L fM fG) (un_CG x))"
traytel@58385
   111
| "fK y = CK (map_K0 fG fL (un_CK y))"
traytel@58385
   112
| "fL z = CL (map_L0 (map_N fG) fK (un_CL z))"
traytel@58385
   113
| "fM w = CM (map_M0 fG fM (un_CM w))"
traytel@58385
   114
thm fG_def fK_def fL_def fM_def fG.simps fK.simps fL.simps fM.simps
traytel@58385
   115
traytel@58385
   116
end
traytel@58385
   117
traytel@58385
   118
datatype ('a, 'b) F1 = F1 'a 'b
traytel@58385
   119
datatype F2 = F2 "((unit, nat) F1, F2) F1" | F2'
traytel@58385
   120
datatype 'a kk1 = K1 'a | K2 "'a kk2" and 'a kk2 = K3 "'a kk1"
traytel@58385
   121
datatype 'a ll1 = L1 'a | L2 "'a ll2 kk2" and 'a ll2 = L3 "'a ll1"
traytel@58385
   122
traytel@58385
   123
datatype_compat F1
traytel@58385
   124
datatype_compat F2
traytel@58385
   125
datatype_compat kk1 kk2
traytel@58385
   126
datatype_compat ll1 ll2
traytel@58385
   127
traytel@58385
   128
blanchet@58396
   129
subsection \<open>Deep Nesting\<close>
traytel@58385
   130
traytel@58385
   131
datatype 'a tree = Empty | Node 'a "'a tree list"
traytel@58385
   132
datatype_compat tree
traytel@58385
   133
traytel@58385
   134
datatype 'a ttree = TEmpty | TNode 'a "'a ttree list tree"
traytel@58385
   135
datatype_compat ttree
traytel@58385
   136
traytel@58385
   137
datatype 'a tttree = TEmpty | TNode 'a "'a tttree list ttree list tree"
traytel@58385
   138
datatype_compat tttree
traytel@58385
   139
(*
traytel@58385
   140
datatype 'a ttttree = TEmpty | TNode 'a "'a ttttree list tttree list ttree list tree"
traytel@58385
   141
datatype_compat ttttree
traytel@58385
   142
*)
traytel@58385
   143
traytel@58385
   144
datatype ('a,'b)complex = 
traytel@58385
   145
  C1 nat "'a ttree" 
traytel@58385
   146
| C2 "('a,'b)complex list tree tree" 'b "('a,'b)complex" "('a,'b)complex2 ttree list"
traytel@58385
   147
and ('a,'b)complex2 = D1 "('a,'b)complex ttree"
traytel@58385
   148
datatype_compat complex complex2
traytel@58385
   149
traytel@58385
   150
datatype 'a F = F1 'a | F2 "'a F"
traytel@58385
   151
datatype 'a G = G1 'a | G2 "'a G F"
traytel@58385
   152
datatype H = H1 | H2 "H G"
traytel@58385
   153
traytel@58385
   154
datatype_compat F
traytel@58385
   155
datatype_compat G
traytel@58385
   156
datatype_compat H
traytel@58385
   157
blanchet@58396
   158
blanchet@58396
   159
subsection \<open>Primrec cache\<close>
traytel@58385
   160
traytel@58385
   161
datatype 'a l = N | C 'a "'a l"
traytel@58385
   162
datatype ('a, 'b) t = T 'a 'b "('a, 'b) t l"
traytel@58385
   163
traytel@58385
   164
context linorder
traytel@58385
   165
begin
traytel@58385
   166
traytel@58385
   167
(* slow *)
traytel@58385
   168
primrec
traytel@58385
   169
  f1_tl :: "(nat, 'a) t l \<Rightarrow> nat" and
traytel@58385
   170
  f1_t :: "(nat, 'a) t \<Rightarrow> nat"
traytel@58385
   171
where
traytel@58385
   172
  "f1_tl N = 0" |
traytel@58385
   173
  "f1_tl (C t ts) = f1_t t + f1_tl ts" |
traytel@58385
   174
  "f1_t (T n _ ts) = n + f1_tl ts"
traytel@58385
   175
traytel@58385
   176
(* should be fast *)
traytel@58385
   177
primrec
traytel@58385
   178
  f2_t :: "(nat, 'b) t \<Rightarrow> nat" and
traytel@58385
   179
  f2_tl :: "(nat, 'b) t l \<Rightarrow> nat"
traytel@58385
   180
where
traytel@58385
   181
  "f2_tl N = 0" |
traytel@58385
   182
  "f2_tl (C t ts) = f2_t t + f2_tl ts" |
traytel@58385
   183
  "f2_t (T n _ ts) = n + f2_tl ts"
traytel@58385
   184
traytel@58385
   185
end
traytel@58385
   186
traytel@58385
   187
(* should be fast *)
traytel@58385
   188
primrec
traytel@58385
   189
  g1_t :: "('a, int) t \<Rightarrow> nat" and
traytel@58385
   190
  g1_tl :: "('a, int) t l \<Rightarrow> nat"
traytel@58385
   191
where
traytel@58385
   192
  "g1_t (T _ _ ts) = g1_tl ts" |
traytel@58385
   193
  "g1_tl N = 0" |
traytel@58385
   194
  "g1_tl (C _ ts) = g1_tl ts"
traytel@58385
   195
traytel@58385
   196
(* should be fast *)
traytel@58385
   197
primrec
traytel@58385
   198
  g2_t :: "(int, int) t \<Rightarrow> nat" and
traytel@58385
   199
  g2_tl :: "(int, int) t l \<Rightarrow> nat"
traytel@58385
   200
where
traytel@58385
   201
  "g2_t (T _ _ ts) = g2_tl ts" |
traytel@58385
   202
  "g2_tl N = 0" |
traytel@58385
   203
  "g2_tl (C _ ts) = g2_tl ts"
traytel@58385
   204
traytel@58385
   205
traytel@58385
   206
datatype
traytel@58385
   207
  'a l1 = N1 | C1 'a "'a l2" and
traytel@58385
   208
  'a l2 = N2 | C2 'a "'a l1"
traytel@58385
   209
traytel@58385
   210
primrec
traytel@58385
   211
  sum_l1 :: "'a::{zero,plus} l1 \<Rightarrow> 'a" and
traytel@58385
   212
  sum_l2 :: "'a::{zero,plus} l2 \<Rightarrow> 'a"
traytel@58385
   213
where
traytel@58385
   214
  "sum_l1 N1 = 0" |
traytel@58385
   215
  "sum_l1 (C1 n ns) = n + sum_l2 ns" |
traytel@58385
   216
  "sum_l2 N2 = 0" |
traytel@58385
   217
  "sum_l2 (C2 n ns) = n + sum_l1 ns"
traytel@58385
   218
traytel@58385
   219
datatype
traytel@58385
   220
  ('a, 'b) t1 = T1 'a 'b "('a, 'b) t1 l1" and
traytel@58385
   221
  ('a, 'b) t2 = T2 "('a, 'b) t1"
traytel@58385
   222
traytel@58385
   223
(* slow *)
traytel@58385
   224
primrec
traytel@58385
   225
  h1_tl1 :: "(nat, 'a) t1 l1 \<Rightarrow> nat" and
traytel@58385
   226
  h1_tl2 :: "(nat, 'a) t1 l2 \<Rightarrow> nat" and
traytel@58385
   227
  h1_t1 :: "(nat, 'a) t1 \<Rightarrow> nat"
traytel@58385
   228
where
traytel@58385
   229
  "h1_tl1 N1 = 0" |
traytel@58385
   230
  "h1_tl1 (C1 t ts) = h1_t1 t + h1_tl2 ts" |
traytel@58385
   231
  "h1_tl2 N2 = 0" |
traytel@58385
   232
  "h1_tl2 (C2 t ts) = h1_t1 t + h1_tl1 ts" |
traytel@58385
   233
  "h1_t1 (T1 n _ ts) = n + h1_tl1 ts"
traytel@58385
   234
traytel@58385
   235
(* should be fast *)
traytel@58385
   236
primrec
traytel@58385
   237
  h2_tl1 :: "(nat, 'a) t1 l1 \<Rightarrow> nat" and
traytel@58385
   238
  h2_tl2 :: "(nat, 'a) t1 l2 \<Rightarrow> nat" and
traytel@58385
   239
  h2_t1 :: "(nat, 'a) t1 \<Rightarrow> nat"
traytel@58385
   240
where
traytel@58385
   241
  "h2_tl1 N1 = 0" |
traytel@58385
   242
  "h2_tl1 (C1 t ts) = h2_t1 t + h2_tl2 ts" |
traytel@58385
   243
  "h2_tl2 N2 = 0" |
traytel@58385
   244
  "h2_tl2 (C2 t ts) = h2_t1 t + h2_tl1 ts" |
traytel@58385
   245
  "h2_t1 (T1 n _ ts) = n + h2_tl1 ts"
traytel@58385
   246
traytel@58385
   247
(* should be fast *)
traytel@58385
   248
primrec
traytel@58385
   249
  h3_tl2 :: "(nat, 'a) t1 l2 \<Rightarrow> nat" and
traytel@58385
   250
  h3_tl1 :: "(nat, 'a) t1 l1 \<Rightarrow> nat" and
traytel@58385
   251
  h3_t1 :: "(nat, 'a) t1 \<Rightarrow> nat"
traytel@58385
   252
where
traytel@58385
   253
  "h3_tl1 N1 = 0" |
traytel@58385
   254
  "h3_tl1 (C1 t ts) = h3_t1 t + h3_tl2 ts" |
traytel@58385
   255
  "h3_tl2 N2 = 0" |
traytel@58385
   256
  "h3_tl2 (C2 t ts) = h3_t1 t + h3_tl1 ts" |
traytel@58385
   257
  "h3_t1 (T1 n _ ts) = n + h3_tl1 ts"
traytel@58385
   258
traytel@58385
   259
(* should be fast *)
traytel@58385
   260
primrec
traytel@58385
   261
  i1_tl2 :: "(nat, 'a) t1 l2 \<Rightarrow> nat" and
traytel@58385
   262
  i1_tl1 :: "(nat, 'a) t1 l1 \<Rightarrow> nat" and
traytel@58385
   263
  i1_t1 :: "(nat, 'a) t1 \<Rightarrow> nat" and
traytel@58385
   264
  i1_t2 :: "(nat, 'a) t2 \<Rightarrow> nat"
traytel@58385
   265
where
traytel@58385
   266
  "i1_tl1 N1 = 0" |
traytel@58385
   267
  "i1_tl1 (C1 t ts) = i1_t1 t + i1_tl2 ts" |
traytel@58385
   268
  "i1_tl2 N2 = 0" |
traytel@58385
   269
  "i1_tl2 (C2 t ts) = i1_t1 t + i1_tl1 ts" |
traytel@58385
   270
  "i1_t1 (T1 n _ ts) = n + i1_tl1 ts" |
traytel@58385
   271
  "i1_t2 (T2 t) = i1_t1 t"
traytel@58385
   272
traytel@58385
   273
(* should be fast *)
traytel@58385
   274
primrec
traytel@58385
   275
  j1_t2 :: "(nat, 'a) t2 \<Rightarrow> nat" and
traytel@58385
   276
  j1_t1 :: "(nat, 'a) t1 \<Rightarrow> nat" and
traytel@58385
   277
  j1_tl1 :: "(nat, 'a) t1 l1 \<Rightarrow> nat" and
traytel@58385
   278
  j1_tl2 :: "(nat, 'a) t1 l2 \<Rightarrow> nat"
traytel@58385
   279
where
traytel@58385
   280
  "j1_tl1 N1 = 0" |
traytel@58385
   281
  "j1_tl1 (C1 t ts) = j1_t1 t + j1_tl2 ts" |
traytel@58385
   282
  "j1_tl2 N2 = 0" |
traytel@58385
   283
  "j1_tl2 (C2 t ts) = j1_t1 t + j1_tl1 ts" |
traytel@58385
   284
  "j1_t1 (T1 n _ ts) = n + j1_tl1 ts" |
traytel@58385
   285
  "j1_t2 (T2 t) = j1_t1 t"
traytel@58385
   286
traytel@58385
   287
traytel@58385
   288
datatype 'a l3 = N3 | C3 'a "'a l3"
traytel@58385
   289
datatype 'a l4 = N4 | C4 'a "'a l4"
traytel@58385
   290
datatype ('a, 'b) t3 = T3 'a 'b "('a, 'b) t3 l3" "('a, 'b) t3 l4"
traytel@58385
   291
traytel@58385
   292
(* slow *)
traytel@58385
   293
primrec
traytel@58385
   294
  k1_tl3 :: "(nat, 'a) t3 l3 \<Rightarrow> nat" and
traytel@58385
   295
  k1_tl4 :: "(nat, 'a) t3 l4 \<Rightarrow> nat" and
traytel@58385
   296
  k1_t3 :: "(nat, 'a) t3 \<Rightarrow> nat"
traytel@58385
   297
where
traytel@58385
   298
  "k1_tl3 N3 = 0" |
traytel@58385
   299
  "k1_tl3 (C3 t ts) = k1_t3 t + k1_tl3 ts" |
traytel@58385
   300
  "k1_tl4 N4 = 0" |
traytel@58385
   301
  "k1_tl4 (C4 t ts) = k1_t3 t + k1_tl4 ts" |
traytel@58385
   302
  "k1_t3 (T3 n _ ts us) = n + k1_tl3 ts + k1_tl4 us"
traytel@58385
   303
traytel@58385
   304
(* should be fast *)
traytel@58385
   305
primrec
traytel@58385
   306
  k2_tl4 :: "(nat, int) t3 l4 \<Rightarrow> nat" and
traytel@58385
   307
  k2_tl3 :: "(nat, int) t3 l3 \<Rightarrow> nat" and
traytel@58385
   308
  k2_t3 :: "(nat, int) t3 \<Rightarrow> nat"
traytel@58385
   309
where
traytel@58385
   310
  "k2_tl4 N4 = 0" |
traytel@58385
   311
  "k2_tl4 (C4 t ts) = k2_t3 t + k2_tl4 ts" |
traytel@58385
   312
  "k2_tl3 N3 = 0" |
traytel@58385
   313
  "k2_tl3 (C3 t ts) = k2_t3 t + k2_tl3 ts" |
traytel@58385
   314
  "k2_t3 (T3 n _ ts us) = n + k2_tl3 ts + k2_tl4 us"
traytel@58385
   315
traytel@58385
   316
traytel@58385
   317
datatype ('a, 'b) l5 = N5 | C5 'a 'b "('a, 'b) l5"
traytel@58385
   318
datatype ('a, 'b) l6 = N6 | C6 'a 'b "('a, 'b) l6"
traytel@58385
   319
datatype ('a, 'b, 'c) t4 = T4 'a 'b "(('a, 'b, 'c) t4, 'b) l5" "(('a, 'b, 'c) t4, 'c) l6"
traytel@58385
   320
traytel@58385
   321
(* slow *)
traytel@58385
   322
primrec
traytel@58385
   323
  l1_tl5 :: "((nat, 'a, 'b) t4, 'a) l5 \<Rightarrow> nat" and
traytel@58385
   324
  l1_tl6 :: "((nat, 'a, 'b) t4, 'b) l6 \<Rightarrow> nat" and
traytel@58385
   325
  l1_t4 :: "(nat, 'a, 'b) t4 \<Rightarrow> nat"
traytel@58385
   326
where
traytel@58385
   327
  "l1_tl5 N5 = 0" |
traytel@58385
   328
  "l1_tl5 (C5 t _ ts) = l1_t4 t + l1_tl5 ts" |
traytel@58385
   329
  "l1_tl6 N6 = 0" |
traytel@58385
   330
  "l1_tl6 (C6 t _ ts) = l1_t4 t + l1_tl6 ts" |
traytel@58385
   331
  "l1_t4 (T4 n _ ts us) = n + l1_tl5 ts + l1_tl6 us"
traytel@58385
   332
traytel@58385
   333
blanchet@58396
   334
subsection \<open>Primcorec Cache\<close>
traytel@58385
   335
traytel@58385
   336
codatatype 'a col = N | C 'a "'a col"
traytel@58385
   337
codatatype ('a, 'b) cot = T 'a 'b "('a, 'b) cot col"
traytel@58385
   338
traytel@58385
   339
context linorder
traytel@58385
   340
begin
traytel@58385
   341
traytel@58385
   342
(* slow *)
traytel@58385
   343
primcorec
traytel@58385
   344
  f1_cotcol :: "nat \<Rightarrow> (nat, 'a) cot col" and
traytel@58385
   345
  f1_cot :: "nat \<Rightarrow> (nat, 'a) cot"
traytel@58385
   346
where
traytel@58385
   347
  "n = 0 \<Longrightarrow> f1_cotcol n = N" |
traytel@58385
   348
  "_ \<Longrightarrow> f1_cotcol n = C (f1_cot n) (f1_cotcol n)" |
traytel@58385
   349
  "f1_cot n = T n undefined (f1_cotcol n)"
traytel@58385
   350
traytel@58385
   351
(* should be fast *)
traytel@58385
   352
primcorec
traytel@58385
   353
  f2_cotcol :: "nat \<Rightarrow> (nat, 'b) cot col" and
traytel@58385
   354
  f2_cot :: "nat \<Rightarrow> (nat, 'b) cot"
traytel@58385
   355
where
traytel@58385
   356
  "n = 0 \<Longrightarrow> f2_cotcol n = N" |
traytel@58385
   357
  "_ \<Longrightarrow> f2_cotcol n = C (f2_cot n) (f2_cotcol n)" |
traytel@58385
   358
  "f2_cot n = T n undefined (f2_cotcol n)"
traytel@58385
   359
traytel@58385
   360
end
traytel@58385
   361
traytel@58385
   362
(* should be fast *)
traytel@58385
   363
primcorec
traytel@58385
   364
  g1_cot :: "int \<Rightarrow> (int, 'a) cot" and
traytel@58385
   365
  g1_cotcol :: "int \<Rightarrow> (int, 'a) cot col"
traytel@58385
   366
where
traytel@58385
   367
  "g1_cot n = T n undefined (g1_cotcol n)" |
traytel@58385
   368
  "n = 0 \<Longrightarrow> g1_cotcol n = N" |
traytel@58385
   369
  "_ \<Longrightarrow> g1_cotcol n = C (g1_cot n) (g1_cotcol n)"
traytel@58385
   370
traytel@58385
   371
(* should be fast *)
traytel@58385
   372
primcorec
traytel@58385
   373
  g2_cot :: "int \<Rightarrow> (int, int) cot" and
traytel@58385
   374
  g2_cotcol :: "int \<Rightarrow> (int, int) cot col"
traytel@58385
   375
where
traytel@58385
   376
  "g2_cot n = T n undefined (g2_cotcol n)" |
traytel@58385
   377
  "n = 0 \<Longrightarrow> g2_cotcol n = N" |
traytel@58385
   378
  "_ \<Longrightarrow> g2_cotcol n = C (g2_cot n) (g2_cotcol n)"
traytel@58385
   379
traytel@58385
   380
traytel@58385
   381
codatatype
traytel@58385
   382
  'a col1 = N1 | C1 'a "'a col2" and
traytel@58385
   383
  'a col2 = N2 | C2 'a "'a col1"
traytel@58385
   384
traytel@58385
   385
codatatype
traytel@58385
   386
  ('a, 'b) cot1 = T1 'a 'b "('a, 'b) cot1 col1" and
traytel@58385
   387
  ('a, 'b) cot2 = T2 "('a, 'b) cot1"
traytel@58385
   388
traytel@58385
   389
(* slow *)
traytel@58385
   390
primcorec
traytel@58385
   391
  h1_cotcol1 :: "nat \<Rightarrow> (nat, 'a) cot1 col1" and
traytel@58385
   392
  h1_cotcol2 :: "nat \<Rightarrow> (nat, 'a) cot1 col2" and
traytel@58385
   393
  h1_cot1 :: "nat \<Rightarrow> (nat, 'a) cot1"
traytel@58385
   394
where
traytel@58385
   395
  "h1_cotcol1 n = C1 (h1_cot1 n) (h1_cotcol2 n)" |
traytel@58385
   396
  "h1_cotcol2 n = C2 (h1_cot1 n) (h1_cotcol1 n)" |
traytel@58385
   397
  "h1_cot1 n = T1 n undefined (h1_cotcol1 n)"
traytel@58385
   398
traytel@58385
   399
(* should be fast *)
traytel@58385
   400
primcorec
traytel@58385
   401
  h2_cotcol1 :: "nat \<Rightarrow> (nat, 'a) cot1 col1" and
traytel@58385
   402
  h2_cotcol2 :: "nat \<Rightarrow> (nat, 'a) cot1 col2" and
traytel@58385
   403
  h2_cot1 :: "nat \<Rightarrow> (nat, 'a) cot1"
traytel@58385
   404
where
traytel@58385
   405
  "h2_cotcol1 n = C1 (h2_cot1 n) (h2_cotcol2 n)" |
traytel@58385
   406
  "h2_cotcol2 n = C2 (h2_cot1 n) (h2_cotcol1 n)" |
traytel@58385
   407
  "h2_cot1 n = T1 n undefined (h2_cotcol1 n)"
traytel@58385
   408
traytel@58385
   409
(* should be fast *)
traytel@58385
   410
primcorec
traytel@58385
   411
  h3_cotcol2 :: "nat \<Rightarrow> (nat, 'a) cot1 col2" and
traytel@58385
   412
  h3_cotcol1 :: "nat \<Rightarrow> (nat, 'a) cot1 col1" and
traytel@58385
   413
  h3_cot1 :: "nat \<Rightarrow> (nat, 'a) cot1"
traytel@58385
   414
where
traytel@58385
   415
  "h3_cotcol1 n = C1 (h3_cot1 n) (h3_cotcol2 n)" |
traytel@58385
   416
  "h3_cotcol2 n = C2 (h3_cot1 n) (h3_cotcol1 n)" |
traytel@58385
   417
  "h3_cot1 n = T1 n undefined (h3_cotcol1 n)"
traytel@58385
   418
traytel@58385
   419
(* should be fast *)
traytel@58385
   420
primcorec
traytel@58385
   421
  i1_cotcol2 :: "nat \<Rightarrow> (nat, 'a) cot1 col2" and
traytel@58385
   422
  i1_cotcol1 :: "nat \<Rightarrow> (nat, 'a) cot1 col1" and
traytel@58385
   423
  i1_cot1 :: "nat \<Rightarrow> (nat, 'a) cot1" and
traytel@58385
   424
  i1_cot2 :: "nat \<Rightarrow> (nat, 'a) cot2"
traytel@58385
   425
where
traytel@58385
   426
  "i1_cotcol1 n = C1 (i1_cot1 n) (i1_cotcol2 n)" |
traytel@58385
   427
  "i1_cotcol2 n = C2 (i1_cot1 n) (i1_cotcol1 n)" |
traytel@58385
   428
  "i1_cot1 n = T1 n undefined (i1_cotcol1 n)" |
traytel@58385
   429
  "i1_cot2 n = T2 (i1_cot1 n)"
traytel@58385
   430
traytel@58385
   431
(* should be fast *)
traytel@58385
   432
primcorec
traytel@58385
   433
  j1_cot2 :: "nat \<Rightarrow> (nat, 'a) cot2" and
traytel@58385
   434
  j1_cot1 :: "nat \<Rightarrow> (nat, 'a) cot1" and
traytel@58385
   435
  j1_cotcol1 :: "nat \<Rightarrow> (nat, 'a) cot1 col1" and
traytel@58385
   436
  j1_cotcol2 :: "nat \<Rightarrow> (nat, 'a) cot1 col2"
traytel@58385
   437
where
traytel@58385
   438
  "j1_cotcol1 n = C1 (j1_cot1 n) (j1_cotcol2 n)" |
traytel@58385
   439
  "j1_cotcol2 n = C2 (j1_cot1 n) (j1_cotcol1 n)" |
traytel@58385
   440
  "j1_cot1 n = T1 n undefined (j1_cotcol1 n)" |
traytel@58385
   441
  "j1_cot2 n = T2 (j1_cot1 n)"
traytel@58385
   442
traytel@58385
   443
traytel@58385
   444
codatatype 'a col3 = N3 | C3 'a "'a col3"
traytel@58385
   445
codatatype 'a col4 = N4 | C4 'a "'a col4"
traytel@58385
   446
codatatype ('a, 'b) cot3 = T3 'a 'b "('a, 'b) cot3 col3" "('a, 'b) cot3 col4"
traytel@58385
   447
traytel@58385
   448
(* slow *)
traytel@58385
   449
primcorec
traytel@58385
   450
  k1_cotcol3 :: "nat \<Rightarrow> (nat, 'a) cot3 col3" and
traytel@58385
   451
  k1_cotcol4 :: "nat \<Rightarrow> (nat, 'a) cot3 col4" and
traytel@58385
   452
  k1_cot3 :: "nat \<Rightarrow> (nat, 'a) cot3"
traytel@58385
   453
where
traytel@58385
   454
  "k1_cotcol3 n = C3 (k1_cot3 n) (k1_cotcol3 n)" |
traytel@58385
   455
  "k1_cotcol4 n = C4 (k1_cot3 n) (k1_cotcol4 n)" |
traytel@58385
   456
  "k1_cot3 n = T3 n undefined (k1_cotcol3 n) (k1_cotcol4 n)"
traytel@58385
   457
traytel@58385
   458
(* should be fast *)
traytel@58385
   459
primcorec
traytel@58385
   460
  k2_cotcol4 :: "nat \<Rightarrow> (nat, 'a) cot3 col4" and
traytel@58385
   461
  k2_cotcol3 :: "nat \<Rightarrow> (nat, 'a) cot3 col3" and
traytel@58385
   462
  k2_cot3 :: "nat \<Rightarrow> (nat, 'a) cot3"
traytel@58385
   463
where
traytel@58385
   464
  "k2_cotcol4 n = C4 (k2_cot3 n) (k2_cotcol4 n)" |
traytel@58385
   465
  "k2_cotcol3 n = C3 (k2_cot3 n) (k2_cotcol3 n)" |
traytel@58385
   466
  "k2_cot3 n = T3 n undefined (k2_cotcol3 n) (k2_cotcol4 n)"
traytel@58385
   467
traytel@58385
   468
end