progtut/Tactical.thy~
author Xingyuan Zhang <xingyuanzhang@126.com>
Sat, 13 Sep 2014 10:07:14 +0800
changeset 25 a5f5b9336007
permissions -rw-r--r--
thys2 added
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
25
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     1
theory Tactical
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     2
imports Advanced
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     3
begin
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     4
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     5
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     6
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     7
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     8
ML {*
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
     9
fun my_print_tac ctxt thm =
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    10
let
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    11
   val _ = tracing (Pretty.string_of (pretty_thm_no_vars ctxt thm))
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    12
in
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    13
   Seq.single thm
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    14
end
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    15
*}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    16
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    17
ML {*
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    18
let
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    19
   val ctxt = @{context}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    20
   val goal = @{prop "P \<or> Q \<Longrightarrow> Q \<or> P"}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    21
in
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    22
   Goal.prove ctxt ["x", "y", "u", "v", "P", "Q"] [@{prop "x = y"}, @{prop "u = v"}] goal
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    23
    (fn {prems = pms, context = ctxt} =>  
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    24
              (my_print_tac ctxt)
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    25
              THEN etac @{thm disjE} 1 THEN
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    26
               (my_print_tac ctxt) 
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    27
              THEN rtac @{thm disjI2} 1
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    28
              THEN  (my_print_tac ctxt) 
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    29
              THEN atac 1
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    30
              THEN rtac @{thm disjI1} 1
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    31
              THEN atac 1)
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    32
end
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    33
*}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    34
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    35
ML {*
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    36
  Goal.prove
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    37
*}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    38
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    39
ML {*
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    40
fun pretty_cterms ctxt ctrms =
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    41
  Pretty.block (Pretty.commas (map (pretty_cterm ctxt) ctrms))
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    42
*}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    43
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    44
ML {*
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    45
fun foc_tac {prems, params, asms, concl, context, schematics} =
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    46
let
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    47
  fun assgn1 f1 f2 xs =
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    48
    let
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    49
       val out = map (fn (x, y) => Pretty.enum ":=" "" "" [f1 x, f2 y]) xs
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    50
    in
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    51
       Pretty.list "" "" out
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    52
    end
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    53
  fun assgn2 f xs = assgn1 f f xs
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    54
  val pps = map (fn (s, pp) => Pretty.block [Pretty.str s, pp])
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    55
    [("params: ", assgn1 Pretty.str (pretty_cterm context) params),
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    56
     ("assumptions: ", pretty_cterms context asms),
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    57
     ("conclusion: ", pretty_cterm context concl),
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    58
     ("premises: ", pretty_thms_no_vars context prems),
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    59
     ("schematics: ", assgn2 (pretty_cterm context) (snd schematics))]
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    60
in
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    61
  tracing (Pretty.string_of (Pretty.chunks pps)); all_tac
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    62
end
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    63
*}
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    64
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    65
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    66
notation (output) "prop"   ("#_" [1000] 1000)
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    67
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    68
lemma
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    69
  shows " \<lbrakk>A; B\<rbrakk> \<Longrightarrow> A \<and> B"
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    70
apply(tactic {* my_print_tac @{context} *})
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    71
apply(rule conjI)
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    72
apply(tactic {* my_print_tac @{context} *})
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    73
apply(assumption)
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    74
apply(tactic {* my_print_tac @{context} *})
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    75
apply(assumption)
a5f5b9336007 thys2 added
Xingyuan Zhang <xingyuanzhang@126.com>
parents:
diff changeset
    76
apply(tactic {* my_print_tac @{context} *})