src/Pure/Proof/proof_rewrite_rules.ML
author berghofe
Mon Nov 19 17:40:07 2001 +0100 (2001-11-19 ago)
changeset 12237 39aeccee9e1c
parent 12002 bc9b5bad0e7b
child 12866 c00df7765656
permissions -rw-r--r--
Added setup.
berghofe@11522
     1
(*  Title:      Pure/Proof/proof_rewrite_rules.ML
berghofe@11522
     2
    ID:         $Id$
wenzelm@11539
     3
    Author:     Stefan Berghofer, TU Muenchen
wenzelm@11539
     4
    License:    GPL (GNU GENERAL PUBLIC LICENSE)
berghofe@11522
     5
berghofe@11522
     6
Simplification function for partial proof terms involving
berghofe@11522
     7
meta level rules.
berghofe@11522
     8
*)
berghofe@11522
     9
berghofe@11522
    10
signature PROOF_REWRITE_RULES =
berghofe@11522
    11
sig
berghofe@11522
    12
  val rprocs : (string * (typ list -> Proofterm.proof -> Proofterm.proof option)) list
berghofe@12237
    13
  val setup : (theory -> theory) list
berghofe@11522
    14
end;
berghofe@11522
    15
berghofe@11522
    16
structure ProofRewriteRules : PROOF_REWRITE_RULES =
berghofe@11522
    17
struct
berghofe@11522
    18
berghofe@11522
    19
open Proofterm;
berghofe@11522
    20
berghofe@11612
    21
fun rew _ (PThm (("ProtoPure.rev_triv_goal", _), _, _, _) % _ %%
berghofe@11612
    22
      (PThm (("ProtoPure.triv_goal", _), _, _, _) % _ %% prf)) = Some prf
berghofe@11612
    23
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % _ % _ %%
berghofe@11612
    24
      (PAxm ("ProtoPure.equal_intr", _, _) % _ % _ %% prf %% _)) = Some prf
berghofe@11612
    25
  | rew _ (PAxm ("ProtoPure.symmetric", _, _) % _ % _ %%
berghofe@11612
    26
      (PAxm ("ProtoPure.equal_intr", _, _) % A % B %% prf1 %% prf2)) =
berghofe@11612
    27
          Some (equal_intr_axm % B % A %% prf2 %% prf1)
berghofe@11522
    28
berghofe@12002
    29
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some (_ $ A) % Some (_ $ B) %%
berghofe@12002
    30
      (PAxm ("ProtoPure.combination", _, _) % Some (Const ("Goal", _)) %
berghofe@12002
    31
        _ % _ % _ %% (PAxm ("ProtoPure.reflexive", _, _) % _) %% prf1) %%
berghofe@12002
    32
      ((tg as PThm (("ProtoPure.triv_goal", _), _, _, _)) % _ %% prf2)) =
berghofe@12002
    33
      Some (tg %> B %% (equal_elim_axm %> A %> B %% prf1 %% prf2))
berghofe@12002
    34
berghofe@12002
    35
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some (_ $ A) % Some (_ $ B) %%
berghofe@12002
    36
      (PAxm ("ProtoPure.symmetric", _, _) % _ % _ %%
berghofe@12002
    37
        (PAxm ("ProtoPure.combination", _, _) % Some (Const ("Goal", _)) %
berghofe@12002
    38
           _ % _ % _ %% (PAxm ("ProtoPure.reflexive", _, _) % _) %% prf1)) %%
berghofe@12002
    39
      ((tg as PThm (("ProtoPure.triv_goal", _), _, _, _)) % _ %% prf2)) =
berghofe@12002
    40
      Some (tg %> B %% (equal_elim_axm %> A %> B %%
berghofe@12002
    41
        (symmetric_axm % None % None %% prf1) %% prf2))
berghofe@12002
    42
berghofe@11612
    43
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some X % Some Y %%
berghofe@11612
    44
      (PAxm ("ProtoPure.combination", _, _) % _ % _ % _ % _ %%
berghofe@11612
    45
        (PAxm ("ProtoPure.combination", _, _) % Some (Const ("==>", _)) % _ % _ % _ %%
berghofe@11612
    46
           (PAxm ("ProtoPure.reflexive", _, _) % _) %% prf1) %% prf2)) =
berghofe@11522
    47
      let
berghofe@11522
    48
        val _ $ A $ C = Envir.beta_norm X;
berghofe@11522
    49
        val _ $ B $ D = Envir.beta_norm Y
berghofe@11522
    50
      in Some (AbsP ("H1", None, AbsP ("H2", None,
berghofe@11612
    51
        equal_elim_axm %> C %> D %% incr_pboundvars 2 0 prf2 %%
berghofe@11612
    52
          (PBound 1 %% (equal_elim_axm %> B %> A %%
berghofe@11612
    53
            (symmetric_axm % None % None %% incr_pboundvars 2 0 prf1) %% PBound 0)))))
berghofe@11522
    54
      end
berghofe@11522
    55
berghofe@11612
    56
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some X % Some Y %%
berghofe@11612
    57
      (PAxm ("ProtoPure.symmetric", _, _) % _ % _ %%
berghofe@11612
    58
        (PAxm ("ProtoPure.combination", _, _) % _ % _ % _ % _ %%
berghofe@11612
    59
          (PAxm ("ProtoPure.combination", _, _) % Some (Const ("==>", _)) % _ % _ % _ %%
berghofe@11612
    60
             (PAxm ("ProtoPure.reflexive", _, _) % _) %% prf1) %% prf2))) =
