Singletons/Lambdas.hs:(0,0)-(0,0): Splicing declarations singletons [d| foo0 :: a -> b -> a foo0 = (\ x y -> x) foo1 :: a -> b -> a foo1 x = (\ _ -> x) foo2 :: a -> b -> a foo2 x y = (\ _ -> x) y foo3 :: a -> a foo3 x = (\ y -> y) x foo4 :: a -> b -> c -> a foo4 x y z = (\ _ _ -> x) y z foo5 :: a -> b -> b foo5 x y = (\ x -> x) y foo6 :: a -> b -> a foo6 a b = (\ x -> \ _ -> x) a b foo7 :: a -> b -> b foo7 x y = (\ (_, b) -> b) (x, y) foo8 :: Foo a b -> a foo8 x = (\ (Foo a _) -> a) x data Foo a b = Foo a b |] ======> foo0 :: a -> b -> a foo0 = \ x y -> x foo1 :: a -> b -> a foo1 x = \ _ -> x foo2 :: a -> b -> a foo2 x y = (\ _ -> x) y foo3 :: a -> a foo3 x = (\ y -> y) x foo4 :: a -> b -> c -> a foo4 x y z = ((\ _ _ -> x) y) z foo5 :: a -> b -> b foo5 x y = (\ x -> x) y foo6 :: a -> b -> a foo6 a b = ((\ x -> \ _ -> x) a) b foo7 :: a -> b -> b foo7 x y = (\ (_, b) -> b) (x, y) data Foo a b = Foo a b foo8 :: Foo a b -> a foo8 x = (\ (Foo a _) -> a) x type FooSym2 (t0123456789876543210 :: a0123456789876543210) (t0123456789876543210 :: b0123456789876543210) = Foo t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (FooSym1 t0123456789876543210) where suppressUnusedWarnings = snd (((,) FooSym1KindInference) ()) data FooSym1 (t0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210) where FooSym1KindInference :: forall t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (FooSym1 t0123456789876543210) arg) (FooSym2 t0123456789876543210 arg) => FooSym1 t0123456789876543210 t0123456789876543210 type instance Apply (FooSym1 t0123456789876543210) t0123456789876543210 = Foo t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings FooSym0 where suppressUnusedWarnings = snd (((,) FooSym0KindInference) ()) data FooSym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 (Foo a0123456789876543210 b0123456789876543210)) where FooSym0KindInference :: forall t0123456789876543210 arg. SameKind (Apply FooSym0 arg) (FooSym1 arg) => FooSym0 t0123456789876543210 type instance Apply FooSym0 t0123456789876543210 = FooSym1 t0123456789876543210 type family Case_0123456789876543210 x arg_0123456789876543210 t where Case_0123456789876543210 x arg_0123456789876543210 (Foo a _) = a type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y arg_0123456789876543210 t where Case_0123456789876543210 x y arg_0123456789876543210 '(_, b) = b type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 a b x arg_0123456789876543210 t where Case_0123456789876543210 a b x arg_0123456789876543210 _ = x type family Lambda_0123456789876543210 a b x t where Lambda_0123456789876543210 a b x arg_0123456789876543210 = Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a0123456789876543210 b0123456789876543210 x0123456789876543210 arg) => Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 b0123456789876543210 x0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 x0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) x0123456789876543210 = Lambda_0123456789876543210Sym3 b0123456789876543210 a0123456789876543210 x0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 type family Lambda_0123456789876543210 a b t where Lambda_0123456789876543210 a b x = Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x type Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a0123456789876543210 b0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a0123456789876543210 b0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210) arg) (Lambda_0123456789876543210Sym3 a0123456789876543210 b0123456789876543210 arg) => Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 b0123456789876543210 a0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 b0123456789876543210 a0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a0123456789876543210 b0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) arg) (Lambda_0123456789876543210Sym2 a0123456789876543210 arg) => Lambda_0123456789876543210Sym1 a0123456789876543210 b0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a0123456789876543210) b0123456789876543210 = Lambda_0123456789876543210Sym2 a0123456789876543210 b0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a0123456789876543210 = Lambda_0123456789876543210Sym1 a0123456789876543210 type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y x = x type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 t where Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 '(_, _) = x type family Lambda_0123456789876543210 x y z t t where Lambda_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210) type Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym4KindInference) ()) data Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym4KindInference :: forall x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym5 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym4 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210) arg) (Lambda_0123456789876543210Sym4 x0123456789876543210 y0123456789876543210 z0123456789876543210 arg) => Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 z0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 z0123456789876543210 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym4 z0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 z0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 z0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) z0123456789876543210 = Lambda_0123456789876543210Sym3 y0123456789876543210 x0123456789876543210 z0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Lambda_0123456789876543210 x t where Lambda_0123456789876543210 x y = y type Lambda_0123456789876543210Sym2 x0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x y arg_0123456789876543210 t where Case_0123456789876543210 x y arg_0123456789876543210 _ = x type family Lambda_0123456789876543210 x y t where Lambda_0123456789876543210 x y arg_0123456789876543210 = Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 y0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 y0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 y0123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 y0123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 y0123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 y0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 y0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) y0123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 y0123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 t where Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 _ = x type family Lambda_0123456789876543210 x a_0123456789876543210 t where Lambda_0123456789876543210 x a_0123456789876543210 arg_0123456789876543210 = Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210 type Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 x0123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 x0123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 x0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 x0123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall x0123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) arg) (Lambda_0123456789876543210Sym2 x0123456789876543210 arg) => Lambda_0123456789876543210Sym1 x0123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 x0123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 x0123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 x0123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall x0123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 x0123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 x0123456789876543210 = Lambda_0123456789876543210Sym1 x0123456789876543210 type family Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 t t where Lambda_0123456789876543210 a_0123456789876543210 a_0123456789876543210 x y = x type Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 = Lambda_0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym3KindInference) ()) data Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym3KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210) arg) (Lambda_0123456789876543210Sym4 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg) => Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym3 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210 t0123456789876543210 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym2KindInference) ()) data Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 where Lambda_0123456789876543210Sym2KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 type instance Apply (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210) t0123456789876543210 = Lambda_0123456789876543210Sym3 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 t0123456789876543210 instance SuppressUnusedWarnings (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym1KindInference) ()) data Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym1KindInference :: forall a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 arg. SameKind (Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) arg) (Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 arg) => Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 type instance Apply (Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210) a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym2 a_01234567898765432100123456789876543210 a_01234567898765432100123456789876543210 instance SuppressUnusedWarnings Lambda_0123456789876543210Sym0 where suppressUnusedWarnings = snd (((,) Lambda_0123456789876543210Sym0KindInference) ()) data Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 where Lambda_0123456789876543210Sym0KindInference :: forall a_01234567898765432100123456789876543210 arg. SameKind (Apply Lambda_0123456789876543210Sym0 arg) (Lambda_0123456789876543210Sym1 arg) => Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 type instance Apply Lambda_0123456789876543210Sym0 a_01234567898765432100123456789876543210 = Lambda_0123456789876543210Sym1 a_01234567898765432100123456789876543210 type Foo8Sym1 (a0123456789876543210 :: Foo a0123456789876543210 b0123456789876543210) = Foo8 a0123456789876543210 instance SuppressUnusedWarnings Foo8Sym0 where suppressUnusedWarnings = snd (((,) Foo8Sym0KindInference) ()) data Foo8Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) (Foo a0123456789876543210 b0123456789876543210) a0123456789876543210 where Foo8Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo8Sym0 arg) (Foo8Sym1 arg) => Foo8Sym0 a0123456789876543210 type instance Apply Foo8Sym0 a0123456789876543210 = Foo8 a0123456789876543210 type Foo7Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo7Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo7Sym1KindInference) ()) data Foo7Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Foo7Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo7Sym1 a0123456789876543210) arg) (Foo7Sym2 a0123456789876543210 arg) => Foo7Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo7Sym1 a0123456789876543210) a0123456789876543210 = Foo7 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo7Sym0 where suppressUnusedWarnings = snd (((,) Foo7Sym0KindInference) ()) data Foo7Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Foo7Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo7Sym0 arg) (Foo7Sym1 arg) => Foo7Sym0 a0123456789876543210 type instance Apply Foo7Sym0 a0123456789876543210 = Foo7Sym1 a0123456789876543210 type Foo6Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo6 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo6Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo6Sym1KindInference) ()) data Foo6Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo6Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo6Sym1 a0123456789876543210) arg) (Foo6Sym2 a0123456789876543210 arg) => Foo6Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo6Sym1 a0123456789876543210) a0123456789876543210 = Foo6 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo6Sym0 where suppressUnusedWarnings = snd (((,) Foo6Sym0KindInference) ()) data Foo6Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo6Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo6Sym0 arg) (Foo6Sym1 arg) => Foo6Sym0 a0123456789876543210 type instance Apply Foo6Sym0 a0123456789876543210 = Foo6Sym1 a0123456789876543210 type Foo5Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo5 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo5Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo5Sym1KindInference) ()) data Foo5Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 b0123456789876543210 where Foo5Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo5Sym1 a0123456789876543210) arg) (Foo5Sym2 a0123456789876543210 arg) => Foo5Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo5Sym1 a0123456789876543210) a0123456789876543210 = Foo5 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo5Sym0 where suppressUnusedWarnings = snd (((,) Foo5Sym0KindInference) ()) data Foo5Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 b0123456789876543210) where Foo5Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo5Sym0 arg) (Foo5Sym1 arg) => Foo5Sym0 a0123456789876543210 type instance Apply Foo5Sym0 a0123456789876543210 = Foo5Sym1 a0123456789876543210 type Foo4Sym3 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) (a0123456789876543210 :: c0123456789876543210) = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo4Sym2 a0123456789876543210 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo4Sym2KindInference) ()) data Foo4Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) :: forall c0123456789876543210. (~>) c0123456789876543210 a0123456789876543210 where Foo4Sym2KindInference :: forall a0123456789876543210 a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) arg) (Foo4Sym3 a0123456789876543210 a0123456789876543210 arg) => Foo4Sym2 a0123456789876543210 a0123456789876543210 a0123456789876543210 type instance Apply (Foo4Sym2 a0123456789876543210 a0123456789876543210) a0123456789876543210 = Foo4 a0123456789876543210 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo4Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo4Sym1KindInference) ()) data Foo4Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210 c0123456789876543210. (~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210) where Foo4Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo4Sym1 a0123456789876543210) arg) (Foo4Sym2 a0123456789876543210 arg) => Foo4Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo4Sym1 a0123456789876543210) a0123456789876543210 = Foo4Sym2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo4Sym0 where suppressUnusedWarnings = snd (((,) Foo4Sym0KindInference) ()) data Foo4Sym0 :: forall a0123456789876543210 b0123456789876543210 c0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 ((~>) c0123456789876543210 a0123456789876543210)) where Foo4Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo4Sym0 arg) (Foo4Sym1 arg) => Foo4Sym0 a0123456789876543210 type instance Apply Foo4Sym0 a0123456789876543210 = Foo4Sym1 a0123456789876543210 type Foo3Sym1 (a0123456789876543210 :: a0123456789876543210) = Foo3 a0123456789876543210 instance SuppressUnusedWarnings Foo3Sym0 where suppressUnusedWarnings = snd (((,) Foo3Sym0KindInference) ()) data Foo3Sym0 :: forall a0123456789876543210. (~>) a0123456789876543210 a0123456789876543210 where Foo3Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo3Sym0 arg) (Foo3Sym1 arg) => Foo3Sym0 a0123456789876543210 type instance Apply Foo3Sym0 a0123456789876543210 = Foo3 a0123456789876543210 type Foo2Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo2Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo2Sym1KindInference) ()) data Foo2Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo2Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo2Sym1 a0123456789876543210) arg) (Foo2Sym2 a0123456789876543210 arg) => Foo2Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo2Sym1 a0123456789876543210) a0123456789876543210 = Foo2 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo2Sym0 where suppressUnusedWarnings = snd (((,) Foo2Sym0KindInference) ()) data Foo2Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo2Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo2Sym0 arg) (Foo2Sym1 arg) => Foo2Sym0 a0123456789876543210 type instance Apply Foo2Sym0 a0123456789876543210 = Foo2Sym1 a0123456789876543210 type Foo1Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo1Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo1Sym1KindInference) ()) data Foo1Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo1Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo1Sym1 a0123456789876543210) arg) (Foo1Sym2 a0123456789876543210 arg) => Foo1Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo1Sym1 a0123456789876543210) a0123456789876543210 = Foo1 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo1Sym0 where suppressUnusedWarnings = snd (((,) Foo1Sym0KindInference) ()) data Foo1Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo1Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo1Sym0 arg) (Foo1Sym1 arg) => Foo1Sym0 a0123456789876543210 type instance Apply Foo1Sym0 a0123456789876543210 = Foo1Sym1 a0123456789876543210 type Foo0Sym2 (a0123456789876543210 :: a0123456789876543210) (a0123456789876543210 :: b0123456789876543210) = Foo0 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings (Foo0Sym1 a0123456789876543210) where suppressUnusedWarnings = snd (((,) Foo0Sym1KindInference) ()) data Foo0Sym1 (a0123456789876543210 :: a0123456789876543210) :: forall b0123456789876543210. (~>) b0123456789876543210 a0123456789876543210 where Foo0Sym1KindInference :: forall a0123456789876543210 a0123456789876543210 arg. SameKind (Apply (Foo0Sym1 a0123456789876543210) arg) (Foo0Sym2 a0123456789876543210 arg) => Foo0Sym1 a0123456789876543210 a0123456789876543210 type instance Apply (Foo0Sym1 a0123456789876543210) a0123456789876543210 = Foo0 a0123456789876543210 a0123456789876543210 instance SuppressUnusedWarnings Foo0Sym0 where suppressUnusedWarnings = snd (((,) Foo0Sym0KindInference) ()) data Foo0Sym0 :: forall a0123456789876543210 b0123456789876543210. (~>) a0123456789876543210 ((~>) b0123456789876543210 a0123456789876543210) where Foo0Sym0KindInference :: forall a0123456789876543210 arg. SameKind (Apply Foo0Sym0 arg) (Foo0Sym1 arg) => Foo0Sym0 a0123456789876543210 type instance Apply Foo0Sym0 a0123456789876543210 = Foo0Sym1 a0123456789876543210 type family Foo8 (a :: Foo a b) :: a where Foo8 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x type family Foo7 (a :: a) (a :: b) :: b where Foo7 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) (Apply (Apply Tuple2Sym0 x) y) type family Foo6 (a :: a) (a :: b) :: a where Foo6 a b = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) a) b type family Foo5 (a :: a) (a :: b) :: b where Foo5 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y type family Foo4 (a :: a) (a :: b) (a :: c) :: a where Foo4 x y z = Apply (Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z) y) z type family Foo3 (a :: a) :: a where Foo3 x = Apply (Apply Lambda_0123456789876543210Sym0 x) x type family Foo2 (a :: a) (a :: b) :: a where Foo2 x y = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) y type family Foo1 (a :: a) (a :: b) :: a where Foo1 x a_0123456789876543210 = Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210) a_0123456789876543210 type family Foo0 (a :: a) (a :: b) :: a where Foo0 a_0123456789876543210 a_0123456789876543210 = Apply (Apply (Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210) a_0123456789876543210) a_0123456789876543210 sFoo8 :: forall a b (t :: Foo a b). Sing t -> Sing (Apply Foo8Sym0 t :: a) sFoo7 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo7Sym0 t) t :: b) sFoo6 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo6Sym0 t) t :: a) sFoo5 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo5Sym0 t) t :: b) sFoo4 :: forall a b c (t :: a) (t :: b) (t :: c). Sing t -> Sing t -> Sing t -> Sing (Apply (Apply (Apply Foo4Sym0 t) t) t :: a) sFoo3 :: forall a (t :: a). Sing t -> Sing (Apply Foo3Sym0 t :: a) sFoo2 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo2Sym0 t) t :: a) sFoo1 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo1Sym0 t) t :: a) sFoo0 :: forall a b (t :: a) (t :: b). Sing t -> Sing t -> Sing (Apply (Apply Foo0Sym0 t) t :: a) sFoo8 (sX :: Sing x) = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { SFoo (sA :: Sing a) _ -> sA }) :: Sing (Case_0123456789876543210 x arg_0123456789876543210 arg_0123456789876543210) }))) sX sFoo7 (sX :: Sing x) (sY :: Sing y) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { STuple2 _ (sB :: Sing b) -> sB }) :: Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) ((applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sX)) sY) sFoo6 (sA :: Sing a) (sB :: Sing b) = (applySing ((applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 a) b)) (\ sX -> case sX of { (_ :: Sing x) -> (singFun1 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 a) b) x)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 a b x arg_0123456789876543210 arg_0123456789876543210) }) }))) sA)) sB sFoo5 (sX :: Sing x) (sY :: Sing y) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sX -> case sX of { (_ :: Sing x) -> sX }))) sY sFoo4 (sX :: Sing x) (sY :: Sing y) (sZ :: Sing z) = (applySing ((applySing ((singFun2 @(Apply (Apply (Apply Lambda_0123456789876543210Sym0 x) y) z)) (\ sArg_0123456789876543210 sArg_0123456789876543210 -> case ((,) sArg_0123456789876543210) sArg_0123456789876543210 of { (,) (_ :: Sing arg_0123456789876543210) (_ :: Sing arg_0123456789876543210) -> (case (applySing ((applySing ((singFun2 @Tuple2Sym0) STuple2)) sArg_0123456789876543210)) sArg_0123456789876543210 of { STuple2 _ _ -> sX }) :: Sing (Case_0123456789876543210 x y z arg_0123456789876543210 arg_0123456789876543210 (Apply (Apply Tuple2Sym0 arg_0123456789876543210) arg_0123456789876543210)) }))) sY)) sZ sFoo3 (sX :: Sing x) = (applySing ((singFun1 @(Apply Lambda_0123456789876543210Sym0 x)) (\ sY -> case sY of { (_ :: Sing y) -> sY }))) sX sFoo2 (sX :: Sing x) (sY :: Sing y) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) y)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 x y arg_0123456789876543210 arg_0123456789876543210) }))) sY sFoo1 (sX :: Sing x) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((singFun1 @(Apply (Apply Lambda_0123456789876543210Sym0 x) a_0123456789876543210)) (\ sArg_0123456789876543210 -> case sArg_0123456789876543210 of { (_ :: Sing arg_0123456789876543210) -> (case sArg_0123456789876543210 of { _ -> sX }) :: Sing (Case_0123456789876543210 x arg_0123456789876543210 a_0123456789876543210 arg_0123456789876543210) }))) sA_0123456789876543210 sFoo0 (sA_0123456789876543210 :: Sing a_0123456789876543210) (sA_0123456789876543210 :: Sing a_0123456789876543210) = (applySing ((applySing ((singFun2 @(Apply (Apply Lambda_0123456789876543210Sym0 a_0123456789876543210) a_0123456789876543210)) (\ sX sY -> case ((,) sX) sY of { (,) (_ :: Sing x) (_ :: Sing y) -> sX }))) sA_0123456789876543210)) sA_0123456789876543210 instance SingI (Foo8Sym0 :: (~>) (Foo a b) a) where sing = (singFun1 @Foo8Sym0) sFoo8 instance SingI (Foo7Sym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @Foo7Sym0) sFoo7 instance SingI d => SingI (Foo7Sym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(Foo7Sym1 (d :: a))) (sFoo7 (sing @d)) instance SingI (Foo6Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo6Sym0) sFoo6 instance SingI d => SingI (Foo6Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo6Sym1 (d :: a))) (sFoo6 (sing @d)) instance SingI (Foo5Sym0 :: (~>) a ((~>) b b)) where sing = (singFun2 @Foo5Sym0) sFoo5 instance SingI d => SingI (Foo5Sym1 (d :: a) :: (~>) b b) where sing = (singFun1 @(Foo5Sym1 (d :: a))) (sFoo5 (sing @d)) instance SingI (Foo4Sym0 :: (~>) a ((~>) b ((~>) c a))) where sing = (singFun3 @Foo4Sym0) sFoo4 instance SingI d => SingI (Foo4Sym1 (d :: a) :: (~>) b ((~>) c a)) where sing = (singFun2 @(Foo4Sym1 (d :: a))) (sFoo4 (sing @d)) instance (SingI d, SingI d) => SingI (Foo4Sym2 (d :: a) (d :: b) :: (~>) c a) where sing = (singFun1 @(Foo4Sym2 (d :: a) (d :: b))) ((sFoo4 (sing @d)) (sing @d)) instance SingI (Foo3Sym0 :: (~>) a a) where sing = (singFun1 @Foo3Sym0) sFoo3 instance SingI (Foo2Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo2Sym0) sFoo2 instance SingI d => SingI (Foo2Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo2Sym1 (d :: a))) (sFoo2 (sing @d)) instance SingI (Foo1Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo1Sym0) sFoo1 instance SingI d => SingI (Foo1Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo1Sym1 (d :: a))) (sFoo1 (sing @d)) instance SingI (Foo0Sym0 :: (~>) a ((~>) b a)) where sing = (singFun2 @Foo0Sym0) sFoo0 instance SingI d => SingI (Foo0Sym1 (d :: a) :: (~>) b a) where sing = (singFun1 @(Foo0Sym1 (d :: a))) (sFoo0 (sing @d)) data instance Sing :: Foo a b -> GHC.Types.Type where SFoo :: forall a b (n :: a) (n :: b). (Sing (n :: a)) -> (Sing (n :: b)) -> Sing (Foo n n) type SFoo = (Sing :: Foo a b -> GHC.Types.Type) instance (SingKind a, SingKind b) => SingKind (Foo a b) where type Demote (Foo a b) = Foo (Demote a) (Demote b) fromSing (SFoo b b) = (Foo (fromSing b)) (fromSing b) toSing (Foo (b :: Demote a) (b :: Demote b)) = case ((,) (toSing b :: SomeSing a)) (toSing b :: SomeSing b) of { (,) (SomeSing c) (SomeSing c) -> SomeSing ((SFoo c) c) } instance (SingI n, SingI n) => SingI (Foo (n :: a) (n :: b)) where sing = (SFoo sing) sing instance SingI (FooSym0 :: (~>) a ((~>) b (Foo a b))) where sing = (singFun2 @FooSym0) SFoo instance SingI (TyCon2 Foo :: (~>) a ((~>) b (Foo a b))) where sing = (singFun2 @(TyCon2 Foo)) SFoo instance SingI d => SingI (FooSym1 (d :: a) :: (~>) b (Foo a b)) where sing = (singFun1 @(FooSym1 (d :: a))) (SFoo (sing @d)) instance SingI d => SingI (TyCon1 (Foo (d :: a)) :: (~>) b (Foo a b)) where sing = (singFun1 @(TyCon1 (Foo (d :: a)))) (SFoo (sing @d))