src/ZF/IMP/Denotation.ML
author wenzelm
Mon, 03 Nov 1997 12:24:13 +0100
changeset 4091 771b1f6422a8
parent 2469 b50b8c0eec01
child 4298 b69eedd3aa6c
permissions -rw-r--r--
isatool fixclasimp;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
     1
(*  Title:      ZF/IMP/Denotation.ML
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
     2
    ID:         $Id$
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
     3
    Author:     Heiko Loetzbeyer & Robert Sandner, TUM
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
     4
    Copyright   1994 TUM
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
     5
*)
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
     6
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
     7
open Denotation;
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
     8
511
b2be4790da7a re-organized using new theory sections
lcp
parents: 500
diff changeset
     9
(**** Rewrite Rules for A,B,C ****)
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    10
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    11
val A_rewrite_rules =
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    12
     [A_nat_def,A_loc_def,A_op1_def,A_op2_def];
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    13
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    14
val B_rewrite_rules =
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    15
     [B_true_def,B_false_def,B_op_def,B_not_def,B_and_def,B_or_def]
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    16
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    17
val C_rewrite_rules = 
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    18
     [C_skip_def,C_assign_def,C_comp_def,C_if_def,C_while_def]; 
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    19
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    20
(**** Type_intr for A ****)
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    21
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    22
val A_type = prove_goal Denotation.thy
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    23
        "!!a.[|a:aexp; sigma:loc->nat|] ==> A(a,sigma):nat"
511
b2be4790da7a re-organized using new theory sections
lcp
parents: 500
diff changeset
    24
   (fn _ => [(etac aexp.induct 1),
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    25
             (rewrite_goals_tac A_rewrite_rules),
4091
771b1f6422a8 isatool fixclasimp;
wenzelm
parents: 2469
diff changeset
    26
             (ALLGOALS (fast_tac (claset() addSIs [apply_type])))]);
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    27
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    28
(**** Type_intr for B ****)
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    29
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    30
val B_type = prove_goal Denotation.thy
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    31
        "!!b. [|b:bexp; sigma:loc->nat|] ==> B(b,sigma):bool"
511
b2be4790da7a re-organized using new theory sections
lcp
parents: 500
diff changeset
    32
   (fn _ => [(etac bexp.induct 1),
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    33
             (rewrite_goals_tac B_rewrite_rules),
4091
771b1f6422a8 isatool fixclasimp;
wenzelm
parents: 2469
diff changeset
    34
             (ALLGOALS (fast_tac (claset() 
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    35
                          addSIs [apply_type,A_type]@bool_typechecks)))]);
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    36
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    37
(**** C_subset ****)
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    38
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    39
val C_subset = prove_goal Denotation.thy 
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    40
        "!!c. c:com ==> C(c) <= (loc->nat)*(loc->nat)"
511
b2be4790da7a re-organized using new theory sections
lcp
parents: 500
diff changeset
    41
   (fn _ => [(etac com.induct 1),
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    42
             (rewrite_tac C_rewrite_rules),
4091
771b1f6422a8 isatool fixclasimp;
wenzelm
parents: 2469
diff changeset
    43
             (ALLGOALS (fast_tac (claset() addDs [lfp_subset RS subsetD])))]);
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    44
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    45
(**** Type_elims for C ****)
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    46
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    47
val C_type = prove_goal Denotation.thy
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    48
        "[| <x,y>:C(c); c:com;                                  \
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    49
\            !!c. [| x:loc->nat; y:loc->nat |]  ==> R |]        \
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    50
\         ==> R"
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    51
     (fn prems => [(cut_facts_tac prems 1),
4091
771b1f6422a8 isatool fixclasimp;
wenzelm
parents: 2469
diff changeset
    52
                   (fast_tac (claset() addSIs prems 
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    53
                                    addDs  [(C_subset RS subsetD)]) 1)]);
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    54
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    55
val C_type_fst = prove_goal Denotation.thy
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    56
        "[| x:C(c); c:com;                                      \
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    57
\            !!c. [| fst(x):loc->nat |]  ==> R |]       \
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    58
\         ==> R"
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    59
     (fn prems => [(cut_facts_tac prems 1),
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    60
                   (resolve_tac prems 1),
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    61
                   (dtac (C_subset RS subsetD) 1),
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    62
                   (atac 1),
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    63
                   (etac SigmaE 1),
2469
b50b8c0eec01 Implicit simpsets and clasets for FOL and ZF
paulson
parents: 1461
diff changeset
    64
                   (Asm_simp_tac 1)]);
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    65
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    66
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    67
(**** bnd_mono (nat->nat*nat->nat,Gamma(b,c) ****)
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    68
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    69
val Gamma_bnd_mono = prove_goalw Denotation.thy [bnd_mono_def,Gamma_def]
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 511
diff changeset
    70
        "!!c. c:com ==> bnd_mono ((loc->nat)*(loc->nat),Gamma(b,c))"
4091
771b1f6422a8 isatool fixclasimp;
wenzelm
parents: 2469
diff changeset
    71
     (fn prems => [(best_tac (claset() addEs [C_type]) 1)]);
482
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    72
3a4e092ba69c Initial revision
nipkow
parents:
diff changeset
    73
(**** End ***)