src/HOL/Tools/ATP/recon_prelim.ML
author wenzelm
Wed, 13 Jul 2005 16:07:24 +0200
changeset 16803 014090d1e64b
parent 16157 1764cc98bafd
child 17305 6cef3aedd661
permissions -rw-r--r--
tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
15789
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
     1
(*  ID:         $Id$
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
     2
    Author:     Claire Quigley
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
     3
    Copyright   2004  University of Cambridge
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
     4
*)
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
     5
16803
wenzelm
parents: 16157
diff changeset
     6
structure ReconPrelim =
wenzelm
parents: 16157
diff changeset
     7
struct
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
     8
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
     9
fun USYN_ERR func mesg = Utils.ERR {module = "USyntax", func = func, mesg = mesg};
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    10
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    11
fun dest_neg(Const("Not",_) $ M) = M
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    12
  | dest_neg _ = raise USYN_ERR "dest_neg" "not a negation";
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    13
16803
wenzelm
parents: 16157
diff changeset
    14
fun iscomb a =
wenzelm
parents: 16157
diff changeset
    15
    if is_Free a then
wenzelm
parents: 16157
diff changeset
    16
      false
wenzelm
parents: 16157
diff changeset
    17
    else if is_Var a then
wenzelm
parents: 16157
diff changeset
    18
      false
wenzelm
parents: 16157
diff changeset
    19
    else if USyntax.is_conj a then
wenzelm
parents: 16157
diff changeset
    20
      false
wenzelm
parents: 16157
diff changeset
    21
    else if USyntax.is_disj a then
wenzelm
parents: 16157
diff changeset
    22
      false
wenzelm
parents: 16157
diff changeset
    23
    else if USyntax.is_forall a then
wenzelm
parents: 16157
diff changeset
    24
      false
wenzelm
parents: 16157
diff changeset
    25
    else if USyntax.is_exists a then
wenzelm
parents: 16157
diff changeset
    26
      false
wenzelm
parents: 16157
diff changeset
    27
    else
wenzelm
parents: 16157
diff changeset
    28
      true;
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    29
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    30
fun getstring (Var (v,T)) = fst v
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    31
   |getstring (Free (v,T))= v;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    32
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    33
fun twoisvar (a,b) = is_Var b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    34
fun twoisfree (a,b) = is_Free b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    35
fun twoiscomb (a,b) = iscomb b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    36
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    37
fun strequalfirst a (b,c) = (getstring a) = (getstring b);
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    38
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    39
fun fstequal a b = a = fst b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    40
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    41
(* Presumably here, we would allow is_Var f for doing HOL, i.e. can subst for propositions *)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    42
fun is_Abs (Abs _) = true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    43
  | is_Abs _ = false;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    44
fun is_Bound (Bound _) = true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    45
  | is_Bound _ = false;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    46
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    47
fun is_hol_tm t =
16803
wenzelm
parents: 16157
diff changeset
    48
    if (is_Free t) then
wenzelm
parents: 16157
diff changeset
    49
      true
wenzelm
parents: 16157
diff changeset
    50
    else if (is_Var t) then
wenzelm
parents: 16157
diff changeset
    51
      true
wenzelm
parents: 16157
diff changeset
    52
    else if (is_Const t) then
wenzelm
parents: 16157
diff changeset
    53
      true
wenzelm
parents: 16157
diff changeset
    54
    else if (is_Abs t) then
wenzelm
parents: 16157
diff changeset
    55
      true
wenzelm
parents: 16157
diff changeset
    56
    else if (is_Bound t) then
wenzelm
parents: 16157
diff changeset
    57
      true
wenzelm
parents: 16157
diff changeset
    58
    else
wenzelm
parents: 16157
diff changeset
    59
      let val (f, args) = strip_comb t in
wenzelm
parents: 16157
diff changeset
    60
        if ((is_Free f) orelse (is_Var f)) andalso (forall is_hol_tm args) then
wenzelm
parents: 16157
diff changeset
    61
          true            (* should be is_const *)
wenzelm
parents: 16157
diff changeset
    62
        else
wenzelm
parents: 16157
diff changeset
    63
          false
wenzelm
parents: 16157
diff changeset
    64
      end;
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    65
16803
wenzelm
parents: 16157
diff changeset
    66
fun is_hol_fm f =
wenzelm
parents: 16157
diff changeset
    67
    if USyntax.is_neg f then
wenzelm
parents: 16157
diff changeset
    68
      let val newf = USyntax.dest_neg f in
wenzelm
parents: 16157
diff changeset
    69
        is_hol_fm newf
wenzelm
parents: 16157
diff changeset
    70
      end
wenzelm
parents: 16157
diff changeset
    71
    else if USyntax.is_disj f then
wenzelm
parents: 16157
diff changeset
    72
      let val {disj1,disj2} = USyntax.dest_disj f in
