IMP/Properties.ML
author nipkow
Fri, 25 Nov 1994 20:06:15 +0100
changeset 188 32b84b520cd3
child 199 ad45e477926c
permissions -rw-r--r--
Proved determinism.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
188
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     1
(*  Title: 	HOL/IMP/Properties.ML
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     2
    ID:         $Id$
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     3
    Author: 	Tobias Nipkow, TUM
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     4
    Copyright   1994 TUM
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     5
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     6
IMP is deterministic.
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     7
*)
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     8
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
     9
(* evaluation of aexp is deterministic *)
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    10
goal Com.thy "!m n. <a,s> -a-> m & <a,s> -a-> n --> m=n";
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    11
by(res_inst_tac[("aexp","a")]Com.aexp.induct 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    12
by(REPEAT(fast_tac (HOL_cs addSIs evala.intrs addSEs evala_elim_cases) 1));
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    13
val aexp_detD =
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    14
  store_thm("aexp_detD", conjI RS (result() RS spec RS spec RS mp));
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    15
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    16
(* evaluation of bexp is deterministic *)
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    17
goal Com.thy "!v w. <b,s> -b-> v & <b,s> -b-> w --> v=w";
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    18
by(res_inst_tac[("bexp","b")]Com.bexp.induct 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    19
by(REPEAT(fast_tac (HOL_cs addSIs evalb.intrs addSEs evalb_elim_cases
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    20
                           addDs [aexp_detD]) 1));
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    21
val bexp_detD =
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    22
  store_thm("bexp_detD", conjI RS (result() RS spec RS spec RS mp));
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    23
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    24
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    25
val evalc_elim_cases = map (evalc.mk_cases com.simps)
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    26
   ["<skip,s> -c-> t", "<x:=a,s> -c-> t", "<c1;c2, s> -c-> t",
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    27
    "<ifc b then c1 else c2, s> -c-> t", "<while b do c,s> -c-> t"];
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    28
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    29
(* evaluation of com is deterministic *)
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    30
goal Com.thy "!!c. <c,s> -c-> t ==> !u. <c,s> -c-> u --> u=t";
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    31
(* start with rule induction *)
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    32
be (evalc.mutual_induct RS spec RS spec RS spec RSN (2,rev_mp)) 1;
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    33
by(fast_tac (set_cs addSEs evalc_elim_cases) 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    34
by(fast_tac (set_cs addSEs evalc_elim_cases addDs [aexp_detD]) 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    35
by(fast_tac (set_cs addSEs evalc_elim_cases) 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    36
by(fast_tac (set_cs addSEs evalc_elim_cases addDs [bexp_detD]) 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    37
by(fast_tac (set_cs addSEs evalc_elim_cases addDs [bexp_detD]) 1);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    38
by(EVERY1[strip_tac, eresolve_tac evalc_elim_cases,
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    39
          atac, dtac bexp_detD, atac, etac False_neq_True]);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    40
by(EVERY1[strip_tac, eresolve_tac evalc_elim_cases,
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    41
          dtac bexp_detD, atac, etac (sym RS False_neq_True),
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    42
          fast_tac HOL_cs]);
32b84b520cd3 Proved determinism.
nipkow
parents:
diff changeset
    43
result();