src/HOL/IMP/BExp.thy
author nipkow
Sun, 23 Oct 2011 16:03:59 +0200
changeset 45257 12063e071d92
parent 45256 62b025f434e9
child 49191 3601bf546775
permissions -rw-r--r--
renamed in ASM
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
     1
theory BExp imports AExp begin
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
     2
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
     3
subsection "Boolean Expressions"
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
     4
45255
nipkow
parents: 45216
diff changeset
     5
text_raw{*\begin{isaverbatimwrite}\newcommand{\BExpbexpdef}{% *}
45200
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
     6
datatype bexp = Bc bool | Not bexp | And bexp bexp | Less aexp aexp
45255
nipkow
parents: 45216
diff changeset
     7
text_raw{*}\end{isaverbatimwrite}*}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
     8
45255
nipkow
parents: 45216
diff changeset
     9
text_raw{*\begin{isaverbatimwrite}\newcommand{\BExpbvaldef}{% *}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    10
fun bval :: "bexp \<Rightarrow> state \<Rightarrow> bool" where
45216
nipkow
parents: 45200
diff changeset
    11
"bval (Bc v) s = v" |
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    12
"bval (Not b) s = (\<not> bval b s)" |
45255
nipkow
parents: 45216
diff changeset
    13
"bval (And b\<^isub>1 b\<^isub>2) s = (bval b\<^isub>1 s \<and> bval b\<^isub>2 s)" |
nipkow
parents: 45216
diff changeset
    14
"bval (Less a\<^isub>1 a\<^isub>2) s = (aval a\<^isub>1 s < aval a\<^isub>2 s)"
nipkow
parents: 45216
diff changeset
    15
text_raw{*}\end{isaverbatimwrite}*}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    16
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    17
value "bval (Less (V ''x'') (Plus (N 3) (V ''y'')))
44036
d03f9f28d01d new state syntax with less conflicts
kleing
parents: 43158
diff changeset
    18
            <''x'' := 3, ''y'' := 1>"
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    19
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    20
45255
nipkow
parents: 45216
diff changeset
    21
text{* To improve automation: *}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    22
45255
nipkow
parents: 45216
diff changeset
    23
lemma bval_And_if[simp]:
nipkow
parents: 45216
diff changeset
    24
  "bval (And b1 b2) s = (if bval b1 s then bval b2 s else False)"
nipkow
parents: 45216
diff changeset
    25
by(simp)
nipkow
parents: 45216
diff changeset
    26
nipkow
parents: 45216
diff changeset
    27
declare bval.simps(3)[simp del]  --"remove the original eqn"
nipkow
parents: 45216
diff changeset
    28
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    29
45255
nipkow
parents: 45216
diff changeset
    30
subsection "Constant Folding"
nipkow
parents: 45216
diff changeset
    31
nipkow
parents: 45216
diff changeset
    32
text{* Optimizing constructors: *}
nipkow
parents: 45216
diff changeset
    33
nipkow
parents: 45216
diff changeset
    34
text_raw{*\begin{isaverbatimwrite}\newcommand{\BExplessdef}{% *}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    35
fun less :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
45255
nipkow
parents: 45216
diff changeset
    36
"less (N n\<^isub>1) (N n\<^isub>2) = Bc(n\<^isub>1 < n\<^isub>2)" |
nipkow
parents: 45216
diff changeset
    37
"less a\<^isub>1 a\<^isub>2 = Less a\<^isub>1 a\<^isub>2"
nipkow
parents: 45216
diff changeset
    38
text_raw{*}\end{isaverbatimwrite}*}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    39
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    40
lemma [simp]: "bval (less a1 a2) s = (aval a1 s < aval a2 s)"
45015
fdac1e9880eb Updated IMP to use new induction method
nipkow
parents: 44036
diff changeset
    41
apply(induction a1 a2 rule: less.induct)
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    42
apply simp_all
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    43
done
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    44
45255
nipkow
parents: 45216
diff changeset
    45
text_raw{*\begin{isaverbatimwrite}\newcommand{\BExpanddef}{% *}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    46
fun "and" :: "bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
45200
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
    47
"and (Bc True) b = b" |
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
    48
"and b (Bc True) = b" |
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
    49
"and (Bc False) b = Bc False" |
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
    50
"and b (Bc False) = Bc False" |
45255
nipkow
parents: 45216
diff changeset
    51
"and b\<^isub>1 b\<^isub>2 = And b\<^isub>1 b\<^isub>2"
nipkow
parents: 45216
diff changeset
    52
text_raw{*}\end{isaverbatimwrite}*}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    53
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    54
lemma bval_and[simp]: "bval (and b1 b2) s = (bval b1 s \<and> bval b2 s)"
45015
fdac1e9880eb Updated IMP to use new induction method
nipkow
parents: 44036
diff changeset
    55
apply(induction b1 b2 rule: and.induct)
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    56
apply simp_all
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    57
done
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    58
45255
nipkow
parents: 45216
diff changeset
    59
text_raw{*\begin{isaverbatimwrite}\newcommand{\BExpnotdef}{% *}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    60
fun not :: "bexp \<Rightarrow> bexp" where
45200
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
    61
"not (Bc True) = Bc False" |
1f1897ac7877 renamed B to Bc
nipkow
parents: 45015
diff changeset
    62
"not (Bc False) = Bc True" |
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    63
"not b = Not b"
45255
nipkow
parents: 45216
diff changeset
    64
text_raw{*}\end{isaverbatimwrite}*}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    65
45255
nipkow
parents: 45216
diff changeset
    66
lemma bval_not[simp]: "bval (not b) s = (\<not> bval b s)"
45015
fdac1e9880eb Updated IMP to use new induction method
nipkow
parents: 44036
diff changeset
    67
apply(induction b rule: not.induct)
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    68
apply simp_all
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    69
done
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    70
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    71
text{* Now the overall optimizer: *}
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    72
45255
nipkow
parents: 45216
diff changeset
    73
text_raw{*\begin{isaverbatimwrite}\newcommand{\BExpbsimpdef}{% *}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    74
fun bsimp :: "bexp \<Rightarrow> bexp" where
45256
62b025f434e9 tuned order of eqns
nipkow
parents: 45255
diff changeset
    75
"bsimp (Bc v) = Bc v" |
62b025f434e9 tuned order of eqns
nipkow
parents: 45255
diff changeset
    76
"bsimp (Not b) = not(bsimp b)" |
45255
nipkow
parents: 45216
diff changeset
    77
"bsimp (And b\<^isub>1 b\<^isub>2) = and (bsimp b\<^isub>1) (bsimp b\<^isub>2)" |
45256
62b025f434e9 tuned order of eqns
nipkow
parents: 45255
diff changeset
    78
"bsimp (Less a\<^isub>1 a\<^isub>2) = less (asimp a\<^isub>1) (asimp a\<^isub>2)"
45255
nipkow
parents: 45216
diff changeset
    79
text_raw{*}\end{isaverbatimwrite}*}
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    80
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    81
value "bsimp (And (Less (N 0) (N 1)) b)"
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    82
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    83
value "bsimp (And (Less (N 1) (N 0)) (B True))"
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    84
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    85
theorem "bval (bsimp b) s = bval b s"
45015
fdac1e9880eb Updated IMP to use new induction method
nipkow
parents: 44036
diff changeset
    86
apply(induction b)
43141
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    87
apply simp_all
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    88
done
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    89
11fce8564415 Replacing old IMP with new Semantics material
nipkow
parents:
diff changeset
    90
end