How to solve ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b in Lean - boolean

I tried solving this but could not, any help? My solution so far:
example : ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b :=
begin
assume a b,
cases a:b,
cases b,
cases a,
have c : tt ≠ ff,
contradiction,
sorry,
end

This is a very unusual question for me (I'm a mathematician so bool doesn't exist for me), so I may be missing the efficient way to do it, but you can certainly case bash on all possibilities for a tt, a ff and b.
example : ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b :=
begin
assume a b,
cases h₁ : a tt ;
cases h₂ : a ff ;
cases b,
repeat { rw h₁ <|> rw h₂ },
end
(slightly simplified in edit)
Don't hesitate to ask if part of the syntax is unclear (or better, come and ask on Zulip).
I'm not really sure what you were doing in your attempt. But your line cases a:b creates a new thing called a in your context, which is very likely to cause confusion. And the fact that the contradiction tactic succeeds is an unfortunate accident, it would be clearer to use trivial here.

Using your tactic style:
example : ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b :=
begin
assume a b,
-- split reasoning into b as ff or tt
cases hb : b,
{ -- in this case, all b is now ff
-- so let's split what (a ff) is into ff and tt
-- since we have two (a ff) expressions in our goal
cases hf : a ff,
{ -- this case is where (a ff) = ff,
-- so we use it directly twice
exact hf.symm ▸ hf },
{ -- in this case, (a ff) = tt, so now we have
-- the expression (a tt) in our goal
-- we split it into the cases ff and tt
cases ht : a tt,
{ -- in this case, we already have the goal, use it
exact hf },
{ -- in this case, we already have the goal, use it
exact ht } } },
{ -- in this case, all b is now ff
-- so let's split what (a tt) is into ff and tt
-- since we have two (a tt) expressions in our goal
cases ht : a tt,
{ -- in this case, (a tt) = ff, so now we have
-- the expression (a ff) in our goal
-- we split it into the cases ff and tt
cases hf : a ff,
{ -- in this case, we already have the goal, use it
exact hf },
{ -- in this case, we already have the goal, use it
exact ht } },
{ -- this case is where (a tt) = tt,
-- so we use it directly twice
exact ht.symm ▸ ht } },
end
and in a case-bash variant, still without tactics:
example : ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b :=
begin
intros a b,
-- split reasoning into b as ff or tt
cases hb : b;
-- and for all cases, split reasoning of the (a ff) expression
cases hf : a ff;
-- and for all cases, split reasoning of the (a tt) expression
cases ht : a tt,
-- now deal with all cases
{ exact hf.symm ▸ hf },
{ exact hf.symm ▸ hf },
{ exact hf },
{ exact ht },
{ exact hf.symm ▸ hf },
{ exact ht.symm ▸ ht },
{ exact hf.symm ▸ ht },
{ exact ht.symm ▸ ht },
end
and finally, using simple tactics:
example : ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b :=
begin
intros a b,
-- split reasoning into b as ff or tt
cases hb : b;
-- and for all cases, split reasoning of the (a ff) expression
cases hf : a ff;
-- and for all cases, split reasoning of the (a tt) expression
cases ht : a tt;
-- now deal with all cases using tactics
all_goals {
-- we can try rewriting either (a ff) or (a tt) which must occur
-- in the goal expression because of the original (a b) expression
-- and only one of those is present, so we use the
-- <|> syntax to try the second tactic (rw) if the first one fails
rw ht <|> rw hf,
-- now, either we've formed a reflexive equality and we're done
-- or the equality we're left with is of the form (a tt = ff)
-- which we'll have as an assumption
-- if tactic we tried to use here was a plain "assumption",
-- that would fail in the cases where we had already solved the goal
-- so we wrap it in a "try"
try { assumption } },
end

Here is a cheating solution:
import tactic.fin_cases
example : ∀ a : bool → bool, ∀ b : bool, a (a (a b)) = a b :=
begin
intros a b,
fin_cases a; fin_cases b; refl
end
Here fin_cases is a tactic from mathlib. It does cases analysis on a : α if it can find a computable [fintype α]. So, mathematically the solution says: consider all cases, verify that in each case we have a definitional equality.

Related

How does the induction principle for the singleton type unit in Coq work?

