File FOEquality_ProofSystem

From MatchingLogic Require Export DeductionTheorem.
Import MatchingLogic.Logic.Notations
       MatchingLogic.Theories.Definedness_Syntax.Notations.


Open Scope list_scope.

Lemma membership_imp_equal {Σ : Signature} {syntax : Syntax} Γ φ φ' :
  theoryΓmu_free φ' →
  well_formed φ → well_formed φ' →
  Γ ⊢ (ex , (φ =ml b0)) --->
      (ex , (φ' =ml b0)) --->
      (φ ∈ml φ') ---> (φ =ml φ').

Lemma membership_imp_equal_meta {Σ : Signature} {syntax : Syntax} Γ φ φ' :
    theoryΓmu_free φ' →
    well_formed φ → well_formed φ' →
    Γ ⊢ (ex , (φ =ml b0)) →
    Γ ⊢ (ex , (φ' =ml b0)) →
    Γ ⊢ (φ ∈ml φ') ---> (φ =ml φ') .

Lemma membership_impl_subseteq {Σ : Signature} {syntax : Syntax} Γ g ψ :
  theoryΓmu_free ψ → mu_free g
  well_formed gwell_formed ψ →
  Γ ⊢ (ex , (g =ml b0)) →
  Γ ⊢ (gml ψ) →
  Γ ⊢ (gml ψ).
Lemma functional_pattern_defined {Σ : Signature} {syntax : Syntax} :
   Γ φ, theoryΓwell_formed φ →
     Γ ⊢ (ex , (φ =ml b0)) ---> ⌈ φ ⌉.

Lemma membership_equal_equal {Σ : Signature} {syntax : Syntax} :
   Γ φ φ',
    theoryΓmu_free φ' →
    well_formed φ → well_formed φ' →
    Γ ⊢ (ex , (φ =ml b0)) →
    Γ ⊢ (ex , (φ' =ml b0)) →
    Γ ⊢ (φ ∈ml φ') =ml (φ =ml φ') .

Lemma funcional_application {Σ : Signature} {syntax : Syntax} Γ t1 t2 :
  theoryΓ
  well_formed t1
  well_formed t2
  Γ ⊢ (ex , t2 =ml b0) ---> (all , ex , (t1b1)%ml =ml b0) --->
    ex , (t1t2)%ml =ml b0.

Section nary_functions.

  Context {Σ : Signature} {syntax : Syntax}.
  Fixpoint nary_function (f : Pattern) (n : nat) :=
    match n with
    | 0 ⇒ ex , f =ml b0
    | S n'all , nary_function (fpatt_bound_evar (S n')) n'
    end.

  Definition nary_function_symbol (f : symbols) (n : nat) := nary_function (patt_sym f) n.

  Eval simpl in nary_function patt_bott 3.

  Lemma nary_function_well_formed_positive :
     n φ, well_formed_positive φ → well_formed_positive (nary_function φ n).

  Lemma nary_function_well_formed_closed_mu_aux :
     m n φ, well_formed_closed_mu_aux φ n
      well_formed_closed_mu_aux (nary_function φ m) n.

  Lemma nary_function_well_formed_closed_ex_aux_helper :
     m n φ,
      n > m
      well_formed_closed_ex_aux φ n
      well_formed_closed_ex_aux (nary_function φ m) (n - S m).

  Lemma nary_function_well_formed_closed_ex_aux :
     m n φ, well_formed_closed_ex_aux φ n
      well_formed_closed_ex_aux (nary_function φ m) (n - S m).

  Lemma nary_function_mu_free :
     m φ, mu_free φ → mu_free (nary_function φ m).

  Lemma nary_function_bevar_subst :
     m n φ ψ,
      (nary_function φ m)^[evar:n↦ψ] =
      (nary_function φ^[evar: S m + n ↦ ψ] m).

  Lemma function_application_many Γ l φ :
    theoryΓ
    wf l
    well_formed φ →
    mu_free φ →
    foldr andb true (map mu_free l) →
    Γnary_function φ (length l) --->
        foldr (fun p acc ⇒ (ex , p =ml b0) ---> acc)
              (ex , foldl patt_app φ l =ml b0) l.

End nary_functions.

Fixpoint deconstruct_function {Σ : Signature} (pat : Pattern) : option (symbols × list Pattern) :=
match pat with
| patt_app t1 t2match deconstruct_function t1 with
                    | Some (f, pats) ⇒ Some (f, pats ++ [t2])
                    | _None
                    end
| patt_sym sSome (s, [])
| _None
end.

Ltac mlSplitAnds :=
match goal with
[ |- @of_MLGoal _ (@mkMLGoal _ ?Γ _ (patt_and _ _) _)] ⇒
  mlSplitAnd; mlSplitAnds
| _idtac
end.

Ltac solve_functional_var :=
lazymatch goal with
[ |- @of_MLGoal _ (@mkMLGoal _ ?Γ _ (ex, patt_free_evar ?x =ml b0) _)] ⇒
  mlExists x;
  mlSimpl; cbn; try (rewrite bevar_subst_not_occur; wf_auto2);
  mlReflexivity
| [ |- _ ] ⇒ fail "Not a functional variable claim"
end.

Ltac solve_functional_symbol :=
(* TODO: check the shape, this tactic is fragile *)
  fromMLGoal;
  gapply hypothesis;
  try assumption;
  wf_auto2;
  set_solver
.

Ltac solve_functional_step :=
  lazymatch goal with
  | [ |- @of_MLGoal _ (@mkMLGoal _ ?Γ _ (ex, ?p =ml patt_bound_evar 0) _)] ⇒
    lazymatch eval cbv in (deconstruct_function p) with
    | Some (?f, ?p::?pats) ⇒
      mlApplyMeta (function_application_many Γ (p::pats) (patt_sym f) ltac:(set_solver) ltac:(wf_auto2) ltac:(wf_auto2) ltac:(by simpl) ltac:(by simpl));
      try mlSplitAnds
    | Some (?f, []) ⇒ solve_functional_symbol
    | Nonefail "Claim does not contain a first function symbol"
    end
  | _fail "Claim is not shaped as 'ex, <pat> =ml b0'"
  end.

Ltac solve_functional :=
  (repeat solve_functional_step); try solve_functional_var; try solve_functional_symbol.

Goal
   {Σ : Signature} {syntax: Syntax} f g one Γ x y,
    theoryΓ
    (all, all, all, ex, patt_app (patt_app (patt_app (patt_sym f) b3) b2) b1 =ml b0) ∈ Γ
    (all, ex, patt_app (patt_sym g) b1 =ml b0) ∈ Γ
    (ex , patt_sym one =ml b0) ∈ Γ
  Γex, (patt_sym fpatt_free_evar x ⋅ (patt_sym gpatt_sym one) ⋅ (patt_sym gpatt_free_evar y))%ml =ml b0.

Theorem exists_functional_subst_meta: ∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ φ' : Pattern) ,
  Definedness_Syntax.theoryΓ
  mu_free φ →
  well_formed φ' →
  well_formed_closed_ex_aux φ 1 →
  well_formed_closed_mu_aux φ 0 →
  Γ ⊢ (ex , φ)^[φ'] →
  Γis_functional φ' →
  Γi (ex , φ) using AnyReasoning.

Theorem membership_monotone_functional: ∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ φ t : Pattern) (i : ProofInfo),
  Definedness_Syntax.theoryΓ
  well_formed φ
  well_formed φ
  well_formed t
  Γi is_functional t using i
  Γi φ ---> φ using i
  Γi tml φ ---> tml φ using i .

 Theorem membership_or_2_functional: ∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ φ t : Pattern),
  well_formed φ
  well_formed φ
  well_formed t
  Definedness_Syntax.theoryΓ
  Γi is_functional t --->
  tml φ or tml φ --->
  tml or φ) using AnyReasoning.

Theorem membership_or_2_functional_meta: ∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ φ t : Pattern),
  well_formed φ
  well_formed φ
  well_formed t
  Definedness_Syntax.theoryΓ
  Γi is_functional t using AnyReasoning
  Γi tml φ or tml φ --->
  tml or φ) using AnyReasoning.

