60 lines
1.3 KiB
Haskell
60 lines
1.3 KiB
Haskell
module Data.Fin
|
|
( Fin (FZ, FS)
|
|
, FinF (FZF, FSF)
|
|
, fin2nat
|
|
) where
|
|
|
|
import Data.Functor.Const (Const (Const))
|
|
import Data.Identity
|
|
import Data.Kind (Type)
|
|
import Data.Nat
|
|
import Functor.Algebra
|
|
import Functor.Base
|
|
import Relation
|
|
|
|
data Fin :: N -> Type where
|
|
FZ :: Fin ('S n)
|
|
FS :: Fin n -> Fin ('S n)
|
|
data FinF r :: N -> Type where
|
|
FZF :: FinF r ('S n)
|
|
FSF :: r n -> FinF r ('S n)
|
|
|
|
instance Functor Fin where
|
|
type Cod Fin = (->)
|
|
type Dom Fin = (:~:)
|
|
map Refl = \case
|
|
FZ -> FZ
|
|
FS n -> FS (map Refl n)
|
|
|
|
instance Functor (FinF r) where
|
|
type Cod (FinF r) = (->)
|
|
type Dom (FinF r) = (:~:)
|
|
map Refl = id
|
|
|
|
instance Functor FinF where
|
|
type Cod FinF = Nat (->) (:~:)
|
|
type Dom FinF = Nat (->) (:~:)
|
|
map (Nat f) = Nat \_ -> \case
|
|
FZF -> FZF
|
|
FSF n -> FSF (f id n)
|
|
|
|
instance Recursive Fin where
|
|
type Base Fin = FinF
|
|
project = Nat \_ -> \case
|
|
FZ -> FZF
|
|
FS n -> FSF n
|
|
embed = Nat \_ -> \case
|
|
FZF -> FZ
|
|
FSF n -> FS n
|
|
|
|
instance Functor (Const a :: N -> Type) where
|
|
type Cod (Const a) = (->)
|
|
type Dom (Const a) = (:~:)
|
|
map Refl (Const x) = Const x
|
|
|
|
fin2nat :: Nat (->) (:~:) Fin (Const N)
|
|
fin2nat = fold (Nat \_ -> alg)
|
|
where alg :: FinF (Const N) n -> Const N n
|
|
alg FZF = Const Z
|
|
alg (FSF (Const n)) = Const (S n)
|