17 codatatype 'a stream = SCons (shd: 'a) (stl: "'a stream") (infixr "\<lhd>" 65) |
17 codatatype 'a stream = SCons (shd: 'a) (stl: "'a stream") (infixr "\<lhd>" 65) |
18 |
18 |
19 corec "natsFrom" :: "nat \<Rightarrow> nat stream" where |
19 corec "natsFrom" :: "nat \<Rightarrow> nat stream" where |
20 "natsFrom n = n \<lhd> natsFrom (n + 1)" |
20 "natsFrom n = n \<lhd> natsFrom (n + 1)" |
21 |
21 |
22 corec (friend) addOne :: "nat stream \<Rightarrow> nat stream" |
22 corec (friend) add1 :: "nat stream \<Rightarrow> nat stream" |
23 where "addOne n = (shd n + 1) \<lhd> addOne (stl n)" |
23 where "add1 n = (shd n + 1) \<lhd> add1 (stl n)" |
24 |
24 |
25 corec natsFrom' :: "nat \<Rightarrow> nat stream" where |
25 corec natsFrom' :: "nat \<Rightarrow> nat stream" where |
26 "natsFrom' n = n \<lhd> addOne (natsFrom' n)" |
26 "natsFrom' n = n \<lhd> add1 (natsFrom' n)" |
27 |
|
28 |
27 |
29 section \<open>Examples from section 3\<close> |
28 section \<open>Examples from section 3\<close> |
30 |
29 |
31 text \<open>We curry the example functions in this section because infix syntax works only for curried functions.\<close> |
30 text \<open>We curry the example functions in this section because infix syntax works only for curried functions.\<close> |
32 |
31 |
33 corec (friend) Plus :: "nat stream \<Rightarrow> nat stream \<Rightarrow> nat stream" (infix "\<oplus>" 67) where |
32 corec (friend) Plus :: "nat stream \<Rightarrow> nat stream \<Rightarrow> nat stream" (infix "\<oplus>" 67) where |
34 "x\<^sub>1 \<oplus> x\<^sub>2 = (shd x\<^sub>1 + shd x\<^sub>2) \<lhd> (stl x\<^sub>1 \<oplus> stl x\<^sub>2)" |
33 "x\<^sub>1 \<oplus> x\<^sub>2 = (shd x\<^sub>1 + shd x\<^sub>2) \<lhd> (stl x\<^sub>1 \<oplus> stl x\<^sub>2)" |
35 |
34 |
36 |
|
37 section \<open>Examples from section 4\<close> |
35 section \<open>Examples from section 4\<close> |
38 |
36 |
39 corec collatz :: "nat \<Rightarrow> nat stream" where |
37 codatatype 'a llist = LNil | LCons 'a "'a llist" |
40 "collatz n = (if even n \<and> n > 0 then collatz (n div 2) else n \<lhd> collatz (3 * n + 1))" |
38 |
|
39 corec collatz :: "nat \<Rightarrow> nat llist" where |
|
40 "collatz n = (if n \<le> 1 then LNil |
|
41 else if even n then collatz (n div 2) |
|
42 else LCons n (collatz (3 * n + 1)))" |
41 |
43 |
42 datatype 'a nelist = NEList (hd:'a) (tl:"'a list") |
44 datatype 'a nelist = NEList (hd:'a) (tl:"'a list") |
43 |
45 |
44 primrec (transfer) postpend :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a nelist" (infix "\<rhd>" 64) where |
46 primrec (transfer) snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a nelist" (infix "\<rhd>" 64) where |
45 "[] \<rhd> a = NEList a []" |
47 "[] \<rhd> a = NEList a []" |
46 |"(b # bs) \<rhd> a = NEList b (bs @ [a])" |
48 |"(b # bs) \<rhd> a = NEList b (bs @ [a])" |
47 |
49 |
48 corec (friend) inter :: "nat stream nelist \<Rightarrow> nat stream" where |
50 corec (friend) inter :: "nat stream nelist \<Rightarrow> nat stream" where |
49 "inter x = shd (hd x) \<lhd> inter (tl x \<rhd> stl (hd x))" |
51 "inter xss = shd (hd xss) \<lhd> inter (tl xss \<rhd> stl (hd xss))" |
50 |
52 |
51 corec (friend) inter2 :: "nat stream nelist \<Rightarrow> nat stream" where |
53 corec (friend) inter' :: "nat stream nelist \<Rightarrow> nat stream" where |
52 "inter2 x = (case hd x of n \<lhd> y \<Rightarrow> n \<lhd> inter2 (tl x \<rhd> y))" |
54 "inter' xss = (case hd xss of x \<lhd> xs \<Rightarrow> x \<lhd> inter' (tl xss \<rhd> xs))" |
53 |
55 |
54 corec zero :: "nat stream" where "zero = 0 \<lhd> zero" |
56 corec zero :: "nat stream" where "zero = 0 \<lhd> zero" |
55 |
|
56 corec (friend) inter3 :: "nat stream nelist \<Rightarrow> nat stream" where |
|
57 "inter3 x = shd (stl zero) \<lhd> inter3 ([hd x] \<rhd> stl (hd x))" |
|
58 |
|
59 |
57 |
60 section \<open>Examples from Blanchette et al. (ICFP 2015)\<close> |
58 section \<open>Examples from Blanchette et al. (ICFP 2015)\<close> |
61 |
59 |
62 corec oneTwos :: "nat stream" where "oneTwos = 1 \<lhd> 2 \<lhd> oneTwos" |
60 corec oneTwos :: "nat stream" where "oneTwos = 1 \<lhd> 2 \<lhd> oneTwos" |
63 |
61 |
89 |
87 |
90 corec (friend) tplus :: "tree \<Rightarrow> tree \<Rightarrow> tree" |
88 corec (friend) tplus :: "tree \<Rightarrow> tree \<Rightarrow> tree" |
91 where "tplus t u = Node (val t + val u) (map (\<lambda>(t', u'). tplus t' u') (zip (sub t) (sub u)))" |
89 where "tplus t u = Node (val t + val u) (map (\<lambda>(t', u'). tplus t' u') (zip (sub t) (sub u)))" |
92 |
90 |
93 corec (friend) ttimes :: "tree \<Rightarrow> tree \<Rightarrow> tree" |
91 corec (friend) ttimes :: "tree \<Rightarrow> tree \<Rightarrow> tree" |
94 where "ttimes t u = Node (val t * val u) (map (\<lambda>(t , u ). tplus (ttimes t u ) (ttimes t u)) (zip (sub t) (sub u)))" |
92 where "ttimes t u = Node (val t * val u) |
|
93 (map (\<lambda>(t, u). tplus (ttimes t u) (ttimes t u)) (zip (sub t) (sub u)))" |
95 |
94 |
96 corecursive primes :: "nat \<Rightarrow> nat \<Rightarrow> nat stream" |
95 corecursive primes :: "nat \<Rightarrow> nat \<Rightarrow> nat stream" |
97 where "primes m n = |
96 where "primes m n = |
98 (if (m = 0 \<and> n > 1) \<or> coprime m n then n \<lhd> primes (m * n) (n + 1) else primes m (n + 1))" |
97 (if (m = 0 \<and> n > 1) \<or> coprime m n then n \<lhd> primes (m * n) (n + 1) else primes m (n + 1))" |
99 apply (relation "measure (\<lambda>(m, n). if n = 0 then 1 else if coprime m n then 0 else m - n mod m)") |
98 apply (relation "measure (\<lambda>(m, n). if n = 0 then 1 else if coprime m n then 0 else m - n mod m)") |