Commit 7a02a82b by Pierre Letouzey

### Models.v reworked, lighter use of dependent types

parent 202004fd
 ... ... @@ -171,12 +171,15 @@ Qed. (** Which logic are we using : classical or intuitionistic ? *) Inductive logic := Classic | Intuiti. Inductive logic := K | J. Definition Classic := K. Definition Intuiti := J. Instance logic_eqb : Eqb logic := fun l1 l2 => match l1, l2 with | Classic, Classic | Intuiti, Intuiti => true | K, K | J, J => true | _, _ => false end. ... ...
This diff is collapsed.
 ... ... @@ -10,60 +10,17 @@ Import ListNotations. (** For function of arity [n], we re-use [NaryFunctions.nfun A n B] and its notation [A^^n-->B]. *) (** Then, a compact alternative to [option { n:nat & A^^n-->B }] *) Inductive optnfun A B := | NFun n (f:A^^n-->B) | Nop. Arguments Nop {A B}. Arguments NFun {A B} n f. Definition get_arity {A B} (f : optnfun A B) := match f with | Nop => None | NFun n _ => Some n end. Fixpoint mk_nprod {A} n (l:list A)(dft:A) : A^n := match n, l return A^n with | 0, _ => tt | S n, [] => (dft, mk_nprod n l dft) | S n, x::l => (x, mk_nprod n l dft) end. Definition build_args {A B} := fix build {n} (l : list A)(dft:B) : A^^n-->B -> B := match n, l with | 0, [] => fun f => f | S n, a :: l => fun f => build l dft (f a) | _, _ => fun _ => dft end. Definition optnapply {A B}(f:optnfun A B)(l:list A)(dft:B) := match f with | NFun _ f => build_args l dft f | Nop => dft end. Arguments nfun_to_nfun {A B C} f {n}. Arguments ncurry {A B n}. Arguments nuncurry {A B n}. Arguments nprod_to_list {A n}. Arguments nfun_to_nfun {A B C} f {n}. Lemma build_args_ntn {A B B' n} (l : list A)(f:B->B')(any:B)(any':B') : length l = n -> forall (a : A^^n-->B), build_args l any' (nfun_to_nfun f a) = f (build_args l any a). Proof. intros <-. induction l; simpl; auto. Qed. Lemma to_nprod {A} n (l:list A) : length l = n -> exists v : A^n, nprod_to_list v = l. Lemma nuncurry_ncurry {A B n} (f : A^n->B) (v:A^n) : nuncurry (ncurry f) v = f v. Proof. intros <-. exists (nprod_of_list _ l). induction l; cbn; f_equal; auto. induction n; cbn in *; auto. - now destruct v. - destruct v as (a,v). now rewrite IHn. Qed. Lemma nprod_to_list_length {A} n (v:A^n) : ... ... @@ -72,17 +29,73 @@ Proof. induction n; cbn; auto. destruct v; cbn; auto. Qed. Lemma build_args_nprod {A B} n (v:A^n) (f:A^^n-->B) (dft:B) : build_args (nprod_to_list v) dft f = nuncurry f v. Fixpoint nprod_map {A B} (f:A->B) {n} : A^n -> B^n := match n with | 0 => fun _ => tt | S n => fun '(a,v) => (f a, nprod_map f v) end. Lemma nprod_map_to_list {A B} (f:A->B) {n} (v:A^n) : nprod_to_list (nprod_map f v) = map f (nprod_to_list v). Proof. induction n; cbn; destruct v; cbn; f_equal; auto. Qed. (** A variant of [nprod_of_list] with a precise size as target *) Fixpoint optnprod {A} n (l:list A) : option (A^n) := match n, l return option (A^n) with | 0, [] => Some tt | S n, x::l => option_map (pair x) (optnprod n l) | _, _ => None end. Lemma optnprod_some {A} n (l:list A) : optnprod n l <> None <-> length l = n. Proof. induction n; cbn in *; auto. destruct v as (a,v). apply IHn. revert l. induction n; destruct l; cbn; try easy. specialize (IHn l). destruct (optnprod n l); cbn in *; intuition; try easy. f_equal. now apply H. Qed. Lemma nuncurry_ncurry {A B n} (f : A^n->B) (v:A^n) : nuncurry (ncurry f) v = f v. Lemma optnprod_to_list {A} n (l:list A) (v:A^n) : optnprod n l = Some v <-> nprod_to_list v = l. Proof. induction n; cbn in *; auto. revert l. induction n; destruct l; cbn in *. - now destruct v. - destruct v as (a,v). now rewrite IHn. - now intuition. - now intuition. - destruct v as (b,v). specialize (IHn v l). destruct (optnprod n l); cbn. + split; intros [= <- <-]; f_equal. now apply IHn. intuition. congruence. + split. easy. intros [= <- <-]. now intuition. Qed. (** Then, a compact alternative to [option { n:nat & A^^n-->B }] *) Inductive optnfun A B := | NFun n (f:A^^n-->B) | Nop. Arguments Nop {A B}. Arguments NFun {A B} n f. Definition get_arity {A B} (f : optnfun A B) := match f with | Nop => None | NFun n _ => Some n end. Definition optnapply {A B}(f:optnfun A B)(l:list A) := match f with | NFun n f => option_map (nuncurry f) (optnprod n l) | Nop => None end. Definition napply_dft {A B}(f:optnfun A B)(l:list A)(dft:B) := match optnapply f l with | Some b => b | None => dft end.
 ... ... @@ -14,11 +14,25 @@ Set Implicit Arguments. (** A pre-model (also called a Σ-structure) is a non-empty domain M alongside some interpretations for function symbols and predicate symbols. For a full model of a theorie, we'll need the axioms of the theories, and the facts that their interpretations are valid. *) (** TODO: a word why nfun (to use pristine functions like Nat.add in models *) symbols. For a full model of a theory, we'll need later to ensure that all axioms of this theory have valid interpretations, see [Models.v]. For encoding the interpretations of symbols, we use [Nary.optnfun], which is based on [NaryFunctions.nfun], the dependent type of functions of arity [n]. More precisely, an [optnfun] is either [Nop] for symbols not in the signature, or [NFun n f], where [f] is a function expecting [n] arguments. Note that [n] is internal (existential), and may be retrieved via [get_arity]. This choice of representation allows the direct use of Coq usual functions in concrete models, e.g. [NFun 2 Nat.add] for Peano's "+". But [nfun] may be tricky to use in proofs, so we often switch to an equivalent forms based on dependent n-uplets [NaryFunctions.nprod], thanks to [NaryFunctions.nuncurry] and [NaryFunctions.ncurry]. These n-uplets are iterated pairs, but Coq Vectors could also have been considered. *) Record PreModel (M:Type)(sign:signature) := { someone : M; (* M is non-empty *) ... ... @@ -29,7 +43,7 @@ Record PreModel (M:Type)(sign:signature) := }. (** Note: actually, we're not using [sign], [funsOk], [predsOK] anywhere in this file !! See [BogusPoint] below : anywhere in this part !! See [BogusPoint] below : if an interpretation hasn't the right arity, we'll proceed nonetheless, ending up with dummy formulas that won't allow later to prove that the axioms of our theory are valid in ... ... @@ -51,7 +65,7 @@ Definition interp_term G L := match t with | FVar x => G x | BVar n => nth n L BogusPoint | Fun f args => optnapply (funs Mo f) (List.map interp args) BogusPoint | Fun f args => napply_dft (funs Mo f) (List.map interp args) BogusPoint end. Definition interp_op o := ... ... @@ -73,7 +87,7 @@ Definition interp_form G := | Not f => ~(interp L f) | Op o f1 f2 => interp_op o (interp L f1) (interp L f2) | Pred p args => optnapply (preds Mo p) (List.map (interp_term G L) args) BogusProp napply_dft (preds Mo p) (List.map (interp_term G L) args) BogusProp | Quant All f => forall (m:M), interp (m::L) f | Quant Ex f => exists (m:M), interp (m::L) f end. ... ... @@ -294,8 +308,8 @@ Hint Resolve interp_ctx_cons. Definition CoqRequirements lg := match lg with | Classic => forall A:Prop, A\/~A | Intuiti => Logic.True | K => forall A:Prop, A\/~A | J => Logic.True end. (** Note: we do not ask here for the derivation [d] to be ... ...
 ... ... @@ -230,19 +230,20 @@ intros A0 [ | -> ] genv. rewrite interp_nforall. intros. rewrite app_nil_r. destruct stk as [|m l]; try easy. injection H as H. rewrite <- rev_length in H. destruct (to_nprod _ _ H) as (v & Hv). destruct (optnprod n (rev l)) as [v|] eqn:Ev. 2:{ exfalso. revert Ev. apply optnprod_some. now rewrite rev_length. } rewrite interp_form_bsubst_gen with (lenv' := phi v :: l); auto. + unfold th'. simpl. rewrite <- (interp_form_skolem_premodel_ext th M f n Phi mo); auto. * rewrite <- (rev_involutive l), <- Hv. apply Hphi. * apply optnprod_to_list in Ev. rewrite <- (rev_involutive l), <- Ev. apply Hphi. * clear -Thm. destruct Thm as (((CA,_),_),_). rewrite nForall_check in CA. apply CA. + simpl nth_error. f_equal. cbn. rewrite eqb_refl. rewrite interp_downvars, <- Hv by (now rewrite rev_length in H). symmetry. clear -v. unfold Phi. rewrite <- (nuncurry_ncurry phi v). cbn. apply build_args_nprod. rewrite interp_downvars; auto. unfold Phi. unfold napply_dft. cbn. rewrite Ev. cbn. now rewrite nuncurry_ncurry. + destruct k; try easy. Qed. ... ...
 ... ... @@ -30,6 +30,11 @@ Proof. reflexivity. Qed. Lemma option_nat_dec (o o' : option nat) : { o = o' }+{ o <> o' }. Proof. decide equality. apply Nat.eq_dec. Defined. (** Generic boolean equalities (via Coq Classes) *) Delimit Scope eqb_scope with eqb. ... ... @@ -414,6 +419,14 @@ Proof. apply max_mono; auto. Qed. Lemma list_max_map_ext {A} (f g : A->nat) l : (forall a, In a l -> f a = g a) -> list_max (map f l) = list_max (map g l). Proof. intros H. induction l; cbn in *; auto. Qed. Lemma list_max_in l a : In a l -> a <= list_max l. Proof. induction l; simpl. ... ... @@ -457,6 +470,13 @@ Proof. induction l; simpl; f_equal; auto. Qed. Lemma forallb_ext {A} (f f':A->bool) l : (forall a, In a l -> f a = f' a) -> forallb f l = forallb f' l. Proof. induction l; intros E; cbn in *; auto. rewrite <- E by now left. f_equal. apply IHl. intros a' Ha'. apply E. now right. Qed. (** Nth *) Lemma nth_error_some_nth {A} (l:list A) n a d : ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!