I was going through Adam Chlipala's book on Coq and it defined the inductive type:
Inductive unit : Set :=
| tt.
I was trying to understand its induction principle:
Check unit_ind.
(* unit_ind
: forall P : unit -> Prop, P tt -> forall u : unit, P u *)
I am not sure if I understand what the output of Coq means.
1) So check gives me a look at the type of "objects" right? So unit_ind has type:
forall P : unit -> Prop, P tt -> forall u : unit, P u
Right?
2) How does one read that type? I am having trouble understanding where to put the parenthesis or something...For the first thing before the comma, it doesn't make sense to me to read it as:
IF "for all P of type unit" THEN " Prop "
since the hypothesis is not really something true or false. So I assume the real way to real the first thing is this way:
forall P : (unit -> Prop), ...
so P is just a function of type unit to prop. Is this correct?
I wish this was correct but under that interpretation I don't know how to read the part after the first comma:
P tt -> forall u : unit, P u
I would have expected all the quantifications of variables in existence to be defined at the beginning of the proposition but thats not how its done, so I am not sure what is going on...
Can someone help me read this proposition both formally and intuitively? I also want to understand conceptually what it's trying to say and not only get bugged down by the details of it.
Let me put some extra (not really necessary) parentheses:
forall P : unit -> Prop, P tt -> (forall u : unit, P u)
I would translate it as "For any predicate P over the unit type, if P holds of tt, then P holds of any term of type unit".
Intuitively, since tt is the only value of type unit, it makes sense to only prove P for this unique value.
You can check if this intuition works for you by trying to interpret the induction principle for the bool type in the same manner.
Check bool_ind.
bool_ind
: forall P : bool -> Prop, P true -> P false -> (forall b : bool, P b)

Coq: How to prove if statements involving strings?

I have a string a and on comparison with string b, if equals has an string c, else has string x. I know in the hypothesis that fun x <= fun c. How do I prove this below statement? fun is some function which takes in string and returns nat.
fun (if a == b then c else x) <= S (fun c)
The logic seems obvious but I am unable to split the if statements in coq. Any help would be appreciated.
Thanks!
Let me complement Yves answer pointing out to a general "view" pattern that works well in many situations were case analysis is needed. I will use the built-in support in math-comp but the technique is not specific to it.
Let's assume your initial goal:
From mathcomp Require Import all_ssreflect.
Variables (T : eqType) (a b : T).
Lemma u : (if a == b then 0 else 1) = 2.
Proof.
now, you could use case_eq + simpl to arrive to next step; however, you can also match using more specialized "view" lemmas. For example, you could use ifP:
ifP : forall (A : Type) (b : bool) (vT vF : A),
if_spec b vT vF (b = false) b (if b then vT else vF)
where if_spec is:
Inductive if_spec (A : Type) (b : bool) (vT vF : A) (not_b : Prop) : bool -> A -> Set :=
IfSpecTrue : b -> if_spec b vT vF not_b true vT
| IfSpecFalse : not_b -> if_spec b vT vF not_b false vF
That looks a bit confusing, the important bit is the parameters to the type family bool -> A -> Set. The first exercise is "prove the ifP lemma!".
Indeed, if we use ifP in our proof, we get:
case: ifP.
Goal 1: (a == b) = true -> 0 = 2
Goal 2: (a == b) = false -> 1 = 2
Note that we didn't have to specify anything! Indeed, lemmas of the form { A
} + { B } are just special cases of this view pattern. This trick works in many other situations, for example, you can also use eqP, which has a spec relating the boolean equality with the propositional one. If you do:
case: eqP.
you'll get:
Goal 1: a = b -> 0 = 2
Goal 2: a <> b -> 1 = 2
which is very convenient. In fact, eqP is basically a generic version of the type_dec principle.
If you can write an if-then-else statement, it means that the test expression a == b is in a type with two constructors (like bool) or (sumbool). I will first assume the type is bool. In that case, the best approach during a proof is to enter the following command.
case_eq (a == b); intros hyp_ab.
This will generate two goals. In the first one, you will have an hypothesis
hyp_ab : a == b = true
that asserts that the test succeeds and the goal conclusion has the following shape (the if-then-else is replaced by the then branch):
fun c <= S (fun c)
In the second goal, you will have an hypothesis
hyp_ab : a == b = false
and the goal conclusion has the following shape (the if-then-else is replaced by the else branch).
fun x <= S (fun c)
You should be able to carry on from there.
On the other hand, the String library from Coq has a function string_dec with return type {a = b}+{a <> b}. If your notation a == b is a pretty notation for string_dec a b, it is better to use the following tactic:
destruct (a == b) as [hyp_ab | hyp_ab].
The behavior will be quite close to what I described above, only easier to use.
Intuitively, when you reason on an if-then-else statement, you use a command like case_eq, destruct, or case that leads you to studying separately the two executions paths, remember in an hypothesis why you took each of these executions paths.

