(* Formalizing and Proving Theorems in Coq --- Homework 7
   curated by Tobias Kappé, May 2022.

   This file demonstrates the use of records to encode a simple version of
   first-order logic using De Bruijn numbering.

   There are no homework exercises. *)

From Equations Require Import Equations.

(* First, let's define a relational signature as a type (of relation symbols)
   that comes equipped with an arity function. *)
Record signature := {
  symbols: Type;
  arity: symbols -> nat;
}.

(* We are also going to need tuples of a certain type. This brings us to our
   first inductively defined dependent type. *)
Inductive tuple (X: Type): nat -> Type :=
| TEmpty: tuple X 0
| TCons: X -> forall n, tuple X n -> tuple X (S n)
.

(* Let's have a look at the arguments of the constructors. *)
Print tuple.

(* Hmm, some of these arguments are not strictly necessary; we can make them
   implicit using the following vernacular. *)
Arguments TEmpty {X}.
Arguments TCons {X} _ {n}.

(* Here is some boiler plate that makes Equations happy. *)
Derive Signature for tuple.

(* A model over a signature has a domain, and assigns to every symbol in that
   domain a relation of appropriate arity. This is where we use the tuple
   type that was defined above. *)
Record model (sig: signature) := {
  domain: Type;
  relations:
    forall (sym: symbols sig),
      tuple domain (arity sig sym) -> Prop;
}.

(* Again we explicitly make some arguments implicit. *)
Arguments domain {sig}.
Arguments relations {sig}.

(* Each instance of variable n represents one of n many variables. *)
Inductive variable: nat -> Type :=
| VHere: forall n, variable (S n)
| VThere: forall n, variable n -> variable (S n)
.

(* More boilerplate to keep Equations happy. *)
Derive Signature for variable.

(* More arguments that we need to make implicit. *)
Arguments VHere {n}.
Arguments VThere {n}.

(* Here is our dependently typed syntax for formulas. The parameter n in
   formula sig n represents the number of free variables. *)
Inductive formula (sig: signature): nat -> Type :=
| FTop:
    forall n,
      formula sig n
(* Relational primitives consist of a symbol, and a tuple of variables from
   the current context of n-many variables, whose length matches the arity of
   the function symbol. *)
| FRel:
    forall n (sym: symbols sig),
      tuple (variable n) (arity sig sym) ->
      formula sig n
| FCon:
    forall n,
      formula sig n ->
      formula sig n ->
      formula sig n
| FNeg:
    forall n,
      formula sig n ->
      formula sig n
(* Universal quantification peels off one free variable. *)
| FForall:
    forall n,
      formula sig (S n) ->
      formula sig n
.

(* More boilerplate for Equations and implicit parameters. *)
Derive Signature for formula.
Arguments FTop {sig} {n}.
Arguments FRel {sig} {n}.
Arguments FCon {sig} {n}.
Arguments FNeg {sig} {n}.
Arguments FForall {sig} {n}.

(* This dependent type assigns a value to each variable in a context of n
   many variables. *)
Inductive valuation {sig: signature} (mod: model sig): nat -> Type :=
| VEmpty: valuation mod 0
| VCons:
    domain mod ->
      forall n,
        valuation mod n -> valuation mod (S n)
.
Arguments VCons {sig} {mod} _ {n} _.

(* The last bit of boilerplate that we need. *)
Derive Signature for valuation.

(* This is a helper function that looks up the value of a variable in a
   valuation. Note how var and val share the parameter n in their types, which
   means that the variable and valuation line up: there are n many possible
   choices of variable, each of which gets a value in the valuation. *)
Equations lookup
  {sig: signature}
  {mod: model sig}
  {n: nat}
  (var: variable n)
  (val: valuation mod n)
  : domain mod
:= {
  lookup VHere (VCons x _) := x;
  lookup (VThere var) (VCons _ val) :=
    lookup var val;
}.

(* Another helper function to map an m-tuple of variables over a context of
   size n into an m-tuple of values given a valuation. *)
Equations lookup_all
  {sig: signature}
  {mod: model sig}
  {n m: nat}
  (vars: tuple (variable n) m)
  (val: valuation mod n)
  : tuple (domain mod) m
:= {
  lookup_all TEmpty _ :=
    TEmpty;
  lookup_all (TCons var vars) val :=
    TCons (lookup var val) (lookup_all vars val);
}.

(* Semantics for our first-order syntax, parameterized over a valuation for
   each of the free variables. Note that if there are no free variables, then
   the valuation VEmpty suffices. *)
Equations interp
  {sig: signature}
  {mod: model sig}
  {n: nat}
  (val: valuation mod n)
  (fm: formula sig n)
  : Prop
:= {
  interp val (FTop) =>
    True;
  interp val (FRel sym vars) =>
    (* For relations, look up the n-ary relation in the model, and feed to it
       the interpretation of the n-ary tuple of variables. *)
    (relations mod sym) (lookup_all vars val);
  interp val (FCon fm1 fm2) =>
    interp val fm1 /\ interp val fm2;
  interp val (FNeg fm) =>
    ~ interp val fm;
  interp val (FForall fm) =>
    (* For universal quantification, augment the valuation that we have with
       a universally quantified element of the domain to evaluate the inner
       formula, which needs a valuation for the additional symbol. *)
    forall (x: domain mod),
      interp (VCons x val) fm;
}.

(* Here's something we can prove now: universal quantification distributes
   over conjunction. *)
Lemma forall_conjunction
  {sig: signature}
  {mod: model sig}
  {n: nat}
  (fm1 fm2: formula sig (S n))
  (val: valuation mod n)
:
  interp val (FForall (FCon fm1 fm2)) <->
  interp val (FCon (FForall fm1) (FForall fm2))
.
Proof.
  split; intros.
  - rewrite interp_equation_5 in H.
    rewrite interp_equation_3.
    repeat rewrite interp_equation_5.
    split; intros.
    + specialize (H x).
      rewrite interp_equation_3 in H.
      intuition.
    + specialize (H x).
      rewrite interp_equation_3 in H.
      intuition.
  - rewrite interp_equation_3 in H.
    destruct H.
    rewrite interp_equation_5.
    intros.
    rewrite interp_equation_3.
    split.
    + rewrite interp_equation_5 in H.
      apply H.
    + rewrite interp_equation_5 in H0.
      apply H0.
Qed.

(* As an encore, here is a way of defining the semantics using pure Coq
   functions and no functionality provided by the Equations plugin. As you
   can see, we need a generalized version of the "match" predicate, which
   returns a function that is fed the input valuation; this is necessary to
   convince the Coq type checker that the depenent types all line up. *)
Fixpoint interp'
  {sig: signature}
  (mod: model sig)
  {n: nat}
  (val: valuation mod n)
  (fm: formula sig n)
  : Prop
:=
  match fm in formula _ m return valuation _ m -> Prop with
  | FTop =>
    fun _ => True
  | FRel sym vars =>
    fun val => relations mod sym (lookup_all vars val)
  | FCon fm1 fm2 =>
    fun val => interp' mod val fm1 /\ interp' mod val fm2
  | FNeg fm =>
    fun val => interp' mod val fm
  | FForall fm =>
    fun val =>
      forall (x: domain mod),
        interp' mod (VCons x val) fm
  end val
.