singletons-0.10.0: tests/compile-and-dump/Singletons/Nat.ghc78.template
Singletons/Nat.hs:0:0: Splicing declarations
singletons
[d| plus :: Nat -> Nat -> Nat
plus Zero m = m
plus (Succ n) m = Succ (plus n m)
pred :: Nat -> Nat
pred Zero = Zero
pred (Succ n) = n
data Nat
where
Zero :: Nat
Succ :: Nat -> Nat
deriving (Eq, Show, Read) |]
======>
Singletons/Nat.hs:(0,0)-(0,0)
data Nat
= Zero | Succ Nat
deriving (Eq, Show, Read)
plus :: Nat -> Nat -> Nat
plus Zero m = m
plus (Succ n) m = Succ (plus n m)
pred :: Nat -> Nat
pred Zero = Zero
pred (Succ n) = n
type family Equals_0123456789 (a :: Nat) (b :: Nat) :: Bool where
Equals_0123456789 Zero Zero = True
Equals_0123456789 (Succ a) (Succ b) = (==) a b
Equals_0123456789 (a :: Nat) (b :: Nat) = False
type instance (==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b
type family Plus (a :: Nat) (a :: Nat) :: Nat where
Plus Zero m = m
Plus (Succ n) m = Succ (Plus n m)
type family Pred (a :: Nat) :: Nat where
Pred Zero = Zero
Pred (Succ n) = n
data instance Sing (z :: Nat)
= z ~ Zero => SZero |
forall (n :: Nat). z ~ Succ n => SSucc (Sing n)
type SNat (z :: Nat) = Sing z
instance SingKind (KProxy :: KProxy Nat) where
type DemoteRep (KProxy :: KProxy Nat) = Nat
fromSing SZero = Zero
fromSing (SSucc b) = Succ (fromSing b)
toSing Zero = SomeSing SZero
toSing (Succ b)
= case toSing b :: SomeSing (KProxy :: KProxy Nat) of {
SomeSing c -> SomeSing (SSucc c) }
instance SEq (KProxy :: KProxy Nat) where
(%:==) SZero SZero = STrue
(%:==) SZero (SSucc _) = SFalse
(%:==) (SSucc _) SZero = SFalse
(%:==) (SSucc a) (SSucc b) = (%:==) a b
instance SDecide (KProxy :: KProxy Nat) where
(%~) SZero SZero = Proved Refl
(%~) SZero (SSucc _)
= Disproved
(\case {
_ -> error "Empty case reached -- this should be impossible" })
(%~) (SSucc _) SZero
= Disproved
(\case {
_ -> error "Empty case reached -- this should be impossible" })
(%~) (SSucc a) (SSucc b)
= case (%~) a b of {
Proved Refl -> Proved Refl
Disproved contra -> Disproved (\ Refl -> contra Refl) }
instance SingI Zero where
sing = SZero
instance SingI n => SingI (Succ (n :: Nat)) where
sing = SSucc sing
sPlus ::
forall (t :: Nat) (t :: Nat). Sing t -> Sing t -> Sing (Plus t t)
sPlus SZero m = m
sPlus (SSucc n) m = SSucc (sPlus n m)
sPred :: forall (t :: Nat). Sing t -> Sing (Pred t)
sPred SZero = SZero
sPred (SSucc n) = n