src/HOL/ex/CodeRevappl.thy
author haftmann
Tue, 20 Mar 2007 08:27:15 +0100
changeset 22473 753123c89d72
parent 20707 eb0193afca14
permissions -rw-r--r--
explizit "type" superclass
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
20400
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     1
(*  ID:         $Id$
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     2
    Author:     Florian Haftmann, TU Muenchen
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     3
*)
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     4
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     5
header {* Combinators for structured results *}
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     6
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     7
theory CodeRevappl
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     8
imports Main
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
     9
begin
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    10
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    11
section {* Combinators for structured results *}
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    12
20707
eb0193afca14 inserted headings
haftmann
parents: 20400
diff changeset
    13
eb0193afca14 inserted headings
haftmann
parents: 20400
diff changeset
    14
subsection {* primitive definitions *}
eb0193afca14 inserted headings
haftmann
parents: 20400
diff changeset
    15
20400
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    16
definition
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    17
  revappl :: "'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'b" (infixl "\<triangleright>" 55)
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    18
  revappl_def: "x \<triangleright> f = f x"
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    19
  revappl_snd :: "'c \<times> 'a \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'c \<times> 'b" (infixl "|\<triangleright>" 55)
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    20
  revappl_snd_split: "z |\<triangleright> f = (fst z , f (snd z))"
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    21
  revappl_swamp :: "'c \<times> 'a \<Rightarrow> ('a \<Rightarrow> 'd \<times> 'b) \<Rightarrow> ('c \<times> 'd) \<times> 'b" (infixl "|\<triangleright>\<triangleright>" 55)
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    22
  revappl_swamp_split: "z |\<triangleright>\<triangleright> f = ((fst z, fst (f (snd z))), snd (f (snd z)))"
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    23
  revappl_uncurry :: "'c \<times> 'a \<Rightarrow> ('c \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'b" (infixl "\<turnstile>\<triangleright>" 55)
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    24
  revappl_uncurry_split: "z \<turnstile>\<triangleright> f = f (fst z) (snd z)"
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    25
20707
eb0193afca14 inserted headings
haftmann
parents: 20400
diff changeset
    26
eb0193afca14 inserted headings
haftmann
parents: 20400
diff changeset
    27
subsection {* lemmas *}
eb0193afca14 inserted headings
haftmann
parents: 20400
diff changeset
    28
20400
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    29
lemma revappl_snd_def [code]:
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    30
  "(y, x) |\<triangleright> f = (y, f x)" unfolding revappl_snd_split by simp
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    31
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    32
lemma revappl_swamp_def [code]:
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    33
  "(y, x) |\<triangleright>\<triangleright> f = (let (z, w) = f x in ((y, z), w))" unfolding Let_def revappl_swamp_split split_def by simp
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    34
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    35
lemma revappl_uncurry_def [code]:
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    36
  "(y, x) \<turnstile>\<triangleright> f = f y x" unfolding revappl_uncurry_split by simp
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    37
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    38
lemmas revappl = revappl_def revappl_snd_def revappl_swamp_def revappl_uncurry_def
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    39
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    40
lemmas revappl_split = revappl_def revappl_snd_split revappl_swamp_split revappl_uncurry_split
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    41
0ad2f3bbd4f0 added some codegen examples/applications
haftmann
parents:
diff changeset
    42
end