Library Reflection







The last chapter highlighted a very heuristic approach to proving. In this chapter, we will study an alternative technique, proof by reflection . We will write, in Gallina, decision procedures with proofs of correctness, and we will appeal to these procedures in writing very short proofs. Such a proof is checked by running the decision procedure. The term reflection applies because we will need to translate Gallina propositions into values of inductive types representing syntax, so that Gallina programs may analyze them, and translating such a term back to the original form is called reflecting it. Proving Evenness Proving that particular natural number constants are even is certainly something we would rather have happen automatically. The Ltac-programming techniques that we learned in the last chapter make it easy to implement such a procedure. The last chapter highlighted a very heuristic approach to proving. In this chapter, we will study an alternative technique,. We will write, in Gallina, decision procedures with proofs of correctness, and we will appeal to these procedures in writing very short proofs. Such a proof is checked by running the decision procedure. The termapplies because we will need to translate Gallina propositions into values of inductive types representing syntax, so that Gallina programs may analyze them, and translating such a term back to the original form is calledit.Proving that particular natural number constants are even is certainly something we would rather have happen automatically. The Ltac-programming techniques that we learned in the last chapter make it easy to implement such a procedure.



Inductive isEven : nat -> Prop :=

| Even_O : isEven O

| Even_SS : forall n , isEven S ( S



Ltac prove_even := repeat constructor .



Theorem even_256 :

prove_even .

Qed .



Print even_256 .

->:= n -> isEven n )).:= isEven 256.



even_256 =

Even_SS

( Even_SS

( Even_SS

( Even_SS ...and so on. This procedure always works (at least on machines with infinite resources), but it has a serious drawback, which we see when we print the proof it generates that 256 is even. The final proof term has length super-linear in the input value. Coq's implicit arguments mechanism is hiding the values given for parameter n Even_SS Superlinear evenness proof terms seem like a shame, since we could write a trivial and trustworthy program to verify evenness of constants. The proof checker could simply call our program where needed. It is also unfortunate not to have static typing guarantees that our tactic always behaves appropriately. Other invocations of similar tactics might fail with dynamic type errors, and we would not know about the bugs behind these errors until we happened to attempt to prove complex enough goals. The techniques of proof by reflection address both complaints. We will be able to write proofs like in the example above with constant size overhead beyond the size of the input, and we will do it with verified decision procedures written in Gallina. For this example, we begin by using a type from the MoreSpecif module (included in the book source) to write a certified evenness checker. ...and so on. This procedure always works (at least on machines with infinite resources), but it has a serious drawback, which we see when we print the proof it generates that 256 is even. The final proof term has length super-linear in the input value. Coq's implicit arguments mechanism is hiding the values given for parameterof, which is why the proof term only appears linear here. Also, proof terms are represented internally as syntax trees, with opportunity for sharing of node representations, but in this chapter we will measure proof term size as simple textual length or as the number of nodes in the term's syntax tree, two measures that are approximately equivalent. Sometimes apparently large proof terms have enough internal sharing that they take up less memory than we expect, but one avoids having to reason about such sharing by ensuring that the size of a sharing-free version of a term is low enough.Superlinear evenness proof terms seem like a shame, since we could write a trivial and trustworthy program to verify evenness of constants. The proof checker could simply call our program where needed.It is also unfortunate not to have static typing guarantees that our tactic always behaves appropriately. Other invocations of similar tactics might fail with dynamic type errors, and we would not know about the bugs behind these errors until we happened to attempt to prove complex enough goals.The techniques of proof by reflection address both complaints. We will be able to write proofs like in the example above with constant size overhead beyond the size of the input, and we will do it with verified decision procedures written in Gallina.For this example, we begin by using a type from themodule (included in the book source) to write a certified evenness checker.





Print partial .





Inductive partial ( P : Prop ) : Set := Proved : Uncertain : [ ) ::= P -> [ P ] |: [ P A partial P P P ] partial P value is an optional proof of. The notationstands for



Local Open Scope partial_scope .





We bring into scope some notations for the partial type. These overlap with some of the notations we have seen previously for specification types, so they were placed in a separate scope that needs separate opening.



Definition check_even : forall n : nat , [ isEven n ] .

Hint Constructors isEven .



refine ( fix F ( n : nat ) : [ isEven n ] :=

match n with

| 0 => Yes

| 1 => No

| S ( S n' ) => Reduce ( F n' )

end ); auto .

Defined .



) ::=| 0 =>| 1 =>) =>);

