src/HOLCF/Fix.ML
author huffman
Tue, 26 Jul 2005 18:27:16 +0200
changeset 16920 ded12c9e88c2
parent 16214 e3816a7db016
child 16922 2128ac2aa5db
permissions -rw-r--r--
cleaned up
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
     1
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     2
(* legacy ML bindings *)
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
     3
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     4
val iterate_0 = thm "iterate_0";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     5
val iterate_Suc = thm "iterate_Suc";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     6
val Ifix_def = thm "Ifix_def";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     7
val fix_def = thm "fix_def";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     8
val admw_def = thm "admw_def";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
     9
val iterate_Suc2 = thm "iterate_Suc2";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    10
val chain_iterate2 = thm "chain_iterate2";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    11
val chain_iterate = thm "chain_iterate";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    12
val Ifix_eq = thm "Ifix_eq";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    13
val Ifix_least = thm "Ifix_least";
16214
e3816a7db016 cleaned up proof of cont_Ifix
huffman
parents: 16056
diff changeset
    14
val cont_iterate1 = thm "cont_iterate1";
e3816a7db016 cleaned up proof of cont_Ifix
huffman
parents: 16056
diff changeset
    15
val cont_iterate2 = thm "cont_iterate2";
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    16
val monofun_iterate2 = thm "monofun_iterate2";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    17
val contlub_iterate2 = thm "contlub_iterate2";
16214
e3816a7db016 cleaned up proof of cont_Ifix
huffman
parents: 16056
diff changeset
    18
val cont_iterate = thm "cont_iterate";
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    19
val cont_Ifix = thm "cont_Ifix";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    20
val fix_eq = thm "fix_eq";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    21
val fix_least = thm "fix_least";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    22
val fix_eqI = thm "fix_eqI";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    23
val fix_eq2 = thm "fix_eq2";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    24
val fix_eq3 = thm "fix_eq3";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    25
val fix_eq4 = thm "fix_eq4";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    26
val fix_eq5 = thm "fix_eq5";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    27
val fix_def2 = thm "fix_def2";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    28
val def_fix_ind = thm "def_fix_ind";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    29
val adm_impl_admw = thm "adm_impl_admw";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    30
val fix_ind = thm "fix_ind";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    31
val def_fix_ind = thm "def_fix_ind";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    32
val wfix_ind = thm "wfix_ind";
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    33
val def_wfix_ind = thm "def_wfix_ind";
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    34
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    35
structure Fix =
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    36
struct
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    37
  val thy = the_context ();
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    38
  val Ifix_def = Ifix_def;
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    39
  val fix_def = fix_def;
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    40
  val adm_def = adm_def;
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    41
  val admw_def = admw_def;
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    42
end;
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    43
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    44
fun fix_tac3 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq3) i));
1274
ea0668a1c0ba added 8bit pragmas
regensbu
parents: 1267
diff changeset
    45
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    46
fun fix_tac5 thm i  = ((rtac trans i) THEN (rtac (thm RS fix_eq5) i));
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    47
10834
a7897aebbffc *** empty log message ***
nipkow
parents: 10230
diff changeset
    48
(* proves the unfolding theorem for function equations f = fix$... *)
3652
4c484f03079c added case_prover
oheimb
parents: 3460
diff changeset
    49
fun fix_prover thy fixeq s = prove_goal thy s (fn prems => [
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    50
        (rtac trans 1),
3652
4c484f03079c added case_prover
oheimb
parents: 3460
diff changeset
    51
        (rtac (fixeq RS fix_eq4) 1),
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    52
        (rtac trans 1),
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    53
        (rtac beta_cfun 1),
2566
cbf02fc74332 changed handling of cont_lemmas and adm_lemmas
oheimb
parents: 2354
diff changeset
    54
        (Simp_tac 1)
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    55
        ]);
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    56
10834
a7897aebbffc *** empty log message ***
nipkow
parents: 10230
diff changeset
    57
(* proves the unfolding theorem for function definitions f == fix$... *)
3652
4c484f03079c added case_prover
oheimb
parents: 3460
diff changeset
    58
fun fix_prover2 thy fixdef s = prove_goal thy s (fn prems => [
1461
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    59
        (rtac trans 1),
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    60
        (rtac (fix_eq2) 1),
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    61
        (rtac fixdef 1),
6bcb44e4d6e5 expanded tabs
clasohm
parents: 1410
diff changeset
    62
        (rtac beta_cfun 1),
2566
cbf02fc74332 changed handling of cont_lemmas and adm_lemmas
oheimb
parents: 2354
diff changeset
    63
        (Simp_tac 1)
1168
74be52691d62 The curried version of HOLCF is now just called HOLCF. The old
regensbu
parents: 892
diff changeset
    64
        ]);
243
c22b85994e17 Franz Regensburger's Higher-Order Logic of Computable Functions embedding LCF
nipkow
parents:
diff changeset
    65
3652
4c484f03079c added case_prover
oheimb
parents: 3460
diff changeset
    66
(* proves an application case for a function from its unfolding thm *)
4c484f03079c added case_prover
oheimb
parents: 3460
diff changeset
    67
fun case_prover thy unfold s = prove_goal thy s (fn prems => [
15576
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    68
        (cut_facts_tac prems 1),
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    69
        (rtac trans 1),
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    70
        (stac unfold 1),
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    71
        Auto_tac
efb95d0d01f7 converted to new-style theories, and combined numbered files
huffman
parents: 14981
diff changeset
    72
        ]);