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