{-# LANGUAGE TypeOperators, TypeFamilies, GADTs, UndecidableInstances, NoImplicitPrelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Category.Peano -- License : BSD-style (see the file LICENSE) -- -- Maintainer : sjoerd@w3future.com -- Stability : experimental -- Portability : non-portable ----------------------------------------------------------------------------- module Data.Category.NNO where import Data.Category.Functor import Data.Category.Limit import Data.Category.Unit import Data.Category.Coproduct import Data.Category.Fix (Fix(..)) class HasTerminalObject k => HasNaturalNumberObject k where type NaturalNumberObject k :: * zero :: k (TerminalObject k) (NaturalNumberObject k) succ :: k (NaturalNumberObject k) (NaturalNumberObject k) primRec :: k (TerminalObject k) a -> k a a -> k (NaturalNumberObject k) a data NatNum = Z | S NatNum instance HasNaturalNumberObject (->) where type NaturalNumberObject (->) = NatNum zero = \() -> Z succ = S primRec z _ Z = z () primRec z s (S n) = s (primRec z s n) -- type Nat = Fix ((:++:) Unit) -- instance HasNaturalNumberObject Cat where -- type NaturalNumberObject Cat = CatW Nat -- zero = CatA (Const (Fix (I1 Unit))) -- succ = CatA (Wrap :.: Inj2) -- primRec (CatA z) (CatA s) = CatA (PrimRec z s) -- data PrimRec z s = PrimRec z s -- instance (Functor z, Functor s, Dom z ~ Unit, Cod z ~ Dom s, Dom s ~ Cod s) => Functor (PrimRec z s) where -- type Dom (PrimRec z s) = Nat -- type Cod (PrimRec z s) = Cod z -- type PrimRec z s :% I1 () = z :% () -- type PrimRec z s :% I2 n = s :% PrimRec z s :% n -- PrimRec z _ % Fix (I1 Unit) = z % Unit -- PrimRec z s % Fix (I2 n) = s % PrimRec z s % n