summaryrefslogtreecommitdiff
path: root/src/Soat/SecondOrder/Algebra.idr
diff options
context:
space:
mode:
Diffstat (limited to 'src/Soat/SecondOrder/Algebra.idr')
-rw-r--r--src/Soat/SecondOrder/Algebra.idr27
1 files changed, 27 insertions, 0 deletions
diff --git a/src/Soat/SecondOrder/Algebra.idr b/src/Soat/SecondOrder/Algebra.idr
index e7927ae..e52c945 100644
--- a/src/Soat/SecondOrder/Algebra.idr
+++ b/src/Soat/SecondOrder/Algebra.idr
@@ -4,6 +4,7 @@ import Data.List.Elem
import Data.List.Sublist
import Data.Product
import Data.Setoid.Indexed
+import Data.Setoid.Pair
import Data.Setoid.Product
import Soat.SecondOrder.Signature
@@ -137,10 +138,36 @@ public export
(.setoidAt) a ctx = reindex (flip MkPair ctx) a.setoid
public export
+(.renameFunc) : (a : Algebra sig) -> {ctx, ctx' : _} -> (f : ctx `Sublist` ctx')
+ -> a.setoidAt ctx ~> a.setoidAt ctx'
+(.renameFunc) a f = MkIndexedSetoidHomomorphism
+ { H = \t => a.raw.rename t f
+ , homomorphic = \t, _, _ => a.algebra.renameCong t f
+ }
+
+public export
+(.semFunc) : (a : Algebra sig) -> (ctx : _) -> {t : _} -> (op : Op sig t)
+ -> index (Product (reindex (\ty => (snd ty, fst ty ++ ctx)) a.setoid)) op.arity
+ ~> index a.setoid (t, ctx)
+(.semFunc) a ctx op = MkSetoidHomomorphism
+ { H = a.raw.sem ctx op
+ , homomorphic = \_, _ => a.algebra.semCong ctx op
+ }
+
+public export
(.varFunc) : (a : Algebra sig) -> (ctx : _) -> irrelevantCast (flip Elem ctx) ~> a.setoidAt ctx
(.varFunc) a ctx = mate (\_ => a.raw.var)
public export
+(.substFunc) : (a : Algebra sig) -> (t : _) -> (ctx, ctx' : _)
+ -> Pair (index a.setoid (t, ctx')) (index (Product (a.setoidAt ctx)) ctx')
+ ~> index a.setoid (t, ctx)
+(.substFunc) a t ctx ctx' = MkSetoidHomomorphism
+ { H = \x => a.raw.subst t ctx (fst x) (snd x)
+ , homomorphic = \_, _, eq => a.algebra.substCong t ctx (fst eq) (snd eq)
+ }
+
+public export
record (~>) {0 sig : Signature} (a, b : Algebra sig)
where
constructor MkHomomorphism