check_even verified decision procedure, because its type guarantees that it never returns Yes for inputs that are not even. Now we can use dependent pattern-matching to write a function that performs a surprising feat. When given a partial P partialOut P partial value contains a proof, and it returns a (useless) proof of True otherwise. From the standpoint of ML and Haskell programming, it seems impossible to write such a type, but it is trivial with a return annotation. The functionmay be viewed as a, because its type guarantees that it never returnsfor inputs that are not even.Now we can use dependent pattern-matching to write a function that performs a surprising feat. When given a, this functionreturns a proof ofif thevalue contains a proof, and it returns a (useless) proof ofotherwise. From the standpoint of ML and Haskell programming, it seems impossible to write such a type, but it is trivial with aannotation.



Definition partialOut ( P : Prop ) ( x : [ P ] ) :=

match x return ( match x with

| Proved _ =>

| Uncertain => True

end ) with

| Proved pf => pf

| Uncertain => I

end .



) () :==> P =>=>=>

It may seem strange to define a function like this. However, it turns out to be very useful in writing a reflective version of our earlier prove_even tactic:



Ltac prove_even_reflective :=

match goal with

| [ |- N ] => exact ( partialOut ( check_even N ))

end .



:=| [ |- isEven ] =>))

check_even exact tactic proves a proposition P P We identify which natural number we are considering, and we "prove" its evenness by pulling the proof out of the appropriatecall. Recall that thetactic proves a propositionwhen given a proof term of precisely type



even_256' = partialOut (

: check_even 256) isEven 256 We can see a constant wrapper around the object of the proof. For any even number, this form of proof will suffice. The size of the proof term is now linear in the number being checked, containing two repetitions of the unary form of that number, one of which is hidden above within the implicit argument to partialOut What happens if we try the tactic with an odd number? We can see a constant wrapper around the object of the proof. For any even number, this form of proof will suffice. The size of the proof term is now linear in the number being checked, containing two repetitions of the unary form of that number, one of which is hidden above within the implicit argument toWhat happens if we try the tactic with an odd number?



prove_even_reflective . User error: No matching clauses for match goal Thankfully, the tactic fails. To see more precisely what goes wrong, we can run manually the body of the match .

exact ( partialOut ( check_even 255)). Error: The term "partialOut (check_even 255)" has type "match check_even 255 with | Yes => isEven 255 | No => True end" while it is expected to have type "isEven 255" As usual, the type checker performs no reductions to simplify error messages. If we reduced the first term ourselves, we would see that check_even 255 reduces to a No , so that the first term is equivalent to True , which certainly does not unify with isEven 255 . Thankfully, the tactic fails. To see more precisely what goes wrong, we can run manually the body of theAs usual, the type checker performs no reductions to simplify error messages. If we reduced the first term ourselves, we would see thatreduces to a, so that the first term is equivalent to, which certainly does not unify with



Abort .





prove_even_reflective is reflective because it performs a proof search process (a trivial one, in this case) wholly within Gallina, where the only use of Ltac is to translate a goal into an appropriate use of check_even Reifying the Syntax of a Trivial Tautology Language We might also like to have reflective proofs of trivial tautologies like this one: Our tacticis reflective because it performs a proof search process (a trivial one, in this case) wholly within Gallina, where the only use of Ltac is to translate a goal into an appropriate use ofWe might also like to have reflective proofs of trivial tautologies like this one:



Theorem True /\ True ) -> ( True \/ ( True /\ ( True -> True ) ) ).

tauto .

Qed .





Print true_galore .

true_galore : () -> (->).



true_galore =

fun H : True /\ True =>

and_ind ( fun _ _ : True => True /\ ( True -> True )) I ) H

: True /\ True -> True \/ True /\ ( True -> True ) /\=>=> or_introl /\ (->))/\->\//\ (-> As we might expect, the proof that tauto builds contains explicit applications of natural deduction rules. For large formulas, this can add a linear amount of proof size overhead, beyond the size of the input. To write a reflective procedure for this class of goals, we will need to get into the actual "reflection" part of "proof by reflection." It is impossible to case-analyze a Prop in any way in Gallina. We must reify Prop into some type that we can analyze. This inductive type is a good candidate: As we might expect, the proof thatbuilds contains explicit applications of natural deduction rules. For large formulas, this can add a linear amount of proof size overhead, beyond the size of the input.To write a reflective procedure for this class of goals, we will need to get into the actual "reflection" part of "proof by reflection." It is impossible to case-analyze ain any way in Gallina. We mustinto some type that weanalyze. This inductive type is a good candidate:

We write a recursive function to reflect this syntax back to Prop . Such functions are also called interpretation functions, and we have used them in previous examples to give semantics to small programming languages.



Fixpoint tautDenote ( t : Prop :=

match t with

| True

| TautAnd t1 t2 => t1 /\ tautDenote t2

| TautOr t1 t2 => t1 \/ tautDenote t2

| TautImp t1 t2 => t1 -> t2

end .



taut ) ::= TautTrue =>=> tautDenote => tautDenote => tautDenote -> tautDenote

