packages feed

singletons-2.0: tests/compile-and-dump/Singletons/Nat.ghc710.template

Singletons/Nat.hs:(0,0)-(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) |]
  ======>
    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 = TrueSym0
      Equals_0123456789 (Succ a) (Succ b) = (:==) a b
      Equals_0123456789 (a :: Nat) (b :: Nat) = FalseSym0
    instance PEq (KProxy :: KProxy Nat) where
      type (:==) (a :: Nat) (b :: Nat) = Equals_0123456789 a b
    type ZeroSym0 = Zero
    type SuccSym1 (t :: Nat) = Succ t
    instance SuppressUnusedWarnings SuccSym0 where
      suppressUnusedWarnings _
        = snd (GHC.Tuple.(,) SuccSym0KindInference GHC.Tuple.())
    data SuccSym0 (l :: TyFun Nat Nat)
      = forall arg. KindOf (Apply SuccSym0 arg) ~ KindOf (SuccSym1 arg) =>
        SuccSym0KindInference
    type instance Apply SuccSym0 l = SuccSym1 l
    type PredSym1 (t :: Nat) = Pred t
    instance SuppressUnusedWarnings PredSym0 where
      suppressUnusedWarnings _
        = snd (GHC.Tuple.(,) PredSym0KindInference GHC.Tuple.())
    data PredSym0 (l :: TyFun Nat Nat)
      = forall arg. KindOf (Apply PredSym0 arg) ~ KindOf (PredSym1 arg) =>
        PredSym0KindInference
    type instance Apply PredSym0 l = PredSym1 l
    type PlusSym2 (t :: Nat) (t :: Nat) = Plus t t
    instance SuppressUnusedWarnings PlusSym1 where
      suppressUnusedWarnings _
        = snd (GHC.Tuple.(,) PlusSym1KindInference GHC.Tuple.())
    data PlusSym1 (l :: Nat) (l :: TyFun Nat Nat)
      = forall arg. KindOf (Apply (PlusSym1 l) arg) ~ KindOf (PlusSym2 l arg) =>
        PlusSym1KindInference
    type instance Apply (PlusSym1 l) l = PlusSym2 l l
    instance SuppressUnusedWarnings PlusSym0 where
      suppressUnusedWarnings _
        = snd (GHC.Tuple.(,) PlusSym0KindInference GHC.Tuple.())
    data PlusSym0 (l :: TyFun Nat (TyFun Nat Nat -> *))
      = forall arg. KindOf (Apply PlusSym0 arg) ~ KindOf (PlusSym1 arg) =>
        PlusSym0KindInference
    type instance Apply PlusSym0 l = PlusSym1 l
    type family Pred (a :: Nat) :: Nat where
      Pred Zero = ZeroSym0
      Pred (Succ n) = n
    type family Plus (a :: Nat) (a :: Nat) :: Nat where
      Plus Zero m = m
      Plus (Succ n) m = Apply SuccSym0 (Apply (Apply PlusSym0 n) m)
    sPred ::
      forall (t :: Nat). Sing t -> Sing (Apply PredSym0 t :: Nat)
    sPlus ::
      forall (t :: Nat) (t :: Nat).
      Sing t -> Sing t -> Sing (Apply (Apply PlusSym0 t) t :: Nat)
    sPred SZero
      = let
          lambda :: t ~ ZeroSym0 => Sing (Apply PredSym0 ZeroSym0 :: Nat)
          lambda = SZero
        in lambda
    sPred (SSucc sN)
      = let
          lambda ::
            forall n. t ~ Apply SuccSym0 n =>
            Sing n -> Sing (Apply PredSym0 (Apply SuccSym0 n) :: Nat)
          lambda n = n
        in lambda sN
    sPlus SZero sM
      = let
          lambda ::
            forall m. (t ~ ZeroSym0, t ~ m) =>
            Sing m -> Sing (Apply (Apply PlusSym0 ZeroSym0) m :: Nat)
          lambda m = m
        in lambda sM
    sPlus (SSucc sN) sM
      = let
          lambda ::
            forall n m. (t ~ Apply SuccSym0 n, t ~ m) =>
            Sing n
            -> Sing m
               -> Sing (Apply (Apply PlusSym0 (Apply SuccSym0 n)) m :: Nat)
          lambda n m
            = applySing
                (singFun1 (Proxy :: Proxy SuccSym0) SSucc)
                (applySing
                   (applySing (singFun2 (Proxy :: Proxy PlusSym0) sPlus) n) m)
        in lambda sN sM
    data instance Sing (z :: Nat)
      = z ~ Zero => SZero |
        forall (n :: Nat). z ~ Succ n => SSucc (Sing (n :: Nat))
    type SNat = (Sing :: Nat -> *)
    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
            (\ x
               -> case x of {
                    _ -> error "Empty case reached -- this should be impossible" })
      (%~) (SSucc _) SZero
        = Disproved
            (\ x
               -> case x of {
                    _ -> error "Empty case reached -- this should be impossible" })
      (%~) (SSucc a) (SSucc b)
        = case (%~) a b of {
            Proved Refl -> Proved Refl
            Disproved contra
              -> Disproved (\ refl -> case refl of { Refl -> contra Refl }) }
    instance SingI Zero where
      sing = SZero
    instance SingI n => SingI (Succ (n :: Nat)) where
      sing = SSucc sing