62 lines
1.5 KiB
Haskell
62 lines
1.5 KiB
Haskell
{-# LANGUAGE UndecidableSuperClasses #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
module Category.Constraint
|
|
( (:-) (Sub), (\\)
|
|
, ProdC
|
|
) where
|
|
|
|
import Data.Dict
|
|
--import Functor.Associative
|
|
import Functor.Base
|
|
--import Functor.Bifunctor
|
|
--import Functor.Identity
|
|
--import Functor.Product
|
|
import Relation
|
|
|
|
import Data.Kind (Constraint, Type)
|
|
|
|
type (:-) :: Constraint -> Constraint -> Type
|
|
data (:-) c d = Sub (c => Dict d)
|
|
|
|
(\\) :: a => (b => c) -> (a :- b) -> c
|
|
r \\ Sub Dict = r
|
|
|
|
instance Reflexive (:-)
|
|
instance Wide (:-) where
|
|
id = Sub Dict
|
|
|
|
instance Transitive (:-) where
|
|
f . g = Sub (Dict \\ f \\ g)
|
|
|
|
instance Functor ((:-) a) where
|
|
type Cod ((:-) a) = (->)
|
|
type Dom ((:-) a) = (:-)
|
|
map = (.)
|
|
|
|
instance Functor Dict where
|
|
type Cod Dict = (->)
|
|
type Dom Dict = (:-)
|
|
map f = \Dict -> case f of Sub Dict -> Dict
|
|
|
|
type UncurryC :: (a -> b -> Constraint) -> (a, b) -> Constraint
|
|
class f (Pi1 ab) (Pi2 ab) => UncurryC f ab
|
|
instance f (Pi1 ab) (Pi2 ab) => UncurryC f ab
|
|
-- FIXME
|
|
--type instance Uncurry = UncurryC
|
|
|
|
class (c, d) => ProdC c d
|
|
instance (c, d) => ProdC c d
|
|
|
|
instance Functor ProdC where
|
|
type Cod ProdC = Nat (:-) (:-)
|
|
type Dom ProdC = (:-)
|
|
map (Sub f) = Nat \_ -> Sub case f of Dict -> Dict
|
|
|
|
instance Functor (ProdC a) where
|
|
type Cod (ProdC a) = (:-)
|
|
type Dom (ProdC a) = (:-)
|
|
map (Sub f) = Sub case f of Dict -> Dict
|
|
|
|
-- TODO: Re-prove that ProdC is a tensor product in the new rewrite.
|
|
-- It shouldn't be particularly difficult, but it sounds tedious right now.
|