wenzelm
parents: 16157
diff changeset
    73
        (is_hol_fm disj1) andalso (is_hol_fm disj2)  (* shouldn't this be and ? *)
wenzelm
parents: 16157
diff changeset
    74
      end
wenzelm
parents: 16157
diff changeset
    75
    else if USyntax.is_conj f then
wenzelm
parents: 16157
diff changeset
    76
      let val {conj1,conj2} = USyntax.dest_conj f in
wenzelm
parents: 16157
diff changeset
    77
        (is_hol_fm conj1) andalso (is_hol_fm conj2)
wenzelm
parents: 16157
diff changeset
    78
      end
wenzelm
parents: 16157
diff changeset
    79
    else if (USyntax.is_forall f) then
wenzelm
parents: 16157
diff changeset
    80
      let val {Body, Bvar} = USyntax.dest_forall f in
wenzelm
parents: 16157
diff changeset
    81
        is_hol_fm Body
wenzelm
parents: 16157
diff changeset
    82
      end
wenzelm
parents: 16157
diff changeset
    83
    else if (USyntax.is_exists f) then
wenzelm
parents: 16157
diff changeset
    84
      let val {Body, Bvar} = USyntax.dest_exists f in
wenzelm
parents: 16157
diff changeset
    85
        is_hol_fm Body
wenzelm
parents: 16157
diff changeset
    86
      end
wenzelm
parents: 16157
diff changeset
    87
    else if (iscomb f) then
wenzelm
parents: 16157
diff changeset
    88
      let val (P, args) = strip_comb f in
wenzelm
parents: 16157
diff changeset
    89
        ((is_hol_tm P)) andalso (forall is_hol_fm args)
wenzelm
parents: 16157
diff changeset
    90
      end
wenzelm
parents: 16157
diff changeset
    91
    else
wenzelm
parents: 16157
diff changeset
    92
      is_hol_tm f;           (* should be is_const, need to check args *)
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    93
16803
wenzelm
parents: 16157
diff changeset
    94
fun hol_literal t =
wenzelm
parents: 16157
diff changeset
    95
  is_hol_fm t andalso
wenzelm
parents: 16157
diff changeset
    96
    (not (USyntax.is_conj t orelse USyntax.is_disj t orelse USyntax.is_forall t
wenzelm
parents: 16157
diff changeset
    97
      orelse USyntax.is_exists t));
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    98
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    99
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   100
(*PROBLEM HERE WITH THINGS THAT HAVE TWO RANDS e.g. P x y *)
16803
wenzelm
parents: 16157
diff changeset
   101
fun getcombvar a =
wenzelm
parents: 16157
diff changeset
   102
    let val {Rand = rand, Rator = rator} = USyntax.dest_comb a in
wenzelm
parents: 16157
diff changeset
   103
      if (iscomb rand) then
wenzelm
parents: 16157
diff changeset
   104
        getcombvar rand
wenzelm
parents: 16157
diff changeset
   105
      else
wenzelm
parents: 16157
diff changeset
   106
        rand
wenzelm
parents: 16157
diff changeset
   107
    end;
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   108
16803
wenzelm
parents: 16157
diff changeset
   109
fun free2var v =
wenzelm
parents: 16157
diff changeset
   110
  let val (name, vtype) = dest_Free v
wenzelm
parents: 16157
diff changeset
   111
  in Var ((name, 0), vtype) end;
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   112
16803
wenzelm
parents: 16157
diff changeset
   113
fun var2free v =
wenzelm
parents: 16157
diff changeset
   114
  let val ((x, _), tv) = dest_Var v
wenzelm
parents: 16157
diff changeset
   115
  in Free (x, tv) end;
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   116
16803
wenzelm
parents: 16157
diff changeset
   117
val is_empty_seq = is_none o Seq.pull;
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   118
16803
wenzelm
parents: 16157
diff changeset
   119
fun getnewenv seq = fst (fst (the (Seq.pull seq)));
wenzelm
parents: 16157
diff changeset
   120
fun getnewsubsts seq = snd (fst (the (Seq.pull seq)));
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   121
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   122
fun prover s = prove_goal HOL.thy s (fn _ => [blast_tac HOL_cs 1]);
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   123
16803
wenzelm
parents: 16157
diff changeset
   124
fun int_of_string str =
wenzelm
parents: 16157
diff changeset
   125
  (case Int.fromString str of SOME n => n
wenzelm
parents: 16157
diff changeset
   126
  | NONE => error ("int_of_string: " ^ str));
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   127
16803
wenzelm
parents: 16157
diff changeset
   128
val no_lines = filter_out (equal "\n");
wenzelm
parents: 16157
diff changeset
   129
15680
83164f078985 Got rid of Main.thy reference
quigley
parents: 15642
diff changeset
   130
exception ASSERTION of string;
16803
wenzelm
parents: 16157
diff changeset
   131
wenzelm
parents: 16157
diff changeset
   132
end;