How does the discriminate tactic work?

I was curious about how the discriminate tactic works behind the curtain. Therefore I did some experiments.
First a simple Inductive definition:
Inductive AB:=A|B.
Then a simple lemma which can be proved by the discriminate tactic:
Lemma l1: A=B -> False.
intro.
discriminate.
Defined.
Let's see what the proof looks like:
Print l1.
l1 =
fun H : A = B =>
(fun H0 : False => False_ind False H0)
(eq_ind A
(fun e : AB => match e with
| A => True
| B => False
end) I B H)
: A = B -> False
This looks rather complicated and I do not understand what is happening here. Therefore I tried to prove the same lemma more explicitly:
Lemma l2: A=B -> False.
apply (fun e:(A=B) => match e with end).
Defined.
Let's again see what Coq has made with this:
Print l2.
l2 =
fun e : A = B =>
match
e as e0 in (_ = a)
return
(match a as x return (A = x -> Type) with
| A => fun _ : A = A => IDProp
| B => fun _ : A = B => False
end e0)
with
| eq_refl => idProp
end
: A = B -> False
Now I am totally confused. This is still more complicated.
Can anyone explain what is going on here?
Let's go over this l1 term and describe every part of it.
l1 : A = B -> False
l1 is an implication, hence by Curry-Howard correspondence it's an abstraction (function):
fun H : A = B =>
Now we need to construct the body of our abstraction, which must have type False. The discriminate tactic chooses to implement the body as an application f x, where f = fun H0 : False => False_ind False H0 and it's just a wrapper around the induction principle for False, which says that if you have a proof of False, you can get a proof of any proposition you want (False_ind : forall P : Prop, False -> P):
(fun H0 : False => False_ind False H0)
(eq_ind A
(fun e : AB => match e with
| A => True
| B => False
end) I B H)
If we perform one step of beta-reduction, we'll simplify the above into
False_ind False
(eq_ind A
(fun e : AB => match e with
| A => True
| B => False
end) I B H)
The first argument to False_ind is the type of the term we are building. If you were to prove A = B -> True, it would have been False_ind True (eq_ind A ...).
By the way, it's easy to see that we can simplify our body further - for False_ind to work it needs to be provided with a proof of False, but that's exactly what we are trying to construct here! Thus, we can get rid of False_ind completely, getting the following:
eq_ind A
(fun e : AB => match e with
| A => True
| B => False
end) I B H
eq_ind is the induction principle for equality, saying that equals can be substituted for equals:
eq_ind : forall (A : Type) (x : A) (P : A -> Prop),
P x -> forall y : A, x = y -> P y
In other words, if one has a proof of P x, then for all y equal to x, P y holds.
Now, let's create step-by-step a proof of False using eq_ind (in the end we should obtain the eq_ind A (fun e : AB ...) term).
We start, of course, with eq_ind, then we apply it to some x - let's use A for that purpose. Next, we need the predicate P. One important thing to keep in mind while writing P down is that we must be able to prove P x. This goal is easy to achieve - we are going to use the True proposition, which has a trivial proof. Another thing to remember is the proposition we are trying to prove (False) - we should be returning it if the input parameter is not A.
With all the above the predicate almost writes itself:
fun x : AB => match x with
| A => True
| B => False
end
We have the first two arguments for eq_ind and we need three more: the proof for the branch where x is A, which is the proof of True, i.e. I. Some y, which will lead us to the proposition we want to get proof of, i.e. B, and a proof that A = B, which is called H at the very beginning of this answer. Stacking these upon each other we get
eq_ind A
(fun x : AB => match x with
| A => True
| B => False
end)
I
B
H
And this is exactly what discriminate gave us (modulo some wrapping).
Another answer focuses on the discriminate part, I will focus on the manual proof. You tried:
Lemma l2: A=B -> False.
apply (fun e:(A=B) => match e with end).
Defined.
What should be noted and makes me often uncomfortable using Coq is that Coq accepts ill-defined definitions that it internally rewrites into well-typed terms. This allows to be less verbose, since Coq adds itself some parts. But on the other hand, Coq manipulates a different term than the one we entered.
This is the case for your proof. Naturally, the pattern-matching on e should involve the constructor eq_refl which is the single constructor of the eq type. Here, Coq detects that the equality is not inhabited and thus understands how to modify your code, but what you entered is not a proper pattern-matching.
Two ingredients can help understand what is going on here:
the definition of eq
the full pattern-matching syntax, with as, in and return terms
First, we can look at the definition of eq.
Inductive eq {A : Type} (x : A) : A -> Prop := eq_refl : x = x.
Note that this definition is different from the one that seems more natural (in any case, more symmetric).
Inductive eq {A : Type} : A -> A -> Prop := eq_refl : forall (x:A), x = x.
This is really important that eq is defined with the first definition and not the second. In particular, for our problem, what is important is that, in x = y, x is a parameter while y is an index. That is to say, x is constant across all the constructors while y can be different in each constructor. You have the same difference with the type Vector.t. The type of the elements of a vector will not change if you add an element, that's why it is implemented as a parameter. Its size, however, can change, that's why it is implemented as an index.
Now, let us look at the extended pattern-matching syntax. I give here a very brief explanation of what I have understood. Do not hesitate to look at the reference manual for safer information. The return clause can help specify a return type that will be different for each branch. That clause can use the variables defined in the as and in clauses of the pattern-matching, which binds respectively the matched term and the type indices. The return clause will both be interpreted in the context of each branch, substituting the variables of as and in using this context, to type-check the branches one by one, and be used to type the match from an external point of view.
Here is a contrived example with an as clause:
Definition test n :=
match n as n0 return (match n0 with | 0 => nat | S _ => bool end) with
| 0 => 17
| _ => true
end.
Depending on the value of n, we are not returning the same type. The type of test is forall n : nat, match n with | 0 => nat | S _ => bool end. But when Coq can decide in which case of the match we are, it can simplify the type. For example:
Definition test2 n : bool := test (S n).
Here, Coq knows that, whatever is n, S n given to test will result as something of type bool.
For equality, we can do something similar, this time using the in clause.
Definition test3 (e:A=B) : False :=
match e in (_ = c) return (match c with | B => False | _ => True end) with
| eq_refl => I
end.
What's going on here ? Essentially, Coq type-checks separately the branches of the match and the match itself. In the only branch eq_refl, c is equal to A (because of the definition of eq_refl which instantiates the index with the same value as the parameter), therefore we claimed we returned some value of type True, here I. But when seen from an external point of view, c is equal to B (because e is of type A=B), and this time the return clause claims that the match returns some value of type False. We use here the capability of Coq to simplify pattern-matching in types that we have just seen with test2. Note that we used True in the other cases than B, but we don't need True in particular. We only need some inhabited type, such that we can return something in the eq_refl branch.
Going back to the strange term produced by Coq, the method used by Coq does something similar, but on this example, certainly more complicated. In particular, Coq often uses types IDProp inhabited by idProp when it needs useless types and terms. They correspond to True and I used just above.
Finally, I give the link of a discussion on coq-club that really helped me understand how extended pattern-matching is typed in Coq.

