summaryrefslogtreecommitdiff
path: root/src/Soat/FirstOrder/Algebra.idr
blob: bbc0430092b9a6a6dd1c34e641182c6dcca60dc6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
module Soat.FirstOrder.Algebra

import Control.Relation

import Soat.Data.Product
import Soat.FirstOrder.Signature
import Soat.Relation

%default total
%hide Control.Relation.Equivalence

public export
algebraOver : (sig : Signature) -> (U : sig.T -> Type) -> Type
algebraOver sig x = {t : sig.T} -> (op : Op sig t) -> x ^ op.arity -> x t

public export
algebraOver' : (sig : Signature) -> (U : sig.T -> Type) -> Type
algebraOver' sig x = {t : sig.T} -> (op : Op sig t) -> map x op.arity `ary` x t

public export
record RawAlgebra (0 sig : Signature) where
  constructor MakeRawAlgebra
  0 U : sig.T -> Type
  sem : sig `algebraOver` U

public export
MkRawAlgebra : (0 U : sig.T -> Type) -> (sem : sig `algebraOver'` U) -> RawAlgebra sig
MkRawAlgebra u sem = MakeRawAlgebra u (\o => uncurry (sem o))

public export
record IsAlgebra (0 sig : Signature) (0 a : RawAlgebra sig) (0 rel : IRel a.U) where
  constructor MkIsAlgebra
  equivalence : IEquivalence a.U rel
  semCong     : {t : sig.T} -> (op : Op sig t) -> {tms, tms' : a.U ^ op.arity}
    -> Pointwise rel tms tms' -> rel t (a.sem op tms) (a.sem op tms')

public export
record Algebra (0 sig : Signature) where
  constructor MkAlgebra
  raw        : RawAlgebra sig
  0 relation : IRel raw.U
  algebra    : IsAlgebra sig raw relation

public export
(.setoid) : Algebra sig -> ISetoid sig.T
(.setoid) a = MkISetoid a.raw.U a.relation a.algebra.equivalence

public export
record IsHomomorphism
  {0 sig : Signature} (a, b : Algebra sig)
  (f : (t : sig.T) -> a.raw.U t -> b.raw.U t)
  where
  constructor MkIsHomomorphism
  cong    : (t : sig.T) -> {tm, tm' : a.raw.U t}
    -> a.relation t tm tm' -> b.relation t (f t tm) (f t tm')
  semHomo : {t : sig.T} -> (op : Op sig t) -> (tms : a.raw.U ^ op.arity)
    -> b.relation t (f t (a.raw.sem op tms)) (b.raw.sem op (map f tms))

public export
record Homomorphism {0 sig : Signature} (a, b : Algebra sig)
  where
  constructor MkHomomorphism
  f    : (t : sig.T) -> a.raw.U t -> b.raw.U t
  homo : IsHomomorphism a b f