MathClasses.interfaces.ua_basic

Require
  ne_list.
Require Import
  List abstract_algebra.

Local Notation ne_list := ne_list.L.

Section with_sorts.
  Variable Sorts: Set.



  Definition OpType := ne_list Sorts.

  Definition result: OpType → Sorts := @ne_list.last _.

  Variable carrier: Sorts → Type.


  Fixpoint op_type (o: OpType): Type :=
    match o with
    | ne_list.one a ⇒ carrier a
    | ne_list.cons a g ⇒ carrier a → op_type g
    end.



  Context `{e: ∀ s, Equiv (carrier s)}.

  Fixpoint op_type_equiv o: Equiv (op_type o) :=
    match o with
    | ne_list.one _ ⇒ _: Equiv (carrier _)
    | ne_list.cons A g ⇒ (e A ==> op_type_equiv g)%signature
    end.

  Existing Instance op_type_equiv.
  Global Instance sig_type_sym `{∀ s, Symmetric (e s)}: Symmetric (op_type_equiv o).
  Proof. induction o; simpl; firstorder. Qed.


  Global Instance sig_type_trans `{∀ s, Reflexive (e s)} `{∀ s, Transitive (e s)}: Transitive (op_type_equiv o).
  Proof.
   induction o; simpl. firstorder.
   intros ? y ???? y0 ?. transitivity (y y0); firstorder.
  Qed.

  Hint Unfold op_type.

  Global Instance sig_type_trans' `{∀ s, Symmetric (e s)} `{∀ s, Transitive (e s)}: Transitive (op_type_equiv o).
  Proof with auto.
   induction o; simpl...
   intros x y ? ? H2 x0 y0 ?.
   transitivity (y y0)...
   apply H2.
   transitivity x0; firstorder.
  Qed.

  Lemma sig_type_refl `{∀ a, Reflexive (e a)} (o: OpType) a (x: op_type (ne_list.cons a o)) y:
    Proper (=) x → op_type_equiv o (x y) (x y).
  Proof. intro H0. apply H0. reflexivity. Qed.


End with_sorts.

Arguments op_type {Sorts} _ _.

Hint Extern 0 (Equiv (op_type _ _ )) ⇒ eapply @op_type_equiv : typeclass_instances.

Inductive Signature: Type :=
  { sorts: Set
  ; operation:> Set
  ; operation_type:> operation → OpType sorts }.

Definition single_sorted_signature {Op: Set} (arities: Op → nat): Signature :=
  Build_Signature unit Op (ne_list.replicate_Sn tt ∘ arities).


Class AlgebraOps (σ: Signature) (A: sorts σ → Type) := algebra_op: ∀ o, op_type A (σ o).


Class Algebra
  (σ: Signature)
  (carriers: sorts σ → Type)
  {e: ∀ a, Equiv (carriers a)}
  `{AlgebraOps σ carriers}: Prop :=
    { algebra_setoids:> ∀ a, Setoid (carriers a)
    ; algebra_propers:> ∀ o: σ, Proper (=) (algebra_op o) }.