src/HOL/ex/Codegenerator.thy
author huffman
Sat, 30 Sep 2006 17:10:55 +0200
changeset 20792 add17d26151b
parent 20713 823967ef47f1
child 20807 bd3b60f9a343
permissions -rw-r--r--
add type annotations for DERIV
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     1
(*  ID:         $Id$
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     2
    Author:     Florian Haftmann, TU Muenchen
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     3
*)
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     4
20187
af47971ea304 small adjustments
haftmann
parents: 19888
diff changeset
     5
header {* Test and Examples for code generator *}
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     6
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     7
theory Codegenerator
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
     8
imports Main "~~/src/HOL/ex/Records"
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
     9
begin
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    10
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    11
subsection {* booleans *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    12
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    13
definition
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    14
  xor :: "bool \<Rightarrow> bool \<Rightarrow> bool"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    15
  "xor p q = ((p | q) & \<not> (p & q))"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    16
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    17
subsection {* natural numbers *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    18
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    19
definition
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    20
  n :: nat
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    21
  "n = 42"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    22
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    23
subsection {* pairs *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    24
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    25
definition
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    26
  swap :: "'a * 'b \<Rightarrow> 'b * 'a"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    27
  "swap p = (let (x, y) = p in (y, x))"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    28
  appl :: "('a \<Rightarrow> 'b) * 'a \<Rightarrow> 'b"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    29
  "appl p = (let (f, x) = p in f x)"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    30
20187
af47971ea304 small adjustments
haftmann
parents: 19888
diff changeset
    31
subsection {* integers *}
af47971ea304 small adjustments
haftmann
parents: 19888
diff changeset
    32
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    33
definition
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    34
  k :: "int"
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
    35
  "k = -42"
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    36
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    37
consts
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    38
  fac :: "int => int"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    39
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    40
recdef fac "measure nat"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    41
  "fac j = (if j <= 0 then 1 else j * (fac (j - 1)))"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    42
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    43
subsection {* sums *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    44
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    45
subsection {* options *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    46
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    47
subsection {* lists *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    48
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    49
definition
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    50
  ps :: "nat list"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    51
  "ps = [2, 3, 5, 7, 11]"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    52
  qs :: "nat list"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    53
  "qs == rev ps"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    54
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    55
subsection {* mutual datatypes *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    56
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    57
datatype mut1 = Tip | Top mut2
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    58
  and mut2 = Tip | Top mut1
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    59
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    60
consts
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    61
  mut1 :: "mut1 \<Rightarrow> mut1"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    62
  mut2 :: "mut2 \<Rightarrow> mut2"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    63
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    64
primrec
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    65
  "mut1 mut1.Tip = mut1.Tip"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    66
  "mut1 (mut1.Top x) = mut1.Top (mut2 x)"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    67
  "mut2 mut2.Tip = mut2.Tip"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    68
  "mut2 (mut2.Top x) = mut2.Top (mut1 x)"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    69
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
    70
subsection {* records *}
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    71
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    72
subsection {* equalities *}
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    73
20702
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    74
subsection {* strings *}
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    75
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    76
definition
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    77
  "mystring = ''my home is my castle''"
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    78
19789
c08c9f9ea9a5 small fix
haftmann
parents: 19604
diff changeset
    79
subsection {* heavy usage of names *}
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    80
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    81
definition
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    82
  f :: nat
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    83
  "f = 2"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    84
  g :: nat
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    85
  "g = f"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    86
  h :: nat
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    87
  "h = g"
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    88
20383
58f65fc90cf4 adaptions to improvements
haftmann
parents: 20351
diff changeset
    89
code_constname
58f65fc90cf4 adaptions to improvements
haftmann
parents: 20351
diff changeset
    90
  f "Mymod.f"
58f65fc90cf4 adaptions to improvements
haftmann
parents: 20351
diff changeset
    91
  g "Mymod.A.f"
58f65fc90cf4 adaptions to improvements
haftmann
parents: 20351
diff changeset
    92
  h "Mymod.A.B.f"
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
    93
20702
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    94
definition
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    95
  "apply_tower = (\<lambda>x. x (\<lambda>x. x (\<lambda>x. x)))"
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    96
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    97
definition
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    98
  "keywords fun datatype class instance funa classa =
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
    99
    Suc fun + datatype * class mod instance - funa - classa"
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   100
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   101
hide (open) const keywords
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   102
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   103
definition
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   104
  "shadow keywords = keywords @ [Codegenerator.keywords 0 0 0 0 0 0]"
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   105
20713
823967ef47f1 renamed 0 and 1 to HOL.zero and HOL.one respectivly; introduced corresponding syntactic classes
haftmann
parents: 20702
diff changeset
   106
code_gen
823967ef47f1 renamed 0 and 1 to HOL.zero and HOL.one respectivly; introduced corresponding syntactic classes
haftmann
parents: 20702
diff changeset
   107
  xor
823967ef47f1 renamed 0 and 1 to HOL.zero and HOL.one respectivly; introduced corresponding syntactic classes
haftmann
parents: 20702
diff changeset
   108
code_gen
823967ef47f1 renamed 0 and 1 to HOL.zero and HOL.one respectivly; introduced corresponding syntactic classes
haftmann
parents: 20702
diff changeset
   109
  "0::nat" "1::nat"
20702
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   110
code_gen
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   111
  Pair fst snd Let split swap
20597
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   112
code_gen "0::int" "1::int"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   113
  (SML) (Haskell)
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   114
code_gen n
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   115
  (SML) (Haskell)
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   116
code_gen fac
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   117
  (SML) (Haskell)
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   118
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   119
  "op + :: nat \<Rightarrow> nat \<Rightarrow> nat"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   120
  "op - :: nat \<Rightarrow> nat \<Rightarrow> nat"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   121
  "op * :: nat \<Rightarrow> nat \<Rightarrow> nat"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   122
  "op < :: nat \<Rightarrow> nat \<Rightarrow> bool"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   123
  "op <= :: nat \<Rightarrow> nat \<Rightarrow> bool"
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   124
code_gen
20597
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   125
  appl
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   126
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   127
  k
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   128
  "op + :: int \<Rightarrow> int \<Rightarrow> int"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   129
  "op - :: int \<Rightarrow> int \<Rightarrow> int"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   130
  "op * :: int \<Rightarrow> int \<Rightarrow> int"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   131
  "op < :: int \<Rightarrow> int \<Rightarrow> bool"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   132
  "op <= :: int \<Rightarrow> int \<Rightarrow> bool"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   133
  fac
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   134
  "op div :: int \<Rightarrow> int \<Rightarrow> int"
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   135
  "op mod :: int \<Rightarrow> int \<Rightarrow> int"  
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   136
  (SML) (Haskell)
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   137
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   138
  Inl Inr
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   139
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   140
  None Some
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   141
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   142
  hd tl "op @" ps qs
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   143
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   144
  mut1 mut2
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   145
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   146
  remove1
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   147
  null
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   148
  replicate
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   149
  rotate1
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   150
  rotate
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   151
  splice
20597
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   152
code_gen
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   153
  remdups
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   154
  "distinct"
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   155
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   156
  foo1 foo3
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   157
code_gen
20597
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   158
  "OperationalEquality.eq :: bool \<Rightarrow> bool \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   159
  "OperationalEquality.eq :: nat \<Rightarrow> nat \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   160
  "OperationalEquality.eq :: int \<Rightarrow> int \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   161
  "OperationalEquality.eq :: ('a\<Colon>eq) * ('b\<Colon>eq) \<Rightarrow> 'a * 'b \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   162
  "OperationalEquality.eq :: ('a\<Colon>eq) + ('b\<Colon>eq) \<Rightarrow> 'a + 'b \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   163
  "OperationalEquality.eq :: ('a\<Colon>eq) option \<Rightarrow> 'a option \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   164
  "OperationalEquality.eq :: ('a\<Colon>eq) list \<Rightarrow> 'a list \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   165
  "OperationalEquality.eq :: mut1 \<Rightarrow> mut1 \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   166
  "OperationalEquality.eq :: mut2 \<Rightarrow> mut2 \<Rightarrow> bool"
65fe827aa595 code generation 2 adjustments
haftmann
parents: 20453
diff changeset
   167
  "OperationalEquality.eq :: ('a\<Colon>eq) point_scheme \<Rightarrow> 'a point_scheme \<Rightarrow> bool"
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20383
diff changeset
   168
code_gen
20702
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   169
  mystring
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   170
code_gen
20351
c7658e811ffb added more examples
haftmann
parents: 20187
diff changeset
   171
  f g h
20702
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   172
code_gen
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   173
  apply_tower Codegenerator.keywords shadow
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
   174
20702
8b79d853eabb added examples for variable name handling
haftmann
parents: 20597
diff changeset
   175
code_gen (SML -)
19281
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
   176
b411f25fff25 added example for operational classes and code generator
haftmann
parents:
diff changeset
   177
end