Theorem membership_and_2_functional: ∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ φ t : Pattern),
  well_formed φ
  well_formed φ
  mu_free φ
  mu_free φ
  well_formed t
  Definedness_Syntax.theoryΓ
  Γi is_functional t --->
  tml φ and tml φ --->
  tml and φ) using AnyReasoning.

Theorem membership_and_2_functional_meta: ∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ φ t : Pattern),
  well_formed φ
  well_formed φ
  mu_free φ
  mu_free φ
  well_formed t
  Definedness_Syntax.theoryΓ
  Γis_functional t
  Γi tml φ and tml φ --->
  tml and φ) using AnyReasoning.

Theorem membership_symbol_ceil_aux_0_functional:∀ {Σ : Signature} {syntax : Syntax} (Γ : Theory) (φ t1 t2 : Pattern),
  Definedness_Syntax.theoryΓ
  well_formed φ →
  mu_free φ →
  well_formed t1
  well_formed t2
  mu_free t2
  Γi is_functional t1 --->
  is_functional t2 --->
  ⌈ t1 and φ ⌉ --->
  ⌈ t2 andt1 and φ ⌉ ⌉ using AnyReasoning.

Theorem proved_membership_functional:
  ∀ {Σ : Signature} {syntax : Definedness_Syntax.Syntax}
   (Γ : Theory) (φ φ : Pattern),
    Definedness_Syntax.theoryΓ
    well_formed φ
    well_formed φ
    Γi φ using AnyReasoning
    Γi is_functional φ ---> φml φ using AnyReasoning .

