singletons-2.2: tests/compile-and-dump/Singletons/Operators.ghc80.template
Singletons/Operators.hs:(0,0)-(0,0): Splicing declarations
singletons
[d| child :: Foo -> Foo
child FLeaf = FLeaf
child (a :+: _) = a
(+) :: Nat -> Nat -> Nat
Zero + m = m
(Succ n) + m = Succ (n + m)
data Foo
where
FLeaf :: Foo
(:+:) :: Foo -> Foo -> Foo |]
======>
data Foo
where
FLeaf :: Foo
(:+:) :: Foo -> Foo -> Foo
child :: Foo -> Foo
child FLeaf = FLeaf
child (a :+: _) = a
(+) :: Nat -> Nat -> Nat
(+) Zero m = m
(+) (Succ n) m = Succ (n + m)
type FLeafSym0 = FLeaf
type (:+:$$$) (t :: Foo) (t :: Foo) = (:+:) t t
instance SuppressUnusedWarnings (:+:$$) where
suppressUnusedWarnings _
= snd (GHC.Tuple.(,) (:+:$$###) GHC.Tuple.())
data (:+:$$) (l :: Foo) (l :: TyFun Foo Foo)
= forall arg. KindOf (Apply ((:+:$$) l) arg) ~ KindOf ((:+:$$$) l arg) =>
(:+:$$###)
type instance Apply ((:+:$$) l) l = (:+:$$$) l l
instance SuppressUnusedWarnings (:+:$) where
suppressUnusedWarnings _
= snd (GHC.Tuple.(,) (:+:$###) GHC.Tuple.())
data (:+:$) (l :: TyFun Foo (TyFun Foo Foo -> GHC.Types.Type))
= forall arg. KindOf (Apply (:+:$) arg) ~ KindOf ((:+:$$) arg) =>
(:+:$###)
type instance Apply (:+:$) l = (:+:$$) l
type (:+$$$) (t :: Nat) (t :: Nat) = (:+) t t
instance SuppressUnusedWarnings (:+$$) where
suppressUnusedWarnings _
= snd (GHC.Tuple.(,) (:+$$###) GHC.Tuple.())
data (:+$$) (l :: Nat) (l :: TyFun Nat Nat)
= forall arg. KindOf (Apply ((:+$$) l) arg) ~ KindOf ((:+$$$) l arg) =>
(:+$$###)
type instance Apply ((:+$$) l) l = (:+$$$) l l
instance SuppressUnusedWarnings (:+$) where
suppressUnusedWarnings _
= snd (GHC.Tuple.(,) (:+$###) GHC.Tuple.())
data (:+$) (l :: TyFun Nat (TyFun Nat Nat -> GHC.Types.Type))
= forall arg. KindOf (Apply (:+$) arg) ~ KindOf ((:+$$) arg) =>
(:+$###)
type instance Apply (:+$) l = (:+$$) l
type ChildSym1 (t :: Foo) = Child t
instance SuppressUnusedWarnings ChildSym0 where
suppressUnusedWarnings _
= snd (GHC.Tuple.(,) ChildSym0KindInference GHC.Tuple.())
data ChildSym0 (l :: TyFun Foo Foo)
= forall arg. KindOf (Apply ChildSym0 arg) ~ KindOf (ChildSym1 arg) =>
ChildSym0KindInference
type instance Apply ChildSym0 l = ChildSym1 l
type family (:+) (a :: Nat) (a :: Nat) :: Nat where
(:+) Zero m = m
(:+) (Succ n) m = Apply SuccSym0 (Apply (Apply (:+$) n) m)
type family Child (a :: Foo) :: Foo where
Child FLeaf = FLeafSym0
Child ((:+:) a _z_0123456789) = a
(%:+) ::
forall (t :: Nat) (t :: Nat).
Sing t -> Sing t -> Sing (Apply (Apply (:+$) t) t :: Nat)
sChild ::
forall (t :: Foo). Sing t -> Sing (Apply ChildSym0 t :: Foo)
(%:+) SZero sM
= let
lambda ::
forall m.
(t ~ ZeroSym0, t ~ m) =>
Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat)
lambda m = m
in lambda sM
(%:+) (SSucc sN) sM
= let
lambda ::
forall n m.
(t ~ Apply SuccSym0 n, t ~ m) =>
Sing n -> Sing m -> Sing (Apply (Apply (:+$) t) t :: Nat)
lambda n m
= applySing
(singFun1 (Proxy :: Proxy SuccSym0) SSucc)
(applySing (applySing (singFun2 (Proxy :: Proxy (:+$)) (%:+)) n) m)
in lambda sN sM
sChild SFLeaf
= let
lambda :: t ~ FLeafSym0 => Sing (Apply ChildSym0 t :: Foo)
lambda = SFLeaf
in lambda
sChild ((:%+:) sA _s_z_0123456789)
= let
lambda ::
forall a _z_0123456789.
t ~ Apply (Apply (:+:$) a) _z_0123456789 =>
Sing a -> Sing _z_0123456789 -> Sing (Apply ChildSym0 t :: Foo)
lambda a _z_0123456789 = a
in lambda sA _s_z_0123456789
data instance Sing (z :: Foo)
= z ~ FLeaf => SFLeaf |
forall (n :: Foo) (n :: Foo). z ~ (:+:) n n =>
(:%+:) (Sing (n :: Foo)) (Sing (n :: Foo))
type SFoo = (Sing :: Foo -> GHC.Types.Type)
instance SingKind Foo where
type DemoteRep Foo = Foo
fromSing SFLeaf = FLeaf
fromSing ((:%+:) b b) = (:+:) (fromSing b) (fromSing b)
toSing FLeaf = SomeSing SFLeaf
toSing ((:+:) b b)
= case
GHC.Tuple.(,) (toSing b :: SomeSing Foo) (toSing b :: SomeSing Foo)
of {
GHC.Tuple.(,) (SomeSing c) (SomeSing c) -> SomeSing ((:%+:) c c) }
instance SingI FLeaf where
sing = SFLeaf
instance (SingI n, SingI n) =>
SingI ((:+:) (n :: Foo) (n :: Foo)) where
sing = (:%+:) sing sing