Mercurial > cpdt > repo
comparison src/Reflection.v @ 146:2779c651406a
monoid prose
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Tue, 28 Oct 2008 15:50:44 -0400 |
parents | 617323a60cc4 |
children | f103f28a6b57 |
comparison
equal
deleted
inserted
replaced
145:617323a60cc4 | 146:2779c651406a |
---|---|
231 It is worth considering how the reflective tactic improves on a pure-Ltac implementation. The formula reflection process is just as ad-hoc as before, so we gain little there. In general, proofs will be more complicated than formula translation, and the "generic proof rule" that we apply here %\textit{%#<i>#is#</i>#%}% on much better formal footing than a recursive Ltac function. The dependent type of the proof guarantees that it "works" on any input formula. This is all in addition to the proof-size improvement that we have already seen. *) | 231 It is worth considering how the reflective tactic improves on a pure-Ltac implementation. The formula reflection process is just as ad-hoc as before, so we gain little there. In general, proofs will be more complicated than formula translation, and the "generic proof rule" that we apply here %\textit{%#<i>#is#</i>#%}% on much better formal footing than a recursive Ltac function. The dependent type of the proof guarantees that it "works" on any input formula. This is all in addition to the proof-size improvement that we have already seen. *) |
232 | 232 |
233 | 233 |
234 (** * A Monoid Expression Simplifier *) | 234 (** * A Monoid Expression Simplifier *) |
235 | 235 |
236 (** Proof by reflection does not require encoding of all of the syntax in a goal. We can insert "variables" in our syntax types to allow injection of arbitrary pieces, even if we cannot apply specialized reasoning to them. In this section, we explore that possibility by writing a tactic for normalizing monoid equations. *) | |
237 | |
236 Section monoid. | 238 Section monoid. |
237 Variable A : Set. | 239 Variable A : Set. |
238 Variable e : A. | 240 Variable e : A. |
239 Variable f : A -> A -> A. | 241 Variable f : A -> A -> A. |
240 | 242 |
242 | 244 |
243 Hypothesis assoc : forall a b c, (a + b) + c = a + (b + c). | 245 Hypothesis assoc : forall a b c, (a + b) + c = a + (b + c). |
244 Hypothesis identl : forall a, e + a = a. | 246 Hypothesis identl : forall a, e + a = a. |
245 Hypothesis identr : forall a, a + e = a. | 247 Hypothesis identr : forall a, a + e = a. |
246 | 248 |
249 (** We add variables and hypotheses characterizing an arbitrary instance of the algebraic structure of monoids. We have an associative binary operator and an identity element for it. | |
250 | |
251 It is easy to define an expression tree type for monoid expressions. A [Var] constructor is a "catch-all" case for subexpressions that we cannot model. These subexpressions could be actual Gallina variables, or they could just use functions that our tactic is unable to understand. *) | |
252 | |
247 Inductive mexp : Set := | 253 Inductive mexp : Set := |
248 | Ident : mexp | 254 | Ident : mexp |
249 | Var : A -> mexp | 255 | Var : A -> mexp |
250 | Op : mexp -> mexp -> mexp. | 256 | Op : mexp -> mexp -> mexp. |
257 | |
258 (** Next, we write an "un-reflect" function. *) | |
251 | 259 |
252 Fixpoint mdenote (me : mexp) : A := | 260 Fixpoint mdenote (me : mexp) : A := |
253 match me with | 261 match me with |
254 | Ident => e | 262 | Ident => e |
255 | Var v => v | 263 | Var v => v |
256 | Op me1 me2 => mdenote me1 + mdenote me2 | 264 | Op me1 me2 => mdenote me1 + mdenote me2 |
257 end. | 265 end. |
258 | 266 |
267 (** We will normalize expressions by flattening them into lists, via associativity, so it is helpful to have a denotation function for lists of monoid values. *) | |
268 | |
259 Fixpoint mldenote (ls : list A) : A := | 269 Fixpoint mldenote (ls : list A) : A := |
260 match ls with | 270 match ls with |
261 | nil => e | 271 | nil => e |
262 | x :: ls' => x + mldenote ls' | 272 | x :: ls' => x + mldenote ls' |
263 end. | 273 end. |
274 | |
275 (** The flattening function itself is easy to implement. *) | |
264 | 276 |
265 Fixpoint flatten (me : mexp) : list A := | 277 Fixpoint flatten (me : mexp) : list A := |
266 match me with | 278 match me with |
267 | Ident => nil | 279 | Ident => nil |
268 | Var x => x :: nil | 280 | Var x => x :: nil |
269 | Op me1 me2 => flatten me1 ++ flatten me2 | 281 | Op me1 me2 => flatten me1 ++ flatten me2 |
270 end. | 282 end. |
271 | 283 |
272 Lemma flatten_correct' : forall ml2 ml1, f (mldenote ml1) (mldenote ml2) = mldenote (ml1 ++ ml2). | 284 (** [flatten] has a straightforward correctness proof in terms of our [denote] functions. *) |
285 | |
286 Lemma flatten_correct' : forall ml2 ml1, | |
287 mldenote ml1 + mldenote ml2 = mldenote (ml1 ++ ml2). | |
273 induction ml1; crush. | 288 induction ml1; crush. |
274 Qed. | 289 Qed. |
275 | 290 |
276 Theorem flatten_correct : forall me, mdenote me = mldenote (flatten me). | 291 Theorem flatten_correct : forall me, mdenote me = mldenote (flatten me). |
277 Hint Resolve flatten_correct'. | 292 Hint Resolve flatten_correct'. |
278 | 293 |
279 induction me; crush. | 294 induction me; crush. |
280 Qed. | 295 Qed. |
281 | 296 |
282 Theorem monoid_reflect : forall m1 m2, | 297 (** Now it is easy to prove a theorem that will be the main tool behind our simplification tactic. *) |
283 mldenote (flatten m1) = mldenote (flatten m2) | 298 |
284 -> mdenote m1 = mdenote m2. | 299 Theorem monoid_reflect : forall me1 me2, |
300 mldenote (flatten me1) = mldenote (flatten me2) | |
301 -> mdenote me1 = mdenote me2. | |
285 intros; repeat rewrite flatten_correct; assumption. | 302 intros; repeat rewrite flatten_correct; assumption. |
286 Qed. | 303 Qed. |
287 | 304 |
288 Ltac reflect m := | 305 (** We implement reflection into the [mexp] type. *) |
289 match m with | 306 |
307 Ltac reflect me := | |
308 match me with | |
290 | e => Ident | 309 | e => Ident |
291 | ?m1 + ?m2 => | 310 | ?me1 + ?me2 => |
292 let r1 := reflect m1 in | 311 let r1 := reflect me1 in |
293 let r2 := reflect m2 in | 312 let r2 := reflect me2 in |
294 constr:(Op r1 r2) | 313 constr:(Op r1 r2) |
295 | _ => constr:(Var m) | 314 | _ => constr:(Var me) |
296 end. | 315 end. |
316 | |
317 (** The final [monoid] tactic works on goals that equate two monoid terms. We reflect each and change the goal to refer to the reflected versions, finishing off by applying [monoid_reflect] and simplifying uses of [mldenote]. *) | |
297 | 318 |
298 Ltac monoid := | 319 Ltac monoid := |
299 match goal with | 320 match goal with |
300 | [ |- ?m1 = ?m2 ] => | 321 | [ |- ?me1 = ?me2 ] => |
301 let r1 := reflect m1 in | 322 let r1 := reflect me1 in |
302 let r2 := reflect m2 in | 323 let r2 := reflect me2 in |
303 change (mdenote r1 = mdenote r2); | 324 change (mdenote r1 = mdenote r2); |
304 apply monoid_reflect; simpl mldenote | 325 apply monoid_reflect; simpl mldenote |
305 end. | 326 end. |
306 | 327 |
328 (** We can make short work of theorems like this one: *) | |
329 | |
307 Theorem t1 : forall a b c d, a + b + c + d = a + (b + c) + d. | 330 Theorem t1 : forall a b c d, a + b + c + d = a + (b + c) + d. |
308 intros. | 331 intros; monoid. |
309 monoid. | 332 (** [[ |
333 | |
334 ============================ | |
335 a + (b + (c + (d + e))) = a + (b + (c + (d + e))) | |
336 ]] | |
337 | |
338 [monoid] has canonicalized both sides of the equality, such that we can finish the proof by reflexivity. *) | |
339 | |
310 reflexivity. | 340 reflexivity. |
311 Qed. | 341 Qed. |
342 | |
343 (** It is interesting to look at the form of the proof. *) | |
344 | |
345 Print t1. | |
346 (** [[ | |
347 | |
348 t1 = | |
349 fun a b c d : A => | |
350 monoid_reflect (Op (Op (Op (Var a) (Var b)) (Var c)) (Var d)) | |
351 (Op (Op (Var a) (Op (Var b) (Var c))) (Var d)) | |
352 (refl_equal (a + (b + (c + (d + e))))) | |
353 : forall a b c d : A, a + b + c + d = a + (b + c) + d | |
354 ]] | |
355 | |
356 The proof term contains only restatements of the equality operands in reflected form, followed by a use of reflexivity on the shared canonical form. *) | |
312 End monoid. | 357 End monoid. |
358 | |
359 (** Extensions of this basic approach are used in the implementations of the [ring] and [field] tactics that come packaged with Coq. *) | |
313 | 360 |
314 | 361 |
315 (** * A Smarter Tautology Solver *) | 362 (** * A Smarter Tautology Solver *) |
316 | 363 |
317 Require Import Quote. | 364 Require Import Quote. |