Theorem proved_membership_functional_meta:
  ∀ {Σ : Signature} {syntax : Definedness_Syntax.Syntax}
   (Γ : Theory) (φ φ : Pattern),
    Definedness_Syntax.theoryΓ
    well_formed φ
    well_formed φ
    Γi is_functional φ using AnyReasoning
    Γi φ using AnyReasoning
    Γi φml φ using AnyReasoning .

(* Equality elimination for substitution using a functional *)
(* pattern. *)
Lemma equality_elimination_functional_subst {Σ : Signature} {syntax : Syntax} (Γ : Theory) p q p1 p2 x :
  theoryΓ
  well_formed p
  well_formed q
  well_formed p1
  well_formed p2
  mu_free p
  mu_free q
  pattern_kt_well_formed p1
  pattern_kt_well_formed p2
  Γp =ml q
  Γp1 =ml p2
  Γis_functional p1
  Γp^[[evar: xp1]] =ml q^[[evar: xp2]].

Section EqCon.
  Context {Σ : Signature} {syntax : Syntax}.

  (* The remainder works for any theory containing definedness. *)
  Context (Γ : Theory).
  Hypothesis ( : theoryΓ).

  (* The patterns that will be equal, *)
  (* and the evars that they will replace. *)
  Context (σ : list (evar × Pattern × Pattern)).
  (* They are well-formed... *)
  Hypothesis (Hσ1 : wf (map (sndfst) σ)) (Hσ2 : wf (map snd σ)).
  (* ... mu-free ... *)
  Hypothesis (Hmfσ1 : foldr (fun c amu_free c && a) true (map (sndfst) σ)).
  Hypothesis (Hmfσ2 : foldr (fun c amu_free c && a) true (map snd σ)).
  (* ... and one of them is functional. *)
  Hypothesis (Hfpσ : foldr (fun c a ⇒ ((Γis_functional c.1.2) × a)%type) unit σ).

  (* Separate equalities as a hypothesis. *)
  Definition hypos : Type := foldr (fun x t ⇒ ((Γx.1.2 =ml x.2) × t)%type) unit σ.

  (* Same as `emplace`ing into a context with multiple holes. *)
  Definition goal (φ : Pattern) : Pattern := (foldr (fun x pp^[[evar: x.1.1 ↦ x.1.2]]) φ σ) =ml (foldr (fun x pp^[[evar: x.1.1 ↦ x.2]]) φ σ).

  (* For any pattern (which would serve as the core of the context), *)
  (* given the eqalities as hypothesis, substituting into the *)
  (* multihole context yields equality. *)
  Lemma eqcon : φ,
    well_formed φ →
    mu_free φ →
    hypos
    Γgoal φ.
End EqCon.

Section Example.
  Context {Σ : Signature} {syntax : Syntax}.

  (* In any theory that contains the theory of definedness ... *)
  Context (Γ : Theory).
  Hypothesis ( : theoryΓ).

  (* ... given some function/context ... *)
  Context (kseq_sym : symbols).
  Definition kseq x y := patt_sym kseq_symxy.

  (* ... and two pairs of patterns ... *)
  Context (one two one' two' : Pattern).
  (* ... some of which are functional and all of which are *)
  (* well-formed and free of fixed points ... *)
  Hypothesis (fpone : Γis_functional one).
  Hypothesis (fptwo : Γis_functional two).
  Hypothesis (Hwf : well_formed onewell_formed twowell_formed one'well_formed two').
  Hypothesis (Hmf : mu_free onemu_free twomu_free one'mu_free two').
  (* ... and pairwise provable equal ... *)
  Hypothesis (Heqone : Γone =ml one').
  Hypothesis (Heqtwo : Γtwo =ml two').

  (* ... and given two different evars, one of which is free *)
  (* in two of the patterns ... *)
  Context (x y : evar).
  Hypothesis (Hxneqy : yx).
  Hypothesis (Hxfree : xfree_evars twofree_evars two').

  (* ... substituting the two into the same context *)
  (* is also equal. *)
  (*            one = one'       two = two'            *)
  (* ------------------------------------------------- *)
  (* (kseq □₁ □₂)one, two = (kseq □₁ □₂)one', two' *)
  Goal Γkseq one two =ml kseq one' two'.
End Example.

Lemma predicate_iff {Σ : Signature} {syntax : Syntax} Γ φ φ :
  theoryΓ
  well_formed φ
  well_formed φ
  Γis_predicate_pattern φ --->
  is_predicate_pattern φ --->
  is_predicate_pattern <---> φ).


This page has been generated by coqdoc