tautDenote It is easy to prove that every formula in the range ofis true.



Theorem tautTrue : forall t , tautDenote t .

induction t ; crush .

Qed .





tautTrue To useto prove particular formulas, we need to implement the syntax reification process. A recursive Ltac function does the job.



Ltac tautReify P :=

match P with

| True => TautTrue

| ? P1 /\ ? P2 =>

let t1 := tautReify P1 in

let t2 := tautReify P2 in

constr :( t1 t2 )

| ? P1 \/ ? P2 =>

let t1 := tautReify P1 in

let t2 := tautReify P2 in

constr :( t1 t2 )

| ? P1 -> ? P2 =>

let t1 := tautReify P1 in

let t2 := tautReify P2 in

constr :( t1 t2 )

end .



:==>| ?=>:=:=:( TautAnd | ?=>:=:=:( TautOr | ?-> ?=>:=:=:( TautImp

tautReify available, it is easy to finish our reflective tactic. We look at the goal formula, reify it, and apply tautTrue Withavailable, it is easy to finish our reflective tactic. We look at the goal formula, reify it, and applyto the reified formula.



Ltac obvious :=

match goal with

| [ |- ? P ] =>

let t := tautReify P in

exact ( tautTrue t )

end .



:=| [ |- ?] =>:=

obvious We can verify thatsolves our original example, with a proof term that does not mention details of the proof.



Theorem True /\ True ) -> ( True \/ ( True /\ ( True -> True ) ) ).

obvious .

Qed .



Print true_galore' .

true_galore' : () -> (->).



true_galore' =

tautTrue

( TautImp ( TautAnd TautTrue TautTrue )

( TautOr TautTrue ( TautAnd TautTrue ( TautImp TautTrue

: True /\ True -> True \/ True /\ ( True -> True ) TautTrue ))))/\->\//\ (-> It is worth considering how the reflective tactic improves on a pure-Ltac implementation. The formula reification 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 is 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 benefit is in addition to the proof-size improvement that we have already seen. It may also be worth pointing out that our previous example of evenness testing used a function partialOut tautTrue taut A Monoid Expression Simplifier 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. It is worth considering how the reflective tactic improves on a pure-Ltac implementation. The formula reification 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 hereon much better formal footing than a recursive Ltac function. The dependent type of the proof guarantees that it "works" on any input formula. This benefit is in addition to the proof-size improvement that we have already seen.It may also be worth pointing out that our previous example of evenness testing used a functionfor sound handling of input goals that the verified decision procedure fails to prove. Here, we prove that our procedure(recall that an inductive proof may be viewed as a recursive procedure) is able to prove any goal representable in, so no extra step is necessary.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.

It is easy to define an expression tree type for monoid expressions. A Var 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.It is easy to define an expression tree type for monoid expressions. Aconstructor 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.

Next, we write an interpretation function.

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.



Fixpoint mldenote ( ls : list

match ls with

| nil =>

| x :: ls' => x + mldenote ls'

end .



A ) : A :==> e =>

The flattening function itself is easy to implement.



Fixpoint flatten ( me : list

match me with

| nil

| Var x => x :: nil

| Op me1 me2 => me1 ++ flatten me2

end .



mexp ) : A := Ident =>=>=> flatten

denote This function has a straightforward correctness proof in terms of ourfunctions.



Lemma flatten_correct' : forall ml2 ml1 ,

mldenote ml1 + mldenote ml2 = mldenote ( ml1 ++

induction ml1 ; crush .

Qed .



Theorem flatten_correct : forall me , mdenote me = mldenote ( flatten

Hint Resolve flatten_correct' .



induction me ; crush .

Qed .



ml2 ). me ).

Now it is easy to prove a theorem that will be the main tool behind our simplification tactic.



Theorem monoid_reflect : forall me1 me2 ,

mldenote ( flatten me1 ) = mldenote ( flatten me2 )

-> me1 = mdenote me2 .

intros ; repeat rewrite flatten_correct ; assumption .

Qed .



-> mdenote

mexp We implement reification into thetype.



Ltac reify me :=

match me with

| Ident

| ? me1 + ? me2 =>

let r1 := reify me1 in

let r2 := reify me2 in

constr :( r1 r2 )

| _ => constr :( me )

end .



:= e =>| ?=>:=:=:( Op =>:( Var

monoid monoid_reflect mldenote change tactic replaces a conclusion formula with another that is definitionally equal to it. The finaltactic works on goals that equate two monoid terms. We reify each and change the goal to refer to the reified versions, finishing off by applyingand simplifying uses of. Recall that thetactic replaces a conclusion formula with another that is definitionally equal to it.



Ltac monoid :=

match goal with

| [ |- ? me1 = ? me2 ] =>

let r1 := reify me1 in

let r2 := reify me2 in

change ( mdenote r1 = mdenote r2 );

apply monoid_reflect ; simpl

end .



:=| [ |- ?] =>:=:=);

We can make short work of theorems like this one:







============================ a + ( b + ( c + ( d e ))) = a + ( b + ( c + ( d e ))) Our tactic has canonicalized both sides of the equality, such that we can finish the proof by reflexivity. Our tactic has canonicalized both sides of the equality, such that we can finish the proof by reflexivity.



reflexivity .

Qed .





It is interesting to look at the form of the proof.



Print t1 .





t1 =

fun a b c d :

monoid_reflect ( Op ( Op ( Op ( Var

( Op ( Op ( Var Var

( eq_refl (

: forall a b c d : A , a + b + c + d = A => a ) ( Var b )) ( Var c )) ( Var d )) a ) ( Op b ) ( Var c ))) ( Var d )) a + ( b + ( c + ( d e ))))) a + ( b c ) + d The proof term contains only restatements of the equality operands in reified form, followed by a use of reflexivity on the shared canonical form. The proof term contains only restatements of the equality operands in reified form, followed by a use of reflexivity on the shared canonical form.



End monoid .





ring and field tactics that come packaged with Coq. A Smarter Tautology Solver Now we are ready to revisit our earlier tautology solver example. We want to broaden the scope of the tactic to include formulas whose truth is not syntactically apparent. We will want to allow injection of arbitrary formulas, like we allowed arbitrary monoid expressions in the last example. Since we are working in a richer theory, it is important to be able to use equalities between different injected formulas. For instance, we cannot prove P -> P Imp Var P ) Var P ) P To arrive at a nice implementation satisfying these criteria, we introduce the quote tactic and its associated library. Extensions of this basic approach are used in the implementations of theandtactics that come packaged with Coq.Now we are ready to revisit our earlier tautology solver example. We want to broaden the scope of the tactic to include formulas whose truth is not syntactically apparent. We will want to allow injection of arbitrary formulas, like we allowed arbitrary monoid expressions in the last example. Since we are working in a richer theory, it is important to be able to use equalities between different injected formulas. For instance, we cannot proveby translating the formula into a value like, because a Gallina function has no way of comparing the twos for equality.To arrive at a nice implementation satisfying these criteria, we introduce thetactic and its associated library.

