src/HOL/UNITY/Traces.ML
author paulson
Tue, 14 Jul 1998 13:29:39 +0200
changeset 5139 013ea0f023e3
parent 5132 24f992a25adc
child 5232 e5a7cdd07ea5
permissions -rw-r--r--
stac now uses CHANGED_GOAL and correctly fails when it has no useful effect, even for conditional rewrites
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     1
(*  Title:      HOL/UNITY/Traces
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     2
    ID:         $Id$
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     4
    Copyright   1998  University of Cambridge
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     5
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     6
Definitions of
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     7
  * traces: the possible execution traces
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     8
  * reachable: the set of reachable states
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
     9
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    10
*)
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    11
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    12
open Traces;
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    13
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    14
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    15
(****
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    16
Now simulate the inductive definition (illegal due to paired arguments)
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    17
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    18
inductive "reachable(Init,Acts)"
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    19
  intrs 
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    20
    Init  "s: Init ==> s : reachable(Init,Acts)"
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    21
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    22
    Acts  "[| act: Acts;  s : reachable(Init,Acts);  (s,s'): act |]
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    23
	   ==> s' : reachable(Init,Acts)"
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    24
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    25
This amounts to an equivalence proof for the definition actually used, 
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    26
****)
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    27
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    28
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    29
(** reachable: Deriving the Introduction rules **)
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    30
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    31
Goal "s: Init ==> s : reachable(Init,Acts)";
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    32
by (simp_tac (simpset() addsimps [reachable_def]) 1);
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    33
by (blast_tac (claset() addIs traces.intrs) 1);
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    34
qed "reachable_Init";
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    35
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    36
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    37
Goal "[| act: Acts;  s : reachable(Init,Acts) |] \
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    38
\     ==> (s,s'): act --> s' : reachable(Init,Acts)";
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    39
by (asm_full_simp_tac (simpset() addsimps [reachable_def]) 1);
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    40
by (etac exE 1);
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    41
be traces.induct 1;
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    42
by (ALLGOALS Asm_simp_tac);
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    43
by (ALLGOALS (blast_tac (claset() addIs traces.intrs)));
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    44
qed_spec_mp "reachable_Acts";
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    45
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    46
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    47
val major::prems = 
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    48
Goalw [reachable_def] 
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    49
  "[| za : reachable(Init,Acts);  \
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    50
\     !!s. s : Init ==> P s;      \
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    51
\     !!act s s'.  \
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    52
\        [| act : Acts; s : reachable(Init,Acts); P s; (s, s') : act |]  \
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    53
\        ==> P s' |] \
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    54
\  ==> P za";
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    55
by (cut_facts_tac [major] 1);
5132
24f992a25adc isatool expandshort;
wenzelm
parents: 5111
diff changeset
    56
by Auto_tac;
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    57
be traces.induct 1;
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    58
by (ALLGOALS (blast_tac (claset() addIs prems)));
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    59
qed "reachable_induct";
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    60
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    61
structure reachable = 
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    62
  struct 
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    63
  val Init = reachable_Init
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    64
  val Acts = reachable_Acts
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    65
  val intrs = [reachable_Init, reachable_Acts]
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    66
  val induct = reachable_induct
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    67
  end;
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    68
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    69
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    70
(*The strongest invariant is the set of all reachable states!*)
5069
3ea049f7979d isatool fixgoal;
wenzelm
parents: 4776
diff changeset
    71
Goalw [stable_def, constrains_def]
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    72
    "[| Init<=A;  stable Acts A |] ==> reachable(Init,Acts) <= A";
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    73
by (rtac subsetI 1);
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    74
be reachable.induct 1;
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    75
by (REPEAT (blast_tac (claset() addIs reachable.intrs) 1));
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    76
qed "strongest_invariant";
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    77
5111
8f4b72f0c15d Uncurried functions LeadsTo and reach
paulson
parents: 5069
diff changeset
    78
Goal "stable Acts (reachable(Init,Acts))";
4776
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    79
by (REPEAT (blast_tac (claset() addIs [stableI, constrainsI]
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    80
				addIs reachable.intrs) 1));
1f9362e769c1 New UNITY theory
paulson
parents:
diff changeset
    81
qed "stable_reachable";