62725
|
1 |
(* Title: HOL/Corec_Examples/Tests/Stream_Friends.thy
|
|
2 |
Author: Aymeric Bouzy, Ecole polytechnique
|
|
3 |
Author: Jasmin Blanchette, Inria, LORIA, MPII
|
|
4 |
Copyright 2015, 2016
|
|
5 |
|
|
6 |
Friendly functions on streams.
|
|
7 |
*)
|
|
8 |
|
|
9 |
section \<open>Friendly Functions on Streams\<close>
|
|
10 |
|
|
11 |
theory Stream_Friends
|
|
12 |
imports "~~/src/HOL/Library/BNF_Corec"
|
|
13 |
begin
|
|
14 |
|
|
15 |
codatatype 'a stream = SCons (shd: 'a) (stl: "'a stream")
|
|
16 |
|
|
17 |
corec pls :: "nat stream \<Rightarrow> nat stream \<Rightarrow> nat stream" where
|
|
18 |
"pls s s' = SCons (shd s + shd s') (pls (stl s) (stl s'))"
|
|
19 |
|
|
20 |
friend_of_corec pls :: "nat stream \<Rightarrow> nat stream \<Rightarrow> nat stream" where
|
|
21 |
"pls s s' = SCons (shd s + shd s') (pls (stl s) (stl s'))"
|
|
22 |
sorry
|
|
23 |
|
|
24 |
corec onetwo :: "nat stream" where
|
|
25 |
"onetwo = SCons 1 (SCons 2 onetwo)"
|
|
26 |
|
|
27 |
corec prd :: "nat stream \<Rightarrow> nat stream \<Rightarrow> nat stream" where
|
|
28 |
"prd xs ys = SCons (shd xs * shd ys) (pls (prd xs (stl ys)) (prd (stl xs) ys))"
|
|
29 |
|
|
30 |
friend_of_corec prd where
|
|
31 |
"prd xs ys = SCons (shd xs * shd ys) (pls (prd xs (stl ys)) (prd (stl xs) ys))"
|
|
32 |
sorry
|
|
33 |
|
|
34 |
corec Exp :: "nat stream \<Rightarrow> nat stream" where
|
|
35 |
"Exp xs = SCons (2 ^^ shd xs) (prd (stl xs) (Exp xs))"
|
|
36 |
|
|
37 |
friend_of_corec Exp where
|
|
38 |
"Exp xs = SCons (2 ^^ shd xs) (prd (stl xs) (Exp xs))"
|
|
39 |
sorry
|
|
40 |
|
|
41 |
corec prd2 :: "nat stream \<Rightarrow> nat stream \<Rightarrow> nat stream" where
|
|
42 |
"prd2 xs ys = SCons (shd xs * shd ys) (pls (prd xs (stl ys)) (prd2 (stl xs) ys))"
|
|
43 |
|
|
44 |
fun sthe_default :: "'a stream \<Rightarrow> nat \<Rightarrow> 'a stream option \<Rightarrow> 'a stream" where
|
|
45 |
"sthe_default s _ None = s"
|
|
46 |
| "sthe_default _ _ (Some t) = t"
|
|
47 |
|
|
48 |
friend_of_corec sthe_default where
|
|
49 |
"sthe_default s n opt = SCons (shd (case opt of None \<Rightarrow> s | Some t \<Rightarrow> t)) (stl (case opt of None \<Rightarrow> s | Some t \<Rightarrow> t))"
|
|
50 |
sorry
|
|
51 |
|
|
52 |
corec funky0 :: "nat \<Rightarrow> nat stream" where
|
|
53 |
"funky0 n = SCons 0 (sthe_default undefined n (map_option funky0 undefined))"
|
|
54 |
|
|
55 |
consts funky0' :: "nat stream \<Rightarrow> nat stream"
|
|
56 |
|
|
57 |
friend_of_corec funky0' :: "nat stream \<Rightarrow> nat stream" where
|
|
58 |
"funky0' ns = SCons 0 (sthe_default undefined (shd ns) (map_option funky0' undefined))"
|
|
59 |
sorry
|
|
60 |
|
|
61 |
corec funky :: "nat \<Rightarrow> nat stream" where
|
|
62 |
"funky n = SCons 0 (sthe_default (funky (n + 1)) n (map_option funky (Some (n + 2))))"
|
|
63 |
|
|
64 |
corec funky' :: "nat \<Rightarrow> nat \<Rightarrow> nat stream" where
|
|
65 |
"funky' m n = SCons 0 (sthe_default (funky' (m - 1) (n + 1)) m (map_option (%(x, y). funky' (Suc x) (Suc y)) (Some (m - 2, n + 2))))"
|
|
66 |
|
|
67 |
corec funky'' :: "nat \<Rightarrow> nat stream" where
|
|
68 |
"funky'' n = SCons 0 (sthe_default (funky'' (n + 1)) n (Some (funky'' (n + 2))))"
|
|
69 |
|
|
70 |
corec phunky0 :: "nat \<Rightarrow> nat stream" where
|
|
71 |
"phunky0 n = sthe_default undefined n undefined"
|
|
72 |
|
|
73 |
fun lthe_default :: "'a stream \<Rightarrow> 'a stream option \<Rightarrow> 'a stream" where
|
|
74 |
"lthe_default s None = s"
|
|
75 |
| "lthe_default _ (Some t) = t"
|
|
76 |
|
|
77 |
friend_of_corec lthe_default where
|
|
78 |
"lthe_default s opt = SCons (shd (case opt of None \<Rightarrow> s | Some t \<Rightarrow> t)) (stl (case opt of None \<Rightarrow> s | Some t \<Rightarrow> t))"
|
|
79 |
sorry
|
|
80 |
|
|
81 |
corec phunky_debug :: "'a \<Rightarrow> 'a stream" where
|
|
82 |
"phunky_debug n = lthe_default (SCons n (lthe_default undefined (map_option phunky_debug undefined))) undefined"
|
|
83 |
|
|
84 |
corec phunky1 :: "nat \<Rightarrow> nat stream" where
|
|
85 |
"phunky1 n = sthe_default (SCons 0 (sthe_default (phunky1 (n + 1)) n (map_option phunky1 (Some (n + 2))))) n undefined"
|
|
86 |
|
|
87 |
corec phunky2 :: "nat \<Rightarrow> nat stream" where
|
|
88 |
"phunky2 n = sthe_default (SCons 0 (sthe_default (phunky2 (n + 1)) n (map_option phunky2 (Some (n + 2))))) n
|
|
89 |
(map_option (%m. SCons m (sthe_default (phunky2 (n + 1)) n (map_option phunky2 (Some (n + 2))))) (Some n))"
|
|
90 |
|
|
91 |
corec phunky3 :: "nat \<Rightarrow> nat stream" where
|
|
92 |
"phunky3 n = sthe_default (SCons 0 (sthe_default (phunky3 (n + 1)) n (map_option phunky3 (Some (n + 3))))) n
|
|
93 |
(Some (SCons n (sthe_default (phunky3 (n + 1)) n (map_option phunky3 (Some (n + 3))))))"
|
|
94 |
|
|
95 |
end
|