berghofe@11522
    61
      let
berghofe@11522
    62
        val _ $ A $ C = Envir.beta_norm Y;
berghofe@11522
    63
        val _ $ B $ D = Envir.beta_norm X
berghofe@11522
    64
      in Some (AbsP ("H1", None, AbsP ("H2", None,
berghofe@11612
    65
        equal_elim_axm %> D %> C %%
berghofe@11612
    66
          (symmetric_axm % None % None %% incr_pboundvars 2 0 prf2)
berghofe@11612
    67
            %% (PBound 1 %% (equal_elim_axm %> A %> B %% incr_pboundvars 2 0 prf1 %% PBound 0)))))
berghofe@11522
    68
      end
berghofe@11522
    69
berghofe@11612
    70
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some X % Some Y %%
berghofe@11612
    71
      (PAxm ("ProtoPure.combination", _, _) % Some (Const ("all", _)) % _ % _ % _ %%
berghofe@11612
    72
        (PAxm ("ProtoPure.reflexive", _, _) % _) %%
berghofe@11612
    73
          (PAxm ("ProtoPure.abstract_rule", _, _) % _ % _ %% prf))) =
berghofe@11522
    74
      let
berghofe@11522
    75
        val _ $ P = Envir.beta_norm X;
berghofe@11522
    76
        val _ $ Q = Envir.beta_norm Y;
berghofe@11522
    77
      in Some (AbsP ("H", None, Abst ("x", None,
berghofe@11612
    78
          equal_elim_axm %> incr_boundvars 1 P $ Bound 0 %> incr_boundvars 1 Q $ Bound 0 %%
berghofe@11612
    79
            (incr_pboundvars 1 1 prf %> Bound 0) %% (PBound 0 %> Bound 0))))
berghofe@11522
    80
      end
berghofe@11522
    81
berghofe@11612
    82
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some X % Some Y %%
berghofe@11612
    83
      (PAxm ("ProtoPure.symmetric", _, _) % _ % _ %%        
berghofe@11612
    84
        (PAxm ("ProtoPure.combination", _, _) % Some (Const ("all", _)) % _ % _ % _ %%
berghofe@11612
    85
          (PAxm ("ProtoPure.reflexive", _, _) % _) %%
berghofe@11612
    86
            (PAxm ("ProtoPure.abstract_rule", _, _) % _ % _ %% prf)))) =
berghofe@11522
    87
      let
berghofe@11522
    88
        val _ $ P = Envir.beta_norm X;
berghofe@11522
    89
        val _ $ Q = Envir.beta_norm Y;
berghofe@11522
    90
      in Some (AbsP ("H", None, Abst ("x", None,
berghofe@11612
    91
        equal_elim_axm %> incr_boundvars 1 P $ Bound 0 %> incr_boundvars 1 Q $ Bound 0 %%
berghofe@11612
    92
          (symmetric_axm % None % None %% (incr_pboundvars 1 1 prf %> Bound 0))
berghofe@11612
    93
            %% (PBound 0 %> Bound 0))))
berghofe@11522
    94
      end
berghofe@11522
    95
berghofe@11612
    96
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some A % Some C %%
berghofe@11612
    97
      (PAxm ("ProtoPure.transitive", _, _) % _ % Some B % _ %% prf1 %% prf2) %% prf3) =
berghofe@11612
    98
         Some (equal_elim_axm %> B %> C %% prf2 %%
berghofe@11612
    99
           (equal_elim_axm %> A %> B %% prf1 %% prf3))
berghofe@11612
   100
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % Some A % Some C %%
berghofe@11612
   101
      (PAxm ("ProtoPure.symmetric", _, _) % _ % _ %%
berghofe@11612
   102
        (PAxm ("ProtoPure.transitive", _, _) % _ % Some B % _ %% prf1 %% prf2)) %% prf3) =
berghofe@11612
   103
         Some (equal_elim_axm %> B %> C %% (symmetric_axm % None % None %% prf1) %%
berghofe@11612
   104
           (equal_elim_axm %> A %> B %% (symmetric_axm % None % None %% prf2) %% prf3))
berghofe@11522
   105
berghofe@11612
   106
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % _ % _ %%
berghofe@11612
   107
      (PAxm ("ProtoPure.reflexive", _, _) % _) %% prf) = Some prf
berghofe@11612
   108
  | rew _ (PAxm ("ProtoPure.equal_elim", _, _) % _ % _ %%
berghofe@11612
   109
      (PAxm ("ProtoPure.symmetric", _, _) % _ % _ %%
berghofe@11612
   110
        (PAxm ("ProtoPure.reflexive", _, _) % _)) %% prf) = Some prf
berghofe@11522
   111
berghofe@11522
   112
  | rew _ _ = None;
berghofe@11522
   113
berghofe@11522
   114
val rprocs = [("Pure/meta_equality", rew)];
berghofe@12237
   115
val setup = [Proofterm.add_prf_rprocs rprocs];
berghofe@11522
   116
berghofe@11522
   117
end;