86 lines
2.1 KiB
Haskell
86 lines
2.1 KiB
Haskell
module Data.Vec
|
|
( Vec (VZ, VS)
|
|
, VecF (VZF, VSF)
|
|
, index
|
|
) where
|
|
|
|
import Data.Fin
|
|
import Data.Identity
|
|
import Data.Kind (Type)
|
|
import Data.Nat
|
|
import Functor.Algebra
|
|
import Functor.Base
|
|
import Relation
|
|
|
|
type Vec :: Type -> N -> Type
|
|
data Vec a :: N -> Type where
|
|
VZ :: Vec a 'Z
|
|
VS :: a -> Vec a n -> Vec a ('S n)
|
|
type VecF :: Type -> (N -> Type) -> N -> Type
|
|
data VecF a r :: N -> Type where
|
|
VZF :: VecF a r 'Z
|
|
VSF :: a -> r n -> VecF a r ('S n)
|
|
|
|
instance Functor (Vec a) where
|
|
type Cod (Vec a) = (->)
|
|
type Dom (Vec a) = (:~:)
|
|
map Refl = \case
|
|
VZ -> VZ
|
|
VS x xs -> VS x (map Refl xs)
|
|
|
|
instance Functor Vec where
|
|
type Dom Vec = (->)
|
|
type Cod Vec = Nat (->) (:~:)
|
|
map f = Nat \_ -> \case
|
|
VZ -> VZ
|
|
(VS x r) -> VS (f x) (runNat (map f) id r)
|
|
|
|
instance Functor (VecF a r) where
|
|
type Cod (VecF a r) = (->)
|
|
type Dom (VecF a r) = (:~:)
|
|
map Refl = \case
|
|
VZF -> VZF
|
|
VSF x xs -> VSF x xs
|
|
|
|
instance Functor (VecF a) where
|
|
type Cod (VecF a) = Nat (->) (:~:)
|
|
type Dom (VecF a) = Nat (->) (:~:)
|
|
map (Nat f) = Nat \_ -> \case
|
|
VZF -> VZF
|
|
(VSF x r) -> VSF x (f id r)
|
|
|
|
instance Functor VecF where
|
|
type Dom VecF = (->)
|
|
type Cod VecF = Nat (Nat (->) (:~:)) (Nat (->) (:~:))
|
|
map f = Nat \_ -> Nat \_ -> \case
|
|
VZF -> VZF
|
|
(VSF x r) -> VSF (f x) r
|
|
|
|
instance Recursive (Vec a) where
|
|
type Base (Vec a) = VecF a
|
|
project = Nat \_ -> \case
|
|
VZ -> VZF
|
|
VS x xs -> VSF x xs
|
|
embed = Nat \_ -> \case
|
|
VZF -> VZ
|
|
VSF x xs -> VS x xs
|
|
|
|
type Ixr :: (N -> Type) -> Type -> N -> Type
|
|
newtype Ixr ty r a = Ixr { getIxr :: ty a -> r }
|
|
|
|
instance Functor (Ixr ty r) where
|
|
type Cod (Ixr ty r) = (->)
|
|
type Dom (Ixr ty r) = (:~:)
|
|
map Refl = id
|
|
|
|
indexer :: Nat (->) (:~:) Fin (Ixr (Vec a) a)
|
|
indexer = fold alg
|
|
where
|
|
alg :: Nat (->) (:~:) (FinF (Ixr (Vec a) a)) (Ixr (Vec a) a)
|
|
alg = Nat \_ -> \case
|
|
FZF -> Ixr \case VS x _ -> x
|
|
(FSF (Ixr r)) -> Ixr \case VS _ xs -> r xs
|
|
|
|
index :: Fin n -> Vec a n -> a
|
|
index = getIxr . runNat indexer id
|