author  wenzelm 
Tue, 21 Jul 2009 01:03:18 +0200  
changeset 32091  30e2ffbba718 
parent 31945  d5f186aa0bed 
child 32174  9036cc8ae775 
permissions  rwrr 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1 
(* Title: Provers/blast.ML 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

2 
Author: Lawrence C Paulson, Cambridge University Computer Laboratory 
3083  3 
Copyright 1997 University of Cambridge 
2894  4 

5 
Generic tableau prover with proof reconstruction 

6 

2854  7 
SKOLEMIZES ReplaceI WRONGLY: allow new vars in prems, or forbid such rules?? 
2894  8 
Needs explicit instantiation of assumptions? 
9 

18171  10 
Given the typeargs system, constructor Const could be eliminated, with 
11 
TConst replaced by a constructor that takes the typargs list as an argument. 

12 
However, Const is heavily used for logical connectives. 

2894  13 

2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

14 
Blast_tac is often more powerful than fast_tac, but has some limitations. 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

15 
Blast_tac... 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

16 
* ignores wrappers (addss, addbefore, addafter, addWrapper, ...); 
4651  17 
this restriction is intrinsic 
2894  18 
* ignores elimination rules that don't have the correct format 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

19 
(conclusion must be a formula variable) 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

20 
* rules must not require higherorder unification, e.g. apply_type in ZF 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

21 
+ message "Function Var's argument not a bound variable" relates to this 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

22 
* its proof strategy is more general but can actually be slower 
2894  23 

24 
Known problems: 

3092  25 
"Recursive" chains of rules can sometimes exclude other unsafe formulae 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

26 
from expansion. This happens because newlycreated formulae always 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

27 
have priority over existing ones. But obviously recursive rules 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

28 
such as transitivity are treated specially to prevent this. Sometimes 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

29 
the formulae get into the wrong order (see WRONG below). 
3021
39806db47be9
Loop detection: before expanding a haz formula, see whether it is a duplicate
paulson
parents:
2999
diff
changeset

30 

2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

31 
With substition for equalities (hyp_subst_tac): 
3092  32 
When substitution affects a haz formula or literal, it is moved 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

33 
back to the list of safe formulae. 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

34 
But there's no way of putting it in the right place. A "moved" or 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

35 
"no DETERM" flag would prevent proofs failing here. 
2854  36 
*) 
37 

38 
(*Should be a type abbreviation?*) 

39 
type netpair = (int*(bool*thm)) Net.net * (int*(bool*thm)) Net.net; 

40 

41 
signature BLAST_DATA = 

42 
sig 

43 
type claset 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

44 
val equality_name: string 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

45 
val not_name: string 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

46 
val notE : thm (* [ ~P; P ] ==> R *) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

47 
val ccontr : thm 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

48 
val contr_tac : int > tactic 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

49 
val dup_intr : thm > thm 
23908  50 
val hyp_subst_tac : bool > int > tactic 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

51 
val rep_cs : (* dependent on classical.ML *) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

52 
claset > {safeIs: thm list, safeEs: thm list, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

53 
hazIs: thm list, hazEs: thm list, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

54 
swrappers: (string * wrapper) list, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

55 
uwrappers: (string * wrapper) list, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

56 
safe0_netpair: netpair, safep_netpair: netpair, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

57 
haz_netpair: netpair, dup_netpair: netpair, xtra_netpair: ContextRules.netpair} 
30513  58 
val cla_modifiers: Method.modifier parser list 
7559  59 
val cla_meth': (claset > int > tactic) > thm list > Proof.context > Proof.method 
2854  60 
end; 
61 

62 

63 
signature BLAST = 

64 
sig 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

65 
type claset 
4233
85d004a96b98
Rationalized error handling: if lowlevel tactic (depth_tac) cannot accept the
paulson
parents:
4196
diff
changeset