coq change premise 'negation of not equal' to 'equal'

Suppose I have a premise like this:
H2: ~ a b c <> a b c
And I wish to change it to:
a b c = a b c
Where
a is Term -> Term -> Term
b and c are both Term
How can I do it? Thanks!
If you unfold the definitions of ~ and <>, you hypothesis has the following type:
H2: (a b c = a b c -> False) -> False
Therefore, what you wish to achieve is what logicians usually call "double negation elimination". It is not an intuitionistically-provable theorem, and is therefore defined in the Classical module of Coq (see http://coq.inria.fr/distrib/V8.4/stdlib/Coq.Logic.Classical_Prop.html for details):
Classical.NNPP : forall (p : Prop), ~ ~ p -> p
I assume your actual problem is more involved than a b c = a b c, but for the sake of mentioning it, if you really care about obtaining that particular hypothesis, you can safely prove it without even looking at H2:
assert (abc_refl : a b c = a b c) by reflexivity.
If your actual example is not immediately reflexive and the equality is actually false, maybe you want to turn your goal into showing that H2 is absurd. You can do so by eliminating H2 (elim H2., which is basically doing a cut on the False type), and you will end up in the context:
H2 : ~ a b c <> a b c
EQ : a b c = a b c
=====================
False
I'm not sure whether all of this helps, but you might have oversimplified your problem so that I cannot provide more insight on what your real problem is.
Just a little thought to add to Ptival's answer - if your desired goal was not trivially solved by reflexivity, you could still make progress provided you had decidable equality on your Term, for example by applying this little lemma:
Section S.
Parameter T : Type.
Parameter T_eq_dec : forall (x y : T), {x = y} + {x <> y}.
Lemma not_ne : forall (x y : T), ~ (x <> y) -> x = y.
Proof.
intros.
destruct (T_eq_dec x y); auto.
unfold not in *.
assert False.
apply (H n).
contradiction.
Qed.
End S.

Can I extract a Coq proof as a Haskell function?

Ever since I learned a little bit of Coq I wanted to learn to write a Coq proof of the so-called division algorithm that is actually a logical proposition: forall n m : nat, exists q : nat, exists r : nat, n = q * m + r
I recently accomplished that task using what I learned from Software Foundations.
Coq being a system for developing constructive proofs, my proof is in effect a method to construct suitable values q and r from values m and n.
Coq has an intriguing facility for "extracting" an algorithm in Coq's algorithm language (Gallina) to general-purpose functional programming languages including Haskell.
Separately I have managed to write the divmod operation as a Gallina Fixpoint and extract that. I want to note carefully that that task is not what I'm considering here.
Adam Chlipala has written in Certified Programming with Dependent Types that "Many fans of the Curry-Howard correspondence support the idea of extracting programs from proofs. In reality, few users of Coq and related tools do any such thing."
Is it even possible to extract the algorithm implicit in my proof to Haskell? If it is possible, how would it be done?
Thanks to Prof. Pierce's summer 2012 video 4.1 as Dan Feltey suggested, we see that the key is that the theorem to be extracted must provide a member of Type rather than the usual kind of propositions, which is Prop.
For the particular theorem the affected construct is the inductive Prop ex and its notation exists. Similarly to what Prof. Pierce has done, we can state our own alternate definitions ex_t and exists_t that replace occurrences of Prop with occurrences of Type.
Here is the usual redefinition of ex and exists similarly as they are defined in Coq's standard library.
Inductive ex (X:Type) (P : X->Prop) : Prop :=
ex_intro : forall (witness:X), P witness -> ex X P.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
(at level 200, x ident, right associativity) : type_scope.
Here are the alternate definitions.
Inductive ex_t (X:Type) (P : X->Type) : Type :=
ex_t_intro : forall (witness:X), P witness -> ex_t X P.
Notation "'exists_t' x : X , p" := (ex_t _ (fun x:X => p))
(at level 200, x ident, right associativity) : type_scope.
Now, somewhat unfortunately, it is necessary to repeat both the statement and the proof of the theorem using these new definitions.
What in the world??
Why is it necessary to make a reiterated statement of the theorem and a reiterated proof of the theorem, that differ only by using an alternative definition of the quantifier??
I had hoped to use the existing theorem in Prop to prove the theorem over again in Type. That strategy fails when Coq rejects the proof tactic inversion for a Prop in the environment when that Prop uses exists and the goal is a Type that uses exists_t. Coq reports "Error: Inversion would require case analysis on sort Set which is not allowed
for inductive definition ex." This behavior occurred in Coq 8.3. I am not certain that it
still occurs in Coq 8.4.
I think the need to repeat the proof is actually profound although I doubt that I personally am quite managing to perceive its profundity. It involves the facts that Prop is "impredicative" and Type is not impredicative, but rather, tacitly "stratified". Predicativity is (if I understand correctly) vulnerability to Russell's paradox that the set S of sets that are not members of themselves can neither be a member of S, nor a non-member of S. Type avoids Russell's paradox by tacitly creating a sequence of higher types that contain lower types. Because Coq is drenched in the formulae-as-types interpretation of the Curry-Howard correspondence, and if I am getting this right, we can even understand stratification of types in Coq as a way to avoid Gödel incompleteness, the phenomenon that certain formulae express constraints on formulae such as themselves and thereby become unknowable as to their truth or falsehood.
Back on planet Earth, here is the repeated statement of the theorem using "exists_t".
Theorem divalg_t : forall n m : nat, exists_t q : nat,
exists_t r : nat, n = plus (mult q m) r.
As I have omitted the proof of divalg, I will also omit the proof of divalg_t. I will only mention that we do have the good fortune that proof tactics including "exists" and "inversion" work just the same with our new definitions "ex_t" and "exists_t".
Finally, the extraction itself is accomplished easily.
Extraction Language Haskell.
Extraction "divalg.hs" divalg_t.
The resulting Haskell file contains a number of definitions, the heart of which is the reasonably nice code, below. And I was only slightly hampered by my near-total ignorance of the Haskell programming language. Note that Ex_t_intro creates a result whose type is Ex_t; O and S are the zero and the successor function from Peano arithmetic; beq_nat tests Peano numbers for equality; nat_rec is a higher-order function that recurs over the function among its arguments. The definition of nat_rec is not shown here. At any rate it is generated by Coq according to the inductive type "nat" that was defined in Coq.
divalg :: Nat -> Nat -> Ex_t Nat (Ex_t Nat ())
divalg n m =
case m of {
O -> Ex_t_intro O (Ex_t_intro n __);
S m' ->
nat_rec (Ex_t_intro O (Ex_t_intro O __)) (\n' iHn' ->
case iHn' of {
Ex_t_intro q' hq' ->
case hq' of {
Ex_t_intro r' _ ->
let {k = beq_nat r' m'} in
case k of {
True -> Ex_t_intro (S q') (Ex_t_intro O __);
False -> Ex_t_intro q' (Ex_t_intro (S r') __)}}}) n}
Update 2013-04-24: I know a bit more Haskell now. To assist others in reading the extracted code above, I'm presenting the following hand-rewritten code that I claim is equivalent and more readable. I'm also presenting the extracted definitions Nat, O, S, and nat_rec that I did not eliminate.
-- Extracted: Natural numbers (non-negative integers)
-- in the manner in which Peano defined them.
data Nat =
O
| S Nat
deriving (Eq, Show)
-- Extracted: General recursion over natural numbers,
-- an interpretation of Nat in the manner of higher-order abstract syntax.
nat_rec :: a1 -> (Nat -> a1 -> a1) -> Nat -> a1
nat_rec f f0 n =
case n of {
O -> f;
S n0 -> f0 n0 (nat_rec f f0 n0)}
-- Given non-negative integers n and m, produce (q, r) with n = q * m + r.
divalg_t :: Nat -> Nat -> (Nat, Nat)
divalg_t n O = (O, n) -- n/0: Define quotient 0, remainder n.
divalg_t n (S m') = divpos n m' -- n/(S m')
where
-- Given non-negative integers n and m',
-- and defining m = m' + 1,
-- produce (q, r) with n = q * m + r
-- so that q = floor (n / m) and r = n % m.
divpos :: Nat -> Nat -> (Nat, Nat)
divpos n m' = nat_rec (O, O) (incrDivMod m') n
-- Given a non-negative integer m' and
-- a pair of non-negative integers (q', r') with r <= m',
-- and defining m = m' + 1,
-- produce (q, r) with q*m + r = q'*m + r' + 1 and r <= m'.
incrDivMod :: Nat -> Nat -> (Nat, Nat) -> (Nat, Nat)
incrDivMod m' _ (q', r')
| r' == m' = (S q', O)
| otherwise = (q', S r')
The current copy of Software Foundations dated July 25, 2012, answers this quite concisely in the late chapter "Extraction2". The answer is that it can certainly be done, much like this:
Extraction Language Haskell
Extraction "divalg.hs" divalg
One more trick is necessary. Instead of a Prop, divalg must be a Type. Otherwise it will be erased in the process of extraction.
Uh oh, #Anthill is correct, I haven't answered the question because I don't know how to explain how Prof. Pierce accomplished that in his NormInType.v variant of his Norm.v and MoreStlc.v.
OK, here's the rest of my partial answer anyway.
Where "divalg" appears above, it will be necessary to provide a space-separated list of all of the propositions (which must each be redefined as a Type rather than a Prop) on which divalg relies. For a thorough, interesting, and working example of a proof extraction, one may consult the chapter Extraction2 mentioned above. That example extracts to OCaml, but adapting it for Haskell is simply a matter of using Extraction Language Haskell as above.
In part, the reason that I spent some time not knowing the above answer is that I have been using the copy of Software Foundations dated October 14, 2010, that I downloaded in 2011.