src/Provers/clasimp.ML
changeset 11344 57b7ad51971c
parent 11181 d04f57b91166
child 11462 cf3e7f5ad0e1
equal deleted inserted replaced
11343:d5f1b482bfbf 11344:57b7ad51971c
    14   structure Simplifier: SIMPLIFIER
    14   structure Simplifier: SIMPLIFIER
    15   structure Splitter: SPLITTER
    15   structure Splitter: SPLITTER
    16   structure Classical: CLASSICAL
    16   structure Classical: CLASSICAL
    17   structure Blast: BLAST
    17   structure Blast: BLAST
    18   sharing type Classical.claset = Blast.claset
    18   sharing type Classical.claset = Blast.claset
    19   val dest_Trueprop: term -> term
       
    20   val not_const: term
       
    21   val iff_const: term
       
    22   val notE: thm
    19   val notE: thm
    23   val iffD1: thm
    20   val iffD1: thm
    24   val iffD2: thm
    21   val iffD2: thm
    25   val cla_make_elim: thm -> thm
    22   val cla_make_elim: thm -> thm
    26 end
    23 end
   114                             CHANGED o Simplifier.asm_full_simp_tac ss));
   111                             CHANGED o Simplifier.asm_full_simp_tac ss));
   115 
   112 
   116 
   113 
   117 (* iffs: addition of rules to simpsets and clasets simultaneously *)
   114 (* iffs: addition of rules to simpsets and clasets simultaneously *)
   118 
   115 
   119 (*Takes UNCONDITIONAL theorems of the form A<->B to
   116 (*Takes (possibly conditional) theorems of the form A<->B to
   120         the Safe Intr     rule B==>A and
   117         the Safe Intr     rule B==>A and
   121         the Safe Destruct rule A==>B.
   118         the Safe Destruct rule A==>B.
   122   Also ~A goes to the Safe Elim rule A ==> ?R
   119   Also ~A goes to the Safe Elim rule A ==> ?R
   123   Failing other cases, A is added as a Safe Intr rule*)
   120   Failing other cases, A is added as a Safe Intr rule and a warning is issued *)
   124 local
   121 local
   125 
   122 
   126 fun addIff dest elim intro simp ((cs, ss), th) =
   123 fun addIff dest elim intro simp ((cs, ss), th) =
   127   (case dest_Trueprop (#prop (Thm.rep_thm th)) of
   124   (          dest (intro (cs, [zero_var_indexes (th RS Data.iffD2)]),
   128     con $ _ $ _ =>
   125                               [zero_var_indexes (th RS Data.iffD1)])
   129       if con = Data.iff_const then
   126    handle THM _ => (warning ("iff add: theorem is not an equivalence\n" 
   130         dest (intro (cs, [zero_var_indexes (th RS Data.iffD2)]),
   127                   ^ Display.string_of_thm th);
   131           [zero_var_indexes (th RS Data.iffD1)])
   128                     elim (cs, [zero_var_indexes (th RS Data.notE )])
   132       else intro (cs, [th])
   129    handle THM _ => intro (cs, [th])),
   133   | con $ A =>
   130    simp (ss, [th]));
   134       if con = Data.not_const then elim (cs, [zero_var_indexes (th RS Data.notE)])
       
   135       else intro (cs, [th])
       
   136   | _ => intro (cs, [th]), simp (ss, [th]))
       
   137   handle TERM _ => error ("iff add: theorem must be unconditional\n" ^ Display.string_of_thm th);
       
   138 
   131 
   139 fun delIff ((cs, ss), th) =
   132 fun delIff ((cs, ss), th) =
   140   (case dest_Trueprop (#prop (Thm.rep_thm th)) of
   133 (                Classical.delrules (cs, [zero_var_indexes (th RS Data.iffD2),
   141     con $ _ $ _ =>
   134                       Data.cla_make_elim (zero_var_indexes (th RS Data.iffD1))])
   142       if con = Data.iff_const then
   135  handle THM _ => (warning ("iff del: theorem is not an equivalence\n" 
   143         Classical.delrules (cs, [zero_var_indexes (th RS Data.iffD2),
   136                   ^ Display.string_of_thm th);
   144           Data.cla_make_elim (zero_var_indexes (th RS Data.iffD1))])
   137                  Classical.delrules (cs, [zero_var_indexes (th RS Data.notE)])
   145       else Classical.delrules (cs, [th])
   138  handle THM _ => Classical.delrules (cs, [th])), 
   146   | con $ A =>
   139  Simplifier.delsimps (ss, [th]));
   147       if con = Data.not_const then Classical.delrules (cs, [zero_var_indexes (th RS Data.notE)])
       
   148       else Classical.delrules (cs, [th])
       
   149   | _ => Classical.delrules (cs, [th]), Simplifier.delsimps (ss, [th]))
       
   150   handle TERM _ =>
       
   151     (warning ("iff del: ignoring conditional theorem\n" ^ string_of_thm th); (cs, ss));
       
   152 
   140 
   153 fun store_clasimp (cs, ss) =
   141 fun store_clasimp (cs, ss) =
   154   (Classical.claset_ref () := cs; Simplifier.simpset_ref () := ss);
   142   (Classical.claset_ref () := cs; Simplifier.simpset_ref () := ss);
   155 
   143 
   156 in
   144 in