src/HOL/Tools/ATP/recon_prelim.ML
author nipkow
Thu, 07 Jul 2005 12:36:56 +0200
changeset 16732 1bbe526a552c
parent 16157 1764cc98bafd
child 16803 014090d1e64b
permissions -rw-r--r--
Used to be part of Finite_Set (or was it SetInterval?) Added binomial thm.
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
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
     6
val gcounter = ref 0; 
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
     7
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
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    14
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    15
fun iscomb a = if is_Free a then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    16
			false
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    17
	      else if is_Var a then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    18
			false
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    19
		else if USyntax.is_conj a then
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    20
			false
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    21
		else if USyntax.is_disj a then
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    22
			false
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    23
		else if USyntax.is_forall a then
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    24
			false
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    25
		else if USyntax.is_exists a then
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    26
			false
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    27
		else
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    28
			true;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    29
fun getstring (Var (v,T)) = fst v
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    30
   |getstring (Free (v,T))= v;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    31
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    32
fun twoisvar (a,b) = is_Var b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    33
fun twoisfree (a,b) = is_Free b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    34
fun twoiscomb (a,b) = iscomb b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    35
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    36
fun strequalfirst a (b,c) = (getstring a) = (getstring b);
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    37
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    38
fun fstequal a b = a = fst b;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    39
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    40
fun takeout (i,[])  = []
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    41
   | takeout (i,(x::xs)) = if (i>0) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    42
                               (x::(takeout(i-1,xs)))
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    43
                           else
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    44
                               [];
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    45
		
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    46
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    47
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    48
(* 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
    49
fun is_Abs (Abs _) = true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    50
  | is_Abs _ = false;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    51
fun is_Bound (Bound _) = true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    52
  | is_Bound _ = false;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    53
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    54
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    55
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    56
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    57
fun is_hol_tm t =
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    58
                if (is_Free t) then 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    59
                        true 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    60
                else if (is_Var t) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    61
                        true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    62
                else if (is_Const t) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    63
                        true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    64
                else if (is_Abs t) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    65
                        true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    66
                else if (is_Bound t) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    67
                        true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    68
                else 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    69
                        let val (f, args) = strip_comb t in
15789
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
    70
                            if ((is_Free f) orelse (is_Var f)) andalso (forall is_hol_tm args) then 
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    71
                                true            (* should be is_const *)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    72
                            else 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    73
                                false
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    74
                       end;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    75
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    76
fun is_hol_fm f =  if USyntax.is_neg f then
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    77
                        let val newf = USyntax.dest_neg f in
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    78
                            is_hol_fm newf
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    79
                        end
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    80
                    
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    81
               else if USyntax.is_disj f then
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    82
                        let val {disj1,disj2} = USyntax.dest_disj f in
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    83
                            (is_hol_fm disj1) andalso (is_hol_fm disj2)  (* shouldn't this be and ? *)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    84
                        end 
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    85
               else if USyntax.is_conj f then
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    86
                        let val {conj1,conj2} = USyntax.dest_conj f in
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    87
                            (is_hol_fm conj1) andalso (is_hol_fm conj2)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    88
                        end 
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    89
               else if (USyntax.is_forall f) then
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    90
                        let val {Body, Bvar} = USyntax.dest_forall f in
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    91
                            is_hol_fm Body
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    92
                        end
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    93
               else if (USyntax.is_exists f) then
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
    94
                        let val {Body, Bvar} = USyntax.dest_exists f in
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    95
                            is_hol_fm Body
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    96
                        end
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    97
               else if (iscomb f) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
    98
                        let val (P, args) = strip_comb f in
15789
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
    99
                            ((is_hol_tm P)) andalso (forall is_hol_fm args)
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   100
                        end
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   101
                else
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   102
                        is_hol_tm f;                              (* should be is_const, nee
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   103
d to check args *)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   104
               
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   105
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
   106
fun hol_literal t = 
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
   107
   (is_hol_fm t) andalso 
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
   108
   ( not ((USyntax.is_conj t) orelse (USyntax.is_disj t) orelse (USyntax.is_forall t) orelse (USyntax.is_exists t)));
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   109
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   110
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   111
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   112
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   113
(*PROBLEM HERE WITH THINGS THAT HAVE TWO RANDS e.g. P x y *)
15684
5ec4d21889d6 Reconstruction code, now packaged to avoid name clashes
paulson
parents: 15680
diff changeset
   114
fun getcombvar a = let val {Rand = rand, Rator = rator} = USyntax.dest_comb a in
15642
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   115
			if (iscomb rand) then
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   116
				getcombvar rand
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   117
			else
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   118
				rand
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   119
		   end;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   120
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   121
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   122
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   123
fun free2var v = let val thing = dest_Free v 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   124
                     val (name,vtype) = thing
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   125
                     val index = (name,0) in
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   126
                     Var (index,vtype)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   127
                 end;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   128
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   129
fun var2free v = let val (index, tv) = dest_Var v 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   130
                     val istr = fst index in
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   131
                     Free (istr,tv)
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   132
                 end;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   133
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   134
fun is_empty_seq thisseq =  case Seq.chop (1, thisseq) of
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   135
                             ([],_)   => true
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   136
                           |      _   => false
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   137
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   138
fun getnewenv thisseq = 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   139
			   let val seqlist = Seq.list_of thisseq
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   140
			   val envpair =hd seqlist in
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   141
			   fst envpair 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   142
			end;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   143
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   144
fun getnewsubsts thisseq =  let val seqlist = Seq.list_of thisseq
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   145
			   val envpair =hd seqlist in
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   146
			   snd envpair 
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   147
			end;
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   148
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   149
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   150
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   151
fun prover s = prove_goal HOL.thy s (fn _ => [blast_tac HOL_cs 1]);
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   152
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   153
028059faa963 *** empty log message ***
quigley
parents:
diff changeset
   154
15789
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
   155
fun int_of_string str = valOf (Int.fromString str)
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
   156
                        handle Option => error ("int_of_string: " ^ str);
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
   157
    
4cb16144c81b added hearder lines and deleted some redundant material
paulson
parents: 15782
diff changeset
   158
                	 
15680
83164f078985 Got rid of Main.thy reference
quigley
parents: 15642
diff changeset
   159
exception ASSERTION of string;