index comes from the Quote library and represents a countable variable type. The rest of formula The quote tactic will implement injection from Prop into formula quote into not noticing our uses of function types to express logical implication, we will need to declare a wrapper definition for implication, as we did in the last chapter. The typecomes from thelibrary and represents a countable variable type. The rest of's definition should be old hat by now.Thetactic will implement injection fromintofor us, but it is not quite as smart as we might like. In particular, it wants to treat function types specially, so it gets confused if function types are part of the structure we want to encode syntactically. To trickinto not noticing our uses of function types to express logical implication, we will need to declare a wrapper definition for implication, as we did in the last chapter.



Definition imp ( P1 P2 : Prop ) :=

Infix no associativity , at level 95).



) := P1 -> P2 " -->" := imp 95).

Now we can define our denotation function.



Definition varmap Prop .



Fixpoint formulaDenote ( atomics : f : Prop :=

match f with

| Atomic v => varmap_find False v atomics

| True

| False

| And f1 f2 => atomics f1 /\ formulaDenote atomics f2

| Or f1 f2 => atomics f1 \/ formulaDenote atomics f2

| Imp f1 f2 => atomics f1 --> formulaDenote atomics f2

end .



asgn := asgn ) ( formula ) ::==> Truth => Falsehood =>=> formulaDenote => formulaDenote => formulaDenote

varmap type family implements maps from index values. In this case, we define an assignment as a map from variables to Prop s. Our interpretation function formulaDenote varmap_find function to consult the assignment in the Atomic varmap_find is a default value, in case the variable is not found. Thetype family implements maps fromvalues. In this case, we define an assignment as a map from variables tos. Our interpretation functionworks with an assignment, and we use thefunction to consult the assignment in thecase. The first argument tois a default value, in case the variable is not found.



Section my_tauto .

Variable atomics : asgn .



Definition holds ( v : index ) := varmap_find False v atomics .



) :=

We define some shorthand for a particular variable being true, and now we are ready to define some helpful functions based on the ListSet module of the standard library, which (unsurprisingly) presents a view of lists as sets.



Require Import ListSet .



Definition index_eq : forall x y : index , { x = y } + { x <> y } .

decide equality .

Defined .



Definition add ( s : set index ) ( v : index ) := set_add index_eq v s .



Definition In_dec : forall v ( s : set index ), { In v s } + { ~ In v s } .