66 
exception TRANS of string (*reports translation errors*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

67 
datatype term = 
18177  68 
Const of string * term list 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

69 
 Skolem of string * term option ref list 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

70 
 Free of string 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

71 
 Var of term option ref 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

72 
 Bound of int 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

73 
 Abs of string*term 
17795  74 
 $ of term*term; 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

75 
type branch 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

76 
val depth_tac : claset > int > int > tactic 
24112  77 
val depth_limit : int Config.T 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

78 
val blast_tac : claset > int > tactic 
18708  79 
val setup : theory > theory 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

80 
(*debugging tools*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

81 
val stats : bool ref 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

82 
val trace : bool ref 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

83 
val fullTrace : branch list list ref 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

84 
val fromType : (indexname * term) list ref > Term.typ > term 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

85 
val fromTerm : theory > Term.term > term 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

86 
val fromSubgoal : theory > Term.term > term 
4065  87 
val instVars : term > (unit > unit) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

88 
val toTerm : int > term > Term.term 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

89 
val readGoal : theory > string > term 
30609
983e8b6e4e69
Disposed old declarations, tactics, tactic combinators that refer to the simpset or claset of an implicit theory;
wenzelm
parents:
30558
diff
changeset

90 
val tryInThy : theory > claset > int > string > 
3083  91 
(int>tactic) list * branch list list * (int*int*exn) list 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

92 
val normBr : branch > branch 
2854  93 
end; 
94 

95 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

96 
functor BlastFun(Data: BLAST_DATA) : BLAST = 
2854  97 
struct 
98 

99 
type claset = Data.claset; 

100 

4323
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

101 
val trace = ref false 
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

102 
and stats = ref false; (*for runtime and search statistics*) 
2854  103 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

104 
datatype term = 
18177  105 
Const of string * term list (*typargs constantas a terms!*) 
2854  106 
 Skolem of string * term option ref list 
5343
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

107 
 Free of string 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

108 
 Var of term option ref 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

109 
 Bound of int 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

110 
 Abs of string*term 
5613  111 
 op $ of term*term; 
2854  112 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

113 
(*Pending formulae carry md (may duplicate) flags*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

114 
type branch = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

115 
{pairs: ((term*bool) list * (*safe formulae on this level*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

116 
(term*bool) list) list, (*haz formulae on this level*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

117 
lits: term list, (*literals: irreducible formulae*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

118 
vars: term option ref list, (*variables occurring in branch*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

119 
lim: int}; (*resource limit*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

120 

845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

121 

845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

122 
(* global state information *) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

123 

845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

124 
datatype state = State of 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

125 
{thy: theory, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

126 
fullTrace: branch list list ref, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

127 
trail: term option ref list ref, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

128 
ntrail: int ref, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

129 
nclosed: int ref, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

130 
ntried: int ref} 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

131 

845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

132 
fun reject_const thy c = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

133 
is_some (Sign.const_type thy c) andalso 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

134 
error ("blast: theory contains illegal constant " ^ quote c); 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

135 

845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

136 
fun initialize thy = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

137 
(reject_const thy "*Goal*"; 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

138 
reject_const thy "*False*"; 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

139 
State 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

140 
{thy = thy, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

141 
fullTrace = ref [], 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

142 
trail = ref [], 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

143 
ntrail = ref 0, 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

144 
nclosed = ref 0, (*branches closed: number of branches closed during the search*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

145 
ntried = ref 1}); (*branches tried: number of branches created by splitting (counting from 1)*) 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

146 

845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

147 

2854  148 

149 
(** Basic syntactic operations **) 

150 

151 
fun is_Var (Var _) = true 

152 
 is_Var _ = false; 

153 

154 
fun dest_Var (Var x) = x; 

155 

156 
fun rand (f$x) = x; 

157 

158 
(* maps (f, [t1,...,tn]) to f(t1,...,tn) *) 

15570  159 
val list_comb : term * term list > term = Library.foldl (op $); 
2854  160 

161 
(* maps f(t1,...,tn) to (f, [t1,...,tn]) ; naturally tailrecursive*) 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

162 
fun strip_comb u : term * term list = 
2854  163 
let fun stripc (f$t, ts) = stripc (f, t::ts) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

164 
 stripc x = x 
2854  165 
in stripc(u,[]) end; 
166 

167 
(* maps f(t1,...,tn) to f , which is never a combination *) 

168 
fun head_of (f$t) = head_of f 

169 
 head_of u = u; 

170 

171 

172 
(** Particular constants **) 

173 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

174 
fun negate P = Const (Data.not_name, []) $ P; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

175 

ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

176 
fun isNot (Const (c, _) $ _) = c = Data.not_name 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

177 
 isNot _ = false; 
2854  178 

18177  179 
fun mkGoal P = Const ("*Goal*", []) $ P; 
2854  180 

18177  181 
fun isGoal (Const ("*Goal*", _) $ _) = true 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

182 
 isGoal _ = false; 
2854  183 

18177  184 
val TruepropC = ObjectLogic.judgment_name (the_context ()); 
185 
val TruepropT = Sign.the_const_type (the_context ()) TruepropC; 

18171  186 

18177  187 
fun mk_Trueprop t = Term.$ (Term.Const (TruepropC, TruepropT), t); 
2854  188 

18177  189 
fun strip_Trueprop (tm as Const (c, _) $ t) = if c = TruepropC then t else tm 
190 
 strip_Trueprop tm = tm; 

191 

2854  192 

193 

4065  194 
(*** Dealing with overloaded constants ***) 
2854  195 

4065  196 
(*alist is a map from TVar names to Vars. We need to unify the TVars 
197 
faithfully in order to track overloading*) 

18177  198 
fun fromType alist (Term.Type(a,Ts)) = list_comb (Const (a, []), map (fromType alist) Ts) 
4065  199 
 fromType alist (Term.TFree(a,_)) = Free a 
200 
 fromType alist (Term.TVar (ixn,_)) = 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

201 
(case (AList.lookup (op =) (!alist) ixn) of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

202 
NONE => let val t' = Var(ref NONE) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

203 
in alist := (ixn, t') :: !alist; t' 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

204 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

205 
 SOME v => v) 
2854  206 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

207 
fun fromConst thy alist (a, T) = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

208 
Const (a, map (fromType alist) (Sign.const_typargs thy (a, T))); 
2854  209 

210 

211 
(*Tests whether 2 terms are alphaconvertible; chases instantiations*) 

18177  212 
fun (Const (a, ts)) aconv (Const (b, us)) = a=b andalso aconvs (ts, us) 
2854  213 
 (Skolem (a,_)) aconv (Skolem (b,_)) = a=b (*arglists must then be equal*) 
214 
 (Free a) aconv (Free b) = a=b 

15531  215 
 (Var(ref(SOME t))) aconv u = t aconv u 
216 
 t aconv (Var(ref(SOME u))) = t aconv u 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

217 
 (Var v) aconv (Var w) = v=w (*both Vars are unassigned*) 
2854  218 
 (Bound i) aconv (Bound j) = i=j 
219 
 (Abs(_,t)) aconv (Abs(_,u)) = t aconv u 

220 
 (f$t) aconv (g$u) = (f aconv g) andalso (t aconv u) 

18177  221 
 _ aconv _ = false 
222 
and aconvs ([], []) = true 

223 
 aconvs (t :: ts, u :: us) = t aconv u andalso aconvs (ts, us) 

224 
 aconvs _ = false; 

2854  225 

226 

227 
fun mem_term (_, []) = false 

228 
 mem_term (t, t'::ts) = t aconv t' orelse mem_term(t,ts); 

229 

230 
fun ins_term(t,ts) = if mem_term(t,ts) then ts else t :: ts; 

231 

232 
fun mem_var (v: term option ref, []) = false 

233 
 mem_var (v, v'::vs) = v=v' orelse mem_var(v,vs); 

234 

235 
fun ins_var(v,vs) = if mem_var(v,vs) then vs else v :: vs; 

236 

237 

238 
(** Vars **) 

239 

240 
(*Accumulates the Vars in the term, suppressing duplicates*) 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

241 
fun add_term_vars (Skolem(a,args), vars) = add_vars_vars(args,vars) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

242 
 add_term_vars (Var (v as ref NONE), vars) = ins_var (v, vars) 
15531  243 
 add_term_vars (Var (ref (SOME u)), vars) = add_term_vars(u,vars) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

244 
 add_term_vars (Const (_,ts), vars) = add_terms_vars(ts,vars) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

245 
 add_term_vars (Abs (_,body), vars) = add_term_vars(body,vars) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

246 
 add_term_vars (f$t, vars) = add_term_vars (f, add_term_vars(t, vars)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

247 
 add_term_vars (_, vars) = vars 
2854  248 
(*Term list version. [The fold functionals are slow]*) 
249 
and add_terms_vars ([], vars) = vars 

250 
 add_terms_vars (t::ts, vars) = add_terms_vars (ts, add_term_vars(t,vars)) 

251 
(*Var list version.*) 

252 
and add_vars_vars ([], vars) = vars 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

253 
 add_vars_vars (ref (SOME u) :: vs, vars) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

254 
add_vars_vars (vs, add_term_vars(u,vars)) 
15531  255 
 add_vars_vars (v::vs, vars) = (*v must be a ref NONE*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

256 
add_vars_vars (vs, ins_var (v, vars)); 
2854  257 

258 

259 
(*Chase assignments in "vars"; return a list of unassigned variables*) 

260 
fun vars_in_vars vars = add_vars_vars(vars,[]); 

261 

262 

263 

264 
(*increment a term's nonlocal bound variables 

265 
inc is increment for bound variables 

266 
lev is level at which a bound variable is considered 'loose'*) 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

267 
fun incr_bv (inc, lev, u as Bound i) = if i>=lev then Bound(i+inc) else u 
2854  268 
 incr_bv (inc, lev, Abs(a,body)) = Abs(a, incr_bv(inc,lev+1,body)) 
269 
 incr_bv (inc, lev, f$t) = incr_bv(inc,lev,f) $ incr_bv(inc,lev,t) 

270 
 incr_bv (inc, lev, u) = u; 

271 

272 
fun incr_boundvars 0 t = t 

273 
 incr_boundvars inc t = incr_bv(inc,0,t); 

274 

275 

276 
(*Accumulate all 'loose' bound vars referring to level 'lev' or beyond. 

277 
(Bound 0) is loose at level 0 *) 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

278 
fun add_loose_bnos (Bound i, lev, js) = if i<lev then js 
20854  279 
else insert (op =) (i  lev) js 
2854  280 
 add_loose_bnos (Abs (_,t), lev, js) = add_loose_bnos (t, lev+1, js) 
281 
 add_loose_bnos (f$t, lev, js) = 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

282 
add_loose_bnos (f, lev, add_loose_bnos (t, lev, js)) 
2854  283 
 add_loose_bnos (_, _, js) = js; 
284 

285 
fun loose_bnos t = add_loose_bnos (t, 0, []); 

286 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

287 
fun subst_bound (arg, t) : term = 
2854  288 
let fun subst (t as Bound i, lev) = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

289 
if i<lev then t (*var is locally bound*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

290 
else if i=lev then incr_boundvars lev arg 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

291 
else Bound(i1) (*loose: change it*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

292 
 subst (Abs(a,body), lev) = Abs(a, subst(body,lev+1)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

293 
 subst (f$t, lev) = subst(f,lev) $ subst(t,lev) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

294 
 subst (t,lev) = t 
2854  295 
in subst (t,0) end; 
296 

297 

3101
e8a92f497295
Again "norm" DOES NOT normalize bodies of abstractions
paulson
parents:
3092
diff
changeset

298 
(*Normalize...but not the bodies of ABSTRACTIONS*) 
2854  299 
fun norm t = case t of 
2952  300 
Skolem (a,args) => Skolem(a, vars_in_vars args) 
18177  301 
 Const(a,ts) => Const(a, map norm ts) 
15531  302 
 (Var (ref NONE)) => t 
303 
 (Var (ref (SOME u))) => norm u 

2854  304 
 (f $ u) => (case norm f of 
3101
e8a92f497295
Again "norm" DOES NOT normalize bodies of abstractions
paulson
parents:
3092
diff
changeset

305 
Abs(_,body) => norm (subst_bound (u, body)) 
e8a92f497295
Again "norm" DOES NOT normalize bodies of abstractions
paulson
parents:
3092
diff
changeset

306 
 nf => nf $ norm u) 
2854  307 
 _ => t; 
308 

309 

310 
(*Weak (onelevel) normalize for use in unification*) 

311 
fun wkNormAux t = case t of 

312 
(Var v) => (case !v of 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

313 
SOME u => wkNorm u 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

314 
 NONE => t) 
2854  315 
 (f $ u) => (case wkNormAux f of 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

316 
Abs(_,body) => wkNorm (subst_bound (u, body)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

317 
 nf => nf $ u) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

318 
 Abs (a,body) => (*etacontract if possible*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

319 
(case wkNormAux body of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

320 
nb as (f $ t) => 
20664  321 
if member (op =) (loose_bnos f) 0 orelse wkNorm t <> Bound 0 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

322 
then Abs(a,nb) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

323 
else wkNorm (incr_boundvars ~1 f) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

324 
 nb => Abs (a,nb)) 
2854  325 
 _ => t 
326 
and wkNorm t = case head_of t of 

327 
Const _ => t 

328 
 Skolem(a,args) => t 

329 
 Free _ => t 

330 
 _ => wkNormAux t; 

331 

332 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

333 
(*Does variable v occur in u? For unification. 
5734
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

334 
Dangling bound vars are also forbidden.*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

335 
fun varOccur v = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

336 
let fun occL lev [] = false (*same as (exists occ), but faster*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

337 
 occL lev (u::us) = occ lev u orelse occL lev us 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

338 
and occ lev (Var w) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

339 
v=w orelse 
15531  340 
(case !w of NONE => false 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

341 
 SOME u => occ lev u) 
5734
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

342 
 occ lev (Skolem(_,args)) = occL lev (map Var args) 
18177  343 
(*ignore Const, since term variables can't occur in types (?) *) 
5734
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

344 
 occ lev (Bound i) = lev <= i 
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

345 
 occ lev (Abs(_,u)) = occ (lev+1) u 
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

346 
 occ lev (f$u) = occ lev u orelse occ lev f 
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

347 
 occ lev _ = false; 
bebd10cb7a8d
occurs check now handles Bound variables (for soundness)
paulson
parents:
5613
diff
changeset

348 
in occ 0 end; 
2854  349 

350 
exception UNIFY; 

351 

352 

353 
(*Restore the trail to some previous state: for backtracking*) 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

354 
fun clearTo (State {ntrail, trail, ...}) n = 
3083  355 
while !ntrail<>n do 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

356 
(hd(!trail) := NONE; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

357 
trail := tl (!trail); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

358 
ntrail := !ntrail  1); 
2854  359 

360 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

361 
(*Firstorder unification with bound variables. 
2854  362 
"vars" is a list of variables local to the rule and NOT to be put 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

363 
on the trail (no point in doing so) 
2854  364 
*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

365 
fun unify state (vars,t,u) = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

366 
let val State {ntrail, trail, ...} = state 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

367 
val n = !ntrail 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

368 
fun update (t as Var v, u) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

369 
if t aconv u then () 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

370 
else if varOccur v u then raise UNIFY 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

371 
else if mem_var(v, vars) then v := SOME u 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

372 
else (*avoid updating Vars in the branch if possible!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

373 
if is_Var u andalso mem_var(dest_Var u, vars) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

374 
then dest_Var u := SOME t 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

375 
else (v := SOME u; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

376 
trail := v :: !trail; ntrail := !ntrail + 1) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

377 
fun unifyAux (t,u) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

378 
case (wkNorm t, wkNorm u) of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

379 
(nt as Var v, nu) => update(nt,nu) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

380 
 (nu, nt as Var v) => update(nt,nu) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

381 
 (Const(a,ats), Const(b,bts)) => if a=b then unifysAux(ats,bts) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

382 
else raise UNIFY 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

383 
 (Abs(_,t'), Abs(_,u')) => unifyAux(t',u') 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

384 
(*NB: can yield unifiers having dangling Bound vars!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

385 
 (f$t', g$u') => (unifyAux(f,g); unifyAux(t',u')) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

386 
 (nt, nu) => if nt aconv nu then () else raise UNIFY 
18177  387 
and unifysAux ([], []) = () 
388 
 unifysAux (t :: ts, u :: us) = (unifyAux (t, u); unifysAux (ts, us)) 

389 
 unifysAux _ = raise UNIFY; 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

390 
in (unifyAux(t,u); true) handle UNIFY => (clearTo state n; false) 
2854  391 
end; 
392 

393 

16774
515b6020cf5d
experimental code to reduce the amount of type information in blast
paulson
parents:
15786
diff
changeset

394 
(*Convert from "real" terms to prototerms; etacontract. 
515b6020cf5d
experimental code to reduce the amount of type information in blast
paulson
parents:
15786
diff
changeset

395 
Code is similar to fromSubgoal.*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

396 
fun fromTerm thy t = 
4065  397 
let val alistVar = ref [] 
398 
and alistTVar = ref [] 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

399 
fun from (Term.Const aT) = fromConst thy alistTVar aT 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

400 
 from (Term.Free (a,_)) = Free a 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

401 
 from (Term.Bound i) = Bound i 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

402 
 from (Term.Var (ixn,T)) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

403 
(case (AList.lookup (op =) (!alistVar) ixn) of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

404 
NONE => let val t' = Var(ref NONE) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

405 
in alistVar := (ixn, t') :: !alistVar; t' 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

406 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

407 
 SOME v => v) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

408 
 from (Term.Abs (a,_,u)) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

409 
(case from u of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

410 
u' as (f $ Bound 0) => 
20664  411 
if member (op =) (loose_bnos f) 0 then Abs(a,u') 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

412 
else incr_boundvars ~1 f 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

413 
 u' => Abs(a,u')) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

414 
 from (Term.$ (f,u)) = from f $ from u 
2854  415 
in from t end; 
416 

4065  417 
(*A debugging function: replaces all Vars by dummy Frees for visual inspection 
418 
of whether they are distinct. Function revert undoes the assignments.*) 

419 
fun instVars t = 

12902  420 
let val name = ref "a" 
4065  421 
val updated = ref [] 
18177  422 
fun inst (Const(a,ts)) = List.app inst ts 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

423 
 inst (Var(v as ref NONE)) = (updated := v :: (!updated); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

424 
v := SOME (Free ("?" ^ !name)); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

425 
name := Symbol.bump_string (!name)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

426 
 inst (Abs(a,t)) = inst t 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

427 
 inst (f $ u) = (inst f; inst u) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

428 
 inst _ = () 
15570  429 
fun revert() = List.app (fn v => v:=NONE) (!updated) 
4065  430 
in inst t; revert end; 
431 

432 

2854  433 
(* A1==>...An==>B goes to [A1,...,An], where B is not an implication *) 
18177  434 
fun strip_imp_prems (Const ("==>", _) $ A $ B) = strip_Trueprop A :: strip_imp_prems B 
2854  435 
 strip_imp_prems _ = []; 
436 

437 
(* A1==>...An==>B goes to B, where B is not an implication *) 

18177  438 
fun strip_imp_concl (Const ("==>", _) $ A $ B) = strip_imp_concl B 
439 
 strip_imp_concl A = strip_Trueprop A; 

440 

2854  441 

442 

443 
(*** Conversion of Elimination Rules to Tableau Operations ***) 

444 

9170  445 
exception ElimBadConcl and ElimBadPrem; 
446 

447 
(*The conclusion becomes the goal/negated assumption *False*: delete it! 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

448 
If we don't find it then the premise is illformed and could cause 
9170  449 
PROOF FAILED*) 
450 
fun delete_concl [] = raise ElimBadPrem 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

451 
 delete_concl (P :: Ps) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

452 
(case P of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

453 
Const (c, _) $ Var (ref (SOME (Const ("*False*", _)))) => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

454 
if c = "*Goal*" orelse c = Data.not_name then Ps 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

455 
else P :: delete_concl Ps 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

456 
 _ => P :: delete_concl Ps); 
2854  457 

18177  458 
fun skoPrem vars (Const ("all", _) $ Abs (_, P)) = 
2854  459 
skoPrem vars (subst_bound (Skolem (gensym "S_", vars), P)) 
460 
 skoPrem vars P = P; 

461 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

462 
fun convertPrem t = 
9170  463 
delete_concl (mkGoal (strip_imp_concl t) :: strip_imp_prems t); 
2854  464 

465 
(*Expects elimination rules to have a formula variable as conclusion*) 

466 
fun convertRule vars t = 

467 
let val (P::Ps) = strip_imp_prems t 

468 
val Var v = strip_imp_concl t 

18177  469 
in v := SOME (Const ("*False*", [])); 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

470 
(P, map (convertPrem o skoPrem vars) Ps) 
9170  471 
end 
472 
handle Bind => raise ElimBadConcl; 

2854  473 

474 

475 
(*Like dup_elim, but puts the duplicated major premise FIRST*) 

31945  476 
fun rev_dup_elim th = (th RSN (2, revcut_rl)) > Thm.assumption 2 > Seq.hd; 
2854  477 

478 

4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

479 
(*Rotate the assumptions in all new subgoals for the LIFO discipline*) 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

480 
local 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

481 
(*Count new hyps so that they can be rotated*) 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

482 
fun nNewHyps [] = 0 
18177  483 
 nNewHyps (Const ("*Goal*", _) $ _ :: Ps) = nNewHyps Ps 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

484 
 nNewHyps (P::Ps) = 1 + nNewHyps Ps; 
2854  485 

5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

486 
fun rot_tac [] i st = Seq.single st 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

487 
 rot_tac (0::ks) i st = rot_tac ks (i+1) st 
31945  488 
 rot_tac (k::ks) i st = rot_tac ks (i+1) (Thm.rotate_rule (~k) i st); 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

489 
in 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

490 
fun rot_subgoals_tac (rot, rl) = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

491 
rot_tac (if rot then map nNewHyps rl else []) 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

492 
end; 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

493 

2854  494 

32091
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

495 
fun TRACE rl tac st i = 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

496 
if !trace then (writeln (Display.string_of_thm_without_context rl); tac st i) 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

497 
else tac st i; 
2854  498 

5343
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

499 
(*Resolution/matching tactics: if upd then the proof state may be updated. 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

500 
Matching makes the tactics more deterministic in the presence of Vars.*) 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

501 
fun emtac upd rl = TRACE rl (if upd then etac rl else ematch_tac [rl]); 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

502 
fun rmtac upd rl = TRACE rl (if upd then rtac rl else match_tac [rl]); 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

503 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

504 
(*Tableau rule from elimination rule. 
5343
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

505 
Flag "upd" says that the inference updated the branch. 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

506 
Flag "dup" requests duplication of the affected formula.*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

507 
fun fromRule thy vars rl = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

508 
let val trl = rl > Thm.prop_of > fromTerm thy > convertRule vars 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

509 
fun tac (upd, dup,rot) i = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

510 
emtac upd (if dup then rev_dup_elim rl else rl) i 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

511 
THEN 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

512 
rot_subgoals_tac (rot, #2 trl) i 
3244
71b760618f30
Basis library version of type "option" now resides in its own structure Option
paulson
parents:
3101
diff
changeset

513 
in Option.SOME (trl, tac) end 
32091
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

514 
handle 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

515 
ElimBadPrem => (*reject: prems don't preserve conclusion*) 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

516 
(warning ("Ignoring weak elimination rule\n" ^ Display.string_of_thm_global thy rl); 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

517 
Option.NONE) 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

518 
 ElimBadConcl => (*ignore: conclusion is not just a variable*) 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

519 
(if !trace then 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

520 
(warning ("Ignoring illformed elimination rule:\n" ^ 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

521 
"conclusion should be a variable\n" ^ Display.string_of_thm_global thy rl)) 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

522 
else (); 
30e2ffbba718
proper context for Display.pretty_thm etc. or oldstyle versions Display.pretty_thm_global, Display.pretty_thm_without_context etc.;
wenzelm
parents:
31945
diff
changeset

523 
Option.NONE); 
2854  524 

525 

3101
e8a92f497295
Again "norm" DOES NOT normalize bodies of abstractions
paulson
parents:
3092
diff
changeset

526 
(*** Conversion of Introduction Rules ***) 
2854  527 

528 
fun convertIntrPrem t = mkGoal (strip_imp_concl t) :: strip_imp_prems t; 

529 

530 
fun convertIntrRule vars t = 

531 
let val Ps = strip_imp_prems t 

532 
val P = strip_imp_concl t 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

533 
in (mkGoal P, map (convertIntrPrem o skoPrem vars) Ps) 
2854  534 
end; 
535 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

536 
(*Tableau rule from introduction rule. 
5343
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

537 
Flag "upd" says that the inference updated the branch. 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

538 
Flag "dup" requests duplication of the affected formula. 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

539 
Since haz rules are now delayed, "dup" is always FALSE for 
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

540 
introduction rules.*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

541 
fun fromIntrRule thy vars rl = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

542 
let val trl = rl > Thm.prop_of > fromTerm thy > convertIntrRule vars 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

543 
fun tac (upd,dup,rot) i = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

544 
rmtac upd (if dup then Data.dup_intr rl else rl) i 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

545 
THEN 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

546 
rot_subgoals_tac (rot, #2 trl) i 
2854  547 
in (trl, tac) end; 
548 

549 

3030  550 
val dummyVar = Term.Var (("etc",0), dummyT); 
2854  551 

552 
(*Convert from prototerms to ordinary terms with dummy types 

2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

553 
Ignore abstractions; identify all Vars; STOP at given depth*) 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

554 
fun toTerm 0 _ = dummyVar 
18177  555 
 toTerm d (Const(a,_)) = Term.Const (a,dummyT) (*no need to convert typargs*) 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

556 
 toTerm d (Skolem(a,_)) = Term.Const (a,dummyT) 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

557 
 toTerm d (Free a) = Term.Free (a,dummyT) 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

558 
 toTerm d (Bound i) = Term.Bound i 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

559 
 toTerm d (Var _) = dummyVar 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

560 
 toTerm d (Abs(a,_)) = dummyVar 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

561 
 toTerm d (f $ u) = Term.$ (toTerm d f, toTerm (d1) u); 
2854  562 

563 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

564 
fun netMkRules thy P vars (nps: netpair list) = 
2854  565 
case P of 
18177  566 
(Const ("*Goal*", _) $ G) => 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

567 
let val pG = mk_Trueprop (toTerm 2 G) 
19482
9f11af8f7ef9
tuned basic list operators (flat, maps, map_filter);
wenzelm
parents:
19037
diff
changeset

568 
val intrs = maps (fn (inet,_) => Net.unify_term inet pG) nps 
30558
2ef9892114fd
renamed Tactic.taglist/untaglist/orderlist to tag_list/untag_list/order_list (in library.ML);
wenzelm
parents:
30541
diff
changeset

569 
in map (fromIntrRule thy vars o #2) (order_list intrs) end 
2854  570 
 _ => 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

571 
let val pP = mk_Trueprop (toTerm 3 P) 
19482
9f11af8f7ef9
tuned basic list operators (flat, maps, map_filter);
wenzelm
parents:
19037
diff
changeset

572 
val elims = maps (fn (_,enet) => Net.unify_term enet pP) nps 
30558
2ef9892114fd
renamed Tactic.taglist/untaglist/orderlist to tag_list/untag_list/order_list (in library.ML);
wenzelm
parents:
30541
diff
changeset

573 
in map_filter (fromRule thy vars o #2) (order_list elims) end; 
3092  574 

575 

576 
(*Normalize a branchfor tracing*) 

577 
fun norm2 (G,md) = (norm G, md); 

578 

579 
fun normLev (Gs,Hs) = (map norm2 Gs, map norm2 Hs); 

580 

5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

581 
fun normBr {pairs, lits, vars, lim} = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

582 
{pairs = map normLev pairs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

583 
lits = map norm lits, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

584 
vars = vars, 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

585 
lim = lim}; 
3092  586 

587 

4065  588 
val dummyTVar = Term.TVar(("a",0), []); 
3092  589 
val dummyVar2 = Term.Var(("var",0), dummyT); 
590 

26938  591 
(*convert blast_tac's type representation to real types for tracing*) 
4065  592 
fun showType (Free a) = Term.TFree (a,[]) 
593 
 showType (Var _) = dummyTVar 

594 
 showType t = 

595 
(case strip_comb t of 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

596 
(Const (a, _), us) => Term.Type(a, map showType us) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

597 
 _ => dummyT); 
4065  598 

599 
(*Display toplevel overloading if any*) 

18177  600 
fun topType thy (Const (c, ts)) = SOME (Sign.const_instance thy (c, map showType ts)) 
601 
 topType thy (Abs(a,t)) = topType thy t 

602 
 topType thy (f $ u) = (case topType thy f of NONE => topType thy u  some => some) 

603 
 topType _ _ = NONE; 

4065  604 

605 

3092  606 
(*Convert from prototerms to ordinary terms with dummy types for tracing*) 
18177  607 
fun showTerm d (Const (a,_)) = Term.Const (a,dummyT) 
3092  608 
 showTerm d (Skolem(a,_)) = Term.Const (a,dummyT) 
609 
 showTerm d (Free a) = Term.Free (a,dummyT) 

610 
 showTerm d (Bound i) = Term.Bound i 

15531  611 
 showTerm d (Var(ref(SOME u))) = showTerm d u 
612 
 showTerm d (Var(ref NONE)) = dummyVar2 

3092  613 
 showTerm d (Abs(a,t)) = if d=0 then dummyVar 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

614 
else Term.Abs(a, dummyT, showTerm (d1) t) 
3092  615 
 showTerm d (f $ u) = if d=0 then dummyVar 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

616 
else Term.$ (showTerm d f, showTerm (d1) u); 
3092  617 

26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26938
diff
changeset

618 
fun string_of thy d t = Syntax.string_of_term_global thy (showTerm d t); 
3092  619 

19037  620 
(*Convert a Goal to an ordinary Not. Used also in dup_intr, where a goal like 
621 
Ex(P) is duplicated as the assumption ~Ex(P). *) 

622 
fun negOfGoal (Const ("*Goal*", _) $ G) = negate G 

623 
 negOfGoal G = G; 

624 

625 
fun negOfGoal2 (G,md) = (negOfGoal G, md); 

626 

627 
(*Converts all Goals to Nots in the safe parts of a branch. They could 

628 
have been moved there from the literals list after substitution (equalSubst). 

629 
There can be at most onethis function could be made more efficient.*) 

630 
fun negOfGoals pairs = map (fn (Gs,haz) => (map negOfGoal2 Gs, haz)) pairs; 

631 

632 
(*Tactic. Convert *Goal* to negated assumption in FIRST position*) 

633 
fun negOfGoal_tac i = TRACE Data.ccontr (rtac Data.ccontr) i THEN 

634 
rotate_tac ~1 i; 

635 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

636 
fun traceTerm thy t = 
19037  637 
let val t' = norm (negOfGoal t) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

638 
val stm = string_of thy 8 t' 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

639 
in 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

640 
case topType thy t' of 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

641 
NONE => stm (*no type to attach*) 
26939
1035c89b4c02
moved global pretty/string_of functions from Sign to Syntax;
wenzelm
parents:
26938
diff
changeset

642 
 SOME T => stm ^ "\t:: " ^ Syntax.string_of_typ_global thy T 
4065  643 
end; 
3092  644 

645 

646 
(*Print tracing information at each iteration of prover*) 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

647 
fun tracing (State {thy, fullTrace, ...}) brs = 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

648 
let fun printPairs (((G,_)::_,_)::_) = Output.tracing (traceTerm thy G) 
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

649 
 printPairs (([],(H,_)::_)::_) = Output.tracing (traceTerm thy H ^ "\t (Unsafe)") 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

650 
 printPairs _ = () 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

651 
fun printBrs (brs0 as {pairs, lits, lim, ...} :: brs) = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

652 
(fullTrace := brs0 :: !fullTrace; 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

653 
List.app (fn _ => Output.tracing "+") brs; 
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

654 
Output.tracing (" [" ^ Int.toString lim ^ "] "); 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

655 
printPairs pairs; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

656 
writeln"") 
3092  657 
in if !trace then printBrs (map normBr brs) else () 
658 
end; 

659 

5343
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

660 
fun traceMsg s = if !trace then writeln s else (); 
4065  661 

3092  662 
(*Tracing: variables updated in the last branch operation?*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

663 
fun traceVars (State {thy, ntrail, trail, ...}) ntrl = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

664 
if !trace then 
4065  665 
(case !ntrailntrl of 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

666 
0 => () 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

667 
 1 => Output.tracing "\t1 variable UPDATED:" 
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

668 
 n => Output.tracing ("\t" ^ Int.toString n ^ " variables UPDATED:"); 
4065  669 
(*display the instantiations themselves, though no variable names*) 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

670 
List.app (fn v => Output.tracing (" " ^ string_of thy 4 (the (!v)))) 
4065  671 
(List.take(!trail, !ntrailntrl)); 
672 
writeln"") 

3092  673 
else (); 
674 

675 
(*Tracing: how many new branches are created?*) 

676 
fun traceNew prems = 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

677 
if !trace then 
3092  678 
case length prems of 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

679 
0 => Output.tracing "branch closed by rule" 
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

680 
 1 => Output.tracing "branch extended (1 new subgoal)" 
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

681 
 n => Output.tracing ("branch split: "^ Int.toString n ^ " new subgoals") 
3092  682 
else (); 
683 

684 

685 

2854  686 
(*** Code for handling equality: naive substitution, like hyp_subst_tac ***) 
687 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

688 
(*Replace the ATOMIC term "old" by "new" in t*) 
2854  689 
fun subst_atomic (old,new) t = 
15531  690 
let fun subst (Var(ref(SOME u))) = subst u 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

691 
 subst (Abs(a,body)) = Abs(a, subst body) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

692 
 subst (f$t) = subst f $ subst t 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

693 
 subst t = if t aconv old then new else t 
2854  694 
in subst t end; 
695 

696 
(*Etacontract a term from outside: just enough to reduce it to an atom*) 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

697 
fun eta_contract_atom (t0 as Abs(a, body)) = 
2854  698 
(case eta_contract2 body of 
20664  699 
f $ Bound 0 => if member (op =) (loose_bnos f) 0 then t0 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

700 
else eta_contract_atom (incr_boundvars ~1 f) 
2854  701 
 _ => t0) 
702 
 eta_contract_atom t = t 

703 
and eta_contract2 (f$t) = f $ eta_contract_atom t 

704 
 eta_contract2 t = eta_contract_atom t; 

705 

706 

707 
(*When can we safely delete the equality? 

708 
Not if it equates two constants; consider 0=1. 

709 
Not if it resembles x=t[x], since substitution does not eliminate x. 

710 
Not if it resembles ?x=0; another goal could instantiate ?x to Suc(i) 

711 
Prefer to eliminate Bound variables if possible. 

712 
Result: true = use as is, false = reorient first *) 

713 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

714 
(*Can t occur in u? For substitution. 
4354
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

715 
Does NOT examine the args of Skolem terms: substitution does not affect them. 
4196
9953c0995b79
Now applies "map negOfGoal" to lits when expanding haz rules.
paulson
parents:
4149
diff
changeset

716 
REFLEXIVE because hyp_subst_tac fails on x=x.*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

717 
fun substOccur t = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

718 
let (*NO vars are permitted in u except the arguments of t, if it is 
4354
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

719 
a Skolem term. This ensures that no equations are deleted that could 
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

720 
be instantiated to a cycle. For example, x=?a is rejected because ?a 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

721 
could be instantiated to Suc(x).*) 
4354
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

722 
val vars = case t of 
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

723 
Skolem(_,vars) => vars 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

724 
 _ => [] 
4354
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

725 
fun occEq u = (t aconv u) orelse occ u 
15531  726 
and occ (Var(ref(SOME u))) = occEq u 
4354
7f4da01bdf0e
Fixed the treatment of substitution for equations, restricting occurrences of
paulson
parents:
4323
diff
changeset

727 
 occ (Var v) = not (mem_var (v, vars)) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

728 
 occ (Abs(_,u)) = occEq u 
2854  729 
 occ (f$u) = occEq u orelse occEq f 
730 
 occ (_) = false; 

731 
in occEq end; 

732 

3092  733 
exception DEST_EQ; 
734 

18177  735 
(*Take apart an equality. NO constant Trueprop*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

736 
fun dest_eq (Const (c, _) $ t $ u) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

737 
if c = Data.equality_name then (eta_contract_atom t, eta_contract_atom u) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

738 
else raise DEST_EQ 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

739 
 dest_eq _ = raise DEST_EQ; 
3092  740 

4196
9953c0995b79
Now applies "map negOfGoal" to lits when expanding haz rules.
paulson
parents:
4149
diff
changeset

741 
(*Reject the equality if u occurs in (or equals!) t*) 
2854  742 
fun check (t,u,v) = if substOccur t u then raise DEST_EQ else v; 
743 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

744 
(*IF the goal is an equality with a substitutable variable 
2854  745 
THEN orient that equality ELSE raise exception DEST_EQ*) 
3092  746 
fun orientGoal (t,u) = case (t,u) of 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

747 
(Skolem _, _) => check(t,u,(t,u)) (*eliminates t*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

748 
 (_, Skolem _) => check(u,t,(u,t)) (*eliminates u*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

749 
 (Free _, _) => check(t,u,(t,u)) (*eliminates t*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

750 
 (_, Free _) => check(u,t,(u,t)) (*eliminates u*) 
2854  751 
 _ => raise DEST_EQ; 
752 

2894  753 
(*Substitute through the branch if an equality goal (else raise DEST_EQ). 
754 
Moves affected literals back into the branch, but it is not clear where 

4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

755 
they should go: this could make proofs fail.*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

756 
fun equalSubst thy (G, {pairs, lits, vars, lim}) = 
3092  757 
let val (t,u) = orientGoal(dest_eq G) 
758 
val subst = subst_atomic (t,u) 

2854  759 
fun subst2(G,md) = (subst G, md) 
4466
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

760 
(*substitute throughout list; extract affected formulae*) 
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

761 
fun subForm ((G,md), (changed, pairs)) = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

762 
let val nG = subst G 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

763 
in if nG aconv G then (changed, (G,md)::pairs) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

764 
else ((nG,md)::changed, pairs) 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

765 
end 
4466
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

766 
(*substitute throughout "stack frame"; extract affected formulae*) 
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

767 
fun subFrame ((Gs,Hs), (changed, frames)) = 
30190  768 
let val (changed', Gs') = List.foldr subForm (changed, []) Gs 
769 
val (changed'', Hs') = List.foldr subForm (changed', []) Hs 

4466
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

770 
in (changed'', (Gs',Hs')::frames) end 
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

771 
(*substitute throughout literals; extract affected ones*) 
305390f23734
Better equality handling in Blast_tac, usingd a new variant of hyp_subst_tac
paulson
parents:
4391
diff
changeset

772 
fun subLit (lit, (changed, nlits)) = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

773 
let val nlit = subst lit 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

774 
in if nlit aconv lit then (changed, nlit::nlits) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

775 
else ((nlit,true)::changed, nlits) 
2854  776 
end 
30190  777 
val (changed, lits') = List.foldr subLit ([], []) lits 
778 
val (changed', pairs') = List.foldr subFrame (changed, []) pairs 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

779 
in if !trace then writeln ("Substituting " ^ traceTerm thy u ^ 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

780 
" for " ^ traceTerm thy t ^ " in branch" ) 
3092  781 
else (); 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

782 
{pairs = (changed',[])::pairs', (*affected formulas, and others*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

783 
lits = lits', (*unaffected literals*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

784 
vars = vars, 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

785 
lim = lim} 
2854  786 
end; 
787 

788 

789 
exception NEWBRANCHES and CLOSEF; 

790 

791 
exception PROVE; 

792 

4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

793 
(*Trying eq_contr_tac first INCREASES the effort, slowing reconstruction*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

794 
val contr_tac = ematch_tac [Data.notE] THEN' 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

795 
(eq_assume_tac ORELSE' assume_tac); 
2854  796 

4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

797 
val eContr_tac = TRACE Data.notE contr_tac; 
2854  798 
val eAssume_tac = TRACE asm_rl (eq_assume_tac ORELSE' assume_tac); 
799 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

800 
(*Try to unify complementary literals and return the corresponding tactic. *) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

801 
fun tryClose state (G, L) = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

802 
let 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

803 
fun close t u tac = if unify state ([], t, u) then SOME tac else NONE; 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

804 
fun arg (_ $ t) = t; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

805 
in 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

806 
if isGoal G then close (arg G) L eAssume_tac 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

807 
else if isGoal L then close G (arg L) eAssume_tac 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

808 
else if isNot G then close (arg G) L eContr_tac 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

809 
else if isNot L then close G (arg L) eContr_tac 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

810 
else NONE 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

811 
end; 
2854  812 

813 
(*Were there Skolem terms in the premise? Must NOT chase Vars*) 

814 
fun hasSkolem (Skolem _) = true 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

815 
 hasSkolem (Abs (_,body)) = hasSkolem body 
2854  816 
 hasSkolem (f$t) = hasSkolem f orelse hasSkolem t 
817 
 hasSkolem _ = false; 

818 

819 
(*Attach the right "may duplicate" flag to new formulae: if they contain 

820 
Skolem terms then allow duplication.*) 

821 
fun joinMd md [] = [] 

822 
 joinMd md (G::Gs) = (G, hasSkolem G orelse md) :: joinMd md Gs; 

823 

824 

825 
(** Backtracking and Pruning **) 

826 

827 
(*clashVar vars (n,trail) determines whether any of the last n elements 

828 
of "trail" occur in "vars" OR in their instantiations*) 

829 
fun clashVar [] = (fn _ => false) 

830 
 clashVar vars = 

831 
let fun clash (0, _) = false 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

832 
 clash (_, []) = false 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

833 
 clash (n, v::vs) = exists (varOccur v) vars orelse clash(n1,vs) 
2854  834 
in clash end; 
835 

836 

837 
(*nbrs = # of branches just prior to closing this one. Delete choice points 

838 
for goals proved by the latest inference, provided NO variables in the 

839 
next branch have been updated.*) 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

840 
fun prune _ (1, nxtVars, choices) = choices (*DON'T prune at very end: allow 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

841 
backtracking over bad proofs*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

842 
 prune (State {ntrail, trail, ...}) (nbrs: int, nxtVars, choices) = 
2854  843 
let fun traceIt last = 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

844 
let val ll = length last 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

845 
and lc = length choices 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

846 
in if !trace andalso ll<lc then 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

847 
(writeln("Pruning " ^ Int.toString(lcll) ^ " levels"); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

848 
last) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

849 
else last 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

850 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

851 
fun pruneAux (last, _, _, []) = last 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

852 
 pruneAux (last, ntrl, trl, (ntrl',nbrs',exn) :: choices) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

853 
if nbrs' < nbrs 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

854 
then last (*don't backtrack beyond first solution of goal*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

855 
else if nbrs' > nbrs then pruneAux (last, ntrl, trl, choices) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

856 
else (* nbrs'=nbrs *) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

857 
if clashVar nxtVars (ntrlntrl', trl) then last 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

858 
else (*no clashes: can go back at least this far!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

859 
pruneAux(choices, ntrl', List.drop(trl, ntrlntrl'), 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

860 
choices) 
2854  861 
in traceIt (pruneAux (choices, !ntrail, !trail, choices)) end; 
862 

5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

863 
fun nextVars ({pairs, lits, vars, lim} :: _) = map Var vars 
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

864 
 nextVars [] = []; 
2854  865 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

866 
fun backtrack (choices as (ntrl, nbrs, exn)::_) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

867 
(if !trace then (writeln ("Backtracking; now there are " ^ 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

868 
Int.toString nbrs ^ " branches")) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

869 
else (); 
3083  870 
raise exn) 
871 
 backtrack _ = raise PROVE; 

2854  872 

2894  873 
(*Add the literal G, handling *Goal* and detecting duplicates.*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

874 
fun addLit (Const ("*Goal*", _) $ G, lits) = 
2894  875 
(*New literal is a *Goal*, so change all other Goals to Nots*) 
18177  876 
let fun bad (Const ("*Goal*", _) $ _) = true 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

877 
 bad (Const (c, _) $ G') = c = Data.not_name andalso G aconv G' 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

878 
 bad _ = false; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

879 
fun change [] = [] 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

880 
 change (lit :: lits) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

881 
(case lit of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

882 
Const (c, _) $ G' => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

883 
if c = "*Goal*" orelse c = Data.not_name then 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

884 
if G aconv G' then change lits 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

885 
else negate G' :: change lits 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

886 
else lit :: change lits 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

887 
 _ => lit :: change lits) 
2854  888 
in 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

889 
Const ("*Goal*", []) $ G :: (if exists bad lits then change lits else lits) 
2854  890 
end 
891 
 addLit (G,lits) = ins_term(G, lits) 

892 

893 

2952  894 
(*For calculating the "penalty" to assess on a branching factor of n 
895 
log2 seems a little too severe*) 

3083  896 
fun log n = if n<4 then 0 else 1 + log(n div 4); 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

897 

af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

898 

3021
39806db47be9
Loop detection: before expanding a haz formula, see whether it is a duplicate
paulson
parents:
2999
diff
changeset

899 
(*match(t,u) says whether the term u might be an instance of the pattern t 
39806db47be9
Loop detection: before expanding a haz formula, see whether it is a duplicate
paulson
parents:
2999
diff
changeset

900 
Used to detect "recursive" rules such as transitivity*) 
39806db47be9
Loop detection: before expanding a haz formula, see whether it is a duplicate
paulson
parents:
2999
diff
changeset

901 
fun match (Var _) u = true 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

902 
 match (Const (a,tas)) (Const (b,tbs)) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

903 
a = "*Goal*" andalso b = Data.not_name orelse 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

904 
a = Data.not_name andalso b = "*Goal*" orelse 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

905 
a = b andalso matchs tas tbs 
4065  906 
 match (Free a) (Free b) = (a=b) 
907 
 match (Bound i) (Bound j) = (i=j) 

908 
 match (Abs(_,t)) (Abs(_,u)) = match t u 

909 
 match (f$t) (g$u) = match f g andalso match t u 

18177  910 
 match t u = false 
911 
and matchs [] [] = true 

912 
 matchs (t :: ts) (u :: us) = match t u andalso matchs ts us; 

3021
39806db47be9
Loop detection: before expanding a haz formula, see whether it is a duplicate
paulson
parents:
2999
diff
changeset

913 

39806db47be9
Loop detection: before expanding a haz formula, see whether it is a duplicate
paulson
parents:
2999
diff
changeset

914 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

915 
fun printStats (State {ntried, nclosed, ...}) (b, start, tacs) = 
4323
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

916 
if b then 
30187
b92b3375e919
end_timing: generalized result  message plus with explicit time values;
wenzelm
parents:
27809
diff
changeset

917 
writeln (#message (end_timing start) ^ " for search. Closed: " 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

918 
^ Int.toString (!nclosed) ^ 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

919 
" tried: " ^ Int.toString (!ntried) ^ 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

920 
" tactics: " ^ Int.toString (length tacs)) 
4323
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

921 
else (); 
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

922 

561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

923 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

924 
(*Tableau prover based on leanTaP. Argument is a list of branches. Each 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

925 
branch contains a list of unexpanded formulae, a list of literals, and a 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

926 
bound on unsafe expansions. 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

927 
"start" is CPU time at start, for printing search time 
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

928 
*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

929 
fun prove (state, start, cs, brs, cont) = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

930 
let val State {thy, ntrail, nclosed, ntried, ...} = state; 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

931 
val {safe0_netpair, safep_netpair, haz_netpair, ...} = Data.rep_cs cs 
2854  932 
val safeList = [safe0_netpair, safep_netpair] 
933 
and hazList = [haz_netpair] 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

934 
fun prv (tacs, trs, choices, []) = 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

935 
(printStats state (!trace orelse !stats, start, tacs); 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

936 
cont (tacs, trs, choices)) (*all branches closed!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

937 
 prv (tacs, trs, choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

938 
brs0 as {pairs = ((G,md)::br, haz)::pairs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

939 
lits, vars, lim} :: brs) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

940 
(*apply a safe rule only (possibly allowing instantiation); 
3917  941 
defer any haz formulae*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

942 
let exception PRV (*backtrack to precisely this recursion!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

943 
val ntrl = !ntrail 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

944 
val nbrs = length brs0 
2854  945 
val nxtVars = nextVars brs 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

946 
val G = norm G 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

947 
val rules = netMkRules thy G vars safeList 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

948 
(*Make a new branch, decrementing "lim" if instantiations occur*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

949 
fun newBr (vars',lim') prems = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

950 
map (fn prem => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

951 
if (exists isGoal prem) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

952 
then {pairs = ((joinMd md prem, []) :: 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

953 
negOfGoals ((br, haz)::pairs)), 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

954 
lits = map negOfGoal lits, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

955 
vars = vars', 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

956 
lim = lim'} 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

957 
else {pairs = ((joinMd md prem, []) :: 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

958 
(br, haz) :: pairs), 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

959 
lits = lits, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

960 
vars = vars', 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

961 
lim = lim'}) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

962 
prems @ 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

963 
brs 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

964 
(*Seek a matching rule. If unifiable then add new premises 
2854  965 
to branch.*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

966 
fun deeper [] = raise NEWBRANCHES 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

967 
 deeper (((P,prems),tac)::grls) = 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

968 
if unify state (add_term_vars(P,[]), P, G) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

969 
then (*P comes from the rule; G comes from the branch.*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

970 
let val updated = ntrl < !ntrail (*branch updated*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

971 
val lim' = if updated 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

972 
then lim  (1+log(length rules)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

973 
else lim (*discourage branching updates*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

974 
val vars = vars_in_vars vars 
30190  975 
val vars' = List.foldr add_terms_vars vars prems 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

976 
val choices' = (ntrl, nbrs, PRV) :: choices 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

977 
val tacs' = (tac(updated,false,true)) 
5343
871b77df79a0
new version, more resistant to PROOF FAILED. Now it distinguishes between
paulson
parents:
4653
diff
changeset

978 
:: tacs (*no duplication; rotate*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

979 
in 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

980 
traceNew prems; traceVars state ntrl; 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

981 
(if null prems then (*closed the branch: prune!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

982 
(nclosed := !nclosed + 1; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

983 
prv(tacs', brs0::trs, 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

984 
prune state (nbrs, nxtVars, choices'), 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

985 
brs)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

986 
else (*prems nonnull*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

987 
if lim'<0 (*faster to kill ALL the alternatives*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

988 
then (traceMsg"Excessive branching: KILLED"; 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

989 
clearTo state ntrl; raise NEWBRANCHES) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

990 
else 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

991 
(ntried := !ntried + length prems  1; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

992 
prv(tacs', brs0::trs, choices', 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

993 
newBr (vars',lim') prems))) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

994 
handle PRV => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

995 
if updated then 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

996 
(*Backtrack at this level. 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

997 
Reset Vars and try another rule*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

998 
(clearTo state ntrl; deeper grls) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

999 
else (*backtrack to previous level*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1000 
backtrack choices 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1001 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1002 
else deeper grls 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1003 
(*Try to close branch by unifying with head goal*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1004 
fun closeF [] = raise CLOSEF 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1005 
 closeF (L::Ls) = 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1006 
case tryClose state (G,L) of 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1007 
NONE => closeF Ls 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1008 
 SOME tac => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1009 
let val choices' = 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

1010 
(if !trace then (Output.tracing "branch closed"; 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1011 
traceVars state ntrl) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1012 
else (); 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1013 
prune state (nbrs, nxtVars, 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1014 
(ntrl, nbrs, PRV) :: choices)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1015 
in nclosed := !nclosed + 1; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1016 
prv (tac::tacs, brs0::trs, choices', brs) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1017 
handle PRV => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1018 
(*reset Vars and try another literal 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1019 
[this handler is pruned if possible!]*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1020 
(clearTo state ntrl; closeF Ls) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1021 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1022 
(*Try to unify a queued formula (safe or haz) with head goal*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1023 
fun closeFl [] = raise CLOSEF 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1024 
 closeFl ((br, haz)::pairs) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1025 
closeF (map fst br) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1026 
handle CLOSEF => closeF (map fst haz) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1027 
handle CLOSEF => closeFl pairs 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1028 
in tracing state brs0; 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1029 
if lim<0 then (traceMsg "Limit reached. "; backtrack choices) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1030 
else 
23908  1031 
prv (Data.hyp_subst_tac (!trace) :: tacs, 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1032 
brs0::trs, choices, 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1033 
equalSubst thy 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1034 
(G, {pairs = (br,haz)::pairs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1035 
lits = lits, vars = vars, lim = lim}) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1036 
:: brs) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1037 
handle DEST_EQ => closeF lits 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1038 
handle CLOSEF => closeFl ((br,haz)::pairs) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1039 
handle CLOSEF => deeper rules 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1040 
handle NEWBRANCHES => 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1041 
(case netMkRules thy G vars hazList of 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1042 
[] => (*there are no plausible haz rules*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1043 
(traceMsg "moving formula to literals"; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1044 
prv (tacs, brs0::trs, choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1045 
{pairs = (br,haz)::pairs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1046 
lits = addLit(G,lits), 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1047 
vars = vars, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1048 
lim = lim} :: brs)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1049 
 _ => (*G admits some haz rules: try later*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1050 
(traceMsg "moving formula to haz list"; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1051 
prv (if isGoal G then negOfGoal_tac :: tacs 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1052 
else tacs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1053 
brs0::trs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1054 
choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1055 
{pairs = (br, haz@[(negOfGoal G, md)])::pairs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1056 
lits = lits, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1057 
vars = vars, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1058 
lim = lim} :: brs))) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1059 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1060 
 prv (tacs, trs, choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1061 
{pairs = ([],haz)::(Gs,haz')::pairs, lits, vars, lim} :: brs) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1062 
(*no more "safe" formulae: transfer haz down a level*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1063 
prv (tacs, trs, choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1064 
{pairs = (Gs,haz@haz')::pairs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1065 
lits = lits, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1066 
vars = vars, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1067 
lim = lim} :: brs) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1068 
 prv (tacs, trs, choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1069 
brs0 as {pairs = [([], (H,md)::Hs)], 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1070 
lits, vars, lim} :: brs) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1071 
(*no safe steps possible at any level: apply a haz rule*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1072 
let exception PRV (*backtrack to precisely this recursion!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1073 
val H = norm H 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1074 
val ntrl = !ntrail 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1075 
val rules = netMkRules thy H vars hazList 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1076 
(*new premises of haz rules may NOT be duplicated*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1077 
fun newPrem (vars,P,dup,lim') prem = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1078 
let val Gs' = map (fn Q => (Q,false)) prem 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1079 
and Hs' = if dup then Hs @ [(negOfGoal H, md)] else Hs 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1080 
and lits' = if (exists isGoal prem) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1081 
then map negOfGoal lits 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1082 
else lits 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1083 
in {pairs = if exists (match P) prem then [(Gs',Hs')] 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1084 
(*Recursive in this premise. Don't make new 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1085 
"stack frame". New haz premises will end up 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1086 
at the BACK of the queue, preventing 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1087 
exclusion of others*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1088 
else [(Gs',[]), ([],Hs')], 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1089 
lits = lits', 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1090 
vars = vars, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1091 
lim = lim'} 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1092 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1093 
fun newBr x prems = map (newPrem x) prems @ brs 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1094 
(*Seek a matching rule. If unifiable then add new premises 
2854  1095 
to branch.*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1096 
fun deeper [] = raise NEWBRANCHES 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1097 
 deeper (((P,prems),tac)::grls) = 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1098 
if unify state (add_term_vars(P,[]), P, H) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1099 
then 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1100 
let val updated = ntrl < !ntrail (*branch updated*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1101 
val vars = vars_in_vars vars 
30190  1102 
val vars' = List.foldr add_terms_vars vars prems 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1103 
(*duplicate H if md permits*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1104 
val dup = md (*earlier had "andalso vars' <> vars": 
11152
32d002362005
Blast bug fix: now always duplicates when applying a haz rule,
paulson
parents:
11119
diff
changeset

1105 
duplicate only if the subgoal has new vars*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1106 
(*any instances of P in the subgoals? 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1107 
NB: boolean "recur" affects tracing only!*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1108 
and recur = exists (exists (match P)) prems 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1109 
val lim' = (*Decrement "lim" extra if updates occur*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1110 
if updated then lim  (1+log(length rules)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1111 
else lim1 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1112 
(*It is tempting to leave "lim" UNCHANGED if 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1113 
both dup and recur are false. Proofs are 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1114 
found at shallower depths, but looping 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1115 
occurs too often...*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1116 
val mayUndo = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1117 
(*Allowing backtracking from a rule application 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1118 
if other matching rules exist, if the rule 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1119 
updated variables, or if the rule did not 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1120 
introduce new variables. This latter condition 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1121 
means it is not a standard "gammarule" but 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1122 
some other form of unsafe rule. Aim is to 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1123 
emulate Fast_tac, which allows all unsafe steps 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1124 
to be undone.*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1125 
not(null grls) (*other rules to try?*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1126 
orelse updated 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1127 
orelse vars=vars' (*no new Vars?*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1128 
val tac' = tac(updated, dup, true) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1129 
(*if recur then perhaps shouldn't call rotate_tac: new 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1130 
formulae should be last, but that's WRONG if the new 
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1131 
formulae are Goals, since they remain in the first 
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1132 
position*) 
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1133 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1134 
in 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1135 
if lim'<0 andalso not (null prems) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1136 
then (*it's faster to kill ALL the alternatives*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1137 
(traceMsg"Excessive branching: KILLED"; 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1138 
clearTo state ntrl; raise NEWBRANCHES) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1139 
else 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1140 
traceNew prems; 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

1141 
if !trace andalso dup then Output.tracing " (duplicating)" 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1142 
else (); 
30320
5f859035331f
eliminated Output.immediate_output  violates the official message channel protocol;
wenzelm
parents:
30242
diff
changeset

1143 
if !trace andalso recur then Output.tracing " (recursive)" 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1144 
else (); 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1145 
traceVars state ntrl; 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1146 
if null prems then nclosed := !nclosed + 1 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1147 
else ntried := !ntried + length prems  1; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1148 
prv(tac' :: tacs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1149 
brs0::trs, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1150 
(ntrl, length brs0, PRV) :: choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1151 
newBr (vars', P, dup, lim') prems) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1152 
handle PRV => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1153 
if mayUndo 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1154 
then (*reset Vars and try another rule*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1155 
(clearTo state ntrl; deeper grls) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1156 
else (*backtrack to previous level*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1157 
backtrack choices 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1158 
end 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1159 
else deeper grls 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1160 
in tracing state brs0; 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1161 
if lim<1 then (traceMsg "Limit reached. "; backtrack choices) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1162 
else deeper rules 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1163 
handle NEWBRANCHES => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1164 
(*cannot close branch: move H to literals*) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1165 
prv (tacs, brs0::trs, choices, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1166 
{pairs = [([], Hs)], 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1167 
lits = H::lits, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1168 
vars = vars, 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1169 
lim = lim} :: brs) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1170 
end 
2854  1171 
 prv (tacs, trs, choices, _ :: brs) = backtrack choices 
12346  1172 
in prv ([], [], [(!ntrail, length brs, PROVE)], brs) end; 
2854  1173 

1174 

2883  1175 
(*Construct an initial branch.*) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1176 
fun initBranch (ts,lim) = 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1177 
{pairs = [(map (fn t => (t,true)) ts, [])], 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1178 
lits = [], 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1179 
vars = add_terms_vars (ts,[]), 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1180 
lim = lim}; 
2854  1181 

1182 

1183 
(*** Conversion & Skolemization of the Isabelle proof state ***) 

1184 

1185 
(*Make a list of all the parameters in a subgoal, even if nested*) 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1186 
local open Term 
2854  1187 
in 
1188 
fun discard_foralls (Const("all",_)$Abs(a,T,t)) = discard_foralls t 

1189 
 discard_foralls t = t; 

1190 
end; 

1191 

1192 
(*List of variables not appearing as arguments to the given parameter*) 

1193 
fun getVars [] i = [] 

20664  1194 
 getVars ((_,(v,is))::alist) (i: int) = 
1195 
if member (op =) is i then getVars alist i 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1196 
else v :: getVars alist i; 
2854  1197 

4233
85d004a96b98
Rationalized error handling: if lowlevel tactic (depth_tac) cannot accept the
paulson
parents:
4196
diff
changeset

1198 
exception TRANS of string; 
2854  1199 

4233
85d004a96b98
Rationalized error handling: if lowlevel tactic (depth_tac) cannot accept the
paulson
parents:
4196
diff
changeset

1200 
(*Translation of a subgoal: Skolemize all parameters*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1201 
fun fromSubgoal thy t = 
4065  1202 
let val alistVar = ref [] 
1203 
and alistTVar = ref [] 

2854  1204 
fun hdvar ((ix,(v,is))::_) = v 
1205 
fun from lev t = 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1206 
let val (ht,ts) = Term.strip_comb t 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1207 
fun apply u = list_comb (u, map (from lev) ts) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1208 
fun bounds [] = [] 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1209 
 bounds (Term.Bound i::ts) = 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1210 
if i<lev then raise TRANS 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1211 
"Function unknown's argument not a parameter" 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1212 
else ilev :: bounds ts 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1213 
 bounds ts = raise TRANS 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1214 
"Function unknown's argument not a bound variable" 
2854  1215 
in 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1216 
case ht of 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1217 
Term.Const aT => apply (fromConst thy alistTVar aT) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1218 
 Term.Free (a,_) => apply (Free a) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1219 
 Term.Bound i => apply (Bound i) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1220 
 Term.Var (ix,_) => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1221 
(case (AList.lookup (op =) (!alistVar) ix) of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1222 
NONE => (alistVar := (ix, (ref NONE, bounds ts)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1223 
:: !alistVar; 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1224 
Var (hdvar(!alistVar))) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1225 
 SOME(v,is) => if is=bounds ts then Var v 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1226 
else raise TRANS 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1227 
("Discrepancy among occurrences of " 
22678  1228 
^ Term.string_of_vname ix)) 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1229 
 Term.Abs (a,_,body) => 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1230 
if null ts then Abs(a, from (lev+1) body) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1231 
else raise TRANS "argument not in normal form" 
2854  1232 
end 
1233 

1234 
val npars = length (Logic.strip_params t) 

1235 

1236 
(*Skolemize a subgoal from a proof state*) 

1237 
fun skoSubgoal i t = 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1238 
if i<npars then 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1239 
skoSubgoal (i+1) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1240 
(subst_bound (Skolem (gensym "T_", getVars (!alistVar) i), 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1241 
t)) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1242 
else t 
2854  1243 

1244 
in skoSubgoal 0 (from 0 (discard_foralls t)) end; 

1245 

1246 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1247 
(*Tactic using tableau engine and proof reconstruction. 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

1248 
"start" is CPU time at start, for printing SEARCH time 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1249 
(also prints reconstruction time) 
2854  1250 
"lim" is depth limit.*) 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1251 
fun timing_depth_tac start cs lim i st0 = 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1252 
let val thy = Thm.theory_of_thm st0 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1253 
val state = initialize thy 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1254 
val st = Conv.gconv_rule ObjectLogic.atomize_prems i st0 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1255 
val skoprem = fromSubgoal thy (List.nth(prems_of st, i1)) 
4323
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

1256 
val hyps = strip_imp_prems skoprem 
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

1257 
and concl = strip_imp_concl skoprem 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1258 
fun cont (tacs,_,choices) = 
21295
63552bc99cfb
tuned names of start_timing,/end_timing/check_timer;
wenzelm
parents:
20854
diff
changeset

1259 
let val start = start_timing () 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1260 
in 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1261 
case Seq.pull(EVERY' (rev tacs) i st) of 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1262 
NONE => (writeln ("PROOF FAILED for depth " ^ 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1263 
Int.toString lim); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1264 
if !trace then error "************************\n" 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1265 
else (); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1266 
backtrack choices) 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1267 
 cell => (if (!trace orelse !stats) 
30187
b92b3375e919
end_timing: generalized result  message plus with explicit time values;
wenzelm
parents:
27809
diff
changeset

1268 
then writeln (#message (end_timing start) ^ " for reconstruction") 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1269 
else (); 
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1270 
Seq.make(fn()=> cell)) 
4323
561242f8606b
Printing of statistics including time for search & reconstruction
paulson
parents:
4300
diff
changeset

1271 
end 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1272 
in prove (state, start, cs, [initBranch (mkGoal concl :: hyps, lim)], cont) end 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1273 
handle PROVE => Seq.empty 
2854  1274 

4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

1275 
(*Public version with fixed depth*) 
21295
63552bc99cfb
tuned names of start_timing,/end_timing/check_timer;
wenzelm
parents:
20854
diff
changeset

1276 
fun depth_tac cs lim i st = timing_depth_tac (start_timing ()) cs lim i st; 
4391
cc3e8453d7f0
More deterministic and therefore faster (sometimes) proof reconstruction
paulson
parents:
4354
diff
changeset

1277 

24112  1278 
val (depth_limit, setup_depth_limit) = Attrib.config_int_global "blast_depth_limit" 20; 
15162
670ab8497818
depth limit (previously hardcoded with a value of 20) made a reference
webertj
parents:
14984
diff
changeset

1279 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1280 
fun blast_tac cs i st = 
24112  1281 
((DEEPEN (1, Config.get_thy (Thm.theory_of_thm st) depth_limit) 
24099
6534fd4c5d46
replaced depth_limit ref by blast_depth_limit configuration option;
wenzelm
parents:
24062
diff
changeset

1282 
(timing_depth_tac (start_timing ()) cs) 0) i 
5463
a5479f5cd482
Allows more backtracking in proof reconstruction, making it slower but more
paulson
parents:
5411
diff
changeset

1283 
THEN flexflex_tac) st 
14466  1284 
handle TRANS s => 
18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1285 
((if !trace then warning ("blast: " ^ s) else ()); 
14466  1286 
Seq.empty); 
2854  1287 

1288 

2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

1289 

18525
ce1ae48c320f
avoid implicit assumptions about consts Not, op =, *Goal*, *False*;
wenzelm
parents:
18177
diff
changeset

1290 
(*** For debugging: these apply the prover to a subgoal and return 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

1291 
the resulting tactics, trace, etc. ***) 
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

1292 

24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1293 
val fullTrace = ref ([]: branch list list); 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

1294 

af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

1295 
(*Read a string to make an initial, singleton branch*) 
25365  1296 
fun readGoal thy s = Syntax.read_prop_global thy s > fromTerm thy > rand > mkGoal; 
2924
af506c35b4ed
Control over excessive branching by applying a log2 penalty
paulson
parents:
2894
diff
changeset

1297 

30609
983e8b6e4e69
Disposed old declarations, tactics, tactic combinators that refer to the simpset or claset of an implicit theory;
wenzelm
parents:
30558
diff
changeset

1298 
fun tryInThy thy cs lim s = 
24062
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1299 
let 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1300 
val state as State {fullTrace = ft, ...} = initialize thy; 
845c0d693328
explicit global state argument  no longer CRITICAL;
wenzelm
parents:
23985
diff
changeset

1301 
val res = timeap prove 