Separation_Algebra/Sep_Tactics.thy
author Christian Urban <christian dot urban at kcl dot ac dot uk>
Tue, 29 Apr 2014 15:26:48 +0100
changeset 19 087d82632852
parent 0 1378b654acde
child 25 a5f5b9336007
permissions -rw-r--r--
added FMap theory and adapted tm-theory
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     1
(* Authors: Gerwin Klein and Rafal Kolanski, 2012
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     2
   Maintainers: Gerwin Klein <kleing at cse.unsw.edu.au>
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     3
                Rafal Kolanski <rafal.kolanski at nicta.com.au>
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     4
*)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     5
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     6
header "Separation Logic Tactics"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     7
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     8
theory Sep_Tactics
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
     9
imports Separation_Algebra
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    10
begin
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    11
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    12
ML_file "sep_tactics.ML"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    13
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    14
text {* A number of proof methods to assist with reasoning about separation logic. *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    15
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    16
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    17
section {* Selection (move-to-front) tactics *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    18
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    19
method_setup sep_select = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    20
  Scan.lift Parse.int >> (fn n => fn ctxt => SIMPLE_METHOD' (sep_select_tac ctxt n))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    21
*} "Select nth separation conjunct in conclusion"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    22
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    23
method_setup sep_select_asm = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    24
  Scan.lift Parse.int >> (fn n => fn ctxt => SIMPLE_METHOD' (sep_select_asm_tac ctxt n))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    25
*} "Select nth separation conjunct in assumptions"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    26
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    27
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    28
section {* Substitution *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    29
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    30
method_setup "sep_subst" = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    31
  Scan.lift (Args.mode "asm" -- Scan.optional (Args.parens (Scan.repeat Parse.nat)) [0]) --
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    32
    Attrib.thms >> (fn ((asm, occs), thms) => fn ctxt =>
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    33
      SIMPLE_METHOD' ((if asm then sep_subst_asm_tac else sep_subst_tac) ctxt occs thms))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    34
*}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    35
"single-step substitution after solving one separation logic assumption"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    36
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    37
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    38
section {* Forward Reasoning *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    39
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    40
method_setup "sep_drule" = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    41
  Attrib.thms >> (fn thms => fn ctxt => SIMPLE_METHOD' (sep_dtac ctxt thms))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    42
*} "drule after separating conjunction reordering"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    43
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    44
method_setup "sep_frule" = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    45
  Attrib.thms >> (fn thms => fn ctxt => SIMPLE_METHOD' (sep_ftac ctxt thms))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    46
*} "frule after separating conjunction reordering"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    47
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    48
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    49
section {* Backward Reasoning *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    50
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    51
method_setup "sep_rule" = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    52
  Attrib.thms >> (fn thms => fn ctxt => SIMPLE_METHOD' (sep_rtac ctxt thms))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    53
*} "applies rule after separating conjunction reordering"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    54
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    55
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    56
section {* Cancellation of Common Conjuncts via Elimination Rules *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    57
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    58
ML {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    59
  structure SepCancel_Rules = Named_Thms (
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    60
    val name = @{binding "sep_cancel"};
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    61
    val description = "sep_cancel rules";
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    62
  );
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    63
*}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    64
setup SepCancel_Rules.setup
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    65
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    66
text {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    67
  The basic @{text sep_cancel_tac} is minimal. It only eliminates
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    68
  erule-derivable conjuncts between an assumption and the conclusion.
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    69
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    70
  To have a more useful tactic, we augment it with more logic, to proceed as
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    71
  follows:
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    72
  \begin{itemize}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    73
  \item try discharge the goal first using @{text tac}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    74
  \item if that fails, invoke @{text sep_cancel_tac}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    75
  \item if @{text sep_cancel_tac} succeeds
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    76
    \begin{itemize}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    77
    \item try to finish off with tac (but ok if that fails)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    78
    \item try to finish off with @{term sep_true} (but ok if that fails)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    79
    \end{itemize}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    80
  \end{itemize}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    81
  *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    82
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    83
ML {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    84
  fun sep_cancel_smart_tac ctxt tac =
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    85
    let fun TRY' tac = tac ORELSE' (K all_tac)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    86
    in
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    87
      tac
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    88
      ORELSE' (sep_cancel_tac ctxt tac
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    89
               THEN' TRY' tac
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    90
               THEN' TRY' (rtac @{thm TrueI}))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    91
      ORELSE' (etac @{thm sep_conj_sep_emptyE}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    92
               THEN' sep_cancel_tac ctxt tac
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    93
               THEN' TRY' tac
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    94
               THEN' TRY' (rtac @{thm TrueI}))
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    95
    end;
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    96
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    97
  fun sep_cancel_smart_tac_rules ctxt etacs =
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    98
      sep_cancel_smart_tac ctxt (FIRST' ([atac] @ etacs));
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
    99
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   100
  val sep_cancel_syntax = Method.sections [
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   101
    Args.add -- Args.colon >> K (I, SepCancel_Rules.add)] >> K ();
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   102
*}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   103
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   104
method_setup sep_cancel = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   105
  sep_cancel_syntax >> (fn _ => fn ctxt =>
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   106
    let
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   107
      val etacs = map etac (SepCancel_Rules.get ctxt);
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   108
    in
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   109
      SIMPLE_METHOD' (sep_cancel_smart_tac_rules ctxt etacs)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   110
    end)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   111
*} "Separating conjunction conjunct cancellation"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   112
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   113
text {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   114
  As above, but use blast with a depth limit to figure out where cancellation
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   115
  can be done. *}
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   116
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   117
method_setup sep_cancel_blast = {*
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   118
  sep_cancel_syntax >> (fn _ => fn ctxt =>
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   119
    let
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   120
      val rules = SepCancel_Rules.get ctxt;
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   121
      val tac = Blast.depth_tac (ctxt addIs rules) 10;
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   122
    in
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   123
      SIMPLE_METHOD' (sep_cancel_smart_tac ctxt tac)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   124
    end)
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   125
*} "Separating conjunction conjunct cancellation using blast"
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   126
1378b654acde initial commit for Isabelle 2013-1
Christian Urban <christian dot urban at kcl dot ac dot uk>
parents:
diff changeset
   127
end