Local Open Scope specif_scope .



intro ; refine ( fix F ( s : set index ) : { In v s } + { ~ In v s } :=

match s with

| nil => No

| v' :: s' => v' v || F s'

end ); crush .

Defined .



) () :=),) ::==>=> index_eq );

We define what it means for all members of an index set to represent true propositions, and we prove some lemmas about this notion.



Fixpoint allTrue ( s : set index ) : Prop :=

match s with

| nil => True

| v :: s' => v /\ allTrue s'

end .



Theorem allTrue_add : forall v s ,

allTrue s

-> v

-> add s

induction s ; crush ;

match goal with

| [ |- context [ if ? E then _ else _ ] ] => destruct E

end ; crush .

Qed .



Theorem allTrue_In : forall v s ,

allTrue s

-> set_In v s

-> varmap_find False v atomics .

induction s ; crush .

Qed .



Hint Resolve allTrue_add allTrue_In .



Local Open Scope partial_scope .



) ::==>=> holds -> holds -> allTrue v ).| [ |-] ] =>->->

forward Or The forward forward f known hyp cont known hyp Now we can write a functionthat implements deconstruction of hypotheses, expanding a compound formula into a set of sets of atomic formulas covering all possible cases introduced with use of. To handle consideration of multiple cases, the function takes in a continuation argument, which will be called once for each case.Thefunction has a dependent type, in the style of Chapter 6, guaranteeing correctness. The arguments toare a goal formula, a setof atomic formulas that we may assume are true, a hypothesis formula, and a success continuationthat we call when we have extendedto hold new truths implied by



Definition forward : forall ( f : known : set index ) ( hyp : formula )

( cont : forall known' , [ allTrue atomics f ] ),

[ allTrue atomics atomics f ] .

refine ( fix F ( f : known : set index ) ( hyp : formula )

( cont : forall known' , [ allTrue atomics f ] )

: [ allTrue atomics atomics f ] :=

match hyp with

| Atomic v => Reduce ( cont ( add known v ) )

| Reduce ( cont known )

| Yes

| And h1 h2 =>

Reduce ( F ( Imp h2 f ) known h1 ( fun known' =>

Reduce ( F f known' h2 cont ) ) )

| Or h1 h2 => f known h1 cont && F f known h2 cont

| Imp _ _ => Reduce ( cont known )

end ); crush .

Defined .



formula ) () ( known' -> formulaDenote ), known -> formulaDenote hyp -> formulaDenote formula ) () ( known' -> formulaDenote known -> formulaDenote hyp -> formulaDenote :==> Truth => Falsehood =>=>=>=> F =>);

backward forward function implements analysis of the final goal. It callsto handle implications.



Definition backward : forall ( known : set index ) ( f :

[ allTrue atomics f ] .

refine ( fix F ( known : set index ) ( f : formula )

: [ allTrue atomics f ] :=

match f with

| Atomic v => Reduce ( In_dec v known )

| Yes

| No

| And f1 f2 => known f1 && F known f2

| Or f1 f2 => known f1 || F known f2

| Imp f1 f2 => f2 known f1 ( fun known' => known' f2 )

end ); crush ; eauto .

Defined .



) ( formula ), known -> formulaDenote ) ( known -> formulaDenote :==> Truth => Falsehood =>=> F => F => forward => F );

backward A simple wrapper aroundgives us the usual type of a partial decision procedure.



Definition my_tauto : forall f : formula , [ formulaDenote atomics f ] .

intro ; refine ( Reduce ( backward nil f ) ); crush .

Defined .

End my_tauto .



);

intro all quantifiers that do not bind Prop s. Then we call the quote tactic, which implements the reification for us. Finally, we are able to construct an exact proof via partialOut my_tauto Our final tactic implementation is now fairly straightforward. First, weall quantifiers that do not binds. Then we call thetactic, which implements the reification for us. Finally, we are able to construct an exact proof viaand theGallina function.



Ltac my_tauto :=

repeat match goal with

| [ |- forall x : ? P , _ ] =>

match type of P with

| Prop => fail 1

| _ => intro

end

end ;

quote formulaDenote ;

match goal with

| [ |- m ? f ] => exact ( partialOut ( my_tauto m f ))

end .



:=| [ |-: ?] =>=>=>| [ |- formulaDenote ] =>))

A few examples demonstrate how the tactic works.



Theorem mt1 : True .

my_tauto .

Qed .



Print mt1 .





mt1 = partialOut ( my_tauto ( Empty_vm Prop ) Truth )

: True We see my_tauto varmap , since every subformula is handled by formulaDenote We seeapplied with an empty, since every subformula is handled by



Theorem mt2 : forall x y : nat , x = y --> x = y .

