(* Reynold's theorem states that there are no set theoretic models of System F * System F can be intepreted in impredicative set. Thus impredicative set * plus functional extentionality plus Streicher's axiom K has no set theoretic * models. This is all well known. *) Definition T (x:Set) : Set := (x -> bool) -> bool. Definition map (a b:Set) (f: a -> b) (m : T a) : T b := fun c => m (fun x => c (f x)). Definition P : Set := forall k:Set, (T k -> k) -> k. Definition rho (A:Set) (f: T A -> A) (p:P) : A := p A f. Definition H (q:T P) : P := fun k f => f (map P k (rho k f) q). Lemma rho_comm : forall A f x, f (map _ _ (rho A f) x) = (rho A f) (H x). compute. reflexivity. Qed. Definition P' := {p : P | forall (A B:Set) (a: A -> B) (f1: T A -> A) (f2: T B -> B), (forall x, a (f1 x) = f2 (map A B a x)) -> rho B f2 p = a (rho A f1 p) }. Require Import FunctionalExtensionality. Definition J (x:P') : P := let (y,_) := x in y. Definition H' (q:T P') : P'. intros q. exists (H (map P' P J q)). intros. assert (HJ : forall x, (rho B f2 (J x)) = a (rho A f1 (J x))). intros [x' Hx']. simpl. apply Hx'. apply H0. unfold rho at 1. unfold H at 1. unfold rho at 2. unfold H at 1. rewrite H0. unfold map. apply f_equal. extensionality x. apply f_equal. extensionality y. apply f_equal. apply HJ. Defined. Definition rho' (A:Set) f (x:P') : A := rho A f (J x). Definition rho0' (x:P') := rho' P' H' x. Lemma rho0'_comm : forall x, H' (map P' P' rho0' x) = rho0' (H' x). Proof. reflexivity. Qed. Lemma ThreeA : forall A (f: T A -> A) (theta: P' -> A), (forall x, f (map P' A theta x) = theta (H' x)) -> forall z, rho' A f z = theta (rho0' z). Proof. intros A f theta Hf [z Hz]. simpl in *. unfold rho in Hz. apply Hz. symmetry. apply Hf. Qed. Lemma ThreeB : forall A (f: T A -> A) (theta: P' -> A) x, f (map P' A (rho' A f) x) = rho' A f (H' x). Proof. reflexivity. Qed. Lemma rho0'_idemp : forall x, rho0' (rho0' x) = rho0' x. symmetry. apply ThreeA. reflexivity. Qed. Definition P'' := {p | rho0' p = p}. Definition Gamma (x:P') : P''. intros x. exists (rho0' x). apply rho0'_idemp. Defined. Definition Kappa (x:P'') : P' := let (y,_) := x in y. Definition H'' (q:T P'') : P'' := Gamma (H' (map P'' P' Kappa q)). Definition rho'' (A:Set) f (x:P'') : A := rho' A f (Kappa x). Lemma KappaGamma : (fun x => Kappa(Gamma x)) = rho0'. extensionality x. reflexivity. Qed. Require Eqdep. Lemma GammaKappa : forall x, Gamma (Kappa x) = x. intros [x Hx]. simpl in *. unfold Gamma. generalize (rho0'_idemp x). rewrite Hx. intros e. replace e with Hx. reflexivity. apply Eqdep.EqdepTheory.UIP. Qed. Lemma F : forall x, Kappa (H'' x) = H' (map P'' P' Kappa x). Proof. intros x. unfold H''. change (rho0' (H' (map P'' P' Kappa x)) = H' (map P'' P' Kappa x)). rewrite <- rho0'_comm. rewrite <- KappaGamma. change (H' (map P'' P' (fun x0 : P'' => Kappa (Gamma (Kappa x0))) x) = H' (map P'' P' Kappa x)). replace (fun x0 : P'' => Kappa (Gamma (Kappa x0))) with Kappa. reflexivity. symmetry. extensionality y. rewrite GammaKappa. reflexivity. Qed. Lemma Gish : forall x,Gamma (H' x) = H'' (map P' P'' Gamma x). Proof. intros x. rewrite <- (GammaKappa (Gamma (H' x))). change (Kappa (Gamma (H' x))) with (rho0' (H' x)). rewrite <- rho0'_comm. rewrite <- KappaGamma. change (map P' P' (fun x0 : P' => Kappa (Gamma x0)) x) with (map _ _ Kappa (map _ _ Gamma x)). rewrite <- F. rewrite GammaKappa. reflexivity. Qed. Lemma D1 : forall A (f: T A -> A) (theta: P'' -> A), (forall x,f (map P'' A (fun x =>theta x) x) = theta (H'' x)) -> forall z, rho'' A f z = theta z. Proof. intros A f theta H0 z. unfold rho''. rewrite (ThreeA A f (fun x => theta (Gamma x))). rewrite <- KappaGamma. do 2 rewrite GammaKappa. reflexivity. intros x. change (map P' A (fun x0 : P' => theta (Gamma x0)) x) with (map _ _ (fun x0 : P'' => theta x0) (map _ _ Gamma x)). rewrite H0. apply f_equal. symmetry. apply Gish. Qed. Lemma D2 : forall A f x, f (map P'' A (rho'' A f) x) = (rho'' A f (H'' x)). Proof. intros A f x. unfold rho''. rewrite F. reflexivity. Qed. Definition G'' (x:P'') : T P'' := rho'' (T P'') (map (T P'') P'' H'') x. Lemma TGH : forall x, (G'' (H'' x)) = map _ _ H'' (map _ _ G'' x). Proof. symmetry. apply D2. Qed. Lemma iso1 : forall x, (H'' (G'' x)) = x. intros x. transitivity (rho'' P'' H'' x). symmetry. change (H'' (G'' x)) with ((fun x => (H'' (G'' x))) x). apply D1. intros y. rewrite TGH. reflexivity. change (rho'' P'' H'' x = (fun x => x) x). apply D1. intros y. reflexivity. Qed. Lemma iso2 : forall x, (G'' (H'' x)) = x. Proof. intros x. rewrite TGH. change (map _ _ (fun x => H'' (G'' x)) x = x). replace (fun x => (H'' (G'' x))) with (fun x:P'' => x). extensionality y. unfold map. apply f_equal. extensionality z. reflexivity. extensionality y. symmetry. apply iso1. Qed. Record ReynoldsStatement := { A : Set; f : ((A -> bool) -> bool) -> A; g : A -> (A -> bool) -> bool; isoA : forall x, f (g x) = x; isoB : forall x, g (f x) = x }. Theorem Reynolds : ReynoldsStatement. exists P'' H'' G''. apply iso1. apply iso2. Defined.