22 val strip_imp_concl : term -> term |
22 val strip_imp_concl : term -> term |
23 val strip_prems : int * term list * term -> term list * term |
23 val strip_prems : int * term list * term -> term list * term |
24 val count_prems : term * int -> int |
24 val count_prems : term * int -> int |
25 val mk_conjunction : term * term -> term |
25 val mk_conjunction : term * term -> term |
26 val mk_conjunction_list: term list -> term |
26 val mk_conjunction_list: term list -> term |
27 val mk_flexpair : term * term -> term |
27 val strip_horn : term -> term list * term |
28 val dest_flexpair : term -> term * term |
|
29 val list_flexpairs : (term*term)list * term -> term |
|
30 val rule_of : (term*term)list * term list * term -> term |
|
31 val strip_flexpairs : term -> (term*term)list * term |
|
32 val skip_flexpairs : term -> term |
|
33 val strip_horn : term -> (term*term)list * term list * term |
|
34 val mk_cond_defpair : term list -> term * term -> string * term |
28 val mk_cond_defpair : term list -> term * term -> string * term |
35 val mk_defpair : term * term -> string * term |
29 val mk_defpair : term * term -> string * term |
36 val mk_type : typ -> term |
30 val mk_type : typ -> term |
37 val dest_type : term -> typ |
31 val dest_type : term -> typ |
38 val mk_inclass : typ * class -> term |
32 val mk_inclass : typ * class -> term |
116 |
110 |
117 (*Count premises -- quicker than (length ostrip_prems) *) |
111 (*Count premises -- quicker than (length ostrip_prems) *) |
118 fun count_prems (Const("==>", _) $ A $ B, n) = count_prems (B,n+1) |
112 fun count_prems (Const("==>", _) $ A $ B, n) = count_prems (B,n+1) |
119 | count_prems (_,n) = n; |
113 | count_prems (_,n) = n; |
120 |
114 |
|
115 (*strip a proof state (Horn clause): |
|
116 B1 ==> ... Bn ==> C goes to ([B1, ..., Bn], C) *) |
|
117 fun strip_horn A = (strip_imp_prems A, strip_imp_concl A); |
|
118 |
121 |
119 |
122 (** conjunction **) |
120 (** conjunction **) |
123 |
121 |
124 fun mk_conjunction (t, u) = |
122 fun mk_conjunction (t, u) = |
125 Term.list_all ([("C", propT)], mk_implies (list_implies ([t, u], Bound 0), Bound 0)); |
123 Term.list_all ([("C", propT)], mk_implies (list_implies ([t, u], Bound 0), Bound 0)); |
126 |
124 |
127 fun mk_conjunction_list [] = Term.all propT $ Abs ("dummy", propT, mk_implies (Bound 0, Bound 0)) |
125 fun mk_conjunction_list [] = Term.all propT $ Abs ("dummy", propT, mk_implies (Bound 0, Bound 0)) |
128 | mk_conjunction_list ts = foldr1 mk_conjunction ts; |
126 | mk_conjunction_list ts = foldr1 mk_conjunction ts; |
129 |
|
130 |
|
131 (** flex-flex constraints **) |
|
132 |
|
133 (*Make a constraint.*) |
|
134 fun mk_flexpair(t,u) = flexpair(fastype_of t) $ t $ u; |
|
135 |
|
136 fun dest_flexpair (Const("=?=",_) $ t $ u) = (t,u) |
|
137 | dest_flexpair t = raise TERM("dest_flexpair", [t]); |
|
138 |
|
139 (*make flexflex antecedents: ( [(a1,b1),...,(an,bn)] , C ) |
|
140 goes to (a1=?=b1) ==>...(an=?=bn)==>C *) |
|
141 fun list_flexpairs ([], A) = A |
|
142 | list_flexpairs ((t,u)::pairs, A) = |
|
143 implies $ (mk_flexpair(t,u)) $ list_flexpairs(pairs,A); |
|
144 |
|
145 (*Make the object-rule tpairs==>As==>B *) |
|
146 fun rule_of (tpairs, As, B) = list_flexpairs(tpairs, list_implies(As, B)); |
|
147 |
|
148 (*Remove and return flexflex pairs: |
|
149 (a1=?=b1)==>...(an=?=bn)==>C to ( [(a1,b1),...,(an,bn)] , C ) |
|
150 [Tail recursive in order to return a pair of results] *) |
|
151 fun strip_flex_aux (pairs, Const("==>", _) $ (Const("=?=",_)$t$u) $ C) = |
|
152 strip_flex_aux ((t,u)::pairs, C) |
|
153 | strip_flex_aux (pairs,C) = (rev pairs, C); |
|
154 |
|
155 fun strip_flexpairs A = strip_flex_aux([], A); |
|
156 |
|
157 (*Discard flexflex pairs*) |
|
158 fun skip_flexpairs (Const("==>", _) $ (Const("=?=",_)$_$_) $ C) = |
|
159 skip_flexpairs C |
|
160 | skip_flexpairs C = C; |
|
161 |
|
162 (*strip a proof state (Horn clause): |
|
163 (a1==b1)==>...(am==bm)==>B1==>...Bn==>C |
|
164 goes to ( [(a1,b1),...,(am,bm)] , [B1,...,Bn] , C) *) |
|
165 fun strip_horn A = |
|
166 let val (tpairs,horn) = strip_flexpairs A |
|
167 in (tpairs, strip_imp_prems horn, strip_imp_concl horn) end; |
|
168 |
127 |
169 |
128 |
170 (** definitions **) |
129 (** definitions **) |
171 |
130 |
172 fun mk_cond_defpair As (lhs, rhs) = |
131 fun mk_cond_defpair As (lhs, rhs) = |
268 let |
227 let |
269 fun is_meta (Const ("==>", _) $ _ $ _) = true |
228 fun is_meta (Const ("==>", _) $ _ $ _) = true |
270 | is_meta (Const ("==", _) $ _ $ _) = true |
229 | is_meta (Const ("==", _) $ _ $ _) = true |
271 | is_meta (Const ("all", _) $ _) = true |
230 | is_meta (Const ("all", _) $ _) = true |
272 | is_meta _ = false; |
231 | is_meta _ = false; |
273 val horn = skip_flexpairs prop; |
|
274 in |
232 in |
275 (case strip_prems (i, [], horn) of |
233 (case strip_prems (i, [], prop) of |
276 (B :: _, _) => exists is_meta (strip_assums_hyp B) |
234 (B :: _, _) => exists is_meta (strip_assums_hyp B) |
277 | _ => false) handle TERM _ => false |
235 | _ => false) handle TERM _ => false |
278 end; |
236 end; |
279 |
237 |
280 (*Removes the parameters from a subgoal and renumber bvars in hypotheses, |
238 (*Removes the parameters from a subgoal and renumber bvars in hypotheses, |