my_tauto .

Qed .





Print mt2 .





mt2 =

fun x y :

partialOut

( my_tauto ( Node_vm ( x = Empty_vm Prop ) ( Empty_vm Prop ))

( Imp ( Atomic End_idx ) ( End_idx )))

: forall x y : nat , x = y nat => y ) () ())) ( Atomic ))) y --> x Crucially, both instances of x = y End_idx . The value of this index only needs to appear once in the varmap , whose form reveals that varmap s are represented as binary trees, where index values denote paths from tree roots to leaves. Crucially, both instances ofare represented with the same index,. The value of this index only needs to appear once in the, whose form reveals thats are represented as binary trees, wherevalues denote paths from tree roots to leaves.



Theorem mt3 : forall x y z ,

( x < y /\ y > z ) \/ ( y > z /\ x < S y )

--> y > z /\ ( x < y \/ x < S y ) .

my_tauto .

Qed .



Print mt3 .





fun x y z :

partialOut

( my_tauto

( Node_vm ( x < S Node_vm ( x < Empty_vm Prop ) ( Empty_vm Prop ))

( Node_vm ( y > Empty_vm Prop ) ( Empty_vm Prop )))

( Imp

( Or ( And ( Atomic ( Left_idx End_idx )) ( Right_idx End_idx )))

( And ( Atomic ( Right_idx End_idx )) ( End_idx )))

( And ( Atomic ( Right_idx End_idx ))

( Or ( Atomic ( Left_idx End_idx )) ( End_idx )))))

: forall x y z : nat ,

x < S S y ) nat => y ) ( y ) () ()) z ) () ())))) ( Atomic ))))) ( Atomic ))))))) ( Atomic ))))) y /\ y z \/ y z /\ x y --> y z /\ ( x y \/ x Our goal contained three distinct atomic formulas, and we see that a three-element varmap is generated. It can be interesting to observe differences between the level of repetition in proof terms generated by my_tauto tauto for especially trivial theorems. Our goal contained three distinct atomic formulas, and we see that a three-elementis generated.It can be interesting to observe differences between the level of repetition in proof terms generated byandfor especially trivial theorems.



Theorem mt4 : True /\ True /\ True /\ True /\ True /\ True /\ False --> False .

my_tauto .

Qed .



Print mt4 .





mt4 =

partialOut

( my_tauto ( Empty_vm Prop )

( Imp

( And Truth

( And Truth

( And Truth ( And Truth ( And Truth ( And Truth



: True /\ True /\ True /\ True /\ True /\ True /\ False --> False Falsehood )))))) Falsehood ))/\/\/\/\/\/\-->



Theorem mt4' : True /\ True /\ True /\ True /\ True /\ True /\ False -> False .

tauto .

Qed .





Print mt4' .

->



mt4' =

fun H : True /\ True /\ True /\ True /\ True /\ True /\ False =>

and_ind

( fun ( _ : True ) ( True /\ True /\ True /\ True /\ True /\ False ) =>

and_ind

( fun ( _ : True ) ( True /\ True /\ True /\ True /\ False ) =>

and_ind

( fun ( _ : True ) ( H5 : True /\ True /\ True /\ False ) =>

and_ind

( fun ( _ : True ) ( H7 : True /\ True /\ False ) =>

and_ind

( fun ( _ : True ) ( H9 : True /\ False ) =>

and_ind ( fun ( _ : True ) ( H11 : False ) => False_ind False H11 )

H9 ) H7 ) H5 ) H3 ) H1 ) H

: True /\ True /\ True /\ True /\ True /\ True /\ False -> False /\/\/\/\/\/\=>) ( H1 /\/\/\/\/\) =>) ( H3 /\/\/\/\) =>) (/\/\/\) =>) (/\/\) =>) (/\) =>) () =>/\/\/\/\/\/\-> The traditional tauto tactic introduces a quadratic blow-up in the size of the proof term, whereas proofs produced by my_tauto Manual Reification of Terms with Variables The traditionaltactic introduces a quadratic blow-up in the size of the proof term, whereas proofs produced byalways have linear size.





quote tactic above may seem like magic. Somehow it performs equality comparison between subterms of arbitrary types, so that these subterms may be represented with the same reified variable. While quote is implemented in OCaml, we can code the reification process completely in Ltac, as well. To make our job simpler, we will represent variables as nat Step one of the process is to crawl over a term, building a duplicate-free list of all values that appear in positions we will encode as variables. A useful helper function adds an element to a list, preventing duplicates. Note how we use Ltac pattern matching to implement an equality test on Gallina terms; this is simple syntactic equality, not even the richer definitional equality. We also represent lists as nested tuples, to allow different list elements to have different Gallina types. The action of thetactic above may seem like magic. Somehow it performs equality comparison between subterms of arbitrary types, so that these subterms may be represented with the same reified variable. Whileis implemented in OCaml, we can code the reification process completely in Ltac, as well. To make our job simpler, we will represent variables ass, indexing into a simple list of variable values that may be referenced.Step one of the process is to crawl over a term, building a duplicate-free list of all values that appear in positions we will encode as variables. A useful helper function adds an element to a list, preventing duplicates. Note how we use Ltac pattern matching to implement an equality test on Gallina terms; this is simple syntactic equality, not even the richer definitional equality. We also represent lists as nested tuples, to allow different list elements to have different Gallina types.



Ltac inList x xs :=

match xs with

| tt => false

| ( x , _ ) => true

| ( _ , ? xs' ) => inList x xs'

end .



Ltac addToList x xs :=

let b := inList x xs in

match b with

| true => xs

| false => constr : ( x , xs )

end .





Now we can write our recursive function to calculate the list of variable values we will want to use to represent a term.



Ltac allVars xs e :=

match e with

| True => xs

| False => xs

| ? e1 /\ ? e2 =>

let xs := allVars xs e1 in

allVars xs e2

| ? e1 \/ ? e2 =>

let xs := allVars xs e1 in

allVars xs e2

| ? e1 -> ? e2 =>

let xs := allVars xs e1 in

allVars xs e2

| _ => addToList e xs

end .





We will also need a way to map a value to its position in a list.



Ltac lookup x xs :=

match xs with

| ( x , _ ) => O

| ( _ , ? xs' ) =>

let n := lookup x xs' in

constr :( S n )

end .





formula index is replaced by nat The next building block is a procedure for reifying a term, given a list of all allowed variable values. We are free to make this procedure partial, where tactic failure may be triggered upon attempting to reify a term containing subterms not included in the list of variables. The type of the output term is a copy ofwhereis replaced by, in the type of the constructor for atomic formulas.

Note that, when we write our own Ltac procedure, we can work directly with the normal -> operator, rather than needing to introduce a wrapper for it.



Ltac reifyTerm xs e :=

match e with

| True => constr : Truth'

| False => constr : Falsehood'

| ? e1 /\ ? e2 =>

let p1 := reifyTerm xs e1 in

let p2 := reifyTerm xs e2 in

constr :( p1 p2 )

| ? e1 \/ ? e2 =>

let p1 := reifyTerm xs e1 in

let p2 := reifyTerm xs e2 in

constr :( p1 p2 )

| ? e1 -> ? e2 =>

let p1 := reifyTerm xs e1 in

let p2 := reifyTerm xs e2 in

constr :( p1 p2 )

| _ =>

let n := lookup e xs in

constr :( n )

end .



:==>=>| ?=>:=:=:( And' | ?=>:=:=:( Or' | ?-> ?=>:=:=:( Imp' =>:=:( Atomic'

Finally, we bring all the pieces together.



Ltac reify :=

match goal with

| [ |- ? G ] => let xs := allVars tt G in

let p := reifyTerm xs G in

pose p

end .





A quick test verifies that we are doing reification correctly.



Theorem mt3' : forall x y z ,

( x < y /\ y > z ) \/ ( y > z /\ x < S y )

-> > z /\ ( x < y \/ x < S y ) .

do 3 intro ; reify .



-> y

Abort .





More work would be needed to complete the reflective tactic, as we must connect our new syntax type with the real meanings of formulas, but the details are the same as in our prior implementation with quote .





Building a Reification Tactic that Recurses Under Binders All of our examples so far have stayed away from reifying the syntax of terms that use such features as quantifiers and fun function abstractions. Such cases are complicated by the fact that different subterms may be allowed to reference different sets of free variables. Some cleverness is needed to clear this hurdle, but a few simple patterns will suffice. Consider this example of a simple dependently typed term language, where a function abstraction body is represented conveniently with a Coq function. All of our examples so far have stayed away from reifying the syntax of terms that use such features as quantifiers andfunction abstractions. Such cases are complicated by the fact that different subterms may be allowed to reference different sets of free variables. Some cleverness is needed to clear this hurdle, but a few simple patterns will suffice. Consider this example of a simple dependently typed term language, where a function abstraction body is represented conveniently with a Coq function.



Inductive type : Type :=

| Nat : type

| NatFunc : type -> type .



Inductive term : type -> Type :=

| Const : nat -> Nat

| Plus : term Nat

| Abs : forall t , ( nat -> NatFunc



Fixpoint typeDenote ( t : type ) : Type :=

match t with

| nat

| NatFunc t => nat -> t

end .



Fixpoint termDenote t ( e : term

match e with

| Const n => n

| Plus e1 e2 => e1 + termDenote e2

| Abs _ e1 => fun x => e1 x )

end .



:=->->:=-> term Nat -> term Nat -> term , (-> term t ) -> term t ).) ::= Nat =>=>-> typeDenote t ) : typeDenote t :==>=> termDenote =>=> termDenote

Here is a naive first attempt at a reification tactic.



Ltac refl' e :=

match e with

| ? E1 + ? E2 =>

let r1 := refl' E1 in

let r2 := refl' E2 in

constr :( r1 r2 )



| fun x : nat => ? E1 =>

let r1 := refl' E1 in

constr :( fun x => r1



| _ => constr :( e )

end .



:=| ?=>:=:=:( Plus => ?=>:=:( Abs => x ))=>:( Const

? X only matches terms that do not mention new variables introduced within the pattern. In our naive implementation, the case for matching function abstractions matches the function body in a way that prevents it from mentioning the function argument! Our code above plays fast and loose with the function body in a way that leads to independent problems, but we could change the code so that it indeed handles function abstractions that ignore their arguments. To handle functions in general, we will use the pattern variable form @? X , which allows X to mention newly introduced variables that are declared explicitly. A use of @? X must be followed by a list of the local variables that may be mentioned. The variable X then comes to stand for a Gallina function over the values of those variables. For instance: Recall that a regular Ltac pattern variableonly matches terms that. In our naive implementation, the case for matching function abstractions matches the function body in a way that prevents it from mentioning the function argument! Our code above plays fast and loose with the function body in a way that leads to independent problems, but we could change the code so that it indeed handles function abstractions that ignore their arguments.To handle functions in general, we will use the pattern variable form, which allowsto mention newly introduced variables that are declared explicitly. A use ofmust be followed by a list of the local variables that may be mentioned. The variablethen comes to stand for a Gallina function over the values of those variables. For instance:



Reset refl' .

Ltac refl' e :=

match e with

| ? E1 + ? E2 =>

let r1 := refl' E1 in

let r2 := refl' E2 in

constr :( r1 r2 )



| fun x : nat => @? E1

let r1 := refl' E1 in

constr :( r1 )



| _ => constr :( e )

end .



:=| ?=>:=:=:( Plus => @? x =>:=:( Abs =>:( Const

E1 as a function from an x refl' as a function over the values of variables introduced during recursion. Now, in the abstraction case, we bindas a function from anvalue to the value of the abstraction body. Unfortunately, our recursive call there is not destined for success. It will match the same abstraction pattern and trigger another recursive call, and so on through infinite recursion. One last refactoring yields a working procedure. The key idea is to consider every input toas



Reset refl' .

Ltac refl' e :=

match eval simpl in e with

| fun x : ? T => @? E1 x + @? E2

let r1 := refl' E1 in

let r2 := refl' E2 in

constr :( fun x => r1 r2



| fun ( x : ? T ) ( y : nat ) => @? E1 x

let r1 := refl' ( fun p : T * nat => E1 ( fst snd in

constr :( fun x => fun y => r1 ( x , y ) ))



| _ => constr :( fun x => e

end .



:=: ?=> @?@? x =>:=:=:(=> Plus x ) ( x )): ?) () => @? y =>:==> p ) ( p )):(=> Abs =>))=>:(=> Const x ))

@? X patterns. The abstraction case introduces a new variable by extending the type used to represent the free variables. In particular, the argument to refl' used type T T * nat simpl reduction on the function argument, in the first line of the body of refl' . Now one more tactic provides an example of how to apply reification. Let us consider goals that are equalities between terms that can be reified. We want to change such goals into equalities between appropriate calls to termDenote Note how now even the addition case works in terms of functions, withpatterns. The abstraction case introduces a new variable by extending the type used to represent the free variables. In particular, the argument toused typeto represent all free variables. We extend the type tofor the type representing free variable values within the abstraction body. A bit of bookkeeping with pairs and their projections produces an appropriate version of the abstraction body to pass in a recursive call. To ensure that all this repackaging of terms does not interfere with pattern matching, we add an extrareduction on the function argument, in the first line of the body ofNow one more tactic provides an example of how to apply reification. Let us consider goals that are equalities between terms that can be reified. We want to change such goals into equalities between appropriate calls to



Ltac refl :=

match goal with

| [ |- ? E1 = ? E2 ] =>

let E1' := refl' ( fun _ : unit => E1 ) in

let E2' := refl' ( fun _ : unit => E2 ) in

change ( termDenote ( E1' tt ) = termDenote ( E2' tt ));

cbv beta iota delta [ fst snd ]

end .



Goal ( fun ( x y : nat ) => + y + 13 ) = ( fun ( _ z : nat ) => ) .

refl .

:=| [ |- ?] =>:==>:==>));) => x